happs-tutorial-0.8: src/MultiExample1.hs

{-# LANGUAGE TemplateHaskell, DeriveDataTypeable,
             MultiParamTypeClasses, TypeFamilies,
             FlexibleContexts #-}

module Main where

{- This code is almost identical to the previous MACID examples.
   There's one, and only, major difference between them:
   the replacement of startSystemState with startSystemStateMultimaster.
-}

import Happstack.State

import Data.Typeable
import Control.Monad.State
import Control.Monad.Reader
import Control.Concurrent (MVar)

data ExampleState = ExampleState Int deriving (Typeable)

instance Version ExampleState
$(deriveSerialize ''ExampleState)

succVal :: Update ExampleState ()
succVal = modify (\(ExampleState n) -> ExampleState (succ n))

getVal :: Query ExampleState Int
getVal = do
  ExampleState n <- ask
  return n

$(mkMethods ''ExampleState ['succVal, 'getVal])

instance Component ExampleState where
    type Dependencies ExampleState = End
    initialValue = ExampleState 0

rootState :: Proxy ExampleState
rootState = Proxy

main:: IO ()
main = do
  c <- startSystemStateMultimaster rootState
  commandLoop c

commandLoop :: MVar TxControl -> IO ()
commandLoop c = do
  putStrLn "Enter 'v' to view the state."
  putStrLn "Enter 's' to increment the state by 1."
  putStrLn "Enter 'c' to create a checkpoint."
  putStrLn "Enter 'q' to quit."
  val <- liftM head getLine
  handler c val

handler :: MVar TxControl -> Char -> IO ()
handler _ 'q' = return ()
handler c 'v' = query GetVal >>= print >> commandLoop c
handler c 's' = update SuccVal >> commandLoop c
handler c 'c' = createCheckpoint c >> commandLoop c
handler c _ = commandLoop c