Miso Navigation

-- | Haskell language pragma
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | Haskell module declaration
module Main where

import Prelude hiding (concat)

-- | Miso framework import
import           Miso
-- import           Miso.Html
import           Miso.String hiding (map)

-- | JSAddle import
-- import           Language.Javascript.JSaddle (eval, runJSM, askJSM, textToJSString)
#ifndef __GHCJS__
import           Language.Javascript.JSaddle.Warp as JSaddle
import qualified Network.Wai.Handler.Warp         as Warp
import           Network.WebSockets
#endif
-- import           Control.Monad.IO.Class

-- | Type synonym for an application model
data Model = Model { header :: String
                   , content :: String
                   , nPages :: Int} deriving (Show, Eq)

-- | Sum type for application events
data Action
  = SetPage Int
  | AddPage
  | RemovePage
  | NoOp
  deriving (Show, Eq)

#ifndef __GHCJS__
runApp :: JSM () -> IO ()
runApp f =
  Warp.runSettings (Warp.setPort 8081 (Warp.setTimeout 3600 Warp.defaultSettings)) =<<
    JSaddle.jsaddleOr defaultConnectionOptions (f >> syncPoint) JSaddle.jsaddleApp
#else
runApp :: IO () -> IO ()
runApp app = app
#endif

-- | Entry point for a miso application
main :: IO ()
main = runApp $ startApp App {..}
  where
    initialAction = NoOp -- initial action to be executed on application load
    model  = Model "hello" "world" 4                   -- initial model
    update = updateModel          -- update function
    view   = viewModel            -- view function
    events = defaultEvents        -- default delegated events
    subs   = []                   -- empty subscription list
    mountPoint = Nothing          -- mount point for application (Nothing defaults to 'body')
    logLevel = Off                -- used during prerendering to see if the VDOM and DOM are in synch (only used with `miso` function)

-- | Updates model, optionally introduces side effects
updateModel :: Action -> Model -> Effect Action Model
updateModel (SetPage pageI) m = noEff $ m {
    header = "page " ++ show pageI
  , content = "page " ++ show pageI ++ " content"
  }
updateModel AddPage m = noEff $ m {nPages = nPages m + 1}
updateModel RemovePage m = noEff $ m {nPages = if nPages m > 0 then nPages m - 1 else 0}
updateModel NoOp m = noEff m

-- | Constructs a virtual DOM from a model
viewModel :: Model -> View Action
viewModel m = div_ [] $
 (map (\i -> button_ [ onClick (SetPage i) ] [ text $ ms $ "Page" ++ show i ]) [1..nPages m])
 <>
 [
   br_ []
 , br_ []
 , button_ [onClick AddPage] [ text "add page" ]
 , button_ [onClick RemovePage] [ text "remove page" ]
 , br_ []
 , h1_ [] [text (ms $ header m)]
 , br_ []
 , text (ms $ content m)
 ]