Yesod's Monads
As you've read through this book, there have been a number of monads which have
appeared: Handler
, Widget
and
YesodDB
(for Persistent). As with most monads, each one provides some specific
functionality: Handler
gives access to the request and allows you to
send responses, a Widget
contains HTML, CSS, and Javascript, and
YesodDB
let's you make database queries. In Model-View-Controller
(MVC) terms, we could consider YesodDB
to be the model, Widget
to be the view, and Handler
to be the controller.
So far, we've presented some very straight-forward ways to use these monads: your main
handler will run in Handler
, using runDB
to execute a
YesodDB
query, and defaultLayout
to return a
Widget
, which in turn was created by calls to toWidget
.
However, if we have a deeper understanding of these types, we can achieve some fancier results.
Monad Transformers
Monads are like onions. Monads are not like cakes.Shrek, more or less
Before we get into the heart of Yesod's monads, we need to understand a bit about
monad transformers. (If you already know all about monad transformers, you can likely skip this
section.) Different monads provide different functionality: Reader
allows
read-only access to some piece of data throughout a computation, Error
allows
you to short-circuit computations, and so on.
Often times, however, you would like to be able to combine a few of these features
together. After all, why not have a computation with read-only access to some settings variable,
that could error out at any time? One approach to this would be to write a new monad like
ReaderError
, but this has the obvious downside of exponential complexity:
you'll need to write a new monad for every single possible combination.
Instead, we have monad transformers. In addition to Reader
, we have
ReaderT
, which adds reader functionality to any other monad. So we could
represent our ReaderError
as (conceptually):
type ReaderError = ReaderT Error
In order to access our settings variable, we can use the ask
function. But what about short-circuiting a computation? We'd like to use
throwError
, but that won't exactly work. Instead, we need to lift
our call into the next monad up. In other words:
throwError :: errValue -> Error
lift . throwError :: errValue -> ReaderT Error
There are a few things you should pick up here:
-
A transformer can be used to add functionality to an existing monad.
-
A transformer must always wrap around an existing monad.
-
The functionality available in a wrapped monad will be dependent not only on the monad transformer, but also on the inner monad that is being wrapped.
A great example of that last point is the IO
monad. No matter how
many layers of transformers you have around an IO
, there's still an
IO
at the core, meaning you can perform I/O in any of these monad transformer stacks. You'll often see code that looks like liftIO
$ putStrLn "Hello There!"
.
The Three Transformers
We've already discussed two of our transformers previously: Handler
and
Widget
. Just to recap, there are two special things about these
transformers:
-
In order to simplify error messages, they are not actual transformers. Instead, they are newtypes that hard-code their inner monads.
-
In reality they have extra type parameters for the sub and master site. As a result, the Yesod libraries provide
GHandler sub master a
andGWidget sub master a
, and each site gets a pair of type synonymstype Handler = GHandler MyApp MyApp
andtype Widget = GWidget MyApp My App ()
.
In persistent, we have a typeclass called
PersistStore
. This typeclass defines all of the primitive operations you can
perform on a database, like get
. This typeclass essentially looks like
class (Monad (b m)) => PersistStore b m
. b
is the backend itself, and is in fact a monad transformer, while m
is the inner monad that b
wraps around. Both SQL and
MongoDB have their own instances; in the case of SQL, it looks like:
instance MonadBaseControl IO m => PersistBackend SqlPersist m
This means that you can run a SQL database with any underlying monad, so long as that
underlying monad supports MonadBaseControl IO
, which allows you to
properly deal with exceptions in a monad stack. That basically means any transformer stack built
around IO
(besides exceptional cases like ContT
).
Fortunately for us, that includes both Handler
and Widget
. The
takeaway here is that we can layer our Persistent transformer on top of Handler
or Widget
.
In order to make it simpler to refer to the relevant Persistent transformer, the
yesod-persistent package defines the YesodPersistBackend
associated type. For example, if I have a site called MyApp
and it uses SQL, I
would define something like type instance YesodPersistBackend MyApp =
SqlPersist
.
When we want to run our database actions, we'll have a SqlPersist
wrapped around a Handler
or Widget
. We can then use the
standard Persistent unwrap functions (like runSqlPool
) to run the action and get
back a normal Handler
/Widget
. To automate this, we provide the
runDB
function. Putting it all together, we can now run database actions inside
our handlers and widgets.
Most of the time in Yesod code, and especially thus far in this book, widgets have
been treated as actionless containers that simply combine together HTML, CSS and Javascript. But
if you look at that last paragraph again, you'll realize that's not the way things have to be.
Since a widget is a transformer on top of a handler, anything you do in a handler can be done in
a widget, including database actions. All you have to do is lift
.
Example: Database-driven navbar
Let's put some of this new knowledge into action. We want to create a
Widget
that generates its output based on the contents of the
database. Previously, our approach would have been to load up the data in a
Handler
, and then pass that data into a Widget
.
Now, we'll do the loading of data in the Widget
itself. This is a boon
for modularity, as this Widget
can be used in any
Handler
we want, without any need to pass in the database
contents.
{-# LANGUAGE OverloadedStrings, TypeFamilies, TemplateHaskell, FlexibleContexts,
QuasiQuotes, TypeFamilies, MultiParamTypeClasses, GADTs #-}
import Yesod
import Database.Persist.Sqlite
import Data.Text (Text)
import Data.Time
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
Link
title Text
url Text
added UTCTime
|]
data LinksExample = LinksExample ConnectionPool
mkYesod "LinksExample" [parseRoutes|
/ RootR GET
/add-link AddLinkR POST
|]
instance Yesod LinksExample
instance RenderMessage LinksExample FormMessage where
renderMessage _ _ = defaultFormMessage
instance YesodPersist LinksExample where
type YesodPersistBackend LinksExample = SqlPersist
runDB db = do
LinksExample pool <- getYesod
runSqlPool db pool
getRootR :: Handler RepHtml
getRootR = defaultLayout [whamlet|
<form method=post action=@{AddLinkR}>
<p>
Add a new link to #
<input type=url name=url value=http://>
\ titled #
<input type=text name=title>
\ #
<input type=submit value="Add link">
<h2>Existing links
^{existingLinks}
|]
existingLinks :: Widget
existingLinks = do
links <- lift $ runDB $ selectList [] [LimitTo 5, Desc LinkAdded]
[whamlet|
<ul>
$forall Entity _ link <- links
<li>
<a href=#{linkUrl link}>#{linkTitle link}
|]
postAddLinkR :: Handler ()
postAddLinkR = do
url <- runInputPost $ ireq urlField "url"
title <- runInputPost $ ireq textField "title"
now <- liftIO getCurrentTime
runDB $ insert $ Link title url now
setMessage "Link added"
redirect RootR
main :: IO ()
main = withSqlitePool "links.db3" 10 $ \pool -> do
runSqlPool (runMigration migrateAll) pool
warpDebug 3000 $ LinksExample pool
Pay attention in particular to the existingLinks
function.
Notice how all we needed to do was apply lift
to a normal
database action. And from within getRootR
, we treated existingLinks
like any ordinary Widget
,
no special parameters at all. See the figure for the output of this app.
Example: Request information
Likewise, you can get request information inside a Widget
. Here we
can determine the sort order of a list based on a GET parameter.
{-# LANGUAGE OverloadedStrings, TypeFamilies, TemplateHaskell,
QuasiQuotes, TypeFamilies, MultiParamTypeClasses, GADTs #-}
import Yesod
import Data.Text (Text)
import Data.List (sortBy)
import Data.Ord (comparing)
data Person = Person
{ personName :: Text
, personAge :: Int
}
people :: [Person]
people =
[ Person "Miriam" 25
, Person "Eliezer" 3
, Person "Michael" 26
, Person "Gavriella" 1
]
data People = People
mkYesod "People" [parseRoutes|
/ RootR GET
|]
instance Yesod People
instance RenderMessage People FormMessage where
renderMessage _ _ = defaultFormMessage
getRootR :: Handler RepHtml
getRootR = defaultLayout [whamlet|
<p>
<a href="?sort=name">Sort by name
\ | #
<a href="?sort=age">Sort by age
\ | #
<a href="?">No sort
^{showPeople}
|]
showPeople :: Widget
showPeople = do
msort <- lift $ runInputGet $ iopt textField "sort"
let people' =
case msort of
Just "name" -> sortBy (comparing personName) people
Just "age" -> sortBy (comparing personAge) people
_ -> people
[whamlet|
<dl>
$forall person <- people'
<dt>#{personName person}
<dd>#{show $ personAge person}
|]
main :: IO ()
main = warpDebug 3000 People
Once again, all we need to do is lift
our normal
Handler
code (in this case, runInputGet
) to have
it run in our Widget
.
Summary
If you completely ignore this chapter, you'll still be able to use Yesod to great benefit. The
advantage of understanding how Yesod's monads interact is to be able to produce cleaner, more
modular code. Being able to perform arbitrary actions in a Widget
can be a
powerful tool, and understanding how Persistent and your Handler
code interact
can help you make more informed design decisions in your app.