Improves haddocks and explicit imports.

chat-bots/src/Control/Monad/ListT.hs

@@ -5,11 +5,11 @@
 {-# LANGUAGE UndecidableInstances #-}
 
 module Control.Monad.ListT
-  ( -- * ListF
+  ( -- * ListT
+    ListT (..),
     ListF (..),
 
-    -- * ListT
-    ListT (..),
+    -- * Operations
     emptyListT,
     consListT,
     singletonListT,
@@ -21,34 +21,41 @@ module Control.Monad.ListT
   )
 where
 
-import Control.Applicative
-import Control.Monad.Except
+--------------------------------------------------------------------------------
+
+import Control.Applicative (Alternative (..))
+import Control.Monad.Except (MonadError (..), MonadIO (..), MonadTrans (..), ap)
 import Data.Bifunctor (Bifunctor (..))
-import Data.Foldable
+import Data.Foldable (Foldable (..))
 import Data.Functor ((<&>))
-import Data.These
+import Data.These (These (..))
 
-data ListF a r = NilF | ConsF a r
-  deriving (Functor)
-
-instance Bifunctor ListF where
-  bimap f g = \case
-    NilF -> NilF
-    ConsF a r -> ConsF (f a) (g r)
+--------------------------------------------------------------------------------
 
+-- | ListT done right, see https://www.haskell.org/haskellwiki/ListT_done_right_alternative
+--
+-- NOTE: There are several other encodings available on hackage. This
+-- particular version best fit our use case.
 newtype ListT m a = ListT
   { runListT :: m (ListF a (ListT m a))
   }
 
 instance Functor m => Functor (ListT m) where
+  fmap :: Functor m => (a -> b) -> ListT m a -> ListT m b
   fmap f (ListT ma) = ListT $ fmap (bimap f (fmap f)) $ ma
 
 instance Monad m => Applicative (ListT m) where
+  pure :: Monad m => a -> ListT m a
   pure = ListT . return . (`ConsF` emptyListT)
+
+  (<*>) :: Monad m => ListT m (a -> b) -> ListT m a -> ListT m b
   (<*>) = ap
 
 instance Monad m => Alternative (ListT m) where
+  empty :: Monad m => ListT m a
   empty = emptyListT
+
+  (<|>) :: Monad m => ListT m a -> ListT m a -> ListT m a
   ListT m <|> ListT n = ListT $ do
     x <- m
     y <- n
@@ -60,15 +67,18 @@ instance Monad m => Alternative (ListT m) where
         ConsF x' (ListT $ pure $ ConsF y' (xs <|> ys))
 
 instance MonadTrans ListT where
+  lift :: Monad m => m a -> ListT m a
   lift ma = ListT $ fmap (\a -> ConsF a (ListT $ pure NilF)) ma
 
 instance MonadIO m => MonadIO (ListT m) where
+  liftIO :: MonadIO m => IO a -> ListT m a
   liftIO io = ListT $ liftIO $ fmap (\a -> ConsF a (ListT $ pure NilF)) io
 
 instance MonadError e m => MonadError e (ListT m) where
+  throwError :: MonadError e m => e -> ListT m a
   throwError = lift . throwError
 
-  -- catchError m f = ListT $ runListT m `catchError` \e -> runListT (f e)
+  catchError :: MonadError e m => ListT m a -> (e -> ListT m a) -> ListT m a
   catchError m f = ListT . deepCatch . runListT $ m
     where
       deepCatch m' = fmap deepCatch' m' `catchError` \e -> runListT (f e)
@@ -77,9 +87,33 @@ instance MonadError e m => MonadError e (ListT m) where
         NilF -> NilF
         ConsF a r -> ConsF a (ListT $ deepCatch $ runListT r)
 
+instance Monad m => Monad (ListT m) where
+  return :: Monad m => a -> ListT m a
+  return = pure
+
+  (>>=) :: Monad m => ListT m a -> (a -> ListT m b) -> ListT m b
+  ma >>= amb = joinListT $ fmap amb ma
+
+data ListF a r = NilF | ConsF a r
+  deriving (Functor)
+
+instance Bifunctor ListF where
+  bimap :: (a -> b) -> (c -> d) -> ListF a c -> ListF b d
+  bimap f g = \case
+    NilF -> NilF
+    ConsF a r -> ConsF (f a) (g r)
+
+--------------------------------------------------------------------------------
+
+-- | The empty 'ListT'.
 emptyListT :: Applicative m => ListT m a
 emptyListT = ListT $ pure NilF
 
+-- | A 'ListT' of one element.
+singletonListT :: Applicative m => a -> ListT m a
+singletonListT a = consListT a emptyListT
+
+-- | Consing a value to a 'LisT'.
 consListT :: Applicative m => a -> ListT m a -> ListT m a
 consListT a = \case
   ListT ml ->
@@ -88,9 +122,18 @@ consListT a = \case
         NilF -> ConsF a emptyListT
         ConsF x xs -> ConsF a $ ListT $ pure $ ConsF x xs
 
-singletonListT :: Applicative m => a -> ListT m a
-singletonListT a = consListT a emptyListT
+-- | Convert some 'Foldable' @t@ into a 'ListT'.
+toListT :: (Foldable t, Applicative m) => t a -> ListT m a
+toListT = foldr' consListT emptyListT
+
+-- | Convert a 'ListT' into a '[]' and sequence the effects.
+fromListT :: Monad m => ListT m a -> m [a]
+fromListT (ListT m) =
+  m >>= \case
+    NilF -> pure []
+    ConsF a xs -> fmap (a :) $ fromListT xs
 
+-- | The join operation of the 'ListT' @m@ monad.
 joinListT :: Monad m => ListT m (ListT m a) -> ListT m a
 joinListT (ListT ma) = ListT $ do
   fma <- ma
@@ -102,22 +145,12 @@ joinListT (ListT ma) = ListT $ do
         NilF -> runListT $ joinListT xss
         x `ConsF` xs' -> runListT $ consListT x $ joinListT $ consListT xs' xss
 
-instance Monad m => Monad (ListT m) where
-  return = pure
-  ma >>= amb = joinListT $ fmap amb ma
-
-toListT :: (Foldable t, Applicative m) => t a -> ListT m a
-toListT = foldr' consListT emptyListT
-
+-- | Lift a monad morphism from @m@ to @n@ into a monad morphism from
+-- @ListT m@ to @ListT n@.
 hoistListT :: Functor n => (forall x. m x -> n x) -> ListT m a -> ListT n a
 hoistListT f = ListT . fmap (fmap (hoistListT f)) . f . runListT
 
-fromListT :: Monad m => ListT m a -> m [a]
-fromListT (ListT m) =
-  m >>= \case
-    NilF -> pure []
-    ConsF a xs -> fmap (a :) $ fromListT xs
-
+-- | Align two 'ListT's, interleaving their effects.
 interleaveListT :: Monad m => ListT m a -> ListT m b -> ListT m (These a b)
 interleaveListT (ListT m) (ListT n) = ListT $ do
   x <- m