Skip to content

Commit c27ee34

Browse files
authored
Merge pull request #75 from coot/exploreM
add exploreM
2 parents 52687d1 + a21f831 commit c27ee34

File tree

1 file changed

+19
-2
lines changed

1 file changed

+19
-2
lines changed

src/Control/Comonad/Cofree.purs

Lines changed: 19 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -11,11 +11,12 @@ module Control.Comonad.Cofree
1111
) where
1212

1313
import Prelude
14-
import Control.Monad.Free (Free, runFreeM)
1514
import Control.Alternative (class Alternative, (<|>), empty)
1615
import Control.Comonad (class Comonad, extract)
1716
import Control.Extend (class Extend)
18-
import Control.Monad.State (State, runState, state)
17+
import Control.Monad.Free (Free, runFreeM)
18+
import Control.Monad.Rec.Class (class MonadRec)
19+
import Control.Monad.State (State, StateT(..), runState, runStateT, state)
1920
import Data.Foldable (class Foldable, foldr, foldl, foldMap)
2021
import Data.Lazy (Lazy, force, defer)
2122
import Data.Traversable (class Traversable, traverse)
@@ -83,6 +84,22 @@ explore pair m w =
8384
step :: f (Free f (a -> b)) -> State (Cofree g a) (Free f (a -> b))
8485
step ff = state \cof -> pair (map Tuple ff) (tail cof)
8586

87+
exploreM
88+
:: forall f g a b m
89+
. (Functor f, Functor g, MonadRec m)
90+
=> (forall x y. f (x -> y) -> g x -> m y)
91+
-> Free f (a -> b)
92+
-> Cofree g a
93+
-> m b
94+
exploreM pair m w =
95+
eval <$> runStateT (runFreeM step m) w
96+
where
97+
step :: f (Free f (a -> b)) -> StateT (Cofree g a) m (Free f (a -> b))
98+
step ff = StateT \cof -> pair (map Tuple ff) (tail cof)
99+
100+
eval :: forall x y. Tuple (x -> y) (Cofree g x) -> y
101+
eval (Tuple f cof) = f (extract cof)
102+
86103
instance eqCofree :: (Eq (f (Cofree f a)), Eq a) => Eq (Cofree f a) where
87104
eq x y = head x == head y && tail x == tail y
88105

0 commit comments

Comments
 (0)