happs-tutorial-0.8: src/MultiExample3.hs

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

module Main where

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)

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

$(mkMethods ''ExampleState ['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 '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 'c' = createCheckpoint c >> commandLoop c
handler c _ = commandLoop c