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