Added thumbnail rendering!!!

spago.dhall

@@ -23,7 +23,6 @@ to generate this file without the comments in this block.
   , "either"
   , "fetch"
   , "filterable"
-  , "foldable-traversable"
   , "halogen"
   , "maybe"
   , "newtype"

src/Logic.purs

@@ -90,6 +90,13 @@ 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
+fetchThumb image = case image.thumb of
+    Unloaded fileID -> do
+        key <- image.key
+        fetchImageAsBlobUrl nonce image.format key fileID
+    loadedOrError -> pure loadedOrError
+
 fetch_gallery_from_page_info :: Aff Model
 fetch_gallery_from_page_info = do
     urlInfo <- liftEffect do

src/Model.purs

@@ -9,7 +9,8 @@ import Data.Maybe (Maybe(..))
 import Effect.Aff (Aff)
 
 data GalleryError
-    = ServerError
+    = UnexpectedError String
+    | ServerError
     | NotFound
     | MalformedKey
     | DecryptFailed
@@ -29,6 +30,11 @@ data ImageData
     | ILoaded String -- blob url of decrypted image
     | IError ImageError
 
+instance showImageData :: Show ImageData where
+    show (Unloaded fileID) = "Unloaded Image with fileID " <> fileID
+    show (ILoaded url) = "image: " <> url
+    show (IError e) = "error loading image: " <> (show e)
+
 type Image =
     { key :: Aff CryptoKey
     , blurhash :: String
@@ -45,6 +51,10 @@ data Model
         (Array Image) -- Images
 
 instance showGalleryError :: Show GalleryError where
+    show (UnexpectedError message) =
+        "Something that should be impossible just happened!  Please open up a new issue "
+        <> "on our issue tracker to let us know, so that we can stop it from happening "
+        <> "in the future.  The thing that happened was:  " <> message
     show ServerError =
         "The server is experiencing issues at the minute.  Please try again later, or if "
         <> "it keeps up, make a report to the server owner."

src/UI.purs

@@ -2,22 +2,26 @@ module Aviary.UI where
 
 import Prelude
 
-import Aviary.Model (Image, ImageData(..), Model(..))
+import Aviary.Logic (fetchThumb)
+import Aviary.Model (GalleryError(..), Image, ImageData(..), Model(..))
 
-import Data.Maybe (maybe)
+import Control.Parallel (parSequence_)
+import Data.Array (mapWithIndex, modifyAt)
+import Data.Maybe (maybe, Maybe(..))
 import Effect.Aff (Aff)
 import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.Properties as HP
 import Web.HTML.Common (ClassName(..))
 
-data Event = Unimplemented
+data Event = LoadThumbs
+    | ThumbLoaded Int ImageData
 
-component :: forall query input output. Model -> H.Component query input output Aff
+component :: forall query input. Model -> H.Component query input Event Aff
 component initialState = H.mkComponent
     { initialState: \_ -> initialState
     , render
-    , eval: H.mkEval $ H.defaultEval { handleAction = update }
+    , eval: H.mkEval $ H.defaultEval { handleAction = update, initialize = Just LoadThumbs }
     }
 
 placeholderBlurhash :: forall r i. String -> HH.IProp r i
@@ -42,8 +46,25 @@ renderThumbnail {blurhash, thumb} =
             _ -> []
         )
 
-update :: forall output. Event -> H.HalogenM Model Event () output Aff Unit
-update Unimplemented = pure unit
+setThumb :: Int -> ImageData -> Model -> Model
+setThumb pos newThumb (GLoaded title desc images) =
+    case modifyAt pos (\i -> i{thumb=newThumb}) images of
+        Just newImages -> GLoaded title desc newImages
+        Nothing -> GError $ UnexpectedError "setThumb called with an invalid index!"
+setThumb _ _ model = model
+
+fetchThumbAction :: Int -> Image -> H.HalogenM Model Event () Event Aff Unit
+fetchThumbAction position image = do
+    newData <- H.liftAff $ fetchThumb image
+    update $ ThumbLoaded 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
 
 render :: forall m. Model -> H.ComponentHTML Event () m
 render (GError e) = HH.p_ [ HH.text $ show e ]