118 lines
4.2 KiB
Plaintext
118 lines
4.2 KiB
Plaintext
module Aviary.UI where
|
|
|
|
import Prelude
|
|
|
|
import Aviary.Logic (fetchFull, fetchThumb)
|
|
import Aviary.Model ( fullOrBlurhash
|
|
, GalleryError(..)
|
|
, Image
|
|
, ImageData(..)
|
|
, Model(..)
|
|
, thumbOrBlurhash
|
|
)
|
|
|
|
import Control.Parallel (parSequence_)
|
|
import Data.Array (index, mapWithIndex, modifyAt)
|
|
import Data.Maybe (maybe, Maybe(..))
|
|
import Effect.Aff (Aff)
|
|
import Halogen as H
|
|
import Halogen.HTML as HH
|
|
import Halogen.HTML.Events as HE
|
|
import Halogen.HTML.Properties as HP
|
|
import Web.HTML.Common (ClassName(..))
|
|
|
|
data Event = LoadThumbs
|
|
| ThumbLoaded Int ImageData
|
|
| FullLoaded Int ImageData
|
|
| Focus Int
|
|
|
|
component :: forall query input. Model -> H.Component query input Event Aff
|
|
component initialState = H.mkComponent
|
|
{ initialState: \_ -> initialState
|
|
, render
|
|
, eval: H.mkEval $ H.defaultEval { handleAction = update, initialize = Just LoadThumbs }
|
|
}
|
|
|
|
renderThumbnail :: forall m. Int -> Image -> H.ComponentHTML Event () m
|
|
renderThumbnail pos image =
|
|
HH.div
|
|
[ HP.class_ $ ClassName "thumbnail-card"
|
|
, HE.onClick \_ -> Focus pos
|
|
]
|
|
( [ HH.img
|
|
( [ HP.width 400
|
|
, HP.height 400
|
|
] <> maybe [] (HP.src >>> pure) (thumbOrBlurhash image))
|
|
] <> case image.thumb of
|
|
Unloaded _ -> [HH.p_ [HH.text "Loading..."]]
|
|
IError e -> [HH.p_ [HH.text $ "Error! " <> (show e)]]
|
|
_ -> []
|
|
)
|
|
|
|
renderFocused :: forall m. Image -> H.ComponentHTML Event () m
|
|
renderFocused image =
|
|
HH.div
|
|
[ HP.class_ $ ClassName "focused-panel"
|
|
, HP.class_ $ ClassName "visible"
|
|
]
|
|
( [ HH.img $
|
|
maybe [] (HP.src >>> pure) (fullOrBlurhash image)
|
|
] <> case image.full of
|
|
Unloaded _ -> [HH.p_ [HH.text "Loading..."]]
|
|
IError e -> [HH.p_ [HH.text $ "Error! " <> (show e)]]
|
|
_ -> []
|
|
)
|
|
|
|
setImage :: (Image -> Image) -> Int -> Model -> Model
|
|
setImage _ _ (GError e) = (GError e)
|
|
setImage tranformation pos (GLoaded gallery) =
|
|
case modifyAt pos tranformation gallery.images of
|
|
Just newImages -> GLoaded gallery{images = newImages}
|
|
Nothing -> GError $ UnexpectedError "setImage called with an out of bounds index!"
|
|
|
|
setThumb :: ImageData -> Int -> Model -> Model
|
|
setThumb newThumb = setImage \i -> i{thumb = newThumb}
|
|
|
|
setFull :: ImageData -> Int -> Model -> Model
|
|
setFull newImage = setImage \i -> i{full = newImage}
|
|
|
|
fetchThumbAction :: Int -> Image -> H.HalogenM Model Event () Event Aff Unit
|
|
fetchThumbAction position image = do
|
|
newData <- H.liftAff $ fetchThumb image
|
|
update $ ThumbLoaded position newData
|
|
|
|
fetchFullAction :: Int -> Image -> H.HalogenM Model Event () Event Aff Unit
|
|
fetchFullAction position image = do
|
|
newData <- H.liftAff $ fetchFull image
|
|
update $ FullLoaded position newData
|
|
|
|
update :: Event -> H.HalogenM Model Event () Event Aff Unit
|
|
update LoadThumbs = do
|
|
model <- H.get
|
|
case model of
|
|
GError _ -> pure unit
|
|
GLoaded {images} -> parSequence_ $ mapWithIndex fetchThumbAction images
|
|
update (ThumbLoaded pos newData) = H.modify_ $ setThumb newData pos
|
|
update (FullLoaded pos newData) = H.modify_ $ setFull newData pos
|
|
update (Focus newFocus) = do
|
|
_ <- H.modify_ \model -> case model of
|
|
GError e -> GError e
|
|
GLoaded gal -> GLoaded gal{ focus = Just newFocus }
|
|
model <- H.get
|
|
case model of
|
|
GError _ -> pure unit
|
|
GLoaded gal ->
|
|
let focusedImage = index gal.images newFocus
|
|
in case focusedImage of
|
|
Just focusedImage' -> fetchFullAction newFocus focusedImage'
|
|
Nothing ->
|
|
H.put $ GError $ UnexpectedError "Focus event raised with an out of bounds index!"
|
|
|
|
render :: forall m. Model -> H.ComponentHTML Event () m
|
|
render (GError e) = HH.p_ [ HH.text $ show e ]
|
|
render (GLoaded {title, desc, images, focus}) = HH.div_
|
|
((maybe [] (HH.text >>> pure >>> HH.h1_ >>> pure) title) <>
|
|
(maybe [] (HH.text >>> pure >>> HH.p_ >>> pure) desc) <>
|
|
(mapWithIndex renderThumbnail images) <>
|
|
(maybe [] (renderFocused >>> pure) (index images =<< focus)))
|