Added thumbnail rendering!!!
This commit is contained in:
parent
69f66e7908
commit
10e1ddecdf
|
@ -23,7 +23,6 @@ to generate this file without the comments in this block.
|
||||||
, "either"
|
, "either"
|
||||||
, "fetch"
|
, "fetch"
|
||||||
, "filterable"
|
, "filterable"
|
||||||
, "foldable-traversable"
|
|
||||||
, "halogen"
|
, "halogen"
|
||||||
, "maybe"
|
, "maybe"
|
||||||
, "newtype"
|
, "newtype"
|
||||||
|
|
|
@ -90,6 +90,13 @@ fetchImageAsBlobUrl nonce format key fileID = do
|
||||||
404 -> pure $ IError ImageNotFound
|
404 -> pure $ IError ImageNotFound
|
||||||
s -> pure $ IError $ if s / 100 == 5 then MinorServerError else UnknownStatusCodeForImage s
|
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 :: Aff Model
|
||||||
fetch_gallery_from_page_info = do
|
fetch_gallery_from_page_info = do
|
||||||
urlInfo <- liftEffect do
|
urlInfo <- liftEffect do
|
||||||
|
|
|
@ -9,7 +9,8 @@ import Data.Maybe (Maybe(..))
|
||||||
import Effect.Aff (Aff)
|
import Effect.Aff (Aff)
|
||||||
|
|
||||||
data GalleryError
|
data GalleryError
|
||||||
= ServerError
|
= UnexpectedError String
|
||||||
|
| ServerError
|
||||||
| NotFound
|
| NotFound
|
||||||
| MalformedKey
|
| MalformedKey
|
||||||
| DecryptFailed
|
| DecryptFailed
|
||||||
|
@ -29,6 +30,11 @@ data ImageData
|
||||||
| ILoaded String -- blob url of decrypted image
|
| ILoaded String -- blob url of decrypted image
|
||||||
| IError ImageError
|
| 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 =
|
type Image =
|
||||||
{ key :: Aff CryptoKey
|
{ key :: Aff CryptoKey
|
||||||
, blurhash :: String
|
, blurhash :: String
|
||||||
|
@ -45,6 +51,10 @@ data Model
|
||||||
(Array Image) -- Images
|
(Array Image) -- Images
|
||||||
|
|
||||||
instance showGalleryError :: Show GalleryError where
|
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 =
|
show ServerError =
|
||||||
"The server is experiencing issues at the minute. Please try again later, or if "
|
"The server is experiencing issues at the minute. Please try again later, or if "
|
||||||
<> "it keeps up, make a report to the server owner."
|
<> "it keeps up, make a report to the server owner."
|
||||||
|
|
35
src/UI.purs
35
src/UI.purs
|
@ -2,22 +2,26 @@ module Aviary.UI where
|
||||||
|
|
||||||
import Prelude
|
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 Effect.Aff (Aff)
|
||||||
import Halogen as H
|
import Halogen as H
|
||||||
import Halogen.HTML as HH
|
import Halogen.HTML as HH
|
||||||
import Halogen.HTML.Properties as HP
|
import Halogen.HTML.Properties as HP
|
||||||
import Web.HTML.Common (ClassName(..))
|
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
|
component initialState = H.mkComponent
|
||||||
{ initialState: \_ -> initialState
|
{ initialState: \_ -> initialState
|
||||||
, render
|
, 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
|
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
|
setThumb :: Int -> ImageData -> Model -> Model
|
||||||
update Unimplemented = pure unit
|
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 :: forall m. Model -> H.ComponentHTML Event () m
|
||||||
render (GError e) = HH.p_ [ HH.text $ show e ]
|
render (GError e) = HH.p_ [ HH.text $ show e ]
|
||||||
|
|
Loading…
Reference in New Issue