Added Halogen functions to render list of thumb blurhashes

This commit is contained in:
Emi Simpson 2022-11-06 11:36:31 -05:00
parent e24bdf5b13
commit 4ab1bcdbc1
Signed by: Emi
GPG Key ID: A12F2C2FFDC3D847
3 changed files with 60 additions and 1 deletions

View File

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

View File

@ -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

53
src/UI.purs Normal file
View File

@ -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))