Everyone's suggestions show that in order to advance to a level 3
Haskell Mage[*], I need to spend a chunk of time learning to grok
monad transformers.
let's see whether we can get from the initial version to the suggested
final version without any magic, in a somewhat long sequence of
minor rewrites/refactorings. i won't list all intermediate stages (the
derivation is long enough as it is), and i hope that readers will find
this interesting in spite of its length (you might want to load the initial
version into your editor and follow along as you read the refactoring
notes below).
enjoy (i hope:-),
claus
--------------------------------------------- initial version
dmin p = do
mv <- dmin' p
case mv of
Nothing -> error "dmin: no values"
Just (v,_) -> return v
dmin' p = do
t <- readTVar p
case t of
Empty -> return Nothing
Trie l m r -> do
mv <- dmin' l
case mv of
Nothing -> do
mv <- readTVar m
case mv of
Nothing -> do
mv <- dmin' r
case mv of
Nothing -> error "emit nasal daemons"
Just (v,e) -> do
if e
then writeTVar p Empty
else return ()
return mv
Just v -> do
re <- nullT r
case re of
False -> writeTVar m Nothing
True -> writeTVar p Empty
return (Just (v,re))
Just (v,e) -> do
case e of
True -> do
me <- empty m
re <- nullT r
case me && re of
False -> writeTVar m Nothing
True -> writeTVar p Empty
return (Just (v,me && re))
False -> return mv
where
nullT :: Monad m => TriePtr t -> m Bool
nullT t = undefined
empty m = do
v <- readTVar m
case v of
Nothing -> return True
Just _ -> return False
--------------------------------------------- initial version
simple things first:
in dmin:
replace case with maybe
use =<< to avoid intermediate mv
replace lambda with (return . fst)
in empty:
replace case with maybe
lift return out of the branches
use =<< to avoid intermediate v
'maybe True (const False)' is (Data.Maybe) isNothing
use liftM to apply isNothing
in dmin':
use (Control.Monad) 'when e .' to replace 'if e then . else return ()'
create and use (2x) function 'write'
write m p (v,False) = writeTVar m Nothing >> return (Just (v,False))
write m p (v,True ) = writeTVar p Empty >> return (Just (v,True))
now, on to slightly bigger rewrites:
inside-out, replace 'case . of Nothing -> .; Just . -> .' with maybe
case mv of
Nothing -> error "emit nasal daemons"
Just (v,e) -> do
when e $ writeTVar p Empty
return mv
becomes
maybe (error "emit nasal daemons")
(\(v,e) -> do
when e $ writeTVar p Empty
return mv)
mv
and so on, for all three levels of case (in the outermost case, one
'return mv' needs to be replaced with 'return (Just (v,e))', we'll do
the same for the other 'return mv', for clarity)
at this stage, the code looks somewhat like this:
dmin p = maybe (error "dmin: no values") (return . fst) =<< dmin' p
dmin' p = do
t <- readTVar p
case t of
Empty -> return Nothing
Trie l m r -> do
mv <- dmin' l
maybe (do
mv <- readTVar m
maybe (do
mv <- dmin' r
maybe (error "emit nasal daemons")
(\(v,e) -> do
when e $ writeTVar p Empty
return (Just (v,e)))
mv)
(\v -> do
re <- nullT r
write m p (v,re))
mv)
(\(v,e) -> do
case e of
True -> do
me <- empty m
re <- nullT r
write m p (v,me && re)
False -> return (Just (v,e)))
mv
where
write m p (v,False) = writeTVar m Nothing >> return (Just (v,False))
write m p (v,True ) = writeTVar p Empty >> return (Just (v,True))
nullT :: Monad m => TriePtr t -> m Bool
nullT t = undefined
empty m = liftM isNothing $ readTVar m
we'd still like to get rid of the nesting, and we see the pattern
action >>= maybe (nontrivialB) (nontrivialA)
repeatedly, which strongly suggests the use of (MonadPlus) 'mplus'
(action >>= nontrivialA) `mplus` nontrivialB
the problem is that those Maybes are interleaved with STM operations.
as a first step, we can define our own 'mplus' for the special case of
'STM (Maybe a)', where we want the alternatives to be controlled by
the Maybe result of the outer monad (STM in this case):
a `mplus` b = (a >>= maybe b (return . Just))
however, our pattern is slightly more complex: there's always another
STM operation to be executed first (readTVar or dmin'), and the result
of that operation selects the branch, so we also need to define our
own version of sequential composition:
a >>> b = a >>= maybe (return Nothing) b
now, we can rewrite the pattern
do { v<-op; maybe that this v }
to, using our own combinator versions,
(op >>> this) `mplus` that
so that
do
mv <- dmin' r
maybe (error "emit nasal daemons")
(\(v,e) -> do
when e $ writeTVar p Empty
return (Just (v,e)))
mv
turns into
(dmin' r >>>
(\ (v,e) -> do
when e $ writeTVar p Empty
return (Just (v,e))))
`mplus` (error "emit nasal daemons")
again, we apply this rewriting inside out to all three levels of
maybe, which gives us something like this code:
dmin' p = do
t <- readTVar p
case t of
Empty -> return Nothing
Trie l m r ->
(dmin' l >>>
(\(v,e) -> do
case e of
True -> do
me <- empty m
re <- nullT r
write m p (v,me && re)
False -> return (Just (v,e))))
`mplus` ((readTVar m >>>
(\v -> do
re <- nullT r
write m p (v,re)))
`mplus` ((dmin' r >>>
(\ (v,e) -> do
when e $ writeTVar p Empty
return (Just (v,e))))
`mplus` (error "emit nasal daemons")))
where
a `mplus` b = (a >>= maybe b (return . Just))
a >>> b = a >>= maybe (return Nothing) b
write m p (v,False) = writeTVar m Nothing >> return (Just (v,False))
write m p (v,True ) = writeTVar p Empty >> return (Just (v,True))
nullT :: Monad m => TriePtr t -> m Bool
nullT t = undefined
empty m = liftM isNothing $ readTVar m
which already gets rid of most of the indentation creep. next, we want
to turn our local combinators into proper Monad/MonadPlus instances,
to avoid confusion and to get back the do-notation. since both these
classes are defined over type constructors, rather than plain types,
we need a type constructor that captures the composition of STM and
Maybe in 'STM (Maybe a)'. actually, our combinators only depend on
the composition of some Monad m with Maybe:
data MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
the Monad instance is almost exactly what we expect, using the
definition of >>> we already have, with some added wrapping and
unwrapping for our "type constructor composition constructor"
(aka monad transformer;-):
instance Monad m => Monad (MaybeT m) where
return = MaybeT . return . Just
a >>= b = MaybeT $ runMaybeT a >>= maybe (return Nothing) (runMaybeT . b)
the MonadPlus instance is just what we expect, using our mplus
definition with some extra wrapping and unwrapping.
instance Monad m => MonadPlus (MaybeT m) where
mzero = MaybeT $ return Nothing
a `mplus` b = MaybeT $ runMaybeT a >>= maybe (runMaybeT b) (return . Just)
now, before we can apply our shiny new instances to our code, there is
the issue of plain STM operations like writeTVar and readTVar. when
running code in our composed monad, we still want to be able to run
operations in the wrapped inner monad. the standard way to do that is
to define a 'lift' operation for lifting inner monad operations to the
composed monad. so standard, in fact, that there is a class for this,
(Control.Monad.Trans) MonadTrans, and we only need to define an
instance for our wrapper:
instance MonadTrans MaybeT where
lift m = MaybeT $ m >>= return . Just
to prepare for our next step, we apply lift to all barebones STM
operations, readTVar, write, empty, nullT. at this stage, our types
(asking ghci, with :t dmin') are slightly redundant:
dmin' :: (MonadTrans t1, Monad (t1 STM))
=> TVar (Trie t) -> t1 STM (Maybe (t, Bool))
since our particular MonadTrans, MaybeT, already wraps results in
Maybe, this is one level of Maybe too much. so, when we remove our
local definitions of mplus and >>> (replacing >>> with >>=), we remove
that extra layer of Maybe, by removing the redundant (Just _) in
returns, and by replacing 'return Nothing' with 'mzero'. we could now
declare the type as
dmin' :: TVar (Trie t) -> MaybeT STM (Maybe t, Bool)
to retain compatibility, we also need to apply runMaybeT in dmin,
unwrapping (dmin' p).
after all that refactoring, the code should look something like this:
dmin p = maybe (error "dmin: no values") (return . fst)
=<< runMaybeT (dmin' p)
dmin' p = do
t <- lift $ readTVar p
case t of
Empty -> mzero
Trie l m r ->
(dmin' l >>=
(\ (v,e) -> do
case e of
True -> do
me <- lift $ empty m
re <- lift $ nullT r
lift $ write m p (v,me && re)
False -> return (v,e)))
`mplus` (((lift $ readTVar m) >>=
(\ v -> do
re <- lift $ nullT r
lift $ write m p (v,re)))
`mplus` ((dmin' r >>=
(\ (v,e) -> do
when e $ lift $ writeTVar p Empty
return (v,e)))
`mplus` (error "emit nasal daemons")))
where
write m p (v,False) = writeTVar m Nothing >> return (v,False)
write m p (v,True ) = writeTVar p Empty >> return (v,True)
nullT :: Monad m => TriePtr t -> m Bool
nullT t = undefined
empty m = liftM isNothing $ readTVar m
to clean up, we reapply do-notation instead of >>=, drop some
redundant parentheses for mplus, and move the lift calls to the
definitions of empty, nullT, etc., creating lifted variants
readTVar' and writeTVar'.
next, we can make use of the fact that pattern match failure in
do-notation invokes fail in the monad, by defining 'fail msg = mzero'
in our wrapped monad, and by pattern matching directly on the result
of the first readTVar' (we only need the Trie-case, the other case
will fail to match, leading to mzero, which is what we wanted anyway).
we can also replace the remaining 'case e of True ..' by appealing to
'guard e' and mzero.
at which stage our code looks sufficiently similar to Miguel's. we
still don't need to have any idea what the code is supposed to do,
as long as we haven't made any mistakes in refactoring, the final
version should do the same thing as the initial version. usually,
one would use a testsuite or a proven tool to monitor the steps,
whereas my only test was "does it still compile?", which gives no
assurance that the code transformations were indeed refactorings.
no magic involved, just repeated simplifications, generalizations,
and use of sufficiently advanced technology!-) by noticing that
there was something about your code you didn't like, and looking
for improvements, you've already done the most important step.
as long as you remain determined to keep reviewing and simplifying
your code, the route to "higher levels" isn't all that steep. part of
the reason why i take part in such rewrite exercises on this list is
to hone my own skills - there is always something more to learn;-)
--------------------------------------------- final version
dmin p = maybe (error "dmin: no values") (return . fst)
=<< runMaybeT (dmin' p)
dmin' p = do
Trie l m r <- readTVar' p
(do (v,e) <- dmin' l
(do guard e
me <- empty m
re <- nullT r
write m p (v,me && re))
`mplus` return ((v,e)))
`mplus` (do v <- readTVar' m
re <- nullT r
write m p (v,re))
`mplus` (do (v,e) <- dmin' r
when e $ writeTVar' p Empty
return ((v,e)))
`mplus` error "emit nasal daemons"
where
readTVar' var = lift $ readTVar var
writeTVar' var val = lift $ writeTVar var val
write m p (v,False) = lift $ writeTVar m Nothing >> return ((v,False))
write m p (v,True ) = lift $ writeTVar p Empty >> return ((v,True))
nullT :: Monad m => TriePtr t -> m Bool
nullT t = undefined
empty m = lift $ liftM isNothing $ readTVar m
data MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
instance Monad m => Monad (MaybeT m) where
return = MaybeT . return . Just
a >>= b = MaybeT $ runMaybeT a >>= maybe (return Nothing) (runMaybeT . b)
fail msg= mzero
instance Monad m => MonadPlus (MaybeT m) where
mzero = MaybeT $ return Nothing
a `mplus` b = MaybeT $ runMaybeT a >>= maybe (runMaybeT b) (return . Just)
instance MonadTrans MaybeT where
lift m = MaybeT $ m >>= return . Just
--------------------------------------------- final version
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
