[Haskell-cafe] Indentation Creep

[Miguel Mitrofanov]

TC> dmin p = do
TC>     mv <- dmin' p
TC>     case mv of
TC>         Nothing -> error "dmin: no values"
TC>         Just (v,_) -> return v

TC> dmin' p = do
TC>     t <- readTVar p
TC>     case t of
TC>         Empty -> return Nothing
TC>         Trie l m r -> do
TC>             mv <- dmin' l
TC>             case mv of
TC>                 Nothing -> do
TC>                     mv <- readTVar m
TC>                     case mv of
TC>                         Nothing -> do
TC>                             mv <- dmin' r
TC>                             case mv of
TC>                                 Nothing -> error "emit nasal daemons"
TC>                                 Just (v,e) -> do
TC>                                     if e
TC>                                         then writeTVar p Empty
TC>                                         else return ()
TC>                                     return mv
TC>                         Just v -> do
TC>                             re <- null r
TC>                             case re of
TC>                                 False -> writeTVar m Nothing
TC>                                 True  -> writeTVar p Empty
TC>                             return (Just (v,re))
TC>                 Just (v,e) -> do
TC>                     case e of
TC>                         True -> do
TC>                             me <- empty m
TC>                             re <- null r
TC>                             case me && re of
TC>                                 False -> writeTVar m Nothing
TC>                                 True  -> writeTVar p Empty
TC>                             return (Just (v,me && re))
TC>                         False -> return mv
TC>     where
TC>     empty m = do
TC>         v <- readTVar m
TC>         case v of
TC>             Nothing -> return True
TC>             Just _  -> return False

data MaybeT m a = MaybeT {runMaybeT :: m (Maybe a)}
fromMaybeT dflt handle (MaybeT mmx) = mmx >>= maybe dflt handle
instance Monad m => Monad (MaybeT m) where
    return x = MaybeT $ return $ Just x
    MaybeT mmx >>= f = MaybeT $ mmx >>= maybe (return Nothing) (runMaybeT . f)
instance Monad m => MonadPlus (MaybeT m) where
    mzero = MaybeT $ return mzero
    MaybeT mmx `mplus` MaybeT mmy = MaybeT $ liftM2 mplus mmx mmy
instance MonadTrans MaybeT where
    lift mx = MaybeT $ liftM return mx

dmin p = fromMaybeT (error "dmin: no values") (\(v,_) -> return v) $ dmin' p

dmin' p = do
  null' p >>= guard
  Trie l m r <- readMbTVar p
  (do mv@(v,e) <- dmin' l
      (do guard e
          me <- empty m
          re <- null' r
          let b = me && re
          if b then writeMbTVar p Empty else writeMbTVar m Nothing
          return (v,b)) `mplus` return mv)
          `mplus` (do v <- MaybeT $ readTVar m
                      re <- null' r
                      if re then writeMbTVar m Nothing else writeMbTVar p Empty
                      return (v,re))
          `mplus` (do mv@(v,e) <- dmin' r
                      when e $ writeMbTVar p Empty
                      return mv)
          `mplus` error "emit nasal daemons"
    where
      readMbTVar x = lift $ readTVar x
      writeMbTVar x y = lift $ writeTVar x y
      empty m = liftM isNothing $ readMbTVar m
      null' p = lift $ null p