{-# LANGUAGE TemplateHaskell, DeriveDataTypeable, MultiParamTypeClasses, TypeFamilies, FlexibleContexts, TypeSynonymInstances, TypeOperators #-} module Main where {- The following is a fairly simple example using multiple components. It essentially follows the same structure as the previous example with the exception that the final state, State3, doesn't actually contain any data but has the other two states as a part of its dependency. This means we can create Update and Query functions against State1 and State2 and use them both if we make our proxy have type State3. This allows you to make orthogonal components into separate, potentially reusable, modules. -} import Happstack.State import Data.Typeable import Control.Monad.State import Control.Monad.Reader data State1 = State1 Int deriving (Typeable,Show) instance Version State1 $(deriveSerialize ''State1) getState1 :: Query State1 Int getState1 = do State1 n <- ask return n setState1 :: Int -> Update State1 () setState1 = put . State1 $(mkMethods ''State1 ['getState1,'setState1]) instance Component State1 where type Dependencies State1 = End initialValue = State1 0 data State2 = State2 String deriving (Typeable,Show) instance Version State2 $(deriveSerialize ''State2) getState2 :: Query State2 String getState2 = do State2 s <- ask return s setState2 :: String -> Update State2 () setState2 = put . State2 $(mkMethods ''State2 ['getState2,'setState2]) instance Component State2 where type Dependencies State2 = End initialValue = State2 "" data State3 = State3 deriving (Typeable,Show) instance Version State3 $(deriveSerialize ''State3) instance Component State3 where type Dependencies State3 = State1 :+: State2 :+: End initialValue = State3 -- Wait, I haven't defined any methods, so why do I need to call -- mkMethods? mkMethods actually does a good bit of boilerplate -- that you need even if you haven't defined any Update or Query -- methods for your component $(mkMethods ''State3 []) main :: IO () main = do startSystemState (Proxy :: Proxy State3) s1 <- query GetState1 print s1 s2 <- query GetState2 print s2 update $ SetState1 10 update $ SetState2 "TEST"