Adding FreeC

Author: ethul

MODULE.md

@@ -1,5 +1,86 @@
 # Module Documentation
 
+## Module Data.Coyoneda
+
+### Types
+
+    newtype Coyoneda f a where
+      Coyoneda :: Exists (CoyonedaF f a) -> Coyoneda f a
+
+    newtype CoyonedaF f a i where
+      CoyonedaF :: { fi :: f i, k :: i -> a } -> CoyonedaF f a i
+
+    type Natural f g = forall a. f a -> g a
+
+
+### Type Class Instances
+
+    instance applicativeCoyoneda :: (Applicative f) => Applicative (Coyoneda f)
+
+    instance applyCoyoneda :: (Apply f) => Apply (Coyoneda f)
+
+    instance bindCoyoneda :: (Bind f) => Bind (Coyoneda f)
+
+    instance comonadCoyoneda :: (Comonad w) => Comonad (Coyoneda w)
+
+    instance extendCoyoneda :: (Extend w) => Extend (Coyoneda w)
+
+    instance functorCoyoneda :: Functor (Coyoneda f)
+
+    instance monadCoyoneda :: (Monad f) => Monad (Coyoneda f)
+
+    instance monadTransCoyoneda :: MonadTrans Coyoneda
+
+
+### Values
+
+    coyoneda :: forall f a b. (a -> b) -> f a -> Coyoneda f b
+
+    liftCoyoneda :: forall f a. f a -> Coyoneda f a
+
+    liftCoyonedaT :: forall f g. Natural f g -> Natural (Coyoneda f) (Coyoneda g)
+
+    liftCoyonedaTF :: forall f g. (Functor g) => Natural f g -> Natural (Coyoneda f) g
+
+    lowerCoyoneda :: forall f a. (Functor f) => Coyoneda f a -> f a
+
+
+## Module Data.Yoneda
+
+### Types
+
+    newtype Yoneda f a where
+      Yoneda :: forall b. (a -> b) -> f b -> Yoneda f a
+
+
+### Type Class Instances
+
+    instance applicativeYoneda :: (Applicative f) => Applicative (Yoneda f)
+
+    instance applyYoneda :: (Apply f) => Apply (Yoneda f)
+
+    instance bindCoyoneda :: (Bind f) => Bind (Yoneda f)
+
+    instance comonadYoneda :: (Comonad w) => Comonad (Yoneda w)
+
+    instance extendYoneda :: (Extend w) => Extend (Yoneda w)
+
+    instance functorYoneda :: Functor (Yoneda f)
+
+    instance monadTransYoneda :: MonadTrans Yoneda
+
+    instance monadYoneda :: (Monad f) => Monad (Yoneda f)
+
+
+### Values
+
+    liftYoneda :: forall f a. (Functor f) => f a -> Yoneda f a
+
+    lowerYoneda :: forall f a. Yoneda f a -> f a
+
+    runYoneda :: forall f a b. Yoneda f a -> (a -> b) -> f b
+
+
 ## Module Control.Monad.Free
 
 ### Types
@@ -9,6 +90,8 @@
       Free :: f (Free f a) -> Free f a
       Gosub :: forall s. (forall r. (Unit -> Free f r) -> (r -> Free f a) -> s) -> s -> Free f a
 
+    type FreeC f a = Free (Coyoneda f) a
+
 
 ### Type Classes
 
@@ -39,14 +122,22 @@
 
     goEff :: forall e f a. (Functor f) => (f (Free f a) -> Eff e (Free f a)) -> Free f a -> Eff e a
 
+    goEffC :: forall e f a. Natural f (Eff e) -> FreeC f a -> Eff e a
+
     goM :: forall f m a. (Functor f, Monad m) => (f (Free f a) -> m (Free f a)) -> Free f a -> m a
 
+    goMC :: forall f m a. (Monad m) => Natural f m -> FreeC f a -> m a
+
     iterM :: forall f m a. (Functor f, Monad m) => (forall a. f (m a) -> m a) -> Free f a -> m a
 
     liftF :: forall f m a. (Functor f, Monad m, MonadFree f m) => f a -> m a
 
+    liftFC :: forall f a. f a -> FreeC f a
+
     pureF :: forall f a. (Applicative f) => a -> Free f a
 
+    pureFC :: forall f a. (Applicative f) => a -> FreeC f a
+
 
 ## Module Control.Monad.Trampoline
 

examples/Teletype.purs

@@ -1,29 +1,26 @@
-module Teletype where
+module Main where
 
 import Control.Monad.Eff
 import Control.Monad.Free
+import Data.Coyoneda
 import Debug.Trace
 
 data TeletypeF a = PutStrLn String a | GetLine (String -> a)
 
-instance teletypeFFunctor :: Functor TeletypeF where
-  (<$>) f (PutStrLn s a) = PutStrLn s (f a)
-  (<$>) f (GetLine k) = GetLine (\s -> f (k s))
-
-type Teletype = Free TeletypeF
+type Teletype a = FreeC TeletypeF a
 
 putStrLn :: String -> Teletype Unit
-putStrLn s = liftF $ PutStrLn s unit
+putStrLn s = liftFC $ PutStrLn s unit
 
 getLine :: Teletype String
-getLine = liftF $ GetLine (\a -> a)
+getLine = liftFC $ GetLine id
 
-runF :: forall a. TeletypeF a -> Eff (trace :: Trace) a
-runF (PutStrLn s a) = (\_ -> a) <$> trace s
-runF (GetLine k) = return $ k "fake input"
+teletypeN :: forall e. Natural TeletypeF (Eff (trace :: Trace))
+teletypeN (PutStrLn s a) = const a <$> trace s
+teletypeN (GetLine k) = return $ k "fake input"
 
 run :: forall a. Teletype a -> Eff (trace :: Trace) a
-run = goEff runF
+run = goEffC teletypeN
 
 echo = do
   a <- getLine

src/Control/Monad/Free.purs

@@ -1,23 +1,27 @@
 module Control.Monad.Free
   ( Free(..)
+  , FreeC(..)
   , MonadFree, wrap
-  , liftF
-  , pureF
+  , liftF, liftFC
+  , pureF, pureFC
   , iterM
-  , goM
+  , goM, goMC
   , go
-  , goEff
+  , goEff, goEffC
   ) where
 
 import Control.Monad.Trans
 import Control.Monad.Eff
+import Data.Coyoneda
 import Data.Either
 import Data.Function
 
 data Free f a = Pure a
               | Free (f (Free f a))
               | Gosub (forall s. (forall r. (Unit -> Free f r) -> (r -> Free f a) -> s) -> s)
 
+type FreeC f a = Free (Coyoneda f) a
+
 class MonadFree f m where
   wrap :: forall a. f (m a) -> m a
 
@@ -46,10 +50,16 @@ instance monadFreeFree :: (Functor f) => MonadFree f (Free f) where
   wrap = Free
 
 liftF :: forall f m a. (Functor f, Monad m, MonadFree f m) => f a -> m a
-liftF fa = wrap $ return <$> fa
+liftF = wrap <<< (<$>) return
 
 pureF :: forall f a. (Applicative f) => a -> Free f a
-pureF a = Free (pure (Pure  a))
+pureF = Free <<< pure <<< Pure
+
+liftFC :: forall f a. f a -> FreeC f a
+liftFC = liftF <<< liftCoyoneda
+
+pureFC :: forall f a. (Applicative f) => a -> FreeC f a
+pureFC = liftFC <<< pure
 
 -- Note: can blow the stack!
 iterM :: forall f m a. (Functor f, Monad m) => (forall a. f (m a) -> m a) -> Free f a -> m a
@@ -144,3 +154,10 @@ foreign import goEffImpl
 
 goEff :: forall e f a. (Functor f) => (f (Free f a) -> Eff e (Free f a)) -> Free f a -> Eff e a
 goEff fn f = runFn6 goEffImpl resume isRight unsafeLeft unsafeRight fn f
+
+-- Note: can blow the stack!
+goMC :: forall f m a. (Monad m) => Natural f m -> FreeC f a -> m a
+goMC nat = goM (liftCoyonedaTF nat)
+
+goEffC :: forall e f a. Natural f (Eff e) -> FreeC f a -> Eff e a
+goEffC nat = goEff (liftCoyonedaTF nat)

src/Data/Coyoneda.purs

@@ -1,5 +1,6 @@
 module Data.Coyoneda
   ( Coyoneda(..)
+  , CoyonedaF(..)
   , Natural(..)
   , coyoneda
   , liftCoyoneda