acid-state is a NoSQL, RAM-cloud, persistent data store. One of attractive feature is that it's designed to store arbitrary Haskell datatypes and queries are written using plain old Haskell code. This means you do not have to learn a special query language, or figure out how to turn your beautiful Haskell datastructures into some limited set of ints and strings.
acid-state and safecopy are the successors to the old happstack-state and happstack-data libraries. You can learn more at the acid-state homepage. acid-state is now completely independent from Happstack and can be used with any web framework. However, Happstack is still committed to the improvement and promotion of acid-state.
Apps written using happstack-state can be migrated to use acid-state relatively easily. Details on the process or documented here.
A very simple way to model a database in Haskell would be to create a datatype to represent your data and then store that data in a mutable, global variable, such as a global IORef
. Then you could just write normal Haskell functions to query that value and update it. No need to learn a special query language. No need to marshal your types from expressive Haskell datatypes to some limited set of types supported by an external database.
That works great.. as long as your application is only single-threaded, and as long as it never crashes, and never needs to be restarted. But, for a web application, those requires are completely unacceptable. The idea is still appealing though. acid-state provides a practical implementation of that idea which actually implements the ACID guarantees that you may be familiar with from traditional relational databases such as MySQL, postgres, etc.
In acid-state
we start by defining a type that represents the state we wish to store. Then we write a bunch of pure functions that query that value or which return an updated value. However, we do not call those functions directly. Instead we keep the value inside an AcidState
handle, and we call our functions indirectly by using the update
and query
functions. This allows acid-state to transparently log update events to disk, to ensure that update and query events run automatically and in isolation, etc. It is allows us to make remote API calls, and, eventually, replication and multimaster.
Note that when we say acid-state is pure, we are referring specifically to the fact that the functions we write to perform updates and queries are pure. acid-state itself must do IO in order to coordinate events from multiple threads, log events to disk, perform remote queries, etc.
Now that you have a vague idea how acid-state works, let's clarify it by looking at some examples.
Our first example is a very simple hit counter app.
First a bunch of LANGUAGE
pragmas and imports:
> {-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, GeneralizedNewtypeDeriving, > MultiParamTypeClasses, TemplateHaskell, TypeFamilies, RecordWildCards #-} > > module Main where > > import Control.Applicative ( (<$>) ) > import Control.Exception ( bracket ) > import Control.Monad ( msum ) > import Control.Monad.Reader ( ask ) > import Control.Monad.State ( get, put ) > import Data.Data ( Data, Typeable ) > import Happstack.Server ( Response, ServerPart, dir, nullDir, nullConf, ok > , simpleHTTP, toResponse ) > import Data.Acid ( AcidState, Query, Update, makeAcidic, openLocalState ) > import Data.Acid.Advanced ( query', update' ) > import Data.Acid.Local ( createCheckpointAndClose ) > import Data.SafeCopy ( base, deriveSafeCopy )
Next we define a type that we wish to store in our state. In this case we just create a simple record with a single field count
:
> data CounterState = CounterState { count :: Integer } > deriving (Eq, Ord, Read, Show, Data, Typeable) > > $(deriveSafeCopy 0 'base ''CounterState) >
deriveSafeCopy
creates an instance of the SafeCopy
class for CounterState
. SafeCopy
is class for versioned serialization, deserilization, and migration. The SafeCopy
class is a bit like a combination of the Read
and Show
classes, except that it converts the data to a compact ByteString
representation, and it includes version information in case the type changes and old data needs to be migrated.
Since this is the first version of the CounterState
type, we give it version number 0 and declare it to be the base
type. Later if we change the type, we will increment the version to 1 and declare it to be an extension
of a previous type. We will also provide a migration instance to migrate the old type to the new type. The migration will happen automatically when the old state is read. For more information on SafeCopy, base, extension
and migration see the haddock docs. (A detailed section on migration for the Crash Course is planned, but not yet written).
If you are not familiar with Template Haskell be sure to read this brief intro to Template Haskell
Next we will define an initial value that is suitable for initializing the CounterState
state.
> initialCounterState :: CounterState > initialCounterState = CounterState 0
Now that we have our types, we can define some update and query functions.
First let's define an update function which increments the count and returns the incremented value:
> incCountBy :: Integer -> Update CounterState Integer > incCountBy n = > do c@CounterState{..} <- get > let newCount = count + n > put $ c { count = newCount } > return newCount >
In this line:
> c@CounterState{..} <- get
we are using the RecordWildCards
extension. The {..}
binds all the fields of the record to symbols with the same name. That is why in the next line we can just write count
instead of (count c)
. Using RecordWildCards
here is completely optional, but tends to make the code less cluttered, and easier to read.
Also notice that we are using the get
and put
functions from MonadState
to get and put the ACID state. The Update
monad is basically an enchanced version of the State
monad. For the moment it is perhaps easiest to just pretend that incCountBy
has the type signature:
> incCountBy :: Integer -> State CounterState Integer
And then it becomes clearer that incCountBy
is just a simple function in the State
monad which updates CounterState
and returns an Integer
.
Note that even though we are using a monad here.. the code is still pure. If we wanted we could have required the update function to have a type like this instead:
> incCountBy :: Integer -> CounterState -> (CounterState, Integer)
In that version, the current state is explicitly passed in, and the function explicitly returns the updated state. The monadic version does the same thing, but uses >>=
to make the plumbing easier. This makes the monadic version easier to read and reduces mistakes.
When we later use the update
function to call incCountBy
, incCountBy
will be run in an isolated manner (the 'I' in ACID). That means that you do not need to worry about some other thread modifying the CounterState
between the get
and the put
. It will also be run atomically (the 'A' in ACID), meaning that either the whole function will run or it will not run at all. If the server is killed mid-transaction, the transaction will either be completely applied or not applied at all.
You may also note that Update
(and State
) are not instances of the MonadIO
class. This means you can not perform IO inside the update. This is by design. In order to ensure Durability and to support replication, events need to be pure. That allows us to be confident that if the event log has to be replayed -- it will result in the same state we had before.
We can also define a query which reads the state, and does not update it:
> peekCount :: Query CounterState Integer > peekCount = count <$> ask >
The Query
monad is an enhanced version of the Reader
monad. So we can pretend that peekCount
has the type:
> peekCount :: Reader CounterState Integer
Although we could have just used get
in the Update
monad, it is better to use the Query
monad if you are doing a read-only operation because it will not block other database transactions. It also lets the user calling the function know that the database will not be affected.
Next we have to turn the update and query functions into acid-state events. This is almost always done by using the template haskell function makeAcidic
> $(makeAcidic ''CounterState ['incCountBy, 'peekCount]) >
The makeAcidic
function creates a bunch of boilerplate types and type class instances. If you want to see what is happening under the hood, check out the examples here. The examples with names like, HelloWorldNoTH.hs show how to implement the boilerplate by hand. In practice, you will probably never want to or need to do this. But you may find it useful to have a basic understanding of what is happening. You could also use the -ddump-splices
flag to ghc to see the auto-generated instances -- but the lack of formatting makes it difficult to read.
Here we actually call our query and update functions:
> handlers :: AcidState CounterState -> ServerPart Response > handlers acid = > msum [ dir "peek" $ do c <- query' acid PeekCount > ok $ toResponse $ "peeked at the count and saw: " ++ show c > , do nullDir > c <- update' acid (IncCountBy 1) > ok $ toResponse $ "New count is: " ++ show c > > ] >
Note that we do not call the incCountBy
and peekCount
functions directly. Instead we invoke them using the update'
and query'
functions:
> update' :: (UpdateEvent event, MonadIO m) => > AcidState (EventState event) -- ^ handle to acid-state > -> event -- ^ update event to execute > -> m (EventResult event) > query' :: (QueryEvent event , MonadIO m) => > AcidState (EventState event) -- ^ handle to acid-state > -> event -- ^ query event to execute > -> m (EventResult event)
Thanks to makeAcidic
, the functions that we originally defined now have types with the same name, but starting with an uppercase letter:
> data PeekCount = PeekCount > data IncCountBy = IncCountBy Integer
The arguments to the constructors are the same as the arguments to the original function.
So now we can decipher the meaning of the type for the update'
and query'
functions. For example, in this code:
> c <- update' acid (IncCountBy 1)
The event is (IncCountBy 1)
which has the type IncCountBy
. Since there is an UpdateEvent IncCountBy
instance, we can use this event with the update'
function. That gives us:
> update' :: (UpdateEvent IncCountBy, MonadIO m) => > AcidState (EventState IncCountBy) > -> IncCountBy > -> m (EventResult IncCountBy)
EventState
is a type function. EventState IncCountBy
results in the type CounterState
. So that reduces to AcidState CounterState
. So, we see that we can not accidently call the IncCountBy
event against an acid state handle of the wrong type.
EventResult
is also a type function. EventResult IncCountBy
is Integer
, as we would expect from the type signature for IncCountBy
.
As mentioned earlier, the underlying update and query events we created are pure functions. But, in order to have a durable database (aka, be able to recover after powerloss, etc) we do need to log these pure events to disk so that we can reply them in the event of a recovery. So, rather than invoke our update and query events directly, we call them indirectly via the update
and query
functions. update
and query
interact with the acid-state
system to ensure that the acid-state events are properly logged, called in the correct order, run atomitically and isolated, etc.
There is no way in Haskell to save a function to save a function to disk or send it over the network. So, acid-state has to cheat a little. Instead of storing the function, it just stores the name of the function and the value of its arguments. That is what the IncCountBy
type is for -- it is the value that can be serialized and saved to disk or sent over the network.
Finally, we have our main function:
> main :: IO () > main = > do bracket (openLocalState initialCounterState) > (createCheckpointAndClose) > (\acid -> > simpleHTTP nullConf (handlers acid))
openLocalState
starts up acid-state and returns an handle. If existing state is found on the disk, it will be automatically restored and used. If no pre-existing state is found, then initialCounterState
will be used. openLocalState
stores data in a directory named state/[typeOf state]. In this example, that would be, state/CounterState. If you want control over where the state information is stored use openLocalStateFrom
instead.
The shutdown sequence creates a checkpoint when the server exits. This is good practice because it helps the server start faster, and makes migration go more smoothly. Calling createCheckpointAndClose
is not critical to data integrity. If the server crashes unexpectedly, it will replay all the logged transactions (Durability). However, it is a good idea to create a checkpoint on close. If you change an existing update event, and then tried to replay old versions of the event, things would probably end poorly. However, restoring from a checkpoint does not require the old events to be replayed. Hence, always creating a checkpoint on shutdown makes it easier to upgrade the server.
[Source code for the app is here.]
To use IxSet you will need to install the optional ixset package.
In the first acid-state example we stored a single value. But in real database we typically need to store a large collection of records. And we want to be able to efficiently search and update those records. For simple key/value pairs we can use Data.Map
. However, in practice, we often want to have multiple keys. That is what IxSet
set offers -- a set-like type which can be indexed by multiple keys.
Instead of having:
> Set Foo
we will have:
> IxSet Foo
with the ability to do queries based on the indices of Foo
, which are defined using the Indexable
type-class.
IxSet can be found here on hackage.
In this example, we will use IxSet
to create a mini-blog.
> {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, RecordWildCards > , TemplateHaskell, TypeFamilies, OverloadedStrings #-}
> module Main where
> import Control.Applicative ((<$>), optional) > import Control.Exception (bracket) > import Control.Monad (msum, mzero) > import Control.Monad.Reader (ask) > import Control.Monad.State (get, put) > import Control.Monad.Trans (liftIO) > import Data.Acid (AcidState, Update, Query, makeAcidic, openLocalState) > import Data.Acid.Advanced (update', query') > import Data.Acid.Local (createCheckpointAndClose) > import Data.Data (Data, Typeable) > import Data.IxSet ( Indexable(..), IxSet(..), (@=), Proxy(..), getOne > , ixFun, ixSet ) > import qualified Data.IxSet as IxSet > import Data.SafeCopy (SafeCopy, base, deriveSafeCopy) > import Data.Text (Text) > import Data.Text.Lazy (toStrict) > import qualified Data.Text as Text > import Data.Time (UTCTime(..), getCurrentTime) > import Happstack.Server ( ServerPart, Method(POST, HEAD, GET), Response, decodeBody > , defaultBodyPolicy, dir, lookRead, lookText, method > , notFound, nullConf, nullDir, ok, seeOther, simpleHTTP > , toResponse) > import Text.Blaze ((!), Html) > import qualified Text.Blaze.Html4.Strict as H > import qualified Text.Blaze.Html4.Strict.Attributes as A
The first thing we are going to need is a type to represent a blog post.
It is convenient to assign a unique id to each blog post so that it can be easily referenced in urls and easily queried in the IxSet
. In order to keep ourselves sane, we can create a newtype
wrapper around an Integer
instead of just using a nameless Integer
.
> newtype PostId = PostId { unPostId :: Integer } > deriving (Eq, Ord, Data, Enum, Typeable, SafeCopy)
Note that in addition to deriving normal classes like Eq
and Ord
, we also derive an instance of SafeCopy
. This is not required by IxSet
itself, but since we want to store the our blog posts in acid-state
we will need it there.
A blog post will be able to have two statuses 'draft' and 'published'. We could use a boolean value, but it is easier to understand what Draft
and Published
mean instead of trying to remember what True
and False
mean. Additionally, we can easily extend the type with additional statuses later.
> data Status = > Draft > | Published > deriving (Eq, Ord, Data, Typeable) > > $(deriveSafeCopy 0 'base ''Status)
And now we can create a simple record which represents a single blog post:
> data Post = Post > { postId :: PostId > , title :: Text > , author :: Text > , body :: Text > , date :: UTCTime > , status :: Status > , tags :: [Text] > } > deriving (Eq, Ord, Data, Typeable) > > $(deriveSafeCopy 0 'base ''Post)
Each IxSet
key needs to have a unique type. Looking at Post
it seems like that could be trouble -- because we have multiple fields which all have the type Text
. Fortunately, we can easily get around this by introducing some newtypes which are used for indexing.
> newtype Title = Title Text deriving (Eq, Ord, Data, Typeable, SafeCopy) > newtype Author = Author Text deriving (Eq, Ord, Data, Typeable, SafeCopy) > newtype Tag = Tag Text deriving (Eq, Ord, Data, Typeable, SafeCopy) > newtype WordCount = WordCount Int deriving (Eq, Ord, Data, Typeable, SafeCopy)
We are now ready to create an instance of the Indexable
class. This is the class that defines the keys for a Post
so that we can store it in an IxSet
:
> instance Indexable Post where > empty = ixSet [ ixFun $ \bp -> [ postId bp ] > , ixFun $ \bp -> [ Title $ title bp ] > , ixFun $ \bp -> [ Author $ author bp ] > , ixFun $ \bp -> [ status bp ] > , ixFun $ \bp -> map Tag (tags bp) > , ixFun $ (:[]) . date -- point-free, just for variety > , ixFun $ \bp -> [ WordCount (length $ Text.words $ body bp) ] > ] >
In the Indexable Post
instance we create a list of Ix Post
values by using the ixFun
helper function:
> ixFun :: (Ord b, Typeable b) => (a -> [b]) -> Ix a
We pass to ixFun
a key extraction function. For example, in this line:
> ixFun $ \bp -> [ postId bp ]
we extract the PostId
from a Post
. Note that we return a list of keys values not just a single key. That is because a single entry might have several keys for a specific type. For example, a Post
has a list of tags. But, we want to be able to search for posts that match a specific tag. So, we index each tag separately:
> ixFun $ \bp -> map Tag (tags bp)
Note that the keys do not have to directly correspond to a field in the record. We can perform calculations to create arbitrary keys. For example, the WordCount
key calculates the number of words in a post:
> ixFun $ \bp -> [ WordCount (length $ Text.words $ body bp) ]
For the Title
and Author
keys we add the newtype wrapper.
Now we will create the record that we will use with acid-state to hold the IxSet Post
and other state information.
> data Blog = Blog > { nextPostId :: PostId > , posts :: IxSet Post > } > deriving (Data, Typeable) > > $(deriveSafeCopy 0 'base ''Blog) > > initialBlogState :: Blog > initialBlogState = > Blog { nextPostId = PostId 1 > , posts = empty > }
IxSet
does not (currently) provide any auto-increment functionality for indexes, so we have to keep track of what the next available PostId
is ourselves. That is why we have the nextPostId
field. (Feel free to submit a patch that adds an auto-increment feature to IxSet
!).
Note that in initialBlogState
the nextPostId
is initialized to 1 not 0. Sometimes we want to create a Post
that is not yet in the database, and hence does not have a valid PostId
. I like to reserve PostId 0
to mean uninitialized. If I ever see a PostId 0
stored in the database, I know there is a bug in my code.
Next we will create some update and query functions for our acid-state database.
> -- | create a new, empty post and add it to the database > newPost :: UTCTime -> Update Blog Post > newPost pubDate = > do b@Blog{..} <- get > let post = Post { postId = nextPostId > , title = Text.empty > , author = Text.empty > , body = Text.empty > , date = pubDate > , status = Draft > , tags = [] > } > put $ b { nextPostId = succ nextPostId > , posts = IxSet.insert post posts > } > return post
Nothing in that function should be too surprising. We have to pass in UTCTime
, because we can not do IO in the update function. Because PostId
is an instance of Enum
we can use succ
to increment it. To add the new post to the IxSet
we use IxSet.insert
.
> insert :: (Typeable a, Ord a, Indexable a) => a -> IxSet a -> IxSet a
Next we have a function that updates an existing Post
in the database with a newer version:
> -- | update the post in the database (indexed by PostId) > updatePost :: Post -> Update Blog () > updatePost updatedPost = > do b@Blog{..} <- get > put $ b { posts = IxSet.updateIx (postId updatedPost) updatedPost posts > }
Note that instead of insert
we use updateIx
:
> updateIx :: (Indexable a, Ord a, Typeable a, Typeable key) => > key > -> a > -> IxSet a > -> IxSet a
The first argument to updateIx
is a key that maps to the post we want to updated in the database. The key must uniquely identify a single entry in the database. In this case we use our primary key, PostId
.
Next we have some query functions.
> postById :: PostId -> Query Blog (Maybe Post) > postById pid = > do Blog{..} <- ask > return $ getOne $ posts @= pid
postById
is used to lookup a specific post by its PostId
. This is our first example of querying an IxSet
. Here we use the equals query operator:
> (@=) :: (Typeable key, Ord a, Typeable a, Indexable a) => IxSet a -> key -> IxSet a
It takes an IxSet
and filters it to produce a new IxSet
which only contains values that match the specified key. In this case, we have specified the primary key (PostId
), so we expect exactly zero or one values in the resulting IxSet
. We can use getOne
to turn the result into a simple Maybe
value:
> getOne :: Ord a => IxSet a -> Maybe a
Proxy
typeHere is a query function that gets all the posts with a specific status (Published
vs Draft
) and sorts them in reverse chronological order (aka, newest first):
> postsByStatus :: Status -> Query Blog [Post] > postsByStatus status = > do Blog{..} <- ask > return $ IxSet.toDescList (Proxy :: Proxy UTCTime) $ posts @= status
We use the @=
operator again to select just the posts which have the matching status. Since the publication date is a key (UTCTime
) we can use toDescList
to return a sorted list:
> toDescList :: (Typeable k, Typeable a, Indexable a) => Proxy k -> IxSet a -> [a]
toDescList
takes a funny argument (Proxy :: Proxy UTCTime)
. While the Post
type itself has an Ord
instance -- we generally want to order by a specific key, which may have a different ordering. Since our keys are specified by type, we need a way to pass a type to 'toDescList' so that it knows which key we want to order by. The Proxy
type exists for that sole reason:
> data Proxy a = Proxy
It just gives us a place to stick a type signature that toDescList
and other functions can use.
You have now seen the basics of using IxSet
. IxSet
includes numerous other operations such as range-based queries, deleting records, convert to and from lists and Sets. See the haddock docs for a complete list of functions and their descriptions. You should have no difficulty understanding what they do based on what we have already seen.
The remainder of the code in this section integrates the above code into a fully functioning example. In order to keep things simple I have just used blaze-html. In a real application I would use digestive-functors to deal with the form generation and validation. (I would probably also use web-routes to provide type-safe urls, and HSP for the templates). But those topics will be covered elsewhere. The remainder of the code in this section does not continue any new concepts that have not already been covered in previous sections of the crash course.
> $(makeAcidic ''Blog > [ 'newPost > , 'updatePost > , 'postById > , 'postsByStatus > ])
> -- | HTML template that we use to render all the pages on the site > template :: Text -> [Html] -> Html -> Response > template title headers body = > toResponse $ > H.html $ do > H.head $ do > css > H.title (H.toHtml title) > H.meta ! A.httpEquiv "Content-Type" ! A.content "text/html;charset=utf-8" > sequence_ headers > H.body $ do > H.ul ! A.id "menu" $ do > H.li $ H.a ! A.href "/" $ "home" > H.li $ H.a ! A.href "/drafts" $ "drafts" > H.li $ H.form ! A.enctype "multipart/form-data" > ! A.method "POST" > ! A.action "/new" $ H.button $ "new post" > body >
> -- | CSS for our site > -- > -- Normally this would live in an external .css file. > -- It is included inline here to keep the example self-contained. > css :: Html > css = > let s = Text.concat [ "body { color: #555; padding: 0; margin: 0; margin-left: 1em;}" > , "ul { list-style-type: none; }" > , "ol { list-style-type: none; }" > , "h1 { font-size: 1.5em; color: #555; margin: 0; }" > , ".author { color: #aaa; }" > , ".date { color: #aaa; }" > , ".tags { color: #aaa; }" > , ".post { border-bottom: 1px dotted #aaa; margin-top: 1em; }" > , ".bdy { color: #555; margin-top: 1em; }" > , ".post-footer { margin-top: 1em; margin-bottom: 1em; }" > , "label { display: inline-block; width: 3em; }" > , "#menu { margin: 0; padding: 0; margin-left: -1em;" > , "border-bottom: 1px solid #aaa; }" > , "#menu li { display: inline; margin-left: 1em; }" > , "#menu form { display: inline; margin-left: 1em; }" > ] > in H.style ! A.type_ "text/css" $ H.toHtml s >
> edit :: AcidState Blog -> ServerPart Response > edit acid = > do pid <- PostId <$> lookRead "id" > mMsg <- optional $ lookText "msg" > mPost <- query' acid (PostById pid) > case mPost of > Nothing -> > notFound $ template "no such post" [] $ do "Could not find a post with id " > H.toHtml (unPostId pid) > (Just p@(Post{..})) -> > msum [ do method GET > ok $ template "foo" [] $ do > case mMsg of > (Just msg) | msg == "saved" -> "Changes saved!" > _ -> "" > H.form ! A.enctype "multipart/form-data" > ! A.method "POST" > ! A.action (H.toValue $ "/edit?id=" ++ > (show $ unPostId pid)) $ do > H.label "title" ! A.for "title" > H.input ! A.type_ "text" > ! A.name "title" > ! A.id "title" > ! A.size "80" > ! A.value (H.toValue title) > H.br > H.label "author" ! A.for "author" > H.input ! A.type_ "text" > ! A.name "author" > ! A.id "author" > ! A.size "40" > ! A.value (H.toValue author) > H.br > H.label "tags" ! A.for "tags" > H.input ! A.type_ "text" > ! A.name "tags" > ! A.id "tags" > ! A.size "40" > ! A.value (H.toValue $ Text.intercalate ", " tags) > H.br > H.label "body" ! A.for "body" > H.br > H.textarea ! A.cols "80" ! A.rows "20" ! A.name "body" $ H.toHtml body > H.br > H.button ! A.name "status" ! A.value "publish" $ "publish" > H.button ! A.name "status" ! A.value "save" $ "save as draft" > , do method POST > ttl <- lookText' "title" > athr <- lookText' "author" > tgs <- lookText' "tags" > > bdy <- lookText' "body" > now <- liftIO $ getCurrentTime > stts <- do s <- lookText' "status" > case s of > "save" -> return Draft > "publish" -> return Published > _ -> mzero > let updatedPost = > p { title = ttl > , author = athr > , body = bdy > , date = now > , status = stts > , tags = map Text.strip $ Text.splitOn "," tgs > } > update' acid (UpdatePost updatedPost) > case status of > Published -> > seeOther ("/view?id=" ++ (show $ unPostId pid)) > (toResponse ()) > Draft -> > seeOther ("/edit?msg=saved&id=" ++ (show $ unPostId pid)) > (toResponse ()) > ] > > where lookText' = fmap toStrict . lookText
> -- | create a new blog post in the database , and then redirect to /edit > new :: AcidState Blog -> ServerPart Response > new acid = > do method POST > now <- liftIO $ getCurrentTime > post <- update' acid (NewPost now) > seeOther ("/edit?id=" ++ show (unPostId $ postId post)) (toResponse ())
> -- | render a single blog post into an HTML fragment > postHtml :: Post -> Html > postHtml (Post{..}) = > H.div ! A.class_ "post" $ do > H.h1 $ H.toHtml title > H.div ! A.class_ "author" $ do "author: " >> H.toHtml author > H.div ! A.class_ "date" $ do "published: " >> H.toHtml (show date) > H.div ! A.class_ "tags" $ do "tags: " >> H.toHtml (Text.intercalate ", " tags) > H.div ! A.class_ "bdy" $ H.toHtml body > H.div ! A.class_ "post-footer" $ do > H.span $ H.a ! A.href (H.toValue $ "/view?id=" ++ > show (unPostId postId)) $ "permalink" > H.span $ " " > H.span $ H.a ! A.href (H.toValue $ "/edit?id=" ++ > show (unPostId postId)) $ "edit this post"
> -- | view a single blog post > view :: AcidState Blog -> ServerPart Response > view acid = > do pid <- PostId <$> lookRead "id" > mPost <- query' acid (PostById pid) > case mPost of > Nothing -> > notFound $ template "no such post" [] $ do "Could not find a post with id " > H.toHtml (unPostId pid) > (Just p) -> > ok $ template (title p) [] $ do > (postHtml p)
> -- | render all the Published posts (ordered newest to oldest) > home :: AcidState Blog -> ServerPart Response > home acid = > do published <- query' acid (PostsByStatus Published) > ok $ template "home" [] $ do > mapM_ postHtml published
> -- | show a list of all unpublished blog posts > drafts :: AcidState Blog -> ServerPart Response > drafts acid = > do drafts <- query' acid (PostsByStatus Draft) > case drafts of > [] -> ok $ template "drafts" [] $ "You have no unpublished posts at this time." > _ -> > ok $ template "home" [] $ > H.ol $ mapM_ editDraftLink drafts > where > editDraftLink Post{..} = > H.a ! A.href (H.toValue $ "/edit?id=" ++ show (unPostId postId)) $ H.toHtml title
> -- | route incoming requests > route :: AcidState Blog -> ServerPart Response > route acid = > do decodeBody (defaultBodyPolicy "/tmp/" 0 1000000 1000000) > msum [ dir "favicon.ico" $ notFound (toResponse ()) > , dir "edit" $ edit acid > , dir "new" $ new acid > , dir "view" $ view acid > , dir "drafts" $ drafts acid > , nullDir >> home acid > ]
> -- | start acid-state and the http server > main :: IO () > main = > do bracket (openLocalState initialBlogState) > (createCheckpointAndClose) > (\acid -> > simpleHTTP nullConf (route acid))
[Source code for the app is here.]
To use IxSet with Data.Lens you will need to install the optional data-lens-ixset, data-lens-template, and data-lens-fd packages.
It is very common to use records and nested records with IxSet
and acid-state
. Unfortunately, Haskell record support is pretty pitiful at the moment. People have been proposing improvements for years -- but until some proposals get implemented we need some way to make life more pleasant. One popular solution is the data-lens library.
At first, lenses sound like they must be something really crazy or difficult -- like Arrows
but even worse! But, in reality, lenses are pretty simple. Lenses are really just some new syntax to make it easy to compose getters, setters, and modifiers.
It can take a bit of practice to get used to lenses. But, fortunately, using them is completely optional -- so if they are not your thing, you don't have to use them. In this tutorial we will start with a general introduction to using lenses, and then finish up with showing how to use them with IxSet
and acid-state
.
> {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving > , OverloadedStrings, TemplateHaskell #-}
> module Main where > > import Control.Applicative (pure) > import Control.Category ((.), (>>>)) > import Control.Comonad.Trans.Store.Lazy > import Data.Acid (Update) > import Data.Data (Data, Typeable) > import Data.IxSet (IxSet, Indexable(empty), (@=), fromList, ixFun, ixSet) > import Data.Lens ( Lens, (^$), (^.), (^=), (^%=), (^%%=), (^+=), (%=) > , getL, setL, modL) > import Data.Lens.Template (makeLens) > import Data.Lens.IxSet (ixLens) > import Data.Lens.Partial.Common (PartialLens(..), maybeLens, totalLens) > import Data.SafeCopy (SafeCopy, base, deriveSafeCopy) > import Data.Text (Text) > import Prelude hiding ((.))
We start by defining a simple User
record which contains some nested records:
> newtype UserId = UserId { _userInt :: Integer } > deriving (Eq, Ord, Data, Typeable, SafeCopy, Show) > > $(makeLens ''UserId) > > data Name = Name > { _nickName :: Text > , _firstName :: Text > , _lastName :: Text > } > deriving (Eq, Ord, Data, Typeable, Show) > > $(deriveSafeCopy 0 'base ''Name) > $(makeLens ''Name) > > data User = User > { _userId :: UserId > , _name :: Name > } > deriving (Eq, Ord, Data, Typeable, Show) > > $(deriveSafeCopy 0 'base ''User) > $(makeLens ''User) > > -- | example user > stepcut :: User > stepcut = > User { _userId = UserId 0 > , _name = Name { _nickName = "stepcut" > , _firstName = "Jeremy" > , _lastName = "Shaw" > } > }
There are two things to notice:
the field names all start with an underscore. That is because new helper functions will be generated that do not contain the underscore.
there is a template haskell call $(makeLens ''Type)
. This template haskell call generates lens functions based on the fields in the record. If you want to see what it is actually generating you can compile with -ddump-splices. Here is one of the lenses generated by $(makeLens ''User)
:
> userId :: Lens User UserId > userId = lens _userId (\ uid user -> user { _userId = uid })
We see that a lens is basically just a getter function and a setter function. In this case, a getter function that can get a UserId
from a User
and a setter function that can set the UserId
in a User
.
There are two getter operators: one for left-to-right composition and one for right-to-left composition. There is also a getter function. They all serve the same purpose -- it's just a matter of taste which you use.
The first operator is:
> (^$), (^$!) :: Lens a b -> a -> b
There are two variations ^$
is the normal version. ^$!
does the same thing except that internally it uses $!
to more strictly evaluate the calculation. It is used like this:
> stepcutFirstName :: Text > stepcutFirstName = firstName ^$ name ^$ stepcut
Notice that ^$
is used a lot like $
. In fact we could write this with out lenses at all like this:
> stepcutFirstName2 :: Text > stepcutFirstName2 = _firstName $ _name $ stepcut
The other getter operator is:
> (^.), (^!) :: a -> Lens a b -> b
Where ^.
is the normal version and ^!
is the stricter version.
We can use it like this:
> stepcutFirstName3 :: Text > stepcutFirstName3 = (stepcut ^. name) ^. firstName
So, here ^.
is meant to act like a field accessor in a traditional object oriented language where we would write:
Finally, we have the getL
function:
> getL :: Lens a b -> a -> b
getL
is useful for creating partially applied functions. For
example, we can create a function that gets a User
's first name like
this:
> getFirstName :: User -> Text > getFirstName = getL firstName . getL name
Category
Lens
is an instance of Category
. That means we can use the .
operator from Category
to compose lenses.
The normal .
looks like this:
> -- | as defined in 'Prelude' > (.) :: (b -> c) -> (a -> b) -> a -> c
But .
can be generalized to work for any Category
like this:
> -- | as defined in 'Control.Category' > (.) :: (Category cat) => cat b c -> cat a b -> cat a c
If you look closely at the imports at the top, you will notice that we hide .
from the Prelude
and imported the version from Control.Category
instead. Now we can write this:
> stepcutFirstName4 :: Text > stepcutFirstName4 = firstName . name ^$ stepcut
Which looks very similar to the non-lens version:
> stepcutFirstName5 :: Text > stepcutFirstName5 = _firstName . _name $ stepcut
If we look at the type of firstName . name
we see that we just get a lens that goes straight from User
to Text
:
Next we have the setter operator. This is where lenses start to shine. The setter operator is:
> (^=), (^!=) :: Lens a b -> b -> a -> a
Once again we have a lazier version ^=
and a stricter version ^!=
.
We can use it to update the UserId
in the User
type like this:
> setUserId :: (User -> User) > setUserId = userId ^= (UserId 1)
So, we see that ^=
is used to create an update function. If we wanted to update a specific record we could write it like this:
> setStepcutUserId :: User > setStepcutUserId = userId ^= (UserId 1) $ stepcut
Instead of the infix operator we could instead setL
:
> setL :: Lens a b -> b -> a -> a
as such:
> setUserId' :: (User -> User) > setUserId' = setL userId (UserId 1)
Often times we want to apply a function to transform an existing value rather than just setting a new value. For that we use:
> (^%=), (^!%=) :: Lens a b -> (b -> b) -> a -> a
For example, we can increment the Integer
inside the UserId
like so:
> incUserId :: UserId -> UserId > incUserId = (userInt ^%= succ)
Or we could use the modL
function:
> modL :: Lens a b -> (b -> b) -> a -> a
> incUserId' :: UserId -> UserId > incUserId' = modL userInt succ
If we want to update a nested record then need to combine setters and modifiers. For example, we can update the nickName
like this:
> setNick :: Text -> (User -> User) > setNick nick = name ^%= (nickName ^= nick)
That says we want to modify the name
field of a User
by setting the nickName
of the Name
.
Another option would be to leverage the Category
instance for Lens
and use the .
operator:
> setNick2 :: Text -> (User -> User) > setNick2 newNick = (nickName . name) ^= newNick
However, I find that a bit confusing to read, because the field names are listed right-to-left, but the overall flow of that line is left-to-right. If we want a consistent left-to-right feel we can use the >>>
operator:
> (>>>) :: Control.Category.Category cat => cat a b -> cat b c -> cat a c
> setNick3 :: Text -> (User -> User) > setNick3 newNick = (name >>> nickName) ^= newNick
The lens library also provides some operators that encapsulate common updates such as addition and subtraction. For example,
> addToUserId :: Integer -> (UserId -> UserId) > addToUserId i = (userInt ^+= i)
IxSet
So far we have examined updating fields in a record. But there is no reason why a lens need to be limited to a record. The idea can be used with just about any type where we have the ability to focus on a single element. We can create a lens for an IxSet
by using this ixLens
function:
> ixLens :: (Typeable key, Indexable a, Typeable a, Ord a) => > key > -> Lens (IxSet a) (Maybe a)
For records, the names of the fields are known at compile time, so we were able to automatically create helper functions like userId
, name
, etc, to address those fields. For an IxSet
we generally want to address some value by a key that is determined at runtime, so we can not automatically generate helper functions.
First we need an Indexable User
instance:
> instance Indexable User where > empty = ixSet [ ixFun $ \u -> [ userId ^$ u ] > ]
And then we will add the IxSet
to a state record:
> data UserState = UserState > { _nextUserId :: UserId > , _users :: IxSet User > } > deriving (Eq, Ord, Data, Typeable, Show) > > $(deriveSafeCopy 0 'base ''UserState) > $(makeLens ''UserState) > > userState :: UserState > userState = > UserState { _nextUserId = UserId 1 > , _users = fromList [ stepcut ] > } >
IxSet
It is not a bad idea to define an alias for ixLens
that has a more meaningful name and a more explicit type:
> user :: (Typeable key) => key -> Lens (IxSet User) (Maybe User) > user = ixLens
That will help make it easier to read the code, and will make type errors more readable.
Now we can extract the User
with UserId 0
from userState
:
> user0 :: Maybe User > user0 = user (UserId 0) ^$ users ^$ userState
IxSet
We can use the setter operator to add a new record to an IxSet
:
> addUserId1 :: UserState > addUserId1 = > let stepcut1 = userId ^= (UserId 1) $ stepcut -- create a duplicate of the stepcut > -- record but with 'UserId 1' > in (users ^%= user (userId ^$ stepcut1) ^= (Just stepcut1)) userState
So, there is something a little tricky going on here. Under the hood,
we are using updateIx
to insert the record. In this case, we are
updating the non-existing record for UserId 1
.
An updateIx
is performed by deleting the old record (if it exists) and inserting
the new one. However, the key used to delete the old record may not
match the key in the new record we are inserting. For example, if we
did:
> addUserId1' :: UserState > addUserId1' = > let stepcut1 = userId ^= (UserId 1) $ stepcut -- create a duplicate of the stepcut > -- record but with 'UserId 1' > in (users ^%= user (UserId 0) ^= (Just stepcut1)) userState
That would delete the existing UserId 0
record and add a UserId 1
record instead. It would not insert the stepcut1
record as UserId 0
.
IxSet
We can delete an element from an IxSet
by updating it with Nothing
.
> deleteUserId0 :: UserState > deleteUserId0 = (users ^%= user (UserId 0) ^= Nothing) userState
IxSet
Here we update the nickName
for UserId 0
:
> changeNick :: UserState > changeNick = > (users ^%= user (UserId 0) ^%= fmap (name ^%= (nickName ^= "stepkut"))) userState
In a traditional imperative language we write changeNick something like:
Looking at the two, you can see the similarity, even if the syntax is not as nice.
One important things to note is that the ixLens
returns a Maybe
value since we might request a non-existent UserId
. Here we use fmap
to set the nick inside the Maybe
value. However, that means that for a non-existent UserId
the update silently does nothing. Sometimes that is ok, but if not, then you will need to take a different approach.
We can also try to use >>>
instead of all those ^%=
, but the fmap
is a bit troublesome:
> changeNick2 :: UserState > changeNick2 = > ((users >>> user (UserId 0)) ^%= fmap ((name >>> nickName) ^= "stepkut")) userState
Additionally, it seems like ^%=
binds too tightly and so we need some extra ( )
to keep things happy.
IxSet
The partial-lens
package attempts to address the fmap
problem that we saw in the last section. A partial-lens
is similar to a lens
but allows for the fact that the lens may not always be able to produce a value:
> newtype PartialLens a b = PLens (a -> Maybe (Store b a))
However, it seems a bit awkward to use partial-lens
at the moment. To use a normal lens with need to convert it to a partial lens using totalLens
:
> totalLens :: Lens a b -> PartialLens a b
Additionally, partial-lens
lacks the MonadState
interaction that we will examine in the next section (aka, partial-lens-fd
). But, hopefully these issues will be resolved in the future.
We can turn our ixLens
into a partial lens like this:
> -- | note: `setPL` does not insert into an `IxSet` it only modifies a > -- value if the key already exists in the map > ixPLens :: (Typeable key, Ord a, Typeable a, Indexable a) => key -> PartialLens (IxSet a) a > ixPLens key = maybeLens . totalLens (ixLens key)
See the haddock page for partial-lens
for more information. Using partial-lens
is very similar to a normal lens.
IxSet
in an acid-state eventIf we are using IxSet
with acid-state
, we can use a special version of the modifier operator that automatically does the get
/put
for us:
> (%=) :: (MonadState a m) => Lens a b -> (b -> b) -> m b
Note that this version of %=
was imported from Data.Lens
which comes from the data-lens-fd
package. There are similar functions in Data.Lens.Strict
and Data.Lens.Lazy
but they do not have the right type.
We can now make changeNick
into an Update
event like this:
> changeNick' :: Update UserState (IxSet User) > changeNick' = users %= user (UserId 0) ^%= fmap (name ^%= (nickName ^= "stepkut"))
All we did was change the first ^%=
to %=
. This works because Update
is an instance of MonadState
.
data-lens-fd
provides a few other functions that you can use to get, set, and modify the state in an Update
or Query
event. Check out the haddock documentation for data-lens-fd.
[Source code for the app is here.]
AcidState
handles around transparentlyManually passing around the acid-state
handle gets tedious very quickly. A common solution is to stick the AcidState
handle in a ReaderT
monad. For example:
> newtype MyApp = > MyApp { unMyApp :: ReaderT (AcidState MyAppState) (ServerPartT IO) Response }
We could then write some variants of the update
and query
functions which automatically retrieve the acid handle from ReaderT
.
In this section we will show a slightly more sophisticated version of that solution which allows us to work with multiple AcidState
handles and works well even if our app can be extended with optional plugins that contain additional AcidState
handles.
> {-# LANGUAGE DeriveDataTypeable, FlexibleContexts, GeneralizedNewtypeDeriving > , MultiParamTypeClasses, OverloadedStrings, ScopedTypeVariables, TemplateHaskell > , TypeFamilies, FlexibleInstances #-}
> module Main where
> import Control.Applicative (Applicative, Alternative, (<$>)) > import Control.Exception.Lifted (bracket) > import Control.Monad.Trans.Control (MonadBaseControl) > import Control.Monad (MonadPlus, mplus) > import Control.Monad.Reader (MonadReader, ReaderT(..), ask) > import Control.Monad.Trans (MonadIO(..)) > import Data.Acid ( AcidState(..), EventState(..), EventResult(..) > , Query(..), QueryEvent(..), Update(..), UpdateEvent(..) > , IsAcidic(..), makeAcidic, openLocalState > ) > import Data.Acid.Local ( createCheckpointAndClose > , openLocalStateFrom > ) > import Data.Acid.Advanced (query', update') > import Data.Maybe (fromMaybe) > import Data.SafeCopy (SafeCopy, base, deriveSafeCopy) > import Data.Data (Data, Typeable) > import Data.Lens ((%=), (!=)) > import Data.Lens.Template (makeLens) > import Data.Text.Lazy (Text) > import Happstack.Server ( Happstack, HasRqData, Method(GET, POST), Request(rqMethod) > , Response > , ServerPartT(..), WebMonad, FilterMonad, ServerMonad > , askRq, decodeBody, dir, defaultBodyPolicy, lookText > , mapServerPartT, nullConf, nullDir, ok, simpleHTTP > , toResponse > ) > import Prelude hiding (head, id) > import System.FilePath ((</>)) > import Text.Blaze ((!)) > import Text.Blaze.Html4.Strict (body, head, html, input, form, label, p, title, toHtml) > import Text.Blaze.Html4.Strict.Attributes ( action, enctype, for, id, method, name > , type_, value)
The first thing we have is a very general class that allows us to
retrieve a specific AcidState
handle by its type from an arbitrary
monad:
> class HasAcidState m st where > getAcidState :: m (AcidState st)
Next we redefine query
and update
so that they use getAcidState
to automatically retrieve the the correct acid-state handle from whatever monad they are in:
> query :: forall event m. > ( Functor m > , MonadIO m > , QueryEvent event > , HasAcidState m (EventState event) > ) => > event > -> m (EventResult event) > query event = > do as <- getAcidState > query' (as :: AcidState (EventState event)) event
> update :: forall event m. > ( Functor m > , MonadIO m > , UpdateEvent event > , HasAcidState m (EventState event) > ) => > event > -> m (EventResult event) > update event = > do as <- getAcidState > update' (as :: AcidState (EventState event)) event
> -- | bracket the opening and close of the `AcidState` handle. > > -- automatically creates a checkpoint on close > withLocalState :: (MonadBaseControl IO m, MonadIO m, IsAcidic st, Typeable st) => > Maybe FilePath -- ^ path to state directory > -> st -- ^ initial state value > -> (AcidState st -> m a) -- ^ function which uses the `AcidState` handle > -> m a > withLocalState mPath initialState = > bracket (liftIO $ (maybe openLocalState openLocalStateFrom mPath) initialState) > (liftIO . createCheckpointAndClose)
(These functions will eventually reside in acid-state
itself, or some other library).
Now we can declare a couple acid-state
types:
> -- State that stores a hit count > > data CountState = CountState { _count :: Integer } > deriving (Eq, Ord, Data, Typeable, Show) > > $(deriveSafeCopy 0 'base ''CountState) > $(makeLens ''CountState) > > initialCountState :: CountState > initialCountState = CountState { _count = 0 } > > incCount :: Update CountState Integer > incCount = count %= succ > > $(makeAcidic ''CountState ['incCount])
> -- State that stores a greeting
> data GreetingState = GreetingState { _greeting :: Text } > deriving (Eq, Ord, Data, Typeable, Show) > > $(deriveSafeCopy 0 'base ''GreetingState) > $(makeLens ''GreetingState) > > initialGreetingState :: GreetingState > initialGreetingState = GreetingState { _greeting = "Hello" } > > getGreeting :: Query GreetingState Text > getGreeting = _greeting <$> ask > > setGreeting :: Text -> Update GreetingState Text > setGreeting txt = greeting != txt > > $(makeAcidic ''GreetingState ['getGreeting, 'setGreeting])
Now that we have two states we can create a type to bundle them up like:
> data Acid = Acid { acidCountState :: AcidState CountState > , acidGreetingState :: AcidState GreetingState > } > > withAcid :: Maybe FilePath -> (Acid -> IO a) -> IO a > withAcid mBasePath action = > let basePath = fromMaybe "_state" mBasePath > in withLocalState (Just $ basePath </> "count") initialCountState $ \c -> > withLocalState (Just $ basePath </> "greeting") initialGreetingState $ \g -> > action (Acid c g)
Now we can create our App
monad that stores the Acid
in the ReaderT
:
> newtype App a = App { unApp :: ServerPartT (ReaderT Acid IO) a } > deriving ( Functor, Alternative, Applicative, Monad, MonadPlus, MonadIO > , HasRqData, ServerMonad ,WebMonad Response, FilterMonad Response > , Happstack, MonadReader Acid) > > runApp :: Acid -> App a -> ServerPartT IO a > runApp acid (App sp) = mapServerPartT (flip runReaderT acid) sp
And finally, we need to write the HasAcidState
instances:
> instance HasAcidState App CountState where > getAcidState = acidCountState <$> ask > > instance HasAcidState App GreetingState where > getAcidState = acidGreetingState <$> ask
And that's it. We can now use update
and query
in the remainder of our code with out having to worry about the AcidState
argument anymore.
Here is a page function that uses both the AcidStates
in a transparent manner:
> page :: App Response > page = > do nullDir > g <- greet > c <- update IncCount -- ^ a CountState event > ok $ toResponse $ > html $ do > head $ do > title "acid-state demo" > body $ do > form ! action "/" ! method "POST" ! enctype "multipart/form-data" $ do > label "new message: " ! for "msg" > input ! type_ "text" ! id "msg" ! name "greeting" > input ! type_ "submit" ! value "update message" > p $ toHtml g > p $ do "This page has been loaded " > toHtml c > " time(s)." > where > greet = > do m <- rqMethod <$> askRq > case m of > POST -> > do decodeBody (defaultBodyPolicy "/tmp/" 0 1000 1000) > newGreeting <- lookText "greeting" > update (SetGreeting newGreeting) -- ^ a GreetingState event > return newGreeting > GET -> > do query GetGreeting -- ^ a GreetingState event
If have used happstack-state
in the past, then this may remind you of how happstack-state
worked. However, there is a critical different. In happstack-state
it was possible to call update
and query
on events for state components that were not actually loaded. In this solution, however, the HasAcidState
class ensures that we can only call update
and query
for valid AcidState
handles.
Our main function is simply:
> main :: IO () > main = > withAcid Nothing $ \acid -> > simpleHTTP nullConf $ runApp acid page
In an upcoming section we will explore various methods of extending your app via plugins and 3rd party libraries. These plugins and libraries may contain their own AcidState
components. Very briefly, we will show how that might be handled.
Let's imagine we have this dummy plugin:
> newtype FooState = FooState { foo :: Text } > deriving (Eq, Ord, Data, Typeable, SafeCopy) > > initialFooState :: FooState > initialFooState = FooState { foo = "foo" } > > askFoo :: Query FooState Text > askFoo = foo <$> ask > > $(makeAcidic ''FooState ['askFoo])
> fooPlugin :: (Happstack m, HasAcidState m FooState) => m Response > fooPlugin = > dir "foo" $ do > txt <- query AskFoo > ok $ toResponse txt
We could integrate it into our app by extending the Acid
type to hold
the FooState
and then add an appropriate HasAcidState
instance:
> data Acid' = Acid' { acidCountState' :: AcidState CountState > , acidGreetingState' :: AcidState GreetingState > , acidFooState' :: AcidState FooState > }
> withAcid' :: Maybe FilePath -> (Acid' -> IO a) -> IO a > withAcid' mBasePath action = > let basePath = fromMaybe "_state" mBasePath > in withLocalState (Just $ basePath </> "count") initialCountState $ \c -> > withLocalState (Just $ basePath </> "greeting") initialGreetingState $ \g -> > withLocalState (Just $ basePath </> "foo") initialFooState $ \f -> > action (Acid' c g f)
> newtype App' a = App' { unApp' :: ServerPartT (ReaderT Acid' IO) a } > deriving ( Functor, Alternative, Applicative, Monad, MonadPlus, MonadIO > , HasRqData, ServerMonad ,WebMonad Response, FilterMonad Response > , Happstack, MonadReader Acid') >
> instance HasAcidState App' FooState where > getAcidState = acidFooState' <$> ask
Now we can use fooAppPlugin
like any other part in our app:
> fooAppPlugin :: App' Response > fooAppPlugin = fooPlugin
An advantage of this method is that fooPlugin
could also have access to the other AcidState
components like CountState
and GreetingState
.
A different option would be for fooPlugin
to use its own ReaderT
> fooReaderPlugin :: ReaderT (AcidState FooState) (ServerPartT IO) Response > fooReaderPlugin = fooPlugin
> instance HasAcidState (ReaderT (AcidState FooState) (ServerPartT IO)) FooState where > getAcidState = ask
> withFooPlugin :: (MonadIO m, MonadBaseControl IO m) => > FilePath -- ^ path to state directory > -> (ServerPartT IO Response -> m a) -- ^ function that uses fooPlugin > -> m a > withFooPlugin basePath f = > do withLocalState (Just $ basePath </> "foo") initialFooState $ \fooState -> > f $ runReaderT fooReaderPlugin fooState
> main' :: IO () > main' = > withFooPlugin "_state" $ \fooPlugin' -> > withAcid Nothing $ \acid -> > simpleHTTP nullConf $ fooPlugin' `mplus` runApp acid page
We will come back to this in detail later when we explore plugins and libraries.
[Source code for the app is here.]