diff --git a/src/Logic.purs b/src/Logic.purs index 63a6da9..d17f45a 100644 --- a/src/Logic.purs +++ b/src/Logic.purs @@ -65,7 +65,12 @@ convertIndexFromProtobuf protoindex = let {right: images, left: imagesErrors} = partitionMap convertImageFromProtobuf protoindex'.images in case head imagesErrors of - Nothing -> GLoaded protoindex'.title protoindex'.desc images Nothing + Nothing -> GLoaded + { title: protoindex'.title + , desc: protoindex'.desc + , images + , focus: Nothing + } Just err -> GError err parseIndex :: ArrayBuffer -> Effect Model diff --git a/src/Model.purs b/src/Model.purs index 5e9dbfb..b641102 100644 --- a/src/Model.purs +++ b/src/Model.purs @@ -5,7 +5,7 @@ import Prelude import AviaryFormat.Format (Format(..)) as Format import Crypto.Subtle.Key.Types (CryptoKey) -import Data.Maybe (Maybe(..)) +import Data.Maybe (Maybe) import Effect.Aff (Aff) data GalleryError @@ -43,13 +43,16 @@ type Image = , full :: ImageData } +type LoadedGallery = + { title :: Maybe String + , desc :: Maybe String + , images :: Array Image + , focus :: Maybe Int + } + data Model = GError GalleryError - | GLoaded - (Maybe String) -- Title - (Maybe String) -- Description - (Array Image) -- Images - (Maybe Image) -- Focused image + | GLoaded LoadedGallery instance showGalleryError :: Show GalleryError where show (UnexpectedError message) = diff --git a/src/UI.purs b/src/UI.purs index 1508e3f..ee6cb8e 100644 --- a/src/UI.purs +++ b/src/UI.purs @@ -6,7 +6,7 @@ import Aviary.Logic (fetchFull, fetchThumb) import Aviary.Model (GalleryError(..), Image, ImageData(..), Model(..)) import Control.Parallel (parSequence_) -import Data.Array (mapWithIndex, modifyAt) +import Data.Array (index, mapWithIndex, modifyAt) import Data.Maybe (maybe, Maybe(..)) import Effect.Aff (Aff) import Halogen as H @@ -17,7 +17,8 @@ import Web.HTML.Common (ClassName(..)) data Event = LoadThumbs | ThumbLoaded Int ImageData - | Focus Image + | FullLoaded Int ImageData + | Focus Int component :: forall query input. Model -> H.Component query input Event Aff component initialState = H.mkComponent @@ -29,11 +30,11 @@ component initialState = H.mkComponent 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 = +renderThumbnail :: forall m. Int -> Image -> H.ComponentHTML Event () m +renderThumbnail pos image = HH.div [ HP.class_ $ ClassName "thumbnail-card" - , HE.onClick \_ -> Focus image + , HE.onClick \_ -> Focus pos ] ( [ HH.img ( [ placeholderBlurhash image.blurhash @@ -67,42 +68,55 @@ renderFocused {blurhash, full} = _ -> [] ) -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 +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 pos newData -update (Focus newFocus) = - ( H.modify_ \model -> case model of + 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 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}) - ) + 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_ +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)) + (mapWithIndex renderThumbnail images) <> + (maybe [] (renderFocused >>> pure) (index images =<< focus)))