module Aviary.UI where

import Prelude

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

import Control.Parallel (parSequence_)
import Control.Monad.Free (liftF)
import Data.Array (index, length, mapWithIndex, modifyAt)
import Data.Maybe (fromMaybe, maybe, Maybe(..))
import Data.Tuple (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 Halogen.Query.HalogenM as HM
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
    | DownloadImage 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 = wrapUpdate 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 -> Aff Event
fetchThumbAction position image = fetchThumb image <#> ThumbLoaded position

fetchFullAction :: Int -> Image -> Aff Event
fetchFullAction position image = fetchFull image <#> FullLoaded position

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

data UpdateResult
    = Modify Model
    | Affect (Array (Aff Event))
    | Both (Array (Aff Event)) Model
updateResultToTuple :: Model -> UpdateResult -> Tuple (Array (Aff Event)) Model
updateResultToTuple _ (Modify m) = Tuple [] m
updateResultToTuple m (Affect a) = Tuple a m
updateResultToTuple _ (Both a m) = Tuple a m

wrapUpdate :: (Event -> Model -> UpdateResult) -> Event -> H.HalogenM Model Event () Event Aff Unit
wrapUpdate _ RegisterListeners = do
    document <- H.liftEffect $ Web.document =<< Web.window
    H.subscribe' \_ ->
      eventListener
        KET.keydown
        (HTMLDocument.toEventTarget document)
        (KE.fromEvent >>> (=<<) eventByKey)
wrapUpdate inner event = do
    affects <- H.HalogenM $ liftF $ HM.State (\m -> updateResultToTuple m $ update' event m)
    let wrapAff :: Aff Event -> H.HalogenM Model Event () Event Aff Unit
        wrapAff = H.liftAff >>> (=<<) (wrapUpdate inner)
    parSequence_ $ affects <#> wrapAff

update' :: Event -> Model -> UpdateResult
update' Init _ = Affect $ [RegisterListeners, LoadThumbs] <#> pure
update' LoadThumbs (GLoaded {images}) =
    Affect $ mapWithIndex fetchThumbAction images
update' (ThumbLoaded pos newData) m = Modify $ setThumb newData pos m
update' (FullLoaded pos newData) m = Modify $ setFull newData pos m
update' (Focus imageIndex) (GLoaded gal) = Both
    ([DownloadImage >>> pure] <*> [imageIndex, imageIndex - 1, imageIndex + 1])
    (GLoaded gal{ focus = Just { imageIndex, zoom: false } })
update' Unfocus (GLoaded gal) = Modify $ GLoaded gal{ focus = Nothing }
update' Zoom (GLoaded gal) = Modify $ GLoaded gal{ focus = gal.focus <#> _{ zoom = true } }
update' Unzoom (GLoaded gal) = Modify $ GLoaded gal { focus = gal.focus <#> _{ zoom = false } }
update' (Pan right) (GLoaded gal@{images, focus: Just { imageIndex }}) =
    let offset = if right then 1 else -1
        newImageIndex = mod (imageIndex + offset) (length images) in
    Both
        [ pure $ DownloadImage $ (offset + newImageIndex) ]
        (GLoaded gal{ focus = Just {imageIndex: newImageIndex, zoom: false }})
update' (DownloadImage indx) (GLoaded { images }) =
    let revisedIndex = mod indx (length images)
        maybeImageData = index images revisedIndex in
    case maybeImageData of
        Just imageData -> Affect [fetchFullAction revisedIndex imageData]
        Nothing -> Modify $ GError $ UnexpectedError "Despite taking the modulo, still invalid index"
update' _ modl = Modify modl

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