Renamed API in Control.Category.FreeEff

Renamed `Control.Category.FreeEff` module as
`Control.Category.FreeEffect`
  and renamed top level terms:
  - `EffCategory` type class to `EffectCategory`
  - `FreeEffCat` to `EffCat`
  - `FreeEffCat` constructor as `Effect` and `lift` as `effect`
  - `liftCat` to `liftEffect`
  - `foldNatLift` to `foldNatEffCat`

ChangeLog.md

@@ -18,3 +18,10 @@
 
 ## Unreleased changes
 - hoistOp
+- Renamed `Control.Category.FreeEff` module as `Control.Category.FreeEffect`
+  and renamed top level terms:
+    - `EffCategory` type class to `EffectCategory`
+    - `FreeEffCat` to `EffCat`
+    - `FreeEffCat` constructor as `Effect` and `lift` as `effect`
+    - `liftCat` to `liftEffect`
+    - `foldNatLift` to `foldNatEffCat`

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.FreeEff
+import Control.Category.FreeEffect
 
 {-------------------------------------------------------------------------------
 -- Example State Machine, inspired by:
@@ -74,17 +74,17 @@ data Tr a from to where
 
 login :: Monad m
       => SStateType st
-      -> FreeEffCat m (Cat (Tr a)) (State a 'LoggedOutType) (State a st)
-login = liftCat . Login
+      -> EffCat m (Cat (Tr a)) (State a 'LoggedOutType) (State a st)
+login = liftEffect . Login
 
 logout :: Monad m
        => Maybe a
-       -> FreeEffCat m (Cat (Tr a)) (State a 'LoggedInType) (State a 'LoggedOutType)
-logout = liftCat . Logout
+       -> EffCat m (Cat (Tr a)) (State a 'LoggedInType) (State a 'LoggedOutType)
+logout = liftEffect . Logout
 
 access :: Monad m
-       => FreeEffCat m (Cat (Tr a)) (State a 'LoggedInType) (State a 'LoggedInType)
-access = liftCat Access
+       => EffCat m (Cat (Tr a)) (State a 'LoggedInType) (State a 'LoggedInType)
+access = liftEffect Access
 
 type Username = String
 
@@ -157,9 +157,9 @@ 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
-  -> FreeEffCat m (Cat (Tr a)) (State a 'LoggedOutType) (State a 'LoggedOutType)
-accessSecret 0 HandleLogin{handleAccessDenied}         = lift $ handleAccessDenied $> id
-accessSecret n HandleLogin{handleLogin} = lift $ do
+  -> EffCat m (Cat (Tr a)) (State a 'LoggedOutType) (State a 'LoggedOutType)
+accessSecret 0 HandleLogin{handleAccessDenied}         = effect $ handleAccessDenied $> id
+accessSecret n HandleLogin{handleLogin} = effect $ do
   st <- handleLogin
   case st of
     -- login success
@@ -167,9 +167,9 @@ accessSecret n HandleLogin{handleLogin} = lift $ do
     -- login failure
     Left handler'       -> return $ accessSecret (pred n) handler'
  where
-  handle :: HandleAccess m a -> Maybe a -> FreeEffCat m (Cat (Tr a)) (State a 'LoggedInType) (State a 'LoggedOutType)
+  handle :: HandleAccess m a -> Maybe a -> EffCat m (Cat (Tr a)) (State a 'LoggedInType) (State a 'LoggedOutType)
   handle LogoutHandler ma = logout ma
-  handle (AccessHandler accessHandler dataHandler) _ = lift $ do
+  handle (AccessHandler accessHandler dataHandler) _ = effect $ do
     a <- accessHandler
     accessHandler' <- dataHandler a
     return $ handle accessHandler' (Just a)
@@ -184,7 +184,7 @@ getData
   -> Natural
   -> HandleLogin m String a
   -> m (Maybe a)
-getData nat n handleLogin = case foldNatLift nat (accessSecret n handleLogin) of
+getData nat n handleLogin = case foldNatEffCat nat (accessSecret n handleLogin) of
   Kleisli fn -> do
     ma <- runLoggedOut <$> fn (LoggedOut Nothing)
     return ma

free-category.cabal

@@ -29,7 +29,7 @@ library
       Control.Arrow.Free
       Control.Category.Free
       Control.Category.Free.Internal
-      Control.Category.FreeEff
+      Control.Category.FreeEffect
   other-modules:
       Paths_free_category
   hs-source-dirs:

src/Control/Category/FreeEff.hs

@@ -1,89 +0,0 @@
-{-# LANGUAGE GADTs                  #-}
-{-# LANGUAGE FlexibleInstances      #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE PolyKinds              #-}
-{-# LANGUAGE RankNTypes             #-}
-{-# LANGUAGE TypeFamilies           #-}
-
-{-# OPTIONS_HADDOCK show-extensions #-}
-
-module Control.Category.FreeEff
-  ( EffCategory (..)
-  , FreeEffCat (..)
-  , liftCat
-  , foldNatLift
-  , liftKleisli
-  ) where
-
-import Prelude hiding (id, (.))
-
-import Control.Arrow (Kleisli (..))
-import Control.Category (Category (..))
-import Data.Functor.Identity (Identity (..))
-
-import Control.Category.Free (Cat)
-import Control.Algebra.Free2 (FreeAlgebra2 (..))
-import Data.Algebra.Free (AlgebraType, AlgebraType0, proof)
-
-
--- | Categories which can lift monadic actions, i.e. effectful categories.
---
-class Category c => EffCategory c m | c -> m where
-  lift :: m (c a b) -> c a b
-
-instance Monad m => EffCategory (Kleisli m) m where
-  lift m = Kleisli (\a -> m >>= \(Kleisli f) -> f a)
-
-instance EffCategory (->) Identity where
-  lift = runIdentity
-
--- | 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 (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) => EffCategory (FreeEffCat m c) m where
-  lift = Lift
-
-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
-
-  codom2  = proof
-  forget2 = proof
-
--- | Wrap a transition into a free category @'Cat'@ and then in
--- @'FreeEffCat'@
---
--- prop> liftCat tr = Base (tr :.: Id)
---
-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, EffCategory c m)
-  => (forall x y. tr x y -> c x y)
-  -> 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. @liftKleisli (lift ar) = lift (liftKleisli <$>
--- ar).
---
-liftKleisli :: Applicative m => (a -> b) -> Kleisli m a b
-liftKleisli f = Kleisli (pure . f)

src/Control/Category/FreeEffect.hs

@@ -0,0 +1,87 @@
+{-# LANGUAGE GADTs                  #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE PolyKinds              #-}
+{-# LANGUAGE RankNTypes             #-}
+{-# LANGUAGE TypeFamilies           #-}
+
+{-# OPTIONS_HADDOCK show-extensions #-}
+
+module Control.Category.FreeEffect
+  ( EffectCategory (..)
+  , EffCat (..)
+  , liftEffect
+  , foldNatEffCat
+  , liftKleisli
+  ) where
+
+import Prelude hiding (id, (.))
+
+import Control.Arrow (Kleisli (..))
+import Control.Category (Category (..))
+import Data.Functor.Identity (Identity (..))
+
+import Control.Category.Free (Cat)
+import Control.Algebra.Free2 (FreeAlgebra2 (..))
+import Data.Algebra.Free (AlgebraType, AlgebraType0, proof)
+
+
+-- | Categories which can lift monadic actions, i.e. effectful categories.
+--
+class Category c => EffectCategory c m | c -> m where
+  effect :: m (c a b) -> c a b
+
+instance Monad m => EffectCategory (Kleisli m) m where
+  effect m = Kleisli (\a -> m >>= \(Kleisli f) -> f a)
+
+instance EffectCategory (->) Identity where
+  effect = runIdentity
+
+-- | Category transformer, which adds @'EffectCategory'@ instance to the
+-- underlying base category.
+--
+data EffCat :: (* -> *) -> (k -> k -> *) -> k -> k -> * where
+  Base   :: c a b -> EffCat m c a b
+  Effect :: m (EffCat m c a b) -> EffCat m c a b
+
+instance (Functor m, Category c) => Category (EffCat m c) where
+  id = Base id
+  Base f    . Base g    = Base   $ f . g
+  f         . Effect mg = Effect $ (f .) <$> mg
+  Effect mf . g         = Effect $ (. g) <$> mf
+
+instance (Functor m, Category c) => EffectCategory (EffCat m c) m where
+  effect = Effect
+
+type instance AlgebraType0 (EffCat m) c = (Monad m, Category c)
+type instance AlgebraType  (EffCat m) c  = EffectCategory c m
+instance Monad m => FreeAlgebra2 (EffCat m) where
+  liftFree2    = Base
+  foldNatFree2 nat (Base cab)    = nat cab
+  foldNatFree2 nat (Effect mcab) = effect $ foldNatFree2 nat <$> mcab
+
+  codom2  = proof
+  forget2 = proof
+
+-- | Wrap a transition into a free category @'Cat'@ and then in
+-- @'EffCat'@
+--
+liftEffect :: Monad m => tr a b -> EffCat m (Cat tr) a b
+liftEffect = liftFree2 . liftFree2
+
+-- | Fold @'FreeLifing'@ category based on a free category @'Cat' tr@ using
+-- a functor @tr x y -> c x y@.
+--
+foldNatEffCat
+  :: (Monad m, EffectCategory c m)
+  => (forall x y. tr x y -> c x y)
+  -> EffCat m (Cat tr) a b
+  -> c a b
+foldNatEffCat nat = foldNatFree2 (foldNatFree2 nat)
+
+-- |  Functor from @'->'@ category to @'Kleisli' m@.  If @m@ is @Identity@ then
+-- it will respect @'lift'@ i.e. @liftKleisli (lift ar) = lift (liftKleisli <$>
+-- ar).
+--
+liftKleisli :: Applicative m => (a -> b) -> Kleisli m a b
+liftKleisli f = Kleisli (pure . f)