free-category 0.0.4.2 → 0.0.4.3

raw patch · 9 files changed

+67/−45 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• README.md +4/−4
• free-category.cabal +4/−4
• src/Control/Arrow/Free.hs +4/−4
• src/Control/Category/Free.hs +5/−4
• src/Control/Category/Free/Internal.hs +21/−20
• src/Control/Category/FreeEffect.hs +15/−4
• test/Test/Cat.hs +1/−1
• test/Test/Queue.hs +9/−4

@@ -1,5 +1,9 @@ # Changelog for free-category +## Version 0.0.4.3+- updated for GHC 9.0.1+- added Control.Category.FreeEffect.runEffCat (thanks to Manuel Bärenz)+ ## Version 0.0.4.2 - updated for *GHC 8.10.1* 

@@ -1,6 +1,6 @@ # Free Category [![Maintainer: coot](https://img.shields.io/badge/maintainer-coot-lightgrey.svg)](http://github.com/coot)-[![CircleCI](https://circleci.com/gh/coot/free-category/tree/master.svg?style=svg)](https://circleci.com/gh/coot/free-category/tree/master)+[![Haskell/CI](https://github.com/coot/free-category/workflows/Haskell/CI/badge.svg)](https://github.com/coot/free-category/actions)  This package contains efficient implementations of free categories. There are various representations available:@@ -14,7 +14,7 @@ Free categories are useful to model state machines in a simple yet type safe manner.  For that purpose `Kleisli` categories are a very useful target which allows to include monadic computations.  This package contains a useful-generalisation of `Kliesli` categories captured by `EffectCategory` class+generalisation of `Kleisli` categories captured by `EffectCategory` class (categories with effects), and a (free) transformer which lifts a category to a category with effects. @@ -29,8 +29,8 @@ ## Resources * [LoginStateMachine](https://github.com/coot/free-category/blob/master/examples/src/LoginStateMachine.hs):   based on [State Machines All The Way-  Down](https://www.youtube.com/watch?v=xq7ZuSRgCR4) by Edwin Bradly, 2017 You-  can run it with `cabal new-run examples:login-state-machine`.+  Down](https://www.youtube.com/watch?v=xq7ZuSRgCR4) by Edwin Bradly, 2017.+  You can run it with `cabal new-run examples:login-state-machine`. * Read more [here](https://coot.me/posts/finite-state-machines.html) on   a simple example of a finite state machine encoded using a free category   using a simple GADT.

@@ -1,6 +1,6 @@ cabal-version:  2.0 name:           free-category-version:        0.0.4.2+version:        0.0.4.3 synopsis:       efficient data types for free categories and arrows description:   This package provides various data types for free categories, type@@ -11,8 +11,8 @@ homepage:       https://github.com/coot/free-category#readme bug-reports:    https://github.com/coot/free-category/issues author:         Marcin Szamotulski-maintainer:     profunctor@pm.me-copyright:      (c) 2018-2019 Marcin Szamotulski+maintainer:     coot@coot.me+copyright:      (c) 2018-2021 Marcin Szamotulski license:        MPL-2.0 license-file:   LICENSE build-type:     Simple@@ -23,7 +23,7 @@     bench/report-O1.md     bench/report-O2.md stability:      experimental-tested-with:    GHC==8.6.5, GHC==8.8.3, GHC==8.10.1+tested-with:    GHC==8.6.5, GHC==8.8.4, GHC==8.10.4  source-repository head   type: git

@@ -20,7 +20,7 @@   , A (..)   , fromA   , toA-    -- * Free interface re-exports +    -- * Free interface re-exports   , FreeAlgebra2 (..)   , wrapFree2   , foldFree2@@ -116,7 +116,7 @@ -- Free arrows using CSP style -- --- | Free arrow using CPS sytle.+-- | Free arrow using CPS style. -- newtype A f a b   = A { runA :: forall r. Arrow r@@ -138,7 +138,7 @@ {-# INLINE fromA #-}  instance Category (A f) where-  id = A (const id)+  id = A (\_ -> id)   A f . A g = A $ \k -> f k . g k  instance Semigroup (A f o o) where@@ -151,7 +151,7 @@ #endif  instance Arrow (A f) where-  arr f = A (const (arr f))+  arr f = A (\_ -> (arr f))   A f *** A g  = A $ \k -> f k *** g k   first  (A f) = A $ \k -> first (f k)   second (A f) = A $ \k -> second (f k)

@@ -87,6 +87,7 @@ import           Data.Monoid (Monoid (..)) import           Data.Semigroup (Semigroup (..)) #endif+import           Data.Kind (Type)  import           Control.Category.Free.Internal @@ -127,20 +128,20 @@ fromC = hoistFreeH2 {-# INLINE fromC #-} -liftC :: forall k (f :: k -> k -> *) a b.+liftC :: forall k (f :: k -> k -> Type) a b.          f a b       -> C f a b liftC = \f -> C $ \k -> k f {-# INLINE [1] liftC #-} -consC :: forall k (f :: k -> k -> *) a b c.+consC :: forall k (f :: k -> k -> Type) a b c.          f b c       -> C f a b       -> C f a c consC bc ab = liftC bc `composeC` ab {-# INLINE [1] consC #-} -foldNatC :: forall k (f :: k -> k -> *) c a b.+foldNatC :: forall k (f :: k -> k -> Type) c a b.             Category c          => (forall x y. f x y -> c x y)          -> C f a b@@ -165,7 +166,7 @@ #-}  instance Category (C f) where-  id  = C (const id)+  id  = C (\_ -> id)   (.) = composeC  #if __GLASGOW_HASKELL__ >= 806

@@ -60,6 +60,7 @@ import           Data.Monoid (Monoid (..)) import           Data.Semigroup (Semigroup (..)) #endif+import           Data.Kind (Type)  import           Control.Algebra.Free2 ( AlgebraType0                                        , AlgebraType@@ -70,14 +71,14 @@ -- | Oposite categoy in which arrows from @a@ to @b@ are represented by arrows -- from @b@ to @a@ in the original category. ---newtype Op (f :: k -> k -> *) (a :: k) (b :: k) = Op { runOp :: f b a }+newtype Op (f :: k -> k -> Type) (a :: k) (b :: k) = Op { runOp :: f b a }   deriving Show  -- | 'Op' is an endo-functor of the category of categories. -- hoistOp :: forall k-                  (f :: k -> k -> *)-                  (g :: k -> k -> *)+                  (f :: k -> k -> Type)+                  (g :: k -> k -> Type)                   a b.            (forall x y. f x y -> g x y)         -> Op f a b@@ -122,7 +123,7 @@ -- Note that even though this is a naive version, it behaves quite well in -- simple benchmarks and quite stable regardless of the level of optimisations. ---data ListTr :: (k -> k -> *) -> k -> k -> * where+data ListTr :: (k -> k -> Type) -> k -> k -> Type where   NilTr  :: ListTr f a a   ConsTr :: f b c -> ListTr f a b -> ListTr f a c @@ -130,7 +131,7 @@ lengthListTr NilTr = 0 lengthListTr (ConsTr _ xs) = 1 + lengthListTr xs -composeL :: forall k (f :: k -> k -> *) x y z.+composeL :: forall k (f :: k -> k -> Type) x y z.             ListTr f y z          -> ListTr f x y          -> ListTr f x z@@ -138,12 +139,12 @@ composeL NilTr         ys = ys {-# INLINE [1] composeL #-} -liftL :: forall k (f :: k -> k -> *) x y.+liftL :: forall k (f :: k -> k -> Type) x y.          f x y -> ListTr f x y liftL f = ConsTr f NilTr {-# INLINE [1] liftL #-} -foldNatL :: forall k (f :: k -> k -> *) c a b.+foldNatL :: forall k (f :: k -> k -> Type) c a b.             Category c          => (forall x y. f x y -> c x y)          -> ListTr f a b@@ -173,7 +174,7 @@  -- | 'foldr' of a 'ListTr' ---foldrL :: forall k (f :: k -> k -> *) c a b d.+foldrL :: forall k (f :: k -> k -> Type) c a b d.           (forall x y z. f y z -> c x y -> c x z)        -> c a b        -> ListTr f b d@@ -186,7 +187,7 @@ -- -- TODO: make it strict, like 'foldl''. ---foldlL :: forall k (f :: k -> k -> *) c a b d.+foldlL :: forall k (f :: k -> k -> Type) c a b d.           (forall x y z. c y z -> f x y -> c x z)        -> c b d        -> ListTr f a b@@ -276,7 +277,7 @@ -- Internal invariant: sum of lengths of two last least is equal the length of -- the first one. ---data Queue (f :: k -> k -> *) (a :: k) (b :: k) where+data Queue (f :: k -> k -> Type) (a :: k) (b :: k) where     Queue :: forall f a c b x.                ListTr f      b c           -> !(ListTr (Op f) b a)@@ -295,7 +296,7 @@ {-# complete NilQ, ConsQ #-} #endif -composeQ :: forall k (f :: k -> k -> *) x y z.+composeQ :: forall k (f :: k -> k -> Type) x y z.             Queue f y z          -> Queue f x y          -> Queue f x z@@ -303,11 +304,11 @@ composeQ NilQ         q2 = q2 {-# INLINE [1] composeQ #-} -nilQ :: Queue (f :: k -> k -> *) a a+nilQ :: Queue (f :: k -> k -> Type) a a nilQ = Queue NilTr NilTr NilTr {-# INLINE [1] nilQ #-} -consQ :: forall k (f :: k -> k -> *) a b c.+consQ :: forall k (f :: k -> k -> Type) a b c.          f b c       -> Queue f a b       -> Queue f a c@@ -327,7 +328,7 @@ unconsQ _                         = error "Queue.uncons: invariant violation" {-# INLINE unconsQ #-} -snocQ :: forall k (f :: k -> k -> *) a b c.+snocQ :: forall k (f :: k -> k -> Type) a b c.          Queue f b c       -> f a b       -> Queue f a c@@ -336,7 +337,7 @@  -- | 'foldr' of a 'Queue' ---foldrQ :: forall k (f :: k -> k -> *) c a b d.+foldrQ :: forall k (f :: k -> k -> Type) c a b d.           (forall x y z. f y z -> c x y -> c x z)        -> c a b        -> Queue f b d@@ -368,7 +369,7 @@  #-} -liftQ :: forall k (f :: k -> k -> *) a b.+liftQ :: forall k (f :: k -> k -> Type) a b.          f a b -> Queue f a b liftQ = \fab -> ConsQ fab NilQ {-# INLINE [1] liftQ #-}@@ -377,7 +378,7 @@ -- -- /complexity/ @O\(n\)@ ---foldNatQ :: forall k (f :: k -> k -> *) c a b.+foldNatQ :: forall k (f :: k -> k -> Type) c a b.             Category c          => (forall x y. f x y -> c x y)          -> Queue f a b@@ -408,7 +409,7 @@ -- -- TODO: make it strict, like 'foldl''. ---foldlQ :: forall k (f :: k -> k -> *) c a b d.+foldlQ :: forall k (f :: k -> k -> Type) c a b d.           (forall x y z. c y z -> f x y -> c x z)        -> c b d        -> Queue f a b@@ -435,8 +436,8 @@ -- transformation.  This in analogy to @'map' :: (a -> b) -> [a] -> [b]@. -- hoistQ :: forall k-                 (f :: k -> k -> *)-                 (g :: k -> k -> *)+                 (f :: k -> k -> Type)+                 (g :: k -> k -> Type)                  a  b.           (forall x y. f x y -> g x y)        -> Queue f a b

@@ -12,6 +12,7 @@   , EffCat (..)   , liftEffect   , foldNatEffCat+  , runEffCat   , liftKleisli   ) where @@ -20,6 +21,7 @@ import Control.Arrow (Kleisli (..)) import Control.Category (Category (..)) import Data.Functor.Identity (Identity (..))+import Data.Kind (Type)  import Control.Algebra.Free2 (FreeAlgebra2 (..)) import Data.Algebra.Free (AlgebraType, AlgebraType0, Proof (..))@@ -39,7 +41,7 @@ -- | Category transformer, which adds @'EffectCategory'@ instance to the -- underlying base category. ---data EffCat :: (* -> *) -> (k -> k -> *) -> k -> k -> * where+data EffCat :: (Type -> Type) -> (k -> k -> Type) -> k -> k -> Type where   Base   :: c a b -> EffCat m c a b   Effect :: m (EffCat m c a b) -> EffCat m c a b @@ -73,8 +75,8 @@            => tr a b -> EffCat m (cat tr) a b liftEffect = liftFree2 . liftFree2 --- | Fold @'FreeLifing'@ category based on a free category @'cat' tr@ (e.g.--- @'Cat' tr@) using a functor @tr x y -> c x y@.+-- | Fold @'FreeLifting'@ category based on a free category @'cat' tr@ (e.g.+-- @'C' tr@) using a functor @tr x y -> c x y@. -- foldNatEffCat   :: ( Monad m@@ -89,7 +91,16 @@   -> c a b foldNatEffCat nat = foldNatFree2 (foldNatFree2 nat) --- |  Functor from @(->)@ category to @'Kleisli' m@.  If @m@ is 'Identity' then+-- | Join all effects in a free effectful category 'EffCat'.+--+runEffCat+  :: Monad m+  => EffCat m c a b+  -> m (c a b)+runEffCat (Base f) = return f+runEffCat (Effect mf) = runEffCat =<< mf++-- | Functor from @(->)@ category to @'Kleisli' m@.  If @m@ is 'Identity' then -- it will respect 'effect' i.e. -- @'liftKleisli' ('effect' ar) = 'effect' ('liftKleisli' \<$\> ar)@. --

@@ -288,7 +288,7 @@ instance Arbitrary (IntCat '() '()) where     arbitrary = IntCat <$> arbitrary -fromList :: forall (a :: k) m f.+fromList :: forall k (a :: k) m f.             ( FreeAlgebra2 m             , AlgebraType0 m f             , Category    (m f)

@@ -59,10 +59,15 @@   prop_unconsQ :: Queue Tr 'K 'K -> Bool-prop_unconsQ q = case (q, toList q) of-    (ConsQ a@A{} _, a' : _) -> a == a'-    (NilQ, []) -> True-    _          -> False+prop_unconsQ q =+    case q of+      ConsQ a@A{} _ ->+        case as of+          a' : _ -> a == a'+          []     -> False+      NilQ -> null as+  where+    as = toList q   prop_consQ :: Tr 'K 'K -> Queue Tr 'K 'K -> Bool