Added primitive rendering of a focused element

src/Logic.purs

@@ -1,7 +1,7 @@
 module Aviary.Logic where
 
 import Prelude
-import AviaryFormat.Format (Format, Image, Index, parseIndex) as Format
+import AviaryFormat.Format (Format(..), Image, Index, parseIndex) as Format
 import Aviary.FFI (arrayBufferToBlob, nonce)
 import Aviary.Model (formatToMime, GalleryError(..), Image, ImageData(..), ImageError(..), Model(..))
 
@@ -65,7 +65,7 @@ convertIndexFromProtobuf protoindex =
     let {right: images, left: imagesErrors} = partitionMap convertImageFromProtobuf protoindex'.images
     in
     case head imagesErrors of
-        Nothing -> GLoaded protoindex'.title protoindex'.desc images
+        Nothing -> GLoaded protoindex'.title protoindex'.desc images Nothing
         Just err -> GError err
 
 parseIndex :: ArrayBuffer -> Effect Model
@@ -90,13 +90,19 @@ fetchImageAsBlobUrl nonce format key fileID = do
         404 -> pure $ IError ImageNotFound
         s -> pure $ IError $ if s / 100 == 5 then MinorServerError else UnknownStatusCodeForImage s
 
-fetchThumb :: Image -> Aff ImageData
+_fetchImg :: ImageData -> Format.Format -> Aff CryptoKey -> Aff ImageData
-fetchThumb image = case image.thumb of
+_fetchImg imgdata format cryptokey = case imgdata of
     Unloaded fileID -> do
-        key <- image.key
+        key <- cryptokey
-        fetchImageAsBlobUrl nonce image.format key fileID
+        fetchImageAsBlobUrl nonce format key fileID
     loadedOrError -> pure loadedOrError
 
+fetchThumb :: Image -> Aff ImageData
+fetchThumb image = _fetchImg image.thumb Format.Format_WEBP image.key
+
+fetchFull :: Image -> Aff ImageData
+fetchFull image = _fetchImg image.full image.format image.key
+
 fetch_gallery_from_page_info :: Aff Model
 fetch_gallery_from_page_info = do
     urlInfo <- liftEffect do

src/Model.purs

@@ -49,6 +49,7 @@ data Model
         (Maybe String) -- Title
         (Maybe String) -- Description
         (Array Image) -- Images
+        (Maybe Image) -- Focused image
 
 instance showGalleryError :: Show GalleryError where
     show (UnexpectedError message) =

src/UI.purs

@@ -2,7 +2,7 @@ module Aviary.UI where
 
 import Prelude
 
-import Aviary.Logic (fetchThumb)
+import Aviary.Logic (fetchFull, fetchThumb)
 import Aviary.Model (GalleryError(..), Image, ImageData(..), Model(..))
 
 import Control.Parallel (parSequence_)
@@ -11,11 +11,13 @@ 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
@@ -28,28 +30,47 @@ 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 {blurhash, thumb} =
+renderThumbnail image =
     HH.div
         [ HP.class_ $ ClassName "thumbnail-card"
+        , HE.onClick \_ -> Focus image
         ]
         ( [ HH.img
-            ( [ placeholderBlurhash blurhash
+            ( [ placeholderBlurhash image.blurhash
                 , HP.width 400
                 , HP.height 400
-            ] <> case thumb of
+            ] <> case image.thumb of
                 ILoaded url -> [HP.src url]
                 _ -> []
             )
-        ] <> case thumb of
+        ] <> 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) =
+setThumb pos newThumb (GLoaded title desc images focus) =
     case modifyAt pos (\i -> i{thumb=newThumb}) images of
-        Just newImages -> GLoaded title desc newImages
+        Just newImages -> GLoaded title desc newImages focus
         Nothing -> GError $ UnexpectedError "setThumb called with an invalid index!"
 setThumb _ _ model = model
 
@@ -63,12 +84,25 @@ update LoadThumbs = do
     model <- H.get
     case model of
         GError _ -> pure unit
-        GLoaded _ _ images -> parSequence_ $ mapWithIndex fetchThumbAction images
+        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) = 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))
+    (renderThumbnail <$> images) <>
+    (maybe [] (renderFocused >>> pure) focus))