1 files changed, 0 insertions, 248 deletions
diff --git a/Hero/Node.hs b/Hero/Node.hs
deleted file mode 100644
index 11190e7..0000000
--- a/Hero/Node.hs
+++ /dev/null
@@ -1,248 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
--- | Hero app frontend
---
--- : out mmc.js
-module Hero.Node where
-
-import Alpha
-import Biz.Auth as Auth
-import qualified Data.Aeson as Aeson
-import qualified Data.Set as Set
-import qualified GHC.Show as Legacy
-import GHCJS.Types (JSVal)
-import Hero.Core
-  ( AudioState (..),
-    Comic (..),
-    ComicReaderState (..),
-    ComicReaderView (..),
-    Form (..),
-    LoginForm (..),
-    Move (..),
-    User (..),
-    audioId,
-    chooseExperienceLink,
-    comicReaderFullLink,
-    comicReaderSpreadLink,
-    comicVideoLink,
-    discoverLink,
-    handlers,
-    initForm,
-    routes,
-    the404,
-  )
-import JavaScript.Web.XMLHttpRequest as Ajax
-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
-
--- | Entry point for a miso application
-main :: IO ()
-main = miso <| \currentURI -> App {model = initForm currentURI, ..}
-  where
-    update = move
-    view = see
-    subs =
-      [ uriSub HandleURI,
-        keyboardSub keynav
-      ]
-    events = defaultEvents
-    initialAction = NoOp
-    mountPoint = Nothing
-
-(∈) :: Ord a => a -> Set a -> Bool
-(∈) = Set.member
-
--- | Keyboard navigation - maps keys to actions.
-keynav :: Set Int -> Move
-keynav ks
-  | 37 ∈ ks = PrevPage -- ←
-  | 39 ∈ ks = NextPage -- →
-  | 191 ∈ ks = Dumpform -- ?
-  | 32 ∈ ks = ToggleAudio audioId -- SPC
-  | otherwise = NoOp
-
-see :: Form -> View Move
-see form =
-  case runRoute routes handlers uri form of
-    Left _ -> the404 form
-    Right v -> v
-
--- | Console-logging
-foreign import javascript unsafe "console.log($1);"
-  jslog :: MisoString -> IO ()
-
-foreign import javascript unsafe "$1.value"
-  getValue :: JSVal -> IO MisoString
-
--- | Updates form, optionally introduces side effects
-move :: Move -> Form -> Effect Move Form
-move NoOp form = noEff form
-move Dumpform form =
-  form <# do
-    jslog <| ms <| Legacy.show form
-    pure NoOp
-move (SelectExperience comic) form =
-  form {cpState = ChooseExperience (comicId comic) 1}
-    <# do pure <| ChangeURI <| chooseExperienceLink (comicId comic) 1
-move (StartReading comic) form =
-  form {cpState = Reading Spread (comicId comic) 1}
-    <# do pure <| ChangeURI <| comicReaderSpreadLink (comicId comic) 1
-move (StartWatching comic) form =
-  form {cpState = Watching (comicId comic)}
-    <# do pure <| ChangeURI <| comicVideoLink (comicId comic) 1
-move NextPage form = case cpState form of
-  Reading Spread id pg ->
-    form {cpState = Reading Spread id (pg + 2)} <# do
-      pure <| ChangeURI <| comicReaderSpreadLink id (pg + 2)
-  Reading Full id pg ->
-    form {cpState = Reading Full id (pg + 1)} <# do
-      pure <| ChangeURI <| comicReaderFullLink id (pg + 1)
-  Cover id ->
-    form {cpState = Reading Spread id 1} <# do
-      pure <| ChangeURI <| comicReaderSpreadLink id 1
-  _ -> noEff form
-move PrevPage form = case cpState form of
-  Reading Spread id pg ->
-    form {cpState = Reading Spread id (pg -2)} <# do
-      pure <| ChangeURI <| comicReaderSpreadLink id (pg -2)
-  Reading Full id pg ->
-    form {cpState = Reading Full id (pg -1)} <# do
-      pure <| ChangeURI <| comicReaderFullLink id (pg -1)
-  Cover _ -> noEff form
-  _ -> noEff form
-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 comicReaderSpreadLink)
-      Reading Spread _ _ -> (reading Full, goto comicReaderFullLink)
-      x -> (x, NoOp)
-move (ToggleInLibrary c) form = form {user = newUser} <# pure NoOp
-  where
-    newUser = (user form) {userLibrary = newLib}
-    newLib
-      | c `elem` (userLibrary <| user form) =
-        Alpha.filter (/= c) <| userLibrary <| user form
-      | otherwise = c : (userLibrary <| user form)
-move (HandleURI u) form = form {uri = u} <# pure NoOp
-move (ChangeURI u) form =
-  form <# do
-    pushURI u
-    pure NoOp
-move FetchComics form = form <# (SetComics <$> fetchComics)
-move (SetComics cs) form = noEff form {appComics = cs}
-move (ToggleAudio i) form =
-  form {cpAudioState = newState} <# do
-    el <- Document.getElementById i
-    toggle el
-    pure NoOp
-  where
-    (newState, toggle) = case cpAudioState form of
-      Playing -> (Paused, Audio.pause)
-      Paused -> (Playing, Audio.play)
-move ToggleFullscreen form =
-  form {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 form 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) form =
-  form {dMediaInfo = x}
-    <# case x of
-      Just Comic {comicId = id} ->
-        pure <| ScrollIntoView <| "comic-" <> ms id
-      Nothing ->
-        pure NoOp
-move (ScrollIntoView id) form =
-  form <# do
-    jslog <| ms <| Legacy.show id
-    scrollIntoView id
-    pure NoOp
-move ValidateUserPassword form =
-  batchEff
-    form
-    [doLogin, pure FetchComics, pure <| ChangeURI discoverLink]
-  where
-    doLogin = do
-      user <- getValue =<< Document.getElementById "user"
-      pass <- getValue =<< Document.getElementById "pass"
-      sendLogin (ms user) (ms pass) +> \case
-        Network.Success _ -> pure NoOp
-        -- TODO: handle these error cases
-        Network.Loading -> pure NoOp
-        Network.Failure _ -> pure NoOp
-        Network.NotAsked -> pure NoOp
-
-fetchComics :: IO (Network.RemoteData MisoString [Comic])
-fetchComics =
-  Ajax.xhrByteString req /> Ajax.contents +> \case
-    Nothing ->
-      pure <| Network.Failure "Could not fetch comics from server."
-    Just json ->
-      json
-        |> Aeson.eitherDecodeStrict
-        |> either (Left <. ms) pure
-        |> Network.fromEither
-        |> pure
-  where
-    req =
-      Ajax.Request
-        { Ajax.reqMethod = Ajax.GET,
-          Ajax.reqURI = "/api/comic", -- FIXME: can we replace this hardcoding?
-          Ajax.reqLogin = Nothing,
-          Ajax.reqHeaders = [],
-          Ajax.reqWithCredentials = True,
-          Ajax.reqData = Ajax.NoData
-        }
-
-sendLogin ::
-  -- | User
-  MisoString ->
-  -- | Password
-  MisoString ->
-  IO
-    ( Network.RemoteData
-        MisoString
-        User
-    )
-sendLogin u p =
-  Ajax.xhrByteString req /> Ajax.contents +> \case
-    Nothing ->
-      pure <| Network.Failure "Could not send login request."
-    Just json ->
-      pure <| Network.fromEither
-        <| either (Left <. ms) pure
-        <| Aeson.eitherDecodeStrict json
-  where
-    req =
-      Ajax.Request
-        { Ajax.reqMethod = Ajax.POST,
-          Ajax.reqURI = "/auth",
-          Ajax.reqLogin = Nothing, -- FIXME?
-          Ajax.reqHeaders =
-            [ ("Accept", "application/json"),
-              ("Content-Type", "application/json")
-            ],
-          Ajax.reqWithCredentials = True,
-          Ajax.reqData =
-            LoginForm (fromMisoString u) (fromMisoString p)
-              |> Aeson.encode
-              |> ms
-              |> Ajax.StringData
-        }