module Aviary.UI where import Prelude import Aviary.Model ( Image , ImageData(..) , Model(..) ) import Aviary.Switchboard (Event(..), update) import Data.Array (index, mapWithIndex) import Data.Maybe (fromMaybe, maybe, Maybe(..)) import Effect.Aff (Aff) import Halogen as H import Halogen.HTML as HH import Halogen.HTML.Events as HE import Halogen.HTML.Properties as HP import Web.HTML.Common (ClassName(..)) component :: forall query input. Model -> H.Component query input Event Aff component initialState = H.mkComponent { initialState: \_ -> initialState , render , eval: H.mkEval $ H.defaultEval { handleAction = update, initialize = Just Init } } backgroundUrl :: String -> String backgroundUrl url = "background-image: url(" <> url <> ");" widthHeight :: Int -> Int -> String widthHeight w h = "width:" <> (show w) <> "px;height:" <> (show h) <> "px;" renderThumbnail :: forall m. Int -> Image -> H.ComponentHTML Event () m renderThumbnail pos image = HH.button ( [ HP.classes $ ClassName <$> ["thumbnail-card", "blurhash-frame", "control"] , HE.onClick \_ -> Focus pos ] <> maybe [] (backgroundUrl >>> HP.style >>> pure) (image.blurhashUrl) ) case image.thumb of Unloaded _ -> [] Loading -> [ HH.span [ HP.class_ $ ClassName "loading-msg" ] [ HH.text "Loading..." ] ] Retrying _ e -> [ HH.div [ HP.class_ $ ClassName "error-msg" ] [ HH.p [ HP.class_ $ ClassName "thumb-icon" ] [ HH.text "⚠" ] , HH.span_ [ HH.text $ show e ] ] ] IError e -> [ HH.div [ HP.class_ $ ClassName "error-msg" ] [ HH.p [ HP.class_ $ ClassName "thumb-icon" ] [ HH.text "⚠" ] , HH.span_ [ HH.text $ show e ] ] ] ILoaded url -> [ HH.img [HP.src url] ] renderFocused :: forall m. Boolean -> Image -> H.ComponentHTML Event () m renderFocused zoom image = HH.div [ HP.id "focused-panel" , HP.class_ $ ClassName if zoom then "zoomed" else "unzoomed" ] [ HH.div [ HP.id "focused-bg" , HE.onClick \_ -> Unfocus ] [ HH.button [ HP.id "close" , HP.class_ $ ClassName "control" ] [ HH.text "⨯" ] ] , HH.button [ HP.id "prev-image" , HP.class_ $ ClassName "control" , HE.onClick \_ -> Pan false ] [ HH.text "❰" ] , HH.button [ HP.id "next-image" , HP.class_ $ ClassName "control" , HE.onClick \_ -> Pan true ] [ HH.text "❱" ] , HH.div [ HP.style case image.full of ILoaded _ -> "" IError _ -> maybe "" backgroundUrl (image.blurhashUrl) Retrying _ _ -> maybe "" backgroundUrl (image.blurhashUrl) _ -> ( maybe "" backgroundUrl (image.blurhashUrl) <> widthHeight image.width image.height ) , HP.classes $ ClassName <$> case image.full of IError _ -> ["blurhash-frame", "error-frame"] Retrying _ _ -> ["blurhash-frame", "error-frame"] _ -> ["blurhash-frame"] ] case image.full of Unloaded _ -> [] Loading -> [ HH.span [ HP.class_ $ ClassName "loading-msg" ] [ HH.text "Loading..." ] ] IError e -> [ HH.span [ HP.class_ $ ClassName "error-msg" ] [ HH.p [ HP.class_ $ ClassName "full-icon" ] [ HH.text "⚠" ] , HH.span_ [ HH.text $ show e ] ] ] Retrying _ e -> [ HH.span [ HP.class_ $ ClassName "error-msg" ] [ HH.p [ HP.class_ $ ClassName "full-icon" ] [ HH.text "⚠" ] , HH.span_ [ HH.text $ show e ] ] ] ILoaded url -> [ HH.img [ HP.src url , HE.onClick \_ -> if zoom then Unzoom else Zoom ] ] ] render :: forall m. Model -> H.ComponentHTML Event () m render (GError e) = HH.div [ HP.class_ $ ClassName "uh-oh-stinky" ] [ HH.div_ [ HH.h1_ [ HH.text "⚠" ] , HH.p_ [ HH.text $ show e ] ] ] render (GLoaded {title, desc, images, focus}) = HH.div_ ((maybe [] (HH.text >>> pure >>> HH.h1_ >>> pure) title) <> (maybe [] (HH.text >>> pure >>> HH.p_ >>> pure) desc) <> [ HH.div [ HP.id "thumbnails" ] (mapWithIndex renderThumbnail images) ] <> (maybe [] (renderFocused (fromMaybe false (_.zoom <$> focus)) >>> pure) (index images =<< (_.imageIndex <$> focus))))