framework for composing monads?
Elke Kasimir
elke.kasimir@catmint.de
Thu, 15 Feb 2001 16:55:40 +0100 (CET)
This message is in MIME format
--_=XFMail.1.4.4.Linux:20010215164550:290=_
Content-Type: text/plain; charset=iso-8859-1
Does someone like to comment on this?
I'm planning a new cli/odbc-based database connectivity library for
Haskell 98 and want to manage hidden state (various management
information) on the Haskell side.
Some libs. i.e. for gui, extend the IO monad for this using some
"start" function:
main :: IO ()
main = start prog
prog :: GUI ()
...
I could do the same with my library, but then it is difficult to combine,
for example, Gui operations with Db operations.
I found a better solution in Jeuring/Meijer 1995 in Mark P. Jones' contribution
which consists of using monad transformers and lifting monad operations
to class level like this:
type M a = DB (GUI IO) a
startM = start . start
main = startM prog
prog :: (Io m, Gui m, Db m) => m ()
prog = ...
I hope that this approach not only solves the problem mentioned above
but also supports a more modular approach to handling state etc.
in general and encourages the programmer to add his own monads (instead of
packing all into IO or passing around state etc. explicitly).
However, to be really useful, it would be best if there could be
established a "standard framework" for such libraries. It would be
nice if there were at least agreement on how to lift IO operations
to class level: 'Io.putStr' (which provokes name clashes with the
standard prelude),'Io.putStrC' (C for class level), or some other
prefix/suffix.
In addition to Mark P. Jones' examples in the mentioned article,
- Class Io must be provided,
- all specific monad operations should be encapsulated in ADTs,
- it must be possible to map 'lift' into the ADT
In the attachements I have worked out a scenario, where
DB and GUI are state monad transformers and Io and Gui are
defined as follows:
class Monad m => Io m where io :: IO a -> m a
class Monad m => Db m where db :: DBImpl m a
DBImpl is an ADT which encapsulates a set of characteristic monad
operations, in this case the 'modify' operation of a state
transformer.
For such ADTs, a special
class Liftable l where
mapLift :: (MonadT t, Monad m) => l m -> l (t m)
has been introduced to supply a unified symbol for applying lift
to the encapsulated monad transformation(s). (I don't like the
class name either but didn't find a better up to now...)
However, there remains a problem with the type system. Ideally, it would be
possible to require:
class (Monad m, Monad (t m)) => MonadT t
where lift = ...
such that MonadT applications become automatically members of class Monad,
and declare
instance (Db m, MonadT t) => Db (t m)
where db = mapLift db
(same for class Gui etc.)
with the obvious effects.
Both seems to be not even possible in the extended type systems of Hugs and
ghc. I want to create a library for Haskell 98, so this is of minor importance,
but if there was a way to make life easier for those who use type system
extensions without complicating the situation for Haskell 98 users, I
would of course prefer such a solution.
Until then, again, I think that "standard framework" would make it easier for
users to create those instance declarations by themselves needed to combine
monad transformers from different sources.
Elke.
---
"If you have nothing to say, don't do it here..."
Elke Kasimir
Skalitzer Str. 79
10997 Berlin (Germany)
fon: +49 (030) 612 852 16
mail: elke.kasimir@catmint.de>
see: <http://www.catmint.de/elke>
for pgp public key see:
<http://www.catmint.de/elke/pgp_signature.html>
--_=XFMail.1.4.4.Linux:20010215164550:290=_
Content-Disposition: attachment; filename="Gui.hs"
Content-Transfer-Encoding: none
Content-Description: Gui.hs
Content-Type: application/octet-stream; name=Gui.hs; SizeOnDisk=1423
{-- A dummy monad transformer GUI for Gui programming
whose functionality has been lifted to class Gui.
This module is almost identical (except identifiers)
to Db.hs
--}
module Gui ( Gui, gui, GUI,
guiExampleOp
)
where
import Io
import STM
import MonadT
-- (in this example it is assumed that Gui implies Io for some reason):
class Io m => Gui m where
gui :: GUIImpl m
-- monad transformer GUI:
newtype GUI m a = GUI (STM GUIStat m a)
fromGUI (GUI a) = a
toGUI = GUI
instance Monad m => Functor (GUI m) where
fmap f = toGUI . fmap f . fromGUI
instance Monad m => Monad (GUI m) where
m >>= f = toGUI ((fromGUI m) >>= (fromGUI . f))
return = toGUI . return
instance MonadT GUI where
lift = toGUI . lift
start = run 0 . fromGUI
instance Io m => Io (GUI m) where
io = lift . io
instance Io m => Gui (GUI m) where
gui = GUIImpl (toGUI . modify)
-- state
type GUIStat = Int
-- ADT that encapsulates monad operations:
data GUIImpl m = GUIImpl ((GUIStat -> GUIStat) -> m GUIStat)
instance Liftable GUIImpl where
mapLift (GUIImpl m) = GUIImpl (lift . m)
-- some example class op: set state & read it & print:
guiExampleOp :: Gui m => Int -> m ()
guiExampleOp i
= do
modify (\_ -> i)
result <- modify id
putStrC (show result)
where (GUIImpl modify) = gui
--_=XFMail.1.4.4.Linux:20010215164550:290=_
Content-Disposition: attachment; filename="STM.hs"
Content-Transfer-Encoding: none
Content-Description: STM.hs
Content-Type: application/octet-stream; name=STM.hs; SizeOnDisk=1660
{-- A state monad transformer like that described in
Mark P. Jones's article in Jeuring/Meijers (Eds.):
"Advanced Functional Programming...", Berlin/Heidelberg 1995
--}
module STM
where
import MonadT
{-- s :: state, m a : monad to be composed
--}
data STM s m a = STM (s -> m (a,s))
instance Monad m => Functor (STM s m) where
fmap f (STM transform) = STM (\state -> do
(x,state') <- transform state
return (f x, state'))
instance Monad m => Monad (STM s m) where
(STM transform) >>= f = STM (\state -> do
(x,state') <- transform state
let (STM transform') = f x
transform' state')
return x = STM (\state -> return (x,state))
instance MonadT (STM s) where
lift op = STM (\state -> do
result <- op
return (result,state))
start = run (error "attempt to access unitialized STM state")
{-- applies first argument to state and returns new state.
--}
modify :: Monad m => (a -> a) -> STM a m a
modify f = STM (\state -> return (state,f state))
{-- perform calculation of the STM in the embedded monad m a,
using state 'state' as initial state.
--}
run :: Monad m => s -> STM s m a -> m a
run state (STM transform)
= do
result <- transform state
return (fst result)
--_=XFMail.1.4.4.Linux:20010215164550:290=_
Content-Disposition: attachment; filename="MonadT.hs"
Content-Transfer-Encoding: none
Content-Description: MonadT.hs
Content-Type: application/octet-stream; name=MonadT.hs; SizeOnDisk=789
{- An extended version of the representation of a monad transformer as a class,
see Mark P. Jones's article in Meijers/Jeuring (Eds.):
"Advanced Functional Programming...", Berlin/Heidelberg 1995
-}
module MonadT
where
class MonadT t where
lift :: Monad m => m a -> t m a
start :: Monad m => t m a -> m a -- performs the calcuation represented by (
t m a) in m
{-- Liftable is intended to map "lift" to an ADT which encapsulates
the characteristic monadic operations.
mapLift === fmap (lift .) if l could be declared as a Functor.
--}
class Liftable l where
mapLift :: (MonadT t, Monad m) => l m -> l (t m)
--_=XFMail.1.4.4.Linux:20010215164550:290=_
Content-Disposition: attachment; filename="Main.hs"
Content-Transfer-Encoding: none
Content-Description: Main.hs
Content-Type: application/octet-stream; name=Main.hs; SizeOnDisk=714
{-- Example program for combining Io, Gui and Db functionality
in one program.
--}
module Main
where
import MonadT
import Io
import Gui
import Db
{- set up application monad instance: -}
-- not really needed here:
instance Gui m => Gui (DB m) where
gui = mapLift gui
instance Db m => Db (GUI m) where
db = mapLift db
-- the monad to be used at top level:
type M a = DB (GUI IO) a
startM :: M () -> IO ()
startM = start . start
-- test program:
main :: IO ()
main = startM prog
prog :: (Db m, Gui m, Io m) => m ()
prog = do
putStrC "Hello "
dbExampleOp "World"
putStrC "\nHello "
guiExampleOp 2001
--_=XFMail.1.4.4.Linux:20010215164550:290=_
Content-Disposition: attachment; filename="Io.hs"
Content-Transfer-Encoding: none
Content-Description: Io.hs
Content-Type: application/octet-stream; name=Io.hs; SizeOnDisk=300
{- This module moves the functionality of the IO monad to class level -}
module Io where
class Monad m => Io m where
io :: IO a -> m a
instance Io IO where
io = id
-- moving IO library to class level:
putStrC :: Io m => String -> m ()
putStrC = io . putStr
-- ... to be completed ...
--_=XFMail.1.4.4.Linux:20010215164550:290=_
Content-Disposition: attachment; filename="Db.hs"
Content-Transfer-Encoding: none
Content-Description: Db.hs
Content-Type: application/octet-stream; name=Db.hs; SizeOnDisk=1392
{-- A dummy monad transformer DB for database state management
whose functionality has been lifted to class Db.
--}
module Db ( Db, db, DB,
dbExampleOp )
where
import Io
import STM
import MonadT
-- a class for monads composed from DB:
class Monad m => Db m where
db :: DBImpl m
-- monad transformer DB:
newtype DB m a = DB (STM DBStat m a)
fromDB (DB a) = a
toDB = DB
instance Monad m => Functor (DB m) where
fmap f = toDB . fmap f . fromDB
instance Monad m => Monad (DB m) where
m >>= f = toDB ((fromDB m) >>= (fromDB . f))
return = toDB . return
instance MonadT DB where
lift = toDB . lift
start = run "" . fromDB
-- lift IO functionality to DB:
instance Io m => Io (DB m) where
io = lift . io
instance Monad m => Db (DB m) where
db = DBImpl (toDB . modify)
-- state (represented by a string in this example):
type DBStat = String
-- ADT that encapsulates the specific operations of the DB monad:
data DBImpl m = DBImpl ((DBStat -> DBStat) -> m DBStat)
instance Liftable DBImpl where
mapLift (DBImpl m) = DBImpl (lift . m)
-- some example DB operation: set state & read it & print:
dbExampleOp :: (Io m, Db m) => String -> m ()
dbExampleOp str
= do
modify (\_ -> str)
result <- modify id
putStrC result
where (DBImpl modify) = db
--_=XFMail.1.4.4.Linux:20010215164550:290=_--
End of MIME message