2022-11-06 16:36:31 +00:00
|
|
|
|
module Aviary.UI where
|
|
|
|
|
|
|
|
|
|
import Prelude
|
|
|
|
|
|
2022-11-16 22:24:53 +00:00
|
|
|
|
import Aviary.Model ( Image
|
2022-11-09 01:37:59 +00:00
|
|
|
|
, ImageData(..)
|
|
|
|
|
, Model(..)
|
|
|
|
|
)
|
2022-11-16 22:24:53 +00:00
|
|
|
|
import Aviary.Switchboard (Event(..), update)
|
2022-11-06 16:36:31 +00:00
|
|
|
|
|
2022-11-16 22:24:53 +00:00
|
|
|
|
import Data.Array (index, mapWithIndex)
|
2022-11-11 22:27:58 +00:00
|
|
|
|
import Data.Maybe (fromMaybe, maybe, Maybe(..))
|
2022-11-16 22:24:53 +00:00
|
|
|
|
import Effect.Aff (Aff)
|
2022-11-06 16:36:31 +00:00
|
|
|
|
import Halogen as H
|
|
|
|
|
import Halogen.HTML as HH
|
2022-11-07 17:23:59 +00:00
|
|
|
|
import Halogen.HTML.Events as HE
|
2022-11-06 16:36:31 +00:00
|
|
|
|
import Halogen.HTML.Properties as HP
|
|
|
|
|
import Web.HTML.Common (ClassName(..))
|
|
|
|
|
|
2022-11-07 00:46:39 +00:00
|
|
|
|
component :: forall query input. Model -> H.Component query input Event Aff
|
2022-11-06 16:36:31 +00:00
|
|
|
|
component initialState = H.mkComponent
|
|
|
|
|
{ initialState: \_ -> initialState
|
|
|
|
|
, render
|
2022-11-16 22:24:53 +00:00
|
|
|
|
, eval: H.mkEval $ H.defaultEval { handleAction = update, initialize = Just Init }
|
2022-11-06 16:36:31 +00:00
|
|
|
|
}
|
|
|
|
|
|
2022-11-09 22:44:35 +00:00
|
|
|
|
backgroundUrl :: String -> String
|
|
|
|
|
backgroundUrl url = "background-image: url(" <> url <> ");"
|
|
|
|
|
|
|
|
|
|
widthHeight :: Int -> Int -> String
|
|
|
|
|
widthHeight w h = "width:" <> (show w) <> "px;height:" <> (show h) <> "px;"
|
2022-11-09 17:29:15 +00:00
|
|
|
|
|
2022-11-07 20:41:19 +00:00
|
|
|
|
renderThumbnail :: forall m. Int -> Image -> H.ComponentHTML Event () m
|
|
|
|
|
renderThumbnail pos image =
|
2022-11-13 00:52:43 +00:00
|
|
|
|
HH.button
|
2022-11-09 17:29:15 +00:00
|
|
|
|
(
|
2022-11-13 00:52:43 +00:00
|
|
|
|
[ HP.classes $ ClassName <$> ["thumbnail-card", "blurhash-frame", "control"]
|
2022-11-09 17:29:15 +00:00
|
|
|
|
, HE.onClick \_ -> Focus pos
|
|
|
|
|
]
|
|
|
|
|
<>
|
2022-11-09 22:44:35 +00:00
|
|
|
|
maybe [] (backgroundUrl >>> HP.style >>> pure) (image.blurhashUrl)
|
2022-11-07 17:23:59 +00:00
|
|
|
|
)
|
2022-11-09 17:29:15 +00:00
|
|
|
|
case image.thumb of
|
2022-11-16 02:01:45 +00:00
|
|
|
|
Unloaded _ -> []
|
|
|
|
|
Loading ->
|
2022-11-09 17:29:15 +00:00
|
|
|
|
[ HH.span
|
|
|
|
|
[ HP.class_ $ ClassName "loading-msg"
|
|
|
|
|
]
|
|
|
|
|
[ HH.text "Loading..."
|
|
|
|
|
]
|
|
|
|
|
]
|
2022-11-16 03:18:19 +00:00
|
|
|
|
Retrying _ e ->
|
2022-11-17 17:05:25 +00:00
|
|
|
|
[ HH.div
|
2022-11-16 03:18:19 +00:00
|
|
|
|
[ HP.class_ $ ClassName "error-msg"
|
|
|
|
|
]
|
2022-11-17 17:05:25 +00:00
|
|
|
|
[ HH.p
|
|
|
|
|
[ HP.class_ $ ClassName "thumb-icon"
|
|
|
|
|
]
|
|
|
|
|
[ HH.text "⚠"
|
|
|
|
|
]
|
|
|
|
|
, HH.span_
|
|
|
|
|
[ HH.text $ show e
|
|
|
|
|
]
|
2022-11-16 03:18:19 +00:00
|
|
|
|
]
|
|
|
|
|
]
|
2022-11-09 17:29:15 +00:00
|
|
|
|
IError e ->
|
2022-11-17 17:05:25 +00:00
|
|
|
|
[ HH.div
|
2022-11-09 17:29:15 +00:00
|
|
|
|
[ HP.class_ $ ClassName "error-msg"
|
|
|
|
|
]
|
2022-11-17 17:05:25 +00:00
|
|
|
|
[ HH.p
|
|
|
|
|
[ HP.class_ $ ClassName "thumb-icon"
|
|
|
|
|
]
|
|
|
|
|
[ HH.text "⚠"
|
|
|
|
|
]
|
|
|
|
|
, HH.span_
|
|
|
|
|
[ HH.text $ show e
|
|
|
|
|
]
|
2022-11-09 17:29:15 +00:00
|
|
|
|
]
|
|
|
|
|
]
|
|
|
|
|
ILoaded url ->
|
|
|
|
|
[ HH.img [HP.src url]
|
|
|
|
|
]
|
2022-11-07 17:23:59 +00:00
|
|
|
|
|
2022-11-11 22:27:58 +00:00
|
|
|
|
renderFocused :: forall m. Boolean -> Image -> H.ComponentHTML Event () m
|
|
|
|
|
renderFocused zoom image =
|
2022-11-07 17:23:59 +00:00
|
|
|
|
HH.div
|
2022-11-09 22:44:35 +00:00
|
|
|
|
[ HP.id "focused-panel"
|
2022-11-11 22:27:58 +00:00
|
|
|
|
, HP.class_ $ ClassName if zoom then "zoomed" else "unzoomed"
|
2022-11-07 17:23:59 +00:00
|
|
|
|
]
|
2022-11-09 22:44:35 +00:00
|
|
|
|
[ HH.div
|
2022-11-11 22:27:58 +00:00
|
|
|
|
[ HP.id "focused-bg"
|
|
|
|
|
, HE.onClick \_ -> Unfocus
|
|
|
|
|
]
|
2022-11-13 00:52:43 +00:00
|
|
|
|
[ HH.button
|
2022-11-13 00:44:06 +00:00
|
|
|
|
[ HP.id "close"
|
2022-11-13 00:52:43 +00:00
|
|
|
|
, HP.class_ $ ClassName "control"
|
2022-11-13 00:44:06 +00:00
|
|
|
|
]
|
|
|
|
|
[ HH.text "⨯"
|
|
|
|
|
]
|
|
|
|
|
]
|
2022-11-13 00:52:43 +00:00
|
|
|
|
, HH.button
|
2022-11-13 00:39:11 +00:00
|
|
|
|
[ HP.id "prev-image"
|
2022-11-13 00:52:43 +00:00
|
|
|
|
, HP.class_ $ ClassName "control"
|
2022-11-13 00:39:11 +00:00
|
|
|
|
, HE.onClick \_ -> Pan false
|
|
|
|
|
]
|
|
|
|
|
[ HH.text "❰"
|
|
|
|
|
]
|
2022-11-13 00:52:43 +00:00
|
|
|
|
, HH.button
|
2022-11-13 00:39:11 +00:00
|
|
|
|
[ HP.id "next-image"
|
2022-11-13 00:52:43 +00:00
|
|
|
|
, HP.class_ $ ClassName "control"
|
2022-11-13 00:39:11 +00:00
|
|
|
|
, HE.onClick \_ -> Pan true
|
|
|
|
|
]
|
|
|
|
|
[ HH.text "❱"
|
|
|
|
|
]
|
2022-11-11 22:27:58 +00:00
|
|
|
|
, HH.div
|
2022-11-09 22:44:35 +00:00
|
|
|
|
[ HP.style
|
2022-11-11 22:27:58 +00:00
|
|
|
|
case image.full of
|
|
|
|
|
ILoaded _ -> ""
|
2022-11-17 17:05:25 +00:00
|
|
|
|
IError _ ->
|
|
|
|
|
maybe "" backgroundUrl (image.blurhashUrl)
|
|
|
|
|
Retrying _ _ ->
|
|
|
|
|
maybe "" backgroundUrl (image.blurhashUrl)
|
2022-11-11 22:27:58 +00:00
|
|
|
|
_ ->
|
|
|
|
|
( maybe "" backgroundUrl (image.blurhashUrl)
|
|
|
|
|
<> widthHeight image.width image.height
|
|
|
|
|
)
|
2022-11-17 17:05:25 +00:00
|
|
|
|
, HP.classes $ ClassName <$> case image.full of
|
|
|
|
|
IError _ -> ["blurhash-frame", "error-frame"]
|
|
|
|
|
Retrying _ _ -> ["blurhash-frame", "error-frame"]
|
|
|
|
|
_ -> ["blurhash-frame"]
|
2022-11-09 22:44:35 +00:00
|
|
|
|
]
|
|
|
|
|
case image.full of
|
2022-11-16 02:01:45 +00:00
|
|
|
|
Unloaded _ -> []
|
|
|
|
|
Loading ->
|
2022-11-09 22:44:35 +00:00
|
|
|
|
[ HH.span
|
|
|
|
|
[ HP.class_ $ ClassName "loading-msg"
|
|
|
|
|
]
|
|
|
|
|
[ HH.text "Loading..."
|
|
|
|
|
]
|
|
|
|
|
]
|
|
|
|
|
IError e ->
|
|
|
|
|
[ HH.span
|
|
|
|
|
[ HP.class_ $ ClassName "error-msg"
|
|
|
|
|
]
|
2022-11-17 17:05:25 +00:00
|
|
|
|
[ HH.p
|
|
|
|
|
[ HP.class_ $ ClassName "full-icon"
|
|
|
|
|
]
|
|
|
|
|
[ HH.text "⚠"
|
|
|
|
|
]
|
|
|
|
|
, HH.span_
|
|
|
|
|
[ HH.text $ show e
|
|
|
|
|
]
|
2022-11-09 22:44:35 +00:00
|
|
|
|
]
|
|
|
|
|
]
|
2022-11-16 03:18:19 +00:00
|
|
|
|
Retrying _ e ->
|
|
|
|
|
[ HH.span
|
|
|
|
|
[ HP.class_ $ ClassName "error-msg"
|
|
|
|
|
]
|
2022-11-17 17:05:25 +00:00
|
|
|
|
[ HH.p
|
|
|
|
|
[ HP.class_ $ ClassName "full-icon"
|
|
|
|
|
]
|
|
|
|
|
[ HH.text "⚠"
|
|
|
|
|
]
|
|
|
|
|
, HH.span_
|
|
|
|
|
[ HH.text $ show e
|
|
|
|
|
]
|
2022-11-16 03:18:19 +00:00
|
|
|
|
]
|
|
|
|
|
]
|
2022-11-09 22:44:35 +00:00
|
|
|
|
ILoaded url ->
|
2022-11-11 22:27:58 +00:00
|
|
|
|
[ HH.img
|
|
|
|
|
[ HP.src url
|
|
|
|
|
, HE.onClick \_ -> if zoom then Unzoom else Zoom
|
|
|
|
|
]
|
2022-11-09 22:44:35 +00:00
|
|
|
|
]
|
|
|
|
|
]
|
2022-11-06 16:36:31 +00:00
|
|
|
|
|
|
|
|
|
render :: forall m. Model -> H.ComponentHTML Event () m
|
2022-11-09 17:29:15 +00:00
|
|
|
|
render (GError e) = HH.div
|
|
|
|
|
[ HP.class_ $ ClassName "uh-oh-stinky"
|
|
|
|
|
]
|
2022-11-16 22:50:33 +00:00
|
|
|
|
[ HH.div_
|
|
|
|
|
[ HH.h1_ [ HH.text "⚠" ]
|
|
|
|
|
, HH.p_ [ HH.text $ show e ]
|
|
|
|
|
]
|
2022-11-09 17:29:15 +00:00
|
|
|
|
]
|
2022-11-07 20:41:19 +00:00
|
|
|
|
render (GLoaded {title, desc, images, focus}) = HH.div_
|
2022-11-06 16:36:31 +00:00
|
|
|
|
((maybe [] (HH.text >>> pure >>> HH.h1_ >>> pure) title) <>
|
|
|
|
|
(maybe [] (HH.text >>> pure >>> HH.p_ >>> pure) desc) <>
|
2022-11-09 03:42:02 +00:00
|
|
|
|
[ HH.div
|
|
|
|
|
[ HP.id "thumbnails"
|
|
|
|
|
]
|
|
|
|
|
(mapWithIndex renderThumbnail images)
|
|
|
|
|
] <>
|
2022-11-11 22:27:58 +00:00
|
|
|
|
(maybe [] (renderFocused (fromMaybe false (_.zoom <$> focus)) >>> pure) (index images =<< (_.imageIndex <$> focus))))
|