src/client/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 Data.JSString.Text (textFromJSString)
import qualified Data.Text.Encoding as T
import qualified GHCJS.DOM as Dom
import qualified GHCJS.DOM.NonElementParentNode as Dom
import GHCJS.DOM.Types (JSM, Element, JSString)
import Prelude hiding (init, error)

import Common.Model (InitResult(InitEmpty))
import qualified Common.Message as Message
import qualified Common.Message.Key as Key

import qualified View.App as App

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

readInit :: JSM InitResult
readInit = do
  document <- Dom.currentDocumentUnchecked
  initNode <- Dom.getElementById document "init"
  case initNode of
    Just node -> do
      text <- textFromJSString <$> js_getInnerText node
      return $ case Aeson.decode (LB.fromStrict . T.encodeUtf8 $ text) of
        Just init -> init
        Nothing -> initParseError
    _ ->
      return initParseError
  where initParseError = InitEmpty (Left $ Message.get Key.SignIn_ParseError)

foreign import javascript unsafe "$1[\"innerText\"]"
  js_getInnerText :: Element -> IO JSString