indexed-free 0.1 → 0.2

raw patch · 4 files changed

+83/−4 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Control/Monad/Indexed/Free.hs +22/−2
• Control/Monad/Indexed/Free/Class.hs +9/−0
• Control/Monad/Indexed/Trans/Free.hs +50/−0
• indexed-free.cabal +2/−2

@@ -1,4 +1,4 @@-{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GADTs, MultiParamTypeClasses, FlexibleInstances, Rank2Types #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Control.Monad.Indexed.Free
@@ -10,9 +10,11 @@ -- Portability :  non-portable
 --
 ----------------------------------------------------------------------------
-module Control.Monad.Indexed.Free (IxFree(..)) where
+module Control.Monad.Indexed.Free (IxFree(..), hoistIxFree, module Control.Monad.Indexed.Free.Class) where
 
+import Control.Applicative
 import Control.Monad.Indexed
+import Control.Monad.Indexed.Free.Class
 
 data IxFree f i j x where
     Pure :: a -> IxFree f i i a
@@ -33,3 +35,21 @@ instance IxFunctor f => IxMonad (IxFree f) where
     ibind k (Pure a) = k a
     ibind k (Free fm) = Free $ imap (ibind k) fm
+
+instance IxFunctor f => IxMonadFree f (IxFree f) where
+    iwrap = Free
+
+instance IxFunctor f => Functor (IxFree f i i) where
+    fmap = imap
+
+instance IxFunctor f => Applicative (IxFree f i i) where
+    pure = ireturn
+    (<*>) = iap
+
+instance IxFunctor f => Monad (IxFree f i i) where
+    return = ireturn
+    (>>=) = (>>>=)
+
+hoistIxFree :: (IxFunctor g, IxMonadFree g m) => (forall i j x. f i j x -> g i j x) -> IxFree f i j a -> m i j a
+hoistIxFree _ (Pure a) = ireturn a
+hoistIxFree f (Free fm) = iwrap $ imap (hoistIxFree f) $ f fm

@@ -0,0 +1,9 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
+module Control.Monad.Indexed.Free.Class (IxMonadFree(..)) where
+import Control.Monad.Indexed
+
+class IxMonad m => IxMonadFree f m | m -> f where
+    iwrap :: f i j (m j k a) -> m i k a
+
+iliftFree :: (IxFunctor f, IxMonadFree f m) => f i j a -> m i j a
+iliftFree = iwrap . imap ireturn 

@@ -0,0 +1,50 @@+{-# LANGUAGE GADTs, MultiParamTypeClasses, FlexibleInstances, Rank2Types #-}
+module Control.Monad.Indexed.Trans.Free (IxFreeF(..), IxFreeT(..), transIxFreeT, module Control.Monad.Indexed.Free.Class) where
+
+import Control.Applicative
+import Control.Monad.Indexed
+import Control.Monad.Indexed.Free.Class
+
+data IxFreeF f m i j a where
+    Pure :: a -> IxFreeF f m i i a
+    Free :: f i j (IxFreeT f m j k a) -> IxFreeF f m i k a
+
+newtype IxFreeT f m i j a = IxFreeT { runIxFreeT :: m (IxFreeF f m i j a) }
+
+bindIxFreeT :: (IxFunctor f, Monad m) => IxFreeT f m i j a -> (a -> IxFreeT f m j k b) -> IxFreeT f m i k b
+bindIxFreeT (IxFreeT m) k = IxFreeT $ m >>= \r -> case r of
+    Pure a -> runIxFreeT (k a)
+    Free f -> return $ Free $ imap (`bindIxFreeT` k) f
+
+instance (Monad m, IxFunctor f) => IxFunctor (IxFreeT f m) where
+    imap f (IxFreeT m) = IxFreeT $ m >>= \r -> case r of
+        Pure a -> return $ Pure (f a)
+        Free fm -> return $ Free $ imap (imap f) fm
+
+instance (Monad m, IxFunctor f) => IxPointed (IxFreeT f m) where
+    ireturn = IxFreeT . return . Pure
+
+instance (Monad m, IxFunctor f) => IxApplicative (IxFreeT f m) where
+    iap mf m = bindIxFreeT mf $ \f -> bindIxFreeT m $ \a -> return (f a)
+
+instance (Monad m, IxFunctor f) => IxMonad (IxFreeT f m) where
+    ibind = flip bindIxFreeT
+
+instance (Monad m, IxFunctor f) => IxMonadFree f (IxFreeT f m) where
+    iwrap = IxFreeT . return . Free
+
+instance (Monad m, IxFunctor f) => Functor (IxFreeT f m i i) where
+    fmap = imap
+
+instance (Monad m, IxFunctor f) => Applicative (IxFreeT f m i i) where
+    pure = ireturn
+    (<*>) = iap
+
+instance (Monad m, IxFunctor f) => Monad (IxFreeT f m i i) where
+    return = ireturn
+    (>>=) = (>>>=)
+
+transIxFreeT :: (IxFunctor g, Monad m) => (forall i j x. f i j x -> g i j x) -> IxFreeT f m i j a -> IxFreeT g m i j a
+transIxFreeT f (IxFreeT m) = IxFreeT $ m >>= \r -> return $ case r of
+    Pure a -> Pure a
+    Free fm -> Free $ imap (transIxFreeT f) (f fm) 

@@ -1,5 +1,5 @@ name:                indexed-free
-version:             0.1
+version:             0.2
 synopsis:            indexed monads for free
 description:         A free indexed monad
 homepage:            https://github.com/fumieval/indexed-free
@@ -17,6 +17,6 @@   location: https://github.com/fumieval/indexed-free.git
 
 library
-  exposed-modules:     Control.Monad.Indexed.Free
+  exposed-modules:     Control.Monad.Indexed.Free, Control.Monad.Indexed.Free.Class, Control.Monad.Indexed.Trans.Free
 
   build-depends:       base ==4.*, indexed < 0.2