From 4ab1bcdbc1a7ddc0a4cc3d6da022c751106fc81c Mon Sep 17 00:00:00 2001
From: Emi Simpson <emi@alchemi.dev>
Date: Sun, 6 Nov 2022 11:36:31 -0500
Subject: [PATCH] Added Halogen functions to render list of thumb blurhashes

---
 spago.dhall   |  1 +
 src/Main.purs |  7 ++++++-
 src/UI.purs   | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 60 insertions(+), 1 deletion(-)
 create mode 100644 src/UI.purs

diff --git a/spago.dhall b/spago.dhall
index 1ca43ab..9ceb3d2 100644
--- a/spago.dhall
+++ b/spago.dhall
@@ -24,6 +24,7 @@ to generate this file without the comments in this block.
   , "fetch"
   , "filterable"
   , "foldable-traversable"
+  , "halogen"
   , "maybe"
   , "newtype"
   , "parallel"
diff --git a/src/Main.purs b/src/Main.purs
index 2bcc538..c40067a 100644
--- a/src/Main.purs
+++ b/src/Main.purs
@@ -4,6 +4,7 @@ import Prelude
 import AviaryFormat.Format (Format, Image, Index, parseIndex) as Format
 import Aviary.FFI (arrayBufferToBlob)
 import Aviary.Model (formatToMime, GalleryError(..), Image, ImageData(..), ImageError(..), Model(..))
+import Aviary.UI (component)
 
 import Control.Monad.Error.Class (try)
 import Effect (Effect)
@@ -23,6 +24,8 @@ import Data.ArrayBuffer.Types (ArrayBuffer)
 import Data.Filterable (partitionMap)
 import Data.Foldable (traverse_)
 import Data.String (drop)
+import Halogen.Aff (awaitBody)
+import Halogen.VDom.Driver (runUI)
 import Parsing (runParserT)
 import Web.File.Url (createObjectURL)
 import Web.HTML (window) as HTML
@@ -98,6 +101,7 @@ fetchImageAsBlobUrl nonce format key fileID = do
 
 main_aff :: Aff Unit
 main_aff = do
+    body <- awaitBody
     urlInfo <- liftEffect do
         window <- HTML.window
         location <- location window
@@ -121,7 +125,8 @@ main_aff = do
                             liftEffect $ parseIndex serializedIndex'
                 404 -> pure $ GError NotFound
                 s -> pure $ GError $ if s / 100 == 5 then ServerError else UnknownStatusCodeForIndex s
-    liftEffect $ log "Gallery info loaded or error.  No I won't tell you which one."
+    _ <- runUI (component gallery) unit body
+    pure unit
 
 main :: Effect Unit
 main = launchAff main_aff $> unit
diff --git a/src/UI.purs b/src/UI.purs
new file mode 100644
index 0000000..55cd9db
--- /dev/null
+++ b/src/UI.purs
@@ -0,0 +1,53 @@
+module Aviary.UI where
+
+import Prelude
+
+import Aviary.Model (Image, ImageData(..), Model(..))
+
+import Data.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
+
+component :: forall query input output. Model -> H.Component query input output Aff
+component initialState = H.mkComponent
+    { initialState: \_ -> initialState
+    , render
+    , eval: H.mkEval $ H.defaultEval { handleAction = update }
+    }
+
+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 {blurhash, thumb} =
+    HH.div
+        [ HP.class_ $ ClassName "thumbnail-card"
+        ]
+        ( [ HH.img
+            ( [ placeholderBlurhash blurhash
+                , HP.width 400
+                , HP.height 400
+            ] <> case thumb of
+                ILoaded url -> [HP.src url]
+                _ -> []
+            )
+        ] <> case thumb of
+            Unloaded _ -> [HH.p_ [HH.text "Loading..."]]
+            IError e -> [HH.p_ [HH.text $ "Error!  " <> (show e)]]
+            _ -> []
+        )
+
+update :: forall output. Event -> H.HalogenM Model Event () output Aff Unit
+update Unimplemented = pure unit
+
+render :: forall m. Model -> H.ComponentHTML Event () m
+render (GError e) = HH.p_ [ HH.text $ show e ]
+render (GLoaded title desc images) = HH.div_
+    ((maybe [] (HH.text >>> pure >>> HH.h1_ >>> pure) title) <>
+    (maybe [] (HH.text >>> pure >>> HH.p_ >>> pure) desc)    <>
+    (renderThumbnail <$> images))