module Aviary.UI where import Prelude import Aviary.Logic (fetchFull, fetchThumb) import Aviary.Model (GalleryError(..), Image, ImageData(..), Model(..)) import Control.Parallel (parSequence_) import Data.Array (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 | Focus Image 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 } } placeholderBlurhash :: forall r i. String -> HH.IProp r i placeholderBlurhash = HH.attr (HH.AttrName "data-blurhash") renderThumbnail :: forall m. Image -> H.ComponentHTML Event () m renderThumbnail image = HH.div [ HP.class_ $ ClassName "thumbnail-card" , HE.onClick \_ -> Focus image ] ( [ HH.img ( [ placeholderBlurhash image.blurhash , HP.width 400 , HP.height 400 ] <> case image.thumb of ILoaded url -> [HP.src url] _ -> [] ) ] <> 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 {blurhash, full} = HH.div [ HP.class_ $ ClassName "focused-panel" , HP.class_ $ ClassName "visible" ] ( [ HH.img ( [ placeholderBlurhash blurhash ] <> case full of ILoaded url -> [HP.src url] _ -> [] ) ] <> case full of Unloaded _ -> [HH.p_ [HH.text "Loading..."]] IError e -> [HH.p_ [HH.text $ "Error! " <> (show e)]] _ -> [] ) setThumb :: Int -> ImageData -> Model -> Model setThumb pos newThumb (GLoaded title desc images focus) = case modifyAt pos (\i -> i{thumb=newThumb}) images of Just newImages -> GLoaded title desc newImages focus Nothing -> GError $ UnexpectedError "setThumb called with an invalid index!" setThumb _ _ model = model fetchThumbAction :: Int -> Image -> H.HalogenM Model Event () Event Aff Unit fetchThumbAction position image = do newData <- H.liftAff $ fetchThumb image update $ ThumbLoaded 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 pos newData update (Focus newFocus) = ( H.modify_ \model -> case model of GError e -> GError e GLoaded title desc images _ -> GLoaded title desc images (Just newFocus) ) <> ( do newData <- H.liftAff $ fetchFull newFocus H.modify_ \m -> case m of GError e -> GError e GLoaded title desc images Nothing -> GLoaded title desc images Nothing GLoaded title desc images (Just focus) -> GLoaded title desc images (Just focus{full=newData}) ) 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) <> (renderThumbnail <$> images) <> (maybe [] (renderFocused >>> pure) focus))