70 lines
2.1 KiB
Haskell
70 lines
2.1 KiB
Haskell
-- | Haskell language pragma
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
-- | Haskell module declaration
|
|
module Main where
|
|
|
|
-- | Miso framework import
|
|
import Miso
|
|
import Miso.String
|
|
|
|
-- | JSAddle import
|
|
#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
|
|
newtype Model = Model Int
|
|
deriving (Show, Eq)
|
|
|
|
-- | Sum type for application events
|
|
data Action
|
|
= AddOne
|
|
| SubtractOne
|
|
| NoOp
|
|
| SayHelloWorld
|
|
deriving (Show, Eq)
|
|
|
|
#ifndef __GHCJS__
|
|
runApp :: JSM () -> IO ()
|
|
runApp f = JSaddle.debugOr 8080 (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 = SayHelloWorld -- initial action to be executed on application load
|
|
model = Model 3 -- 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 AddOne (Model m) = noEff $ Model (m + 1)
|
|
updateModel SubtractOne (Model m) = noEff $ Model (m - 1)
|
|
updateModel NoOp m = noEff m
|
|
updateModel SayHelloWorld m = m <# do
|
|
liftIO (putStrLn "Hello World") >> pure NoOp
|
|
|
|
-- | Constructs a virtual DOM from a model
|
|
viewModel :: Model -> View Action
|
|
viewModel (Model m) = div_ [] [
|
|
button_ [ onClick AddOne ] [ text "+" ]
|
|
, text (ms m)
|
|
, button_ [ onClick SubtractOne ] [ text "-" ]
|
|
, div_ [] [ text "UGH" ]
|
|
]
|