fix runListT

src/Control/Monad/List/Trans.purs

@@ -9,7 +9,9 @@ module Control.Monad.List.Trans
   , dropWhile
   , filter
   , foldl
+  , foldlRec
   , foldl'
+  , foldlRec'
   , fromEffect
   , head
   , iterate
@@ -18,6 +20,8 @@ module Control.Monad.List.Trans
   , prepend
   , prepend'
   , repeat
+  , runListT
+  , runListTRec
   , scanl
   , singleton
   , tail
@@ -39,6 +43,7 @@ import Control.Alternative (class Alternative)
 import Control.Monad.Eff.Class (class MonadEff, liftEff)
 import Control.Monad.Trans.Class (class MonadTrans, lift)
 import Control.MonadPlus (class MonadPlus)
+import Control.Monad.Rec.Class as MR
 import Control.MonadZero (class MonadZero)
 import Control.Plus (class Plus)
 
@@ -67,9 +72,14 @@ data Step a s
   | Skip (Lazy s)
   | Done
 
--- | Run a computation in the `ListT` monad.
-runListT :: forall f a. ListT f a -> f (Step a (ListT f a))
-runListT (ListT fa) = fa
+-- | Drain a `ListT`, running it to completion and discarding all values.
+runListT :: forall f a. Monad f => ListT f a -> f Unit
+runListT = foldl' (\_ _ -> pure unit) unit
+
+-- | Drain a `ListT`, running it to completion and discarding all values.
+-- | Stack safe: Uses tail call optimization.
+runListTRec :: forall f a. MR.MonadRec f => ListT f a -> f Unit
+runListTRec = foldlRec' (\_ _ -> pure unit) unit
 
 -- | The empty list.
 nil :: forall f a. Applicative f => ListT f a
@@ -203,6 +213,15 @@ foldl' f = loop where
     g Nothing             = pure b
     g (Just (Tuple a as)) = (f b a) >>= (flip loop as)
 
+-- | Fold a list from the left, accumulating the result (effectfully) using the specified function.
+-- | Uses tail call optimization.
+foldlRec' :: forall f a b. MR.MonadRec f => (b -> a -> f b) -> b -> ListT f a -> f b
+foldlRec' f = MR.tailRecM2 loop where
+  loop b l = uncons l >>= g
+    where
+    g Nothing             = pure (MR.Done b)
+    g (Just (Tuple a as)) = (f b a) >>= \b' -> pure (MR.Loop {a: b', b: as})
+
 -- | Fold a list from the left, accumulating the result using the specified function.
 foldl :: forall f a b. Monad f => (b -> a -> b) -> b -> ListT f a -> f b
 foldl f = loop where
@@ -211,6 +230,16 @@ foldl f = loop where
     g Nothing             = pure b
     g (Just (Tuple a as)) = loop (f b a) as
 
+-- | Fold a list from the left, accumulating the result using the specified function.
+-- | Uses tail call optimization.
+foldlRec :: forall f a b. MR.MonadRec f => (b -> a -> b) -> b -> ListT f a -> f b
+foldlRec f = MR.tailRecM2 loop
+  where
+    loop b l = uncons l >>= g
+      where
+      g Nothing             = pure (MR.Done b)
+      g (Just (Tuple a as)) = pure (MR.Loop {a: f b a, b: as})
+
 -- | Fold a list from the left, accumulating the list of results using the specified function.
 scanl :: forall f a b. Monad f => (b -> a -> b) -> b -> ListT f a -> ListT f b
 scanl f b l = unfold g (Tuple b l)

test/Example/List.purs

@@ -0,0 +1,37 @@
+module Example.List where
+
+import Prelude
+import Data.Array as A
+import Control.Monad.Eff (Eff)
+import Control.Monad.Eff.Class (liftEff)
+import Control.Monad.Eff.Console (CONSOLE, log)
+import Control.Monad.List.Trans (ListT, runListTRec, iterate, takeWhile)
+import Control.MonadZero (guard)
+
+-- based on http://hackage.haskell.org/package/list-transformer
+logList :: forall eff.
+   ListT (Eff (console :: CONSOLE | eff)) String
+-> Eff (console :: CONSOLE | eff) Unit
+logList l = runListTRec do
+  liftEff $ log "logging listT"
+  str <- l
+  liftEff $ log str
+
+-- based on https://wiki.haskell.org/ListT_done_right#Sum_of_squares
+sumSqrs :: forall eff.
+   Int
+-> ListT (Eff (console :: CONSOLE | eff)) Unit
+sumSqrs n = do
+  let
+    nats = iterate (add one) zero
+    squares = takeWhile (_ <= n) $ map (\x -> x * x) nats
+  x <- squares
+  y <- squares
+  liftEff $ log ("<" <> show x <> "," <> show y <> ">")
+  guard $ x + y == n
+  liftEff $ log "Sum of squares."
+
+main :: forall eff. Eff (console :: CONSOLE | eff) Unit
+main = do
+  logList $ A.toUnfoldable ["one", "two", "three"]
+  runListTRec $ sumSqrs 10

test/Test/Main.purs

@@ -11,6 +11,7 @@ import Example.State as State
 import Example.StateEff as StateEff
 import Example.Writer as Writer
 import Example.RWS as RWS
+import Example.List as List
 
 main :: Eff (console :: CONSOLE) Unit
 main = do
@@ -20,3 +21,4 @@ main = do
   StateEff.main
   Writer.main
   RWS.main
+  List.main