{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Com.MusicMeetsComics.Client where

import           Com.MusicMeetsComics.App ( Action(..)
                                          , Comic(..)
                                          , ComicReaderState(..)
                                          , ComicReaderView(..)
                                          , Model(..)
                                          , AudioState(..)
                                          , audioId
                                          , chooseExperienceLink
                                          , comicPlayerSpreadLink
                                          , comicPlayerFullLink
                                          , comicVideoLink
                                          , handlers
                                          , initModel
                                          , the404
                                          , routes
                                          )
import qualified Com.Simatime.Network as Network
import           Data.Aeson ( eitherDecodeStrict )
import qualified Data.Set as Set
import qualified GHC.Show as Legacy
import           JavaScript.Web.XMLHttpRequest ( Request(..)
                                               , Method(GET)
                                               , 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           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 } <# do 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 } <# do
    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
    }