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" , "fetch"
, "filterable" , "filterable"
, "foldable-traversable" , "foldable-traversable"
, "halogen"
, "maybe" , "maybe"
, "newtype" , "newtype"
, "parallel" , "parallel"

View File

@ -4,6 +4,7 @@ import Prelude
import AviaryFormat.Format (Format, Image, Index, parseIndex) as Format import AviaryFormat.Format (Format, Image, Index, parseIndex) as Format
import Aviary.FFI (arrayBufferToBlob) import Aviary.FFI (arrayBufferToBlob)
import Aviary.Model (formatToMime, GalleryError(..), Image, ImageData(..), ImageError(..), Model(..)) import Aviary.Model (formatToMime, GalleryError(..), Image, ImageData(..), ImageError(..), Model(..))
import Aviary.UI (component)
import Control.Monad.Error.Class (try) import Control.Monad.Error.Class (try)
import Effect (Effect) import Effect (Effect)
@ -23,6 +24,8 @@ import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Filterable (partitionMap) import Data.Filterable (partitionMap)
import Data.Foldable (traverse_) import Data.Foldable (traverse_)
import Data.String (drop) import Data.String (drop)
import Halogen.Aff (awaitBody)
import Halogen.VDom.Driver (runUI)
import Parsing (runParserT) import Parsing (runParserT)
import Web.File.Url (createObjectURL) import Web.File.Url (createObjectURL)
import Web.HTML (window) as HTML import Web.HTML (window) as HTML
@ -98,6 +101,7 @@ fetchImageAsBlobUrl nonce format key fileID = do
main_aff :: Aff Unit main_aff :: Aff Unit
main_aff = do main_aff = do
body <- awaitBody
urlInfo <- liftEffect do urlInfo <- liftEffect do
window <- HTML.window window <- HTML.window
location <- location window location <- location window
@ -121,7 +125,8 @@ main_aff = do
liftEffect $ parseIndex serializedIndex' liftEffect $ parseIndex serializedIndex'
404 -> pure $ GError NotFound 404 -> pure $ GError NotFound
s -> pure $ GError $ if s / 100 == 5 then ServerError else UnknownStatusCodeForIndex s 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 :: Effect Unit
main = launchAff main_aff $> 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))