{-# 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)
-- First we define our basic datatype. In this case, it is simply
-- a wrapper around an Int.
data ExampleState = ExampleState Int
deriving (Typeable, Show)
{- Here we accept the default for Version, which corresponds to a version number of 0
and no previous versions of the state defined.
You might be saying "Hold on, there, what's all that about?".
I'm going to say "Oh look, a Unicorn!" and hope you remain distracted until the
chapter on versions & migrations. -}
instance Version ExampleState
-- This is a bit of lovely Template Haskell hackery that you really
-- shouldn't think too hard about. Suffice to say, you need to call this.
$(deriveSerialize ''ExampleState)
{- Now we're getting into the real meat of our application!
The Update and Query methods that we can use to actually
manipulate the persistent state.
The two important points are that Update st is a
MonadState st and that Query st is a MonadReader st.
If you have any familiarity with the mtl library, you can
apply all your normal intuition about Reader & State monads
to writing updates and queries.
-}
-- A very simple Update that just increments the state
succVal :: Update ExampleState ()
succVal = modify (\(ExampleState n) -> ExampleState (n+1))
-- A simple Query that just returns the bare Int contained in the state
getVal :: Query ExampleState Int
getVal = do
ExampleState n <- ask
return n
-- An Update that actually takes an argument. That may not seem odd
-- at the moment, but we'll talk more about it in a second.
incVal :: Int -> Update ExampleState ()
incVal i = modify (\(ExampleState n) -> ExampleState (n+i))
-- An Update that makes use of the utility function getRandomR.
-- getRandom or getRandomR can be used in the middle of an Update
-- or Query without needing to perform any unsafe IO magic or somehow
-- carry around a random seed with your state.
-- This Update also serves as a reminder that despite all the deep
-- magic that is used to make Updates and Querys work, these are
-- still legitimate Haskell monads and we can combine them together
-- the same as always.
succRand :: Update ExampleState ()
succRand = getRandomR (0,1000) >>= incVal
{- Another required bit of Template Haskell magic. This will derive
a set of data types to be used in the over all event handling that
are in 1-1 correspondence with the Updates and Querys that you
defined up above. Try compiling this with the -ddump-splices option
in order to actually take a look at what gets created by mkMethods.
The data types will have the same name as your functions except
with a capitalized first letter.
The parameters to your Update or Query become the parameters to the
constructor of your data type. So in this case incVal becomes
IncVal Int.
-}
$(mkMethods ''ExampleState ['succVal, 'getVal, 'incVal, 'succRand])
-- One more thing you can't forget to define in order for MACID to work
-- If your data type is composed from non-primitive data, then you need
-- to build up a type level list using the constructor :+: and the
-- empty dependency End. Another example is going to cover the use of sub components
-- and when you'd want a non-trivial Dependencies type.
instance Component ExampleState where
type Dependencies ExampleState = End
initialValue = ExampleState 0
{-
The way you actually start running a Happstack.State
application is to call startSystemState and pass it
a Proxy. As you can see below in the definition of
rootState, the Proxy type carries no actual data,
it is simply a carrier of the type of your state.
startSystemState is the function you'll most often use
for Happstack.State clients. It uses the default
behavior of serializing data to files under _local.
While this isn't the only option for serialization of
state, it is the only one we will consider in this
tutorial.
-}
rootState :: Proxy ExampleState
rootState = Proxy
main :: IO ()
main = startSystemState rootState >>= commandLoop
commandLoop :: MVar TxControl -> IO ()
commandLoop ctl = do
putStrLn "Enter 'i' to increment the state by a number of your choosing."
putStrLn "Enter 'v' to view the state."
putStrLn "Enter 's' to increment the state by 1."
putStrLn "Enter 'c' to checkpoint the state."
putStrLn "Enter 'r' to increment the state by a random number."
putStrLn "Enter 'q' to quit."
val <- liftM head getLine
handler ctl val
{-
At last, our handler function is quite simple and bare bones.
If you experiment with it at the command line you should able
to watch it work. There isn't much in the way of a UI here,
but it's enough that you can get the flavor of how one uses
Happstack.State in the main application logic.
The two functions I'd like to discuss are query and update.
They operate fairly similarly to each other.
update :: (MonadIO m, UpdateEvent ev res) => ev -> m res
query :: (MonadIO m, QueryEvent ev res) => ev -> m res
You, basically, pass data corresponding to Query functions
to query and Updates to update. That's really what the
type context about UpdateEvent and QueryEvent comes down
to. The really nice thing is that they work for any
MonadIO. In the example below, we just use IO itself, but
since ServerPartT has a MonadIO instance we can very
seamlessly use update & query in our Happstack web apps.
Now, we're explicitly threading through the MVar TxControl
returned by our call to startSystemState into the handler.
It'd probably be cuter to just use a ReaderT (MVar TxControl) IO
but I want to keep this code extremely straight forward.
The only place where we actually need this TxControl is when
calling the createCheckpoint function.
createCheckpoint does exactly what it sounds like. It
serializes a checkpoint of the application state.
You might be wondering what a checkpoint does if the state
is already persistent. Normally Happstack.State serializes
the event log, which is played back whenever the application
is restarted. When you create a checkpoint, you are
serializing out a state you can use as a starting point
for your application when it is restarted. You might
want to try the following outline to build your intuition
for checkpoints.
1. Increment the state a few times
2. Create a checkpoint
3. Increment the state again
4. Close down the app and examine the
_local directory. You should see
the files corresponding to the checkpoint
and the events recorded after it
5. Restart the app. It should be right where
you left it. Close it again.
6. Delete the events files
7. Restart the app. The state should correspond
to the checkpoint you took.
8. ???
9. Profit!
-}
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 'i' = flip catch (const $ commandLoop c) $ do
v <- readLn
update $ IncVal v
commandLoop c
handler c 'c' = createCheckpoint c >> commandLoop c
handler c 'r' = update SuccRand >> commandLoop c
handler c _ = commandLoop c