Partially sequentialize code for loading adjacent images on focus

spago.dhall

@@ -25,6 +25,7 @@ to generate this file without the comments in this block.
   , "exceptions"
   , "fetch"
   , "filterable"
+  , "foldable-traversable"
   , "free"
   , "halogen"
   , "maybe"

src/UI.purs

@@ -13,6 +13,7 @@ import Aviary.Model ( GalleryError(..)
 import Control.Parallel (parSequence_)
 import Control.Monad.Free (liftF)
 import Data.Array (index, length, mapWithIndex, modifyAt)
+import Data.Foldable (fold)
 import Data.Maybe (fromMaybe, maybe, Maybe(..))
 import Data.Tuple (Tuple(..))
 import Data.Time.Duration (Milliseconds(..))
@@ -196,12 +197,26 @@ focusedIndex :: Model -> Maybe Int
 focusedIndex (GLoaded { focus: Just { imageIndex } }) = Just imageIndex
 focusedIndex _ = Nothing
 
+data AffectKind
+    = Parallel (Array (Aff Event))
+    | Seq (Array (Aff Event))
+    | Single (Aff Event)
+
+affArray :: AffectKind -> Array (Aff Event)
+affArray (Parallel a) = a
+affArray (Seq a) = a
+affArray (Single a) = [a]
+
+isParallel :: AffectKind -> Boolean
+isParallel (Parallel _) = true
+isParallel _ = false
+
 data UpdateResult
     = Modify Model
-    | Affect (Array (Aff Event))
+    | Affect AffectKind
-    | Both (Array (Aff Event)) Model
+    | Both AffectKind Model
-updateResultToTuple :: Model -> UpdateResult -> Tuple (Array (Aff Event)) Model
+updateResultToTuple :: Model -> UpdateResult -> Tuple AffectKind Model
-updateResultToTuple _ (Modify m) = Tuple [] m
+updateResultToTuple _ (Modify m) = Tuple (Seq []) m
 updateResultToTuple m (Affect a) = Tuple a m
 updateResultToTuple _ (Both a m) = Tuple a m
 
@@ -214,15 +229,17 @@ wrapUpdate _ RegisterListeners = do
         (HTMLDocument.toEventTarget document)
         (KE.fromEvent >>> (=<<) eventByKey)
 wrapUpdate inner event = do
-    affects <- H.HalogenM $ liftF $ HM.State (\m -> updateResultToTuple m $ update' event m)
+    affects <- H.HalogenM $ liftF $ HM.State (\m -> updateResultToTuple m $ inner event m)
     let wrapAff :: Aff Event -> H.HalogenM Model Event () Event Aff Unit
         wrapAff = H.liftAff >>> (=<<) (wrapUpdate inner)
-    parSequence_ $ affects <#> wrapAff
+    let runArray :: Array (H.HalogenM Model Event () Event Aff Unit) -> H.HalogenM Model Event () Event Aff Unit
+        runArray = if isParallel affects then parSequence_ else fold
+    runArray $ (affArray affects) <#> wrapAff
 
 update' :: Event -> Model -> UpdateResult
-update' Init _ = Affect $ [RegisterListeners, LoadThumbs] <#> pure
+update' Init _ = Affect $ Seq $ [RegisterListeners, LoadThumbs] <#> pure
 update' LoadThumbs (GLoaded {images}) =
-    Affect $ mapWithIndex fetchThumbAction images
+    Affect $ Parallel $ mapWithIndex fetchThumbAction images
 update' (ImgUpdate isThumb pos newData) (GLoaded gal) =
     let newGallery = (if isThumb then setThumb else setFull) newData pos gal
         updatedImage = case newGallery of
@@ -233,11 +250,11 @@ update' (ImgUpdate isThumb pos newData) (GLoaded gal) =
             _ <- delay failCooldown
             fetch pos img
     in case newData, updatedImage of
-        (Retrying _ _), Just img -> Both [retryAction img] newGallery
+        (Retrying _ _), Just img -> Both (Single $ retryAction img) newGallery
         _, Nothing -> Modify $ GError $ UnexpectedError $ "Suprising out of bound index!"
         _, (Just _) -> Modify newGallery -- No fetch required
 update' (Focus imageIndex) (GLoaded gal) = Both
-    ([DownloadImage >>> pure] <*> [imageIndex, imageIndex + 1, imageIndex - 1])
+    (Seq ([DownloadImage >>> pure] <*> [imageIndex, imageIndex + 1, imageIndex - 1]))
     (GLoaded gal{ focus = Just { imageIndex, zoom: false } })
 update' Unfocus (GLoaded gal) = Modify $ GLoaded gal{ focus = Nothing }
 update' Zoom (GLoaded gal) = Modify $ GLoaded gal{ focus = gal.focus <#> _{ zoom = true } }
@@ -246,7 +263,7 @@ update' (Pan right) (GLoaded gal@{images, focus: Just { imageIndex }}) =
     let offset = if right then 1 else -1
         newImageIndex = mod (imageIndex + offset) (length images) in
     Both
-        [ pure $ DownloadImage $ (offset + newImageIndex) ]
+        (Single $ pure $ DownloadImage $ (offset + newImageIndex))
         (GLoaded gal{ focus = Just {imageIndex: newImageIndex, zoom: false }})
 update' (DownloadImage indx) (GLoaded gal@{ images }) =
     let revisedIndex = mod indx (length images)
@@ -254,7 +271,7 @@ update' (DownloadImage indx) (GLoaded gal@{ images }) =
     case maybeImageData of
         Just imageData -> case modifyAt revisedIndex _{full = Loading} images of
             Just newImages -> Both
-                [fetchFullAction revisedIndex imageData]
+                (Single $ fetchFullAction revisedIndex imageData)
                 (GLoaded gal{ images = newImages })
             Nothing -> Modify $ GError $ UnexpectedError "Valid position asserted by index and module declared invalid by index"
         Nothing -> Modify $ GError $ UnexpectedError "Despite taking the modulo, still invalid index"