Simple monads
Graham Klyne
GK@ninebynine.org
Fri, 27 Jun 2003 18:16:22 +0100
At a casual glance, your Labeller looks to me like a state transformer monad.
I've found that the State transformer monad in the hierarchical libraries
can be useful for this kind of thing; the following example is part of a
larger program, so it can't be run in isolation, but I hope it shows some
possibilities.
Points to note:
+ the initial state is an empty list, part of the 'runState' call in
'rdfQuerySubs2'
+ fmapM is used to sequence the monad over a fairly complex data structure,
based on a FunctorM class described in a message by Tomasz Zielonka sent to
the Haskell mailing list on 4 June 2003. The signature of fmapM is:
fmapM :: Monad m => (a -> m b) -> (t a -> m (t b))
where, in this case, instantiates as
fmapM :: (RDFLabel -> State [RDFLabel] RDFLabel)
-> (RDFGraph -> State [RDFLabel] RDFGraph)
+ 'mapNode' returns the monad instance that collects unbound
variables. The key method is update which, as its name suggests, updates
the state.
+ The library type State handles most of the coding detail for the monad
itself, leaving the application code to focus on using it.
[[
import Control.Monad.State
( State(..), modify )
...
-- This function applies a substitution for a single set of variable
-- bindings, returning the result and a list of unbound variables.
-- It uses a state transformer monad to collect the list of unbound
-- variables.
rdfQuerySubs2 :: RDFQueryBinding -> RDFGraph -> (RDFGraph,[RDFLabel])
rdfQuerySubs2 varb gr = runState ( fmapM (mapNode varb) gr ) []
-- Auxiliary monad function for rdfQuerySubs2.
-- This returns a state transformer Monad which in turn returns the
-- substituted node value based on the supplied query variable bindings.
-- The monad state is a list of labels which accumulates all those
-- variables seen for which no substitution was available.
mapNode :: RDFQueryBinding -> RDFLabel -> State [RDFLabel] RDFLabel
mapNode varb lab =
case qbMap varb lab of
Just v -> return v
Nothing ->
if isQueryVar lab then
do { modify (addVar lab)
; return lab
}
else
return lab
]]
At 14:40 26/06/03 -0400, Mark Carroll wrote:
>Not really seeing why Unique is in the IO monad, not deeply understanding
>the use of Haskell extensions in the State source, and wanting to try to
>learn a bit more about monads, I thought I'd try to write my own monad for
>the first time: something for producing a series of unique labels. This is
>how it turned out:
>
>==========================================================================
>module Label (Label, Labeller, newLabel)
>where
>import Monad
>
>newtype Label = Label Int deriving (Eq, Ord)
>
>newtype Labeller a = Labeller (Int -> (Int, a))
>
>instance Monad Labeller where
> return r = Labeller (\n -> (n, r))
> (Labeller g) >>= y =
> let f m = let (r, n) = g m
> Labeller h = y n
> in h r
> in Labeller f
>
>newLabel :: Labeller Label
>
>newLabel = Labeller (\n -> (n + 1, Label n))
>
>runLabeller :: Labeller a -> a
>
>runLabeller (Labeller l) = snd (l minBound)
>
>labelTest :: Labeller [Int]
>
>labelTest =
> do Label a <- newLabel
> Label b <- newLabel
> Label c <- newLabel
> Label d <- newLabel
> return [a,b,c,d]
>
>main = print (runLabeller labelTest)
>==========================================================================
>
>I was thinking that maybe,
>
>(a) People could point out to me where I'm still confused, as revealed by
>my code. Is it needlessly complicated?
>
>(b) My code may be instructive to someone else.
>
>-- Mark
>
>_______________________________________________
>Haskell-Cafe mailing list
>Haskell-Cafe@haskell.org
>http://www.haskell.org/mailman/listinfo/haskell-cafe
-------------------
Graham Klyne
<GK@NineByNine.org>
PGP: 0FAA 69FF C083 000B A2E9 A131 01B9 1C7A DBCA CB5E