module Aviary.UI where

import Prelude

import Aviary.Logic (fetchFull, fetchThumb)
import Aviary.Model ( GalleryError(..)
                    , Image
                    , ImageData(..)
                    , Model(..)
                    )

import Control.Parallel (parSequence_)
import Data.Array (index, length, mapMaybe, mapWithIndex, modifyAt)
import Data.Maybe (fromMaybe, maybe, Maybe(..))
import Data.Tuple (uncurry, Tuple(..))
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 Halogen.Query.Event (eventListener)
import Web.HTML (window) as Web
import Web.HTML.Common (ClassName(..))
import Web.HTML.HTMLDocument as HTMLDocument
import Web.HTML.Window (document) as Web
import Web.UIEvent.KeyboardEvent as KE
import Web.UIEvent.KeyboardEvent.EventTypes as KET

data Event = LoadThumbs
    | ThumbLoaded Int ImageData
    | FullLoaded Int ImageData
    | Focus Int
    | Unfocus
    | Zoom
    | Unzoom
    | Pan Boolean -- True if right
    | DownloadImages (Array Int)
    | Init
    | RegisterListeners

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 _ ->
                [ HH.span
                    [ HP.class_ $ ClassName "loading-msg"
                    ]
                    [ HH.text "Loading..."
                    ]
                ]
            IError e ->
                [ HH.span
                    [ HP.class_ $ ClassName "error-msg"
                    ]
                    [ HH.text $ "Error!  " <> (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 _ -> ""
                    _ ->
                        (  maybe "" backgroundUrl (image.blurhashUrl)
                        <> widthHeight image.width image.height
                        )
            , HP.class_ $ ClassName "blurhash-frame"
            ]
            case image.full of
                Unloaded _ ->
                    [ HH.span
                        [ HP.class_ $ ClassName "loading-msg"
                        ]
                        [ HH.text "Loading..."
                        ]
                    ]
                IError e ->
                    [ HH.span
                        [ HP.class_ $ ClassName "error-msg"
                        ]
                        [ HH.text $ "Error!  " <> (show e)
                        ]
                    ]
                ILoaded url ->
                    [ HH.img
                        [ HP.src url
                        , HE.onClick \_ -> if zoom then Unzoom else Zoom
                        ]
                    ]
        ]

setImage :: (Image -> Image) -> Int -> Model -> Model
setImage _ _ (GError e) = (GError e)
setImage tranformation pos (GLoaded gallery) =
    case modifyAt pos tranformation gallery.images of
        Just newImages -> GLoaded gallery{images = newImages}
        Nothing -> GError $ UnexpectedError "setImage called with an out of bounds index!"

setThumb :: ImageData -> Int -> Model -> Model
setThumb newThumb = setImage \i -> i{thumb = newThumb}

setFull :: ImageData -> Int -> Model -> Model
setFull newImage = setImage \i -> i{full = newImage}

fetchThumbAction :: Int -> Image -> H.HalogenM Model Event () Event Aff Unit
fetchThumbAction position image = do
    newData <- H.liftAff $ fetchThumb image
    update $ ThumbLoaded position newData

fetchFullAction :: Int -> Image -> H.HalogenM Model Event () Event Aff Unit
fetchFullAction position image = do
    newData <- H.liftAff $ fetchFull image
    update $ FullLoaded position newData

eventByKey :: KE.KeyboardEvent -> Maybe Event
eventByKey ev = case KE.key ev of
    "ArrowLeft" -> Just $ Pan false
    "ArrowRight" -> Just $ Pan true
    "Escape" -> Just $ Unfocus
    "1" -> Just $ Focus 0
    _ -> Nothing

focusedIndex :: Model -> Maybe Int
focusedIndex (GLoaded { focus: Just { imageIndex } }) = Just imageIndex
focusedIndex _ = Nothing

update :: Event -> H.HalogenM Model Event () Event Aff Unit
update Init = update RegisterListeners <> update LoadThumbs
update RegisterListeners = do
    document <- H.liftEffect $ Web.document =<< Web.window
    H.subscribe' \_ ->
      eventListener
        KET.keydown
        (HTMLDocument.toEventTarget document)
        (KE.fromEvent >>> (=<<) eventByKey)
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 newData pos
update (FullLoaded pos newData) = H.modify_ $ setFull newData pos
update (Focus imageIndex) =  do
    _ <- H.modify_ \model -> case model of
        GError e -> GError e
        GLoaded gal -> GLoaded gal{ focus = Just { imageIndex, zoom: false } }
    _ <- update $ DownloadImages [imageIndex]
    update $ DownloadImages [imageIndex - 1, imageIndex + 1]
update Unfocus = H.modify_ \model -> case model of
    GError e -> GError e
    GLoaded gal -> GLoaded gal { focus = Nothing }
update Zoom = H.modify_ \model -> case model of
    GError e -> GError e
    GLoaded gal -> GLoaded gal { focus = gal.focus <#> _{ zoom = true } }
update Unzoom = H.modify_ \model -> case model of
    GError e -> GError e
    GLoaded gal -> GLoaded gal { focus = gal.focus <#> _{ zoom = false } }
update (Pan right) = let offset = if right then 1 else -1 in do
    _ <- H.modify_ \model -> case model of
        GError e -> GError e
        GLoaded gal -> GLoaded gal
            { focus = gal.focus <#> \foc ->
                foc{ imageIndex =
                    mod (foc.imageIndex + offset) (length gal.images)
                }
            }
    focus <- H.get <#> focusedIndex
    let generateIndicies :: Int -> Array Int
        generateIndicies = pure >>> (<*>) [identity, (+) offset]
    let maybeEvent = focus <#> generateIndicies <#> DownloadImages
    maybe (pure unit) update maybeEvent
update (DownloadImages indicies) = do
    model <- H.get
    case model of
        GLoaded { images } ->
            parSequence_ $ indicies
                # (<$>) (\i -> mod i (length images))
                # mapMaybe (\i -> index images i <#> Tuple i)
                <#> uncurry fetchFullAction
        _ -> pure unit


render :: forall m. Model -> H.ComponentHTML Event () m
render (GError e) = HH.div
    [ HP.class_ $ ClassName "uh-oh-stinky"
    ]
    [ 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))))