spork app

Main.purs

import Prelude hiding (div)

import Control.Monad.Eff (Eff)
import DOM (DOM)
import DOM.HTML (window) as DOM
import DOM.HTML.Window (localStorage) as DOM
import DOM.WebStorage.Storage (getItem, setItem) as DOM
import Data.Const (Const)
import Data.Either (hush)
import Data.Maybe (Maybe(..))
import Data.Monoid (mempty)
import Simple.JSON (readJSON, writeJSON)
import Spork.App (BasicApp)
import Spork.App as App
import Spork.Html (Html, button, div, onClick, text)
import Spork.Interpreter (liftNat, merge, never)
  
type Model = { count :: Int } 

data Action = None | Increment | Decrement

data Effect a
  = WriteStorage Model a

render :: Model -> Html Action 
render mod = 
  div []
    [ 
      button [ onClick (const $ Just Decrement)] [ text "-"]
    , div [] [text (show mod.count) ] 
    , button [onClick (const $ Just Increment)] [text "+" ]
    ]

toStorage ∷ Model → App.Transition Effect Model Action
toStorage model =
  { model
  , effects: App.lift (WriteStorage model None)
  }

update :: Model -> Action -> App.Transition Effect Model Action
update model msg = 
  case msg of 
    None      -> App.purely model
    Increment -> toStorage {count : (model.count + 1) } 
    Decrement -> toStorage {count : (model.count - 1) } 

--app :: Maybe Model -> App.App Effect (Const Void) Model Action 
app :: Maybe Model -> BasicApp Effect Model Action 
app storedModel = 
  { 
    render
  , update
  , subs : const mempty
  , init : App.purely model
  }
  where
  model = case storedModel of 
    Nothing -> { count : 0 }
    Just m  -> m
 

runEffect :: ∀ eff. Effect ~> Eff(dom :: DOM | eff)
runEffect = case _ of 
  WriteStorage model next -> do
    let storedModel = { count : model.count }
    DOM.window
      >>= DOM.localStorage
      >>= DOM.setItem "storage-key" (writeJSON storedModel)
    pure next


main :: Eff (App.AppEffects ()) Unit
main = do
  storedModel <- 
    DOM.window
      >>= DOM.localStorage
      >>= DOM.getItem "buttons"
      >>> map (_ >>= readJSON >>> hush)

  inst <-
    App.makeWithSelector
      (liftNat runEffect `merge` never) 
      (app $ storedModel)
      "#app"
  inst.run