Skip to content

Commit cc045ea

Browse files
matthewleonpaf31
authored andcommitted
fix runListT (#89)
* stack-safe foldl * name TCOd foldl fodlRec * add stack-safe foldl' * Adapt runListT from Haskell's List.Transformer * ListT examples * simplify runListT Unnecessary use of `void action`. * add runListTRec and use in examples
1 parent e680771 commit cc045ea

File tree

3 files changed

+49
-3
lines changed

3 files changed

+49
-3
lines changed

src/Control/Monad/List/Trans.purs

Lines changed: 10 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,8 @@ module Control.Monad.List.Trans
2020
, prepend
2121
, prepend'
2222
, repeat
23+
, runListT
24+
, runListTRec
2325
, scanl
2426
, singleton
2527
, tail
@@ -70,9 +72,14 @@ data Step a s
7072
| Skip (Lazy s)
7173
| Done
7274

73-
-- | Run a computation in the `ListT` monad.
74-
runListT :: forall f a. ListT f a -> f (Step a (ListT f a))
75-
runListT (ListT fa) = fa
75+
-- | Drain a `ListT`, running it to completion and discarding all values.
76+
runListT :: forall f a. Monad f => ListT f a -> f Unit
77+
runListT = foldl' (\_ _ -> pure unit) unit
78+
79+
-- | Drain a `ListT`, running it to completion and discarding all values.
80+
-- | Stack safe: Uses tail call optimization.
81+
runListTRec :: forall f a. MR.MonadRec f => ListT f a -> f Unit
82+
runListTRec = foldlRec' (\_ _ -> pure unit) unit
7683

7784
-- | The empty list.
7885
nil :: forall f a. Applicative f => ListT f a

test/Example/List.purs

Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,37 @@
1+
module Example.List where
2+
3+
import Prelude
4+
import Data.Array as A
5+
import Control.Monad.Eff (Eff)
6+
import Control.Monad.Eff.Class (liftEff)
7+
import Control.Monad.Eff.Console (CONSOLE, log)
8+
import Control.Monad.List.Trans (ListT, runListTRec, iterate, takeWhile)
9+
import Control.MonadZero (guard)
10+
11+
-- based on http://hackage.haskell.org/package/list-transformer
12+
logList :: forall eff.
13+
ListT (Eff (console :: CONSOLE | eff)) String
14+
-> Eff (console :: CONSOLE | eff) Unit
15+
logList l = runListTRec do
16+
liftEff $ log "logging listT"
17+
str <- l
18+
liftEff $ log str
19+
20+
-- based on https://wiki.haskell.org/ListT_done_right#Sum_of_squares
21+
sumSqrs :: forall eff.
22+
Int
23+
-> ListT (Eff (console :: CONSOLE | eff)) Unit
24+
sumSqrs n = do
25+
let
26+
nats = iterate (add one) zero
27+
squares = takeWhile (_ <= n) $ map (\x -> x * x) nats
28+
x <- squares
29+
y <- squares
30+
liftEff $ log ("<" <> show x <> "," <> show y <> ">")
31+
guard $ x + y == n
32+
liftEff $ log "Sum of squares."
33+
34+
main :: forall eff. Eff (console :: CONSOLE | eff) Unit
35+
main = do
36+
logList $ A.toUnfoldable ["one", "two", "three"]
37+
runListTRec $ sumSqrs 10

test/Test/Main.purs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@ import Example.State as State
1111
import Example.StateEff as StateEff
1212
import Example.Writer as Writer
1313
import Example.RWS as RWS
14+
import Example.List as List
1415

1516
main :: Eff (console :: CONSOLE) Unit
1617
main = do
@@ -20,3 +21,4 @@ main = do
2021
StateEff.main
2122
Writer.main
2223
RWS.main
24+
List.main

0 commit comments

Comments
 (0)