Fix UnexpectedError in image update event handling
This commit is contained in:
parent
66f2e69026
commit
40757cbe6a
12
src/UI.purs
12
src/UI.purs
|
@ -34,7 +34,7 @@ failCooldown :: Milliseconds
|
||||||
failCooldown = Milliseconds 10000.0
|
failCooldown = Milliseconds 10000.0
|
||||||
|
|
||||||
data Event = LoadThumbs
|
data Event = LoadThumbs
|
||||||
| ImgLoaded Boolean Int ImageData -- isThumb, index, data
|
| ImgUpdate Boolean Int ImageData -- isThumb, index, data
|
||||||
| Focus Int
|
| Focus Int
|
||||||
| Unfocus
|
| Unfocus
|
||||||
| Zoom
|
| Zoom
|
||||||
|
@ -179,10 +179,10 @@ setFull :: ImageData -> Int -> LoadedGallery -> Model
|
||||||
setFull newImage = setImage \i -> i{full = newImage}
|
setFull newImage = setImage \i -> i{full = newImage}
|
||||||
|
|
||||||
fetchThumbAction :: Int -> Image -> Aff Event
|
fetchThumbAction :: Int -> Image -> Aff Event
|
||||||
fetchThumbAction position image = fetchThumb image <#> ImgLoaded true position
|
fetchThumbAction position image = fetchThumb image <#> ImgUpdate true position
|
||||||
|
|
||||||
fetchFullAction :: Int -> Image -> Aff Event
|
fetchFullAction :: Int -> Image -> Aff Event
|
||||||
fetchFullAction position image = fetchFull image <#> ImgLoaded false position
|
fetchFullAction position image = fetchFull image <#> ImgUpdate false position
|
||||||
|
|
||||||
eventByKey :: KE.KeyboardEvent -> Maybe Event
|
eventByKey :: KE.KeyboardEvent -> Maybe Event
|
||||||
eventByKey ev = case KE.key ev of
|
eventByKey ev = case KE.key ev of
|
||||||
|
@ -223,7 +223,7 @@ update' :: Event -> Model -> UpdateResult
|
||||||
update' Init _ = Affect $ [RegisterListeners, LoadThumbs] <#> pure
|
update' Init _ = Affect $ [RegisterListeners, LoadThumbs] <#> pure
|
||||||
update' LoadThumbs (GLoaded {images}) =
|
update' LoadThumbs (GLoaded {images}) =
|
||||||
Affect $ mapWithIndex fetchThumbAction images
|
Affect $ mapWithIndex fetchThumbAction images
|
||||||
update' (ImgLoaded 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
|
||||||
(GLoaded {images}) -> index images pos
|
(GLoaded {images}) -> index images pos
|
||||||
|
@ -234,10 +234,8 @@ update' (ImgLoaded isThumb pos newData) (GLoaded gal) =
|
||||||
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 [retryAction img] newGallery
|
||||||
(IError _), _ -> Modify newGallery
|
|
||||||
(ILoaded _), _ -> Modify newGallery
|
|
||||||
_, Nothing -> Modify $ GError $ UnexpectedError $ "Suprising out of bound index!"
|
_, Nothing -> Modify $ GError $ UnexpectedError $ "Suprising out of bound index!"
|
||||||
weirdData, _ -> Modify $ GError $ UnexpectedError $ "Strange newData passed in ImgLoaded event: " <> show weirdData <> " Please open an issue on our issue tracker!"
|
_, (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])
|
([DownloadImage >>> pure] <*> [imageIndex, imageIndex - 1, imageIndex + 1])
|
||||||
(GLoaded gal{ focus = Just { imageIndex, zoom: false } })
|
(GLoaded gal{ focus = Just { imageIndex, zoom: false } })
|
||||||
|
|
Loading…
Reference in New Issue