client/src/Main.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

module Main
  ( main
  ) where

import qualified Data.Aeson                           as Aeson
import qualified Data.ByteString.Lazy                 as LB
import qualified Data.JSString.Text                   as Dom
import qualified Data.Text.Encoding                   as T
import qualified JSDOM                                as Dom
import qualified JSDOM.Generated.HTMLElement          as Dom
import qualified JSDOM.Generated.NonElementParentNode as Dom
import           JSDOM.Types                          (HTMLElement (..), JSM,
                                                       JSString)
import qualified JSDOM.Types                          as Dom
import           Prelude                              hiding (error, init)

import           Common.Model                         (InitResult (InitError))
import qualified Common.Msg                           as Msg

import qualified View.App                             as App

main :: JSM ()
main = do
  initResult <- readInit
  App.widget initResult

readInit :: JSM InitResult
readInit = do
  document <- Dom.currentDocumentUnchecked
  initNode <- Dom.getElementById document ("init" :: JSString)

  case initNode of
    Just node -> do
      text <- Dom.textFromJSString <$> Dom.getInnerText (Dom.uncheckedCastTo HTMLElement node)
      return $ case Aeson.decode (LB.fromStrict . T.encodeUtf8 $ text) of
        Just init -> init
        Nothing   -> initParseError
    _ ->
      return initParseError

  where initParseError = InitError $ Msg.get Msg.SignIn_ParseError