Rename: EffCategory, FreeEffCat

examples/src/LoginStateMachine.hs

@@ -23,7 +23,7 @@ import Test.QuickCheck
 import Control.Category.Free (Cat)
 
 -- Import classes and combintators used in this example
-import Control.Category.Lifting
+import Control.Category.FreeEff
 
 {-------------------------------------------------------------------------------
 -- Example State Machine, inspired by:
@@ -66,16 +66,16 @@ data Tr a from to where
 
 login :: Monad m
       => SStateType st
-      -> FreeLifting m (Cat (Tr a)) (State a 'LoggedOutType) (State a st)
+      -> FreeEffCat m (Cat (Tr a)) (State a 'LoggedOutType) (State a st)
 login = liftCat . Login
 
 logout :: Monad m
        => Maybe a
-       -> FreeLifting m (Cat (Tr a)) (State a 'LoggedInType) (State a 'LoggedOutType)
+       -> FreeEffCat m (Cat (Tr a)) (State a 'LoggedInType) (State a 'LoggedOutType)
 logout = liftCat . Logout
 
 access :: Monad m
-       => FreeLifting m (Cat (Tr a)) (State a 'LoggedInType) (State a 'LoggedInType)
+       => FreeEffCat m (Cat (Tr a)) (State a 'LoggedInType) (State a 'LoggedInType)
 access = liftCat Access
 
 type Username = String
@@ -149,7 +149,7 @@ accessSecret
   -- @'HandleLogin'@ (with a small modifications) but this way we are able to
   -- test it with a pure @'HandleLogin'@ (see @'handleLoginPure'@).
   -> HandleLogin m String a
-  -> FreeLifting m (Cat (Tr a)) (State a 'LoggedOutType) (State a 'LoggedOutType)
+  -> FreeEffCat m (Cat (Tr a)) (State a 'LoggedOutType) (State a 'LoggedOutType)
 accessSecret 0 HandleLogin{handleAccessDenied}         = lift $ handleAccessDenied $> id
 accessSecret n HandleLogin{handleLogin} = lift $ do
   st <- handleLogin
@@ -159,7 +159,7 @@ accessSecret n HandleLogin{handleLogin} = lift $ do
     -- login failure
     Left handler'       -> return $ accessSecret (pred n) handler'
  where
-  handle :: HandleAccess m a -> Maybe a -> FreeLifting m (Cat (Tr a)) (State a 'LoggedInType) (State a 'LoggedOutType)
+  handle :: HandleAccess m a -> Maybe a -> FreeEffCat m (Cat (Tr a)) (State a 'LoggedInType) (State a 'LoggedOutType)
   handle LogoutHandler ma = logout ma
   handle (AccessHandler accessHandler dataHandler) _ = lift $ do
     a <- accessHandler
@@ -191,7 +191,7 @@ getData nat n handleLogin = case foldNatLift nat (accessSecret n handleLogin) of
 -- here, as we don't use the monad in the transformation, we need
 -- a transformation into a category that satisfies the @'Lifing'@ constraint.
 -- This is bause we will need the monad whn @'foldNatLift'@ will walk over the
--- constructors of '@FreeLifting'@ category.
+-- constructors of '@FreeEffCat'@ category.
 --
 natPure :: forall m a from to. Monad m => Tr a from to -> Kleisli m from to
 natPure = liftKleisli . nat

free-category.cabal

@@ -1,5 +1,5 @@
 name:           free-category
-version:        0.0.1.0
+version:        0.0.2.0
 synopsis:       Free category
 description:    Free categories
 category:       Algebra, Control, Monads, Category
@@ -24,7 +24,7 @@ library
   exposed-modules:
       Control.Arrow.Free
       Control.Category.Free
-      Control.Category.Lifting
+      Control.Category.FreeEff
   other-modules:
       Paths_free_category
   hs-source-dirs:

src/Control/Category/FreeEff.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE FunctionalDependencies #-}
-module Control.Category.Lifting
-  ( Lifting (..)
-  , FreeLifting (..)
+module Control.Category.FreeEff
+  ( EffCategory (..)
+  , FreeEffCat (..)
   , liftCat
   , foldNatLift
   , liftKleisli
@@ -17,35 +17,37 @@ import Control.Category.Free (Cat (..))
 import Control.Algebra.Free2 (FreeAlgebra2 (..))
 import Data.Algebra.Free (AlgebraType, AlgebraType0, proof)
 
--- | Categories which can lift monadic actions.
+
+-- | Categories which can lift monadic actions, i.e. effectful categories.
 --
-class Category c => Lifting c m | c -> m where
+class Category c => EffCategory c m | c -> m where
   lift :: m (c a b) -> c a b
 
-instance Monad m => Lifting (Kleisli m) m where
+instance Monad m => EffCategory (Kleisli m) m where
   lift m = Kleisli (\a -> m >>= \(Kleisli f) -> f a)
 
-instance Lifting (->) Identity where
+instance EffCategory (->) Identity where
   lift = runIdentity
 
--- | Category transformer, which adds @'Lifting'@ instance to the underlying
--- base category.
-data FreeLifting :: (* -> *) -> (k -> k -> *) -> k -> k -> * where
-  Base :: c a b -> FreeLifting m c a b
-  Lift :: m (FreeLifting m c a b) -> FreeLifting m c a b
+-- | Category transformer, which adds @'EffCategory'@ instance to the
+-- underlying base category.
+--
+data FreeEffCat :: (* -> *) -> (k -> k -> *) -> k -> k -> * where
+  Base :: c a b -> FreeEffCat m c a b
+  Lift :: m (FreeEffCat m c a b) -> FreeEffCat m c a b
 
-instance (Functor m, Category c) => Category (FreeLifting m c) where
+instance (Functor m, Category c) => Category (FreeEffCat m c) where
   id = Base id
   Base f  . Base g  = Base $ f . g
   f       . Lift mg = Lift $ (f .) <$> mg
   Lift mf . g       = Lift $ (. g) <$> mf
 
-instance (Functor m, Category c) => Lifting (FreeLifting m c) m where
+instance (Functor m, Category c) => EffCategory (FreeEffCat m c) m where
   lift = Lift
 
-type instance AlgebraType0 (FreeLifting m) c = (Monad m, Category c)
-type instance AlgebraType  (FreeLifting m) c  = Lifting c m
-instance Monad m => FreeAlgebra2 (FreeLifting m) where
+type instance AlgebraType0 (FreeEffCat m) c = (Monad m, Category c)
+type instance AlgebraType  (FreeEffCat m) c  = EffCategory c m
+instance Monad m => FreeAlgebra2 (FreeEffCat m) where
   liftFree2    = Base
   foldNatFree2 nat (Base cab)  = nat cab
   foldNatFree2 nat (Lift mcab) = lift $ foldNatFree2 nat <$> mcab
@@ -54,25 +56,25 @@ instance Monad m => FreeAlgebra2 (FreeLifting m) where
   forget2 = proof
 
 -- | Wrap a transition into a free category @'Cat'@ and then in
--- @'FreeLifting'@
+-- @'FreeEffCat'@
 --
 -- prop> liftCat tr = Base (tr :.: Id)
 --
-liftCat :: Monad m => tr a b -> FreeLifting m (Cat tr) a b
+liftCat :: Monad m => tr a b -> FreeEffCat m (Cat tr) a b
 liftCat = liftFree2 . liftFree2
 
 -- | Fold @'FreeLifing'@ category based on a free category @'Cat' tr@ using
 -- a functor @tr x y -> c x y@.
 --
 foldNatLift
-  :: (Monad m, Lifting c m)
+  :: (Monad m, EffCategory c m)
   => (forall x y. tr x y -> c x y)
-  -> FreeLifting m (Cat tr) a b
+  -> FreeEffCat m (Cat tr) a b
   -> c a b
 foldNatLift nat = foldNatFree2 (foldNatFree2 nat)
 
 -- |  Functor from @'->'@ category to @'Kleisli' m@.  If @m@ is @Identity@ then
--- it will respect @'lift'@ i.e. @lfitKleisli (lift ar) = lift (liftKleisli <$>
+-- it will respect @'lift'@ i.e. @liftKleisli (lift ar) = lift (liftKleisli <$>
 -- ar).
 --
 liftKleisli :: Applicative m => (a -> b) -> Kleisli m a b