{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | Hero app frontend
--
-- : exe mmc.js
--
-- : dep aeson
-- : dep clay
-- : dep containers
-- : dep miso
-- : dep protolude
-- : dep servant
-- : dep split
-- : dep string-quote
-- : dep text
-- : dep ghcjs-base
module Hero.Client where

import Data.Aeson (eitherDecodeStrict)
import qualified Data.Set as Set
import qualified GHC.Show as Legacy
import Hero.App
  ( Action (..),
    AudioState (..),
    Comic (..),
    ComicReaderState (..),
    ComicReaderView (..),
    Model (..),
    audioId,
    chooseExperienceLink,
    comicPlayerFullLink,
    comicPlayerSpreadLink,
    comicVideoLink,
    handlers,
    initModel,
    routes,
    the404,
  )
import JavaScript.Web.XMLHttpRequest
  ( Method (GET),
    Request (..),
    RequestData (NoData),
    contents,
    xhrByteString,
  )
import Miso
import Miso.Effect.DOM (scrollIntoView)
import qualified Miso.FFI.Audio as Audio
import qualified Miso.FFI.Document as Document
import qualified Miso.FFI.Fullscreen as Fullscreen
import Miso.String
import qualified Network.RemoteData as Network
import Protolude

-- | Entry point for a miso application
main :: IO ()
main = miso $ \currentURI -> App {model = initModel currentURI, ..}
  where
    update = move
    view = see
    subs =
      [ uriSub HandleURI,
        keyboardSub keynav
      ]
    events = defaultEvents
    initialAction = FetchComics
    mountPoint = Nothing

(∈) :: Ord a => a -> Set a -> Bool
(∈) = Set.member

-- | Keyboard navigation - maps keys to actions.
keynav :: Set Int -> Action
keynav ks
  | 37 ∈ ks = PrevPage -- left arrow
  | 39 ∈ ks = NextPage -- right arrow
  | 191 ∈ ks = DumpModel -- ?
  | 32 ∈ ks = ToggleAudio audioId -- SPC
  | otherwise = NoOp

see :: Model -> View Action
see model =
  case runRoute routes handlers uri model of
    Left _ -> the404 model
    Right v -> v

-- | Console-logging
foreign import javascript unsafe "console.log($1);"
  say :: MisoString -> IO ()

-- | Updates model, optionally introduces side effects
move :: Action -> Model -> Effect Action Model
move NoOp model = noEff model
move DumpModel model = model <# do
  say $ ms $ Legacy.show model
  pure NoOp
move (SelectExperience comic) model = model {cpState = ChooseExperience (comicId comic) 1}
  <# do pure $ ChangeURI $ chooseExperienceLink (comicId comic) 1
move (StartReading comic) model = model {cpState = Reading Spread (comicId comic) 1}
  <# do pure $ ChangeURI $ comicPlayerSpreadLink (comicId comic) 1
move (StartWatching comic) model = model {cpState = Watching (comicId comic)}
  <# do pure $ ChangeURI $ comicVideoLink (comicId comic) 1
move NextPage model = case cpState model of
  Reading Spread id pg ->
    model {cpState = Reading Spread id (pg + 2)} <# do
      pure $ ChangeURI $ comicPlayerSpreadLink id (pg + 2)
  Reading Full id pg ->
    model {cpState = Reading Full id (pg + 1)} <# do
      pure $ ChangeURI $ comicPlayerFullLink id (pg + 1)
  Cover id ->
    model {cpState = Reading Spread id 1} <# do
      pure $ ChangeURI $ comicPlayerSpreadLink id 1
  _ -> noEff model
move PrevPage model = case cpState model of
  Reading Spread id pg ->
    model {cpState = Reading Spread id (pg -2)} <# do
      pure $ ChangeURI $ comicPlayerSpreadLink id (pg -2)
  Reading Full id pg ->
    model {cpState = Reading Full id (pg -1)} <# do
      pure $ ChangeURI $ comicPlayerFullLink id (pg -1)
  Cover _ -> noEff model
  _ -> noEff model
move (ToggleZoom c pg) m = m {cpState = newState} <# pure act
  where
    goto lnk = ChangeURI $ lnk (comicId c) pg
    reading v = Reading v (comicId c) pg
    (newState, act) = case cpState m of
      Reading Full _ _ -> (reading Spread, goto comicPlayerSpreadLink)
      Reading Spread _ _ -> (reading Full, goto comicPlayerFullLink)
      x -> (x, NoOp)
move (ToggleInLibrary c) model = model {userLibrary = newLib} <# pure NoOp
  where
    newLib
      | c `elem` userLibrary model =
        Protolude.filter (/= c) $ userLibrary model
      | otherwise = c : userLibrary model
move (HandleURI u) model = model {uri = u} <# pure NoOp
move (ChangeURI u) model = model <# do
  pushURI u
  pure NoOp
move FetchComics model = model <# (SetComics <$> fetchComics)
move (SetComics cs) model = noEff model {appComics = cs}
move (ToggleAudio i) model = model {cpAudioState = newState} <# do
  el <- Document.getElementById i
  toggle el
  pure NoOp
  where
    (newState, toggle) = case cpAudioState model of
      Playing -> (Paused, Audio.pause)
      Paused -> (Playing, Audio.play)
move ToggleFullscreen model = model {cpState = newState} <# do
  el <- Document.querySelector "body"
  -- TODO: check Document.fullscreenEnabled
  -- https://developer.mozilla.org/en-US/docs/Web/API/Document/fullscreenEnabled
  _ <- toggle el
  pure NoOp
  where
    (toggle, newState) = case cpState model of
      Reading Full c n -> (const Fullscreen.exit, Reading Full c n)
      Reading Spread c n -> (Fullscreen.request, Reading Spread c n)
      -- otherwise, do nothing:
      x -> (pure, x)
move (SetMediaInfo x) model = model {dMediaInfo = x}
  <# case x of
    Just Comic {comicId = id} ->
      pure $ ScrollIntoView $ "comic-" <> ms id
    Nothing ->
      pure NoOp
move (ScrollIntoView id) model = model <# do
  say $ ms $ Legacy.show id
  scrollIntoView id
  pure NoOp

fetchComics :: IO (Network.RemoteData MisoString [Comic])
fetchComics = do
  mjson <- contents <$> xhrByteString req
  case mjson of
    Nothing ->
      pure $ Network.Failure "Could not fetch comics from server."
    Just json ->
      pure $ Network.fromEither
        $ either (Left . ms) pure
        $ eitherDecodeStrict json
  where
    req =
      Request
        { reqMethod = GET,
          reqURI = "/api/comic", -- FIXME: can we replace this hardcoding?
          reqLogin = Nothing,
          reqHeaders = [],
          reqWithCredentials = False,
          reqData = NoData
        }