Refactored the model, preventing redundant requests of full images

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

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) =

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)))