Added Halogen functions to render list of thumb blurhashes
This commit is contained in:
parent
e24bdf5b13
commit
4ab1bcdbc1
|
@ -24,6 +24,7 @@ to generate this file without the comments in this block.
|
|||
, "fetch"
|
||||
, "filterable"
|
||||
, "foldable-traversable"
|
||||
, "halogen"
|
||||
, "maybe"
|
||||
, "newtype"
|
||||
, "parallel"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
Loading…
Reference in New Issue