Skip to content

Instantly share code, notes, and snippets.

@prozacchiwawa
Created February 13, 2016 12:20
Show Gist options
  • Save prozacchiwawa/07ddbaa914e779b3cbc9 to your computer and use it in GitHub Desktop.
Save prozacchiwawa/07ddbaa914e779b3cbc9 to your computer and use it in GitHub Desktop.
module Main where
import Prelude
import DOM.Node.Types (ElementId(..))
import Signal.Channel
import React
import qualified React.DOM as D
import qualified React.DOM.Props as P
import AppArch
import qualified Count as Count
type Model = { counter :: Int, count :: Count.Game }
data Action
= Increment
| Decrement
| Nop
| CountAct Count.Action
initModel :: Model
initModel = { counter: 0, count: Count.newGameState }
update :: forall eff. Action -> Model -> EffModel (eff) Model Action
update act m =
case act of
Nop -> noFx m
Increment ->
{ model: m { counter = m.counter + 1 }
, effects:
[ do return Nop ]
}
Decrement -> noFx $ m { counter = m.counter - 1 }
CountAct a -> noFx $ m { count = Count.step a m.count }
view :: ReactClass (CompProps Model Action)
view = createClass $ spec unit \ctx -> do
p <- getProps ctx
return $
D.div []
[D.p
[ P.className "Counter"
]
[ D.text (show p.model.counter)
, D.button
[ P.onClick (\_ -> send p.address [Increment]) ]
[ D.text " Click me to increment!" ]
, D.button
[ P.onClick (\_ -> send p.address [Decrement]) ]
[ D.text " Click me to decrement!" ]
],
Count.view (\a -> [CountAct a]) p.address p.model.count
]
main =
runApp
{ init: noFx initModel
, update: update
, view: view
, inputs: []
, renderTarget: ElementId "app"
}
module Count where
import Control.Monad.Eff
import Data.Array (replicate, (!!), updateAt)
import Data.Maybe (Maybe(..))
import Data.Maybe.Unsafe (fromJust)
import Data.Nullable (toMaybe)
import Prelude
import DOM (DOM())
import DOM.HTML (window)
import DOM.HTML.Document (body)
import DOM.HTML.Types (htmlElementToElement)
import DOM.HTML.Window (document)
import DOM.Node.Types (Element())
import React
import qualified React.DOM as D
import qualified React.DOM.Props as P
import Signal.Channel as C
data Action = Inc
type Game = { dummy :: Int }
type Environment a = {
dummy :: Int,
forwardTo :: Action -> a,
channel :: C.Channel a
}
newGameState = { dummy: 0 }
game :: forall a. Environment a -> ReactElement
game env = D.div'
[ D.button [P.onClick (\_ -> C.send env.channel (env.forwardTo Inc))] [D.text "Inc"]
, D.text (show (env.dummy))]
-----------------------------------------------------------
view :: forall a. (Action -> a) -> C.Channel a -> Game -> ReactElement
view forwardTo channel gameState =
game env
where
env = {
dummy: gameState.dummy,
forwardTo: forwardTo,
channel: channel
}
step :: Action -> Game -> Game
step Inc gameState =
gameState { dummy = gameState.dummy + 1 }
-----------------------------------------------------------
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment