aviary-ps/src/UI.purs

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))))