aboutsummaryrefslogtreecommitdiff
path: root/server/src/View/Page.hs
blob: 97b84fa993cfadd79360651b4abfd35eb400c450 (plain)
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
module View.Page
  ( page
  ) where

import           Data.Aeson                    (encode)
import qualified Data.Aeson.Types              as Json
import           Data.Text.Internal.Lazy       (Text)
import           Data.Text.Lazy.Encoding       (decodeUtf8)

import           Text.Blaze.Html
import           Text.Blaze.Html.Renderer.Text (renderHtml)
import           Text.Blaze.Html5
import qualified Text.Blaze.Html5              as H
import           Text.Blaze.Html5.Attributes
import qualified Text.Blaze.Html5.Attributes   as A

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

import           Design.Global                 (globalDesign)

page :: InitResult -> Text
page initResult =
  renderHtml . docTypeHtml $ do
    H.head $ do
      meta ! charset "UTF-8"
      meta ! name "viewport" ! content "width=device-width, initial-scale=1, maximum-scale=1, user-scalable=0"
      H.title (toHtml $ Msg.get Msg.App_Title)
      script ! src "/javascript/main.js" $ ""
      jsonScript "init" initResult
      link ! rel "stylesheet" ! type_ "text/css" ! href "/css/reset.css"
      link ! rel "icon" ! type_ "image/png" ! href "/images/icon.png"
      H.style $ toHtml globalDesign

jsonScript :: Json.ToJSON a => Text -> a -> Html
jsonScript scriptId json =
  script
    ! A.id (toValue scriptId)
    ! type_ "application/json"
    $ toHtml . decodeUtf8 . encode $ json