diff --git a/src/Logic.purs b/src/Logic.purs index 3125294..83338cb 100644 --- a/src/Logic.purs +++ b/src/Logic.purs @@ -2,7 +2,7 @@ module Aviary.Logic where import Prelude import AviaryFormat.Format (Format(..), Image, Index, parseIndex) as Format -import Aviary.FFI (arrayBufferToBlob, nonce) +import Aviary.FFI (arrayBufferToBlob, nonce, decodeBlurhash32) import Aviary.Model (formatToMime, GalleryError(..), Image, ImageData(..), ImageError(..), Model(..)) import Control.Monad.Error.Class (try) @@ -60,10 +60,11 @@ convertImageFromProtobuf protoimage = let protoimage' = unwrap protoimage in do thumbUrl <- note (IndexMissingField "images[].thumb_url") protoimage'.thumb_url blurhash <- note (IndexMissingField "images[].blurhash") protoimage'.blurhash format <- note (IndexMissingField "images[].format") protoimage'.format + let blurhashUrl = decodeBlurhash32 blurhash let key = hush <$> (importKey =<< liftEffect (databuffToBuffer $ unwrap rawKey)) let thumb = Unloaded thumbUrl let full = Unloaded fullUrl - pure { key, blurhash, format, thumb, full } + pure { key, blurhashUrl, format, thumb, full } convertIndexFromProtobuf :: Format.Index -> Model convertIndexFromProtobuf protoindex = diff --git a/src/Model.purs b/src/Model.purs index b301782..c04521f 100644 --- a/src/Model.purs +++ b/src/Model.purs @@ -5,7 +5,7 @@ import Prelude import AviaryFormat.Format (Format(..)) as Format import Crypto.Subtle.Key.Types (CryptoKey) -import Data.Maybe (Maybe) +import Data.Maybe (Maybe(..)) import Effect.Aff (Aff) data GalleryError @@ -41,7 +41,7 @@ instance showImageData :: Show ImageData where type Image = { key :: Aff (Maybe CryptoKey) - , blurhash :: String + , blurhashUrl :: Maybe String , format :: Format.Format , thumb :: ImageData , full :: ImageData @@ -58,6 +58,17 @@ data Model = GError GalleryError | GLoaded LoadedGallery +imgOrBlurhash :: (Image -> ImageData) -> Image -> Maybe String +imgOrBlurhash idealData image = case idealData image of + ILoaded url -> Just url + _ -> image.blurhashUrl + +thumbOrBlurhash :: Image -> Maybe String +thumbOrBlurhash = imgOrBlurhash _.thumb + +fullOrBlurhash :: Image -> Maybe String +fullOrBlurhash = imgOrBlurhash _.full + instance showGalleryError :: Show GalleryError where show (UnexpectedError message) = "Something that should be impossible just happened! Please open up a new issue " diff --git a/src/UI.purs b/src/UI.purs index ee6cb8e..f45ecae 100644 --- a/src/UI.purs +++ b/src/UI.purs @@ -3,7 +3,13 @@ module Aviary.UI where import Prelude import Aviary.Logic (fetchFull, fetchThumb) -import Aviary.Model (GalleryError(..), Image, ImageData(..), Model(..)) +import Aviary.Model ( fullOrBlurhash + , GalleryError(..) + , Image + , ImageData(..) + , Model(..) + , thumbOrBlurhash + ) import Control.Parallel (parSequence_) import Data.Array (index, mapWithIndex, modifyAt) @@ -27,9 +33,6 @@ component initialState = H.mkComponent , eval: H.mkEval $ H.defaultEval { handleAction = update, initialize = Just LoadThumbs } } -placeholderBlurhash :: forall r i. String -> HH.IProp r i -placeholderBlurhash = HH.attr (HH.AttrName "data-blurhash") - renderThumbnail :: forall m. Int -> Image -> H.ComponentHTML Event () m renderThumbnail pos image = HH.div @@ -37,13 +40,9 @@ renderThumbnail pos image = , HE.onClick \_ -> Focus pos ] ( [ HH.img - ( [ placeholderBlurhash image.blurhash - , HP.width 400 - , HP.height 400 - ] <> case image.thumb of - ILoaded url -> [HP.src url] - _ -> [] - ) + ( [ HP.width 400 + , HP.height 400 + ] <> maybe [] (HP.src >>> pure) (thumbOrBlurhash image)) ] <> case image.thumb of Unloaded _ -> [HH.p_ [HH.text "Loading..."]] IError e -> [HH.p_ [HH.text $ "Error! " <> (show e)]] @@ -51,18 +50,14 @@ renderThumbnail pos image = ) renderFocused :: forall m. Image -> H.ComponentHTML Event () m -renderFocused {blurhash, full} = +renderFocused image = HH.div [ HP.class_ $ ClassName "focused-panel" , HP.class_ $ ClassName "visible" ] - ( [ HH.img - ( [ placeholderBlurhash blurhash ] - <> case full of - ILoaded url -> [HP.src url] - _ -> [] - ) - ] <> case full of + ( [ HH.img $ + maybe [] (HP.src >>> pure) (fullOrBlurhash image) + ] <> case image.full of Unloaded _ -> [HH.p_ [HH.text "Loading..."]] IError e -> [HH.p_ [HH.text $ "Error! " <> (show e)]] _ -> [] diff --git a/src/ffi.js b/src/ffi.js index c0b09b0..fedef0c 100644 --- a/src/ffi.js +++ b/src/ffi.js @@ -5,3 +5,19 @@ export function arrayBufferToBlob(mime) { } export const nonce = new Uint8Array([0xd0, 0xc3, 0x75, 0x56, 0x58, 0xc1, 0x7e, 0x5f, 0xd6, 0xcc, 0xb6, 0x76]).buffer + +export function decodeBlurhashImpl(just) { + return function(nothing) { + return function(x) { + return function(y) { + return function(blurhash) { + try { + return just(BlurHash.toDataURL(blurhash, x, y)) + } catch(_) { + return nothing + } + } + } + } + } +} diff --git a/src/ffi.purs b/src/ffi.purs index 22f1c06..690c591 100644 --- a/src/ffi.purs +++ b/src/ffi.purs @@ -1,6 +1,7 @@ module Aviary.FFI where import Data.ArrayBuffer.Types (ArrayBuffer) +import Data.Maybe (Maybe(..)) import Web.File.Blob (Blob) -- mimeType :: String @@ -8,3 +9,9 @@ import Web.File.Blob (Blob) foreign import arrayBufferToBlob :: String -> ArrayBuffer -> Blob foreign import nonce :: ArrayBuffer + +foreign import decodeBlurhashImpl :: (forall x. x -> Maybe x) -> (forall x. Maybe x) -> Int -> Int -> String -> Maybe String +decodeBlurhash :: Int -> Int -> String -> Maybe String +decodeBlurhash = decodeBlurhashImpl Just Nothing +decodeBlurhash32 :: String -> Maybe String +decodeBlurhash32 = decodeBlurhash 32 32