Emi/aviary-ps
1
0
Fork 0
Code Issues Pull requests Releases Activity

Partially sequentialize code for loading adjacent images on focus

Browse source
This commit is contained in:
Emi Simpson 2022-11-16 17:12:53 -05:00
parent b9803d260b
commit 4d8d6ee8e0
Signed by: Emi
GPG key ID: A12F2C2FFDC3D847
2 changed files with 30 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
spago.dhall
View file

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

41
src/UI.purs
View file

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