free-category 0.0.2.0 → 0.0.3.0

raw patch · 7 files changed

+431/−78 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• README.md +7/−2
• free-category.cabal +4/−20
• src/Control/Arrow/Free.hs +69/−10
• src/Control/Category/Free.hs +113/−45
• src/Control/Category/Free/Internal.hs +222/−0
• src/Control/Category/FreeEff.hs +9/−1

@@ -1,5 +1,12 @@ # Changelog for free-category +## Version 0.0.3.0+- Efficient 'Cat' and 'Aff' based on real time queues with scheduling+- Added Monoid instances +- Added Op category+- added `arrArr`, `mapArr`, `foldArr` for `Arr` free arrow category+- added `arrCat`, `mapCat`, `fodlMap` for `Cat` free categroy+ ## Version 0.0.2.0  - EffCategory class and FreeEffCat category transformer

@@ -2,10 +2,15 @@ [![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) -This package introduces variouos presentations of free categories in Haskell.+This package contains efficient free categories. There are two presentations: +* using realtime queues (C. Okasaki 'Pure Functional Data Structures')+* using continuation passing style++Free arrows and free Kleisli categories are also included.+ Free categories are useful to model state machines in a simple yet type safe-way and for that purpose `Kleisli` categroies are a very useful target which+manner.  For that purpose `Kleisli` categroies are a very useful target which allows to include monadic computations.  This packge contains a useful generalisation of `Kliesli` categories captured by `EffCategory` class (effectful categories), and a (free) transformer which lifts a category to

@@ -1,5 +1,5 @@ name:           free-category-version:        0.0.2.0+version:        0.0.3.0 synopsis:       Free category description:    Free categories category:       Algebra, Control, Monads, Category@@ -7,7 +7,7 @@ bug-reports:    https://github.com/coot/free-category/issues author:         Marcin Szamotulski maintainer:     profunctor@pm.me-copyright:      (c) 2018 Marcin Szamotulski+copyright:      (c) 2018-2019 Marcin Szamotulski license:        MPL-2.0 license-file:   LICENSE build-type:     Simple@@ -15,6 +15,7 @@ extra-source-files:     ChangeLog.md     README.md+tested-with:    GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5  source-repository head   type: git@@ -24,29 +25,12 @@   exposed-modules:       Control.Arrow.Free       Control.Category.Free+      Control.Category.Free.Internal       Control.Category.FreeEff   other-modules:       Paths_free_category   hs-source-dirs:       src-  default-extensions:-      ConstraintKinds-      DataKinds-      DeriveFunctor-      EmptyDataDecls-      FlexibleInstances-      FlexibleContexts-      GADTs-      KindSignatures-      InstanceSigs-      MultiParamTypeClasses-      OverloadedStrings-      PolyKinds-      RankNTypes-      ScopedTypeVariables-      TupleSections-      TypeApplications-      TypeFamilies   build-depends:       base          >= 4.9 && <5     , free-algebras >= 0.0.7.0

@@ -1,7 +1,21 @@-{-# LANGUAGE GADTs #-}+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE GADTs               #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE InstanceSigs        #-}+{-# LANGUAGE PolyKinds           #-}+{-# LANGUAGE RankNTypes          #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies        #-}++{-# OPTIONS_HADDOCK show-extensions #-}+ module Control.Arrow.Free   ( -- * Free arrow-    Arr (..)+    Arr (Id, Arr, Prod)+  , arrArr+  , mapArr+  , foldArr+     -- * Free arrow (CPS style)   , A (..)   , fromA@@ -18,6 +32,11 @@ import           Prelude hiding (id, (.)) import           Control.Arrow (Arrow (..)) import           Control.Category (Category (..))+#if __GLASGOW_HASKELL__ < 804+import           Data.Monoid (Monoid (..))+import           Data.Semigroup (Semigroup (..))+#endif+ import           Control.Algebra.Free2   ( AlgebraType0   , AlgebraType@@ -30,23 +49,51 @@   , joinFree2   , bindFree2   )+import           Control.Category.Free.Internal  data Arr f a b where   Id    :: Arr f a a-  (:.:) :: f b c     -> Arr f a b -> Arr f a c+  Cons  :: f b c     -> Queue (Arr f) a b -> Arr f a c   Arr   :: (b -> c)  -> Arr f a b -> Arr f a c   Prod  :: Arr f a b -> Arr f a c -> Arr f a (b, c) +arrArr :: (b -> c) -> Arr f b c+arrArr bc = Arr bc Id++mapArr :: f b c+       -> Arr f a b+       -> Arr f a c+mapArr bc ac = Cons bc emptyQ . ac++foldArr :: forall f arr a b.+           Arrow arr+        => (forall x y. f x y -> arr x y)+        -> Arr f a b+        -> arr a b+foldArr _   Id = id+foldArr fun (Cons bc ab) = fun bc . foldQ (foldNatFree2 fun) ab+foldArr fun (Arr f g)    = arr f  . foldNatFree2 fun g+foldArr fun (Prod f g)   = foldNatFree2 fun f &&& foldNatFree2 fun g+ instance Category (Arr f) where   id = Id   Id         . f  = f   f          . Id = f-  (f :.: g)  . h  = f :.: (g . h)+  (Cons f g)  . h  = Cons f (g `snoc` h)   (Arr f g)  . h  = Arr f (g . h)   (Prod f g) . h  = Prod (f . h) (g . h) +instance Semigroup (Arr f o o) where+    f <> g = f . g++instance Monoid (Arr f o o) where+    mempty = Id+#if __GLASGOW_HASKELL__ < 804+    mappend = (<>)+#endif+ instance Arrow (Arr f) where-  arr f     = Arr f Id+  arr       = arrArr   first bc  = Prod (bc . arr fst) (arr snd)   second bc = Prod (arr fst) (bc . arr snd)   ab *** xy = Prod (ab . arr fst) (xy . arr snd)@@ -56,18 +103,21 @@ type instance AlgebraType  Arr c = Arrow c  instance FreeAlgebra2 Arr where-  liftFree2 = \fab -> fab :.: Id+  liftFree2 = \fab -> Cons fab emptyQ   {-# INLINE liftFree2 #-} -  foldNatFree2 _   Id = id-  foldNatFree2 fun (bc :.: ab) = fun bc . foldNatFree2 fun ab-  foldNatFree2 fun (Arr f g)   = arr f  . foldNatFree2 fun g-  foldNatFree2 fun (Prod f g)  = foldNatFree2 fun f &&& foldNatFree2 fun g+  foldNatFree2 = foldArr   {-# INLINE foldNatFree2 #-}    codom2  = proof   forget2 = proof +--+-- Free arrows using CSP style+--++-- | Free arrow using CPS sytle.+-- newtype A f a b   = A { runA :: forall r. Arrow r              => (forall x y. f x y -> r x y)@@ -90,6 +140,15 @@ instance Category (A f) where   id = A (const id)   A f . A g = A $ \k -> f k . g k++instance Semigroup (A f o o) where+    f <> g = f . g++instance Monoid (A f o o) where+    mempty = id+#if __GLASGOW_HASKELL__ < 804+    mappend = (<>)+#endif  instance Arrow (A f) where   arr f = A (const (arr f))

@@ -1,12 +1,36 @@+{-# LANGUAGE BangPatterns       #-} {-# LANGUAGE CPP                #-}-{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE GADTs              #-}+{-# LANGUAGE FlexibleInstances  #-}+{-# LANGUAGE PatternSynonyms    #-}+{-# LANGUAGE PolyKinds          #-}+{-# LANGUAGE RankNTypes         #-}+{-# LANGUAGE TypeOperators      #-}+{-# LANGUAGE TypeFamilies       #-}+{-# LANGUAGE ViewPatterns       #-}++{-# OPTIONS_HADDOCK show-extensions #-}++#if __GLASGOW_HASKELL__ <= 802+-- ghc802 does not infer that 'cons' is used when using a bidirectional+-- pattern+{-# OPTIONS_GHC -Wno-unused-top-binds    #-}+-- the 'complete' pragma was introduced in ghc804+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}+#endif+ module Control.Category.Free     ( -- * Free category-      Cat (..)+      Cat (Id)+    , arrCat+    , mapCat+    , foldCat       -- * Free category (CPS style)     , C (..)     , toC     , fromC+      -- * Oposite category+    , Op (..)        -- * Free interface re-exports     , FreeAlgebra2 (..)@@ -18,7 +42,7 @@     )     where -import           Prelude hiding (id, (.))+import           Prelude hiding (id, concat, (.)) import           Control.Category (Category (..)) import           Control.Algebra.Free2   ( AlgebraType0@@ -38,71 +62,115 @@ import           Data.Semigroup (Semigroup (..)) #endif --- |--- Free category encoded as a recursive data type, in a simlar way as--- @'Control.Monad.Free.Free'@.  You can use @'FreeAlgebra2'@ class instance:+import           Control.Category.Free.Internal ----- prop> liftFree2    @Cat :: f a b -> Cat f ab--- prop> foldNatFree2 @Cat :: Category d => (forall x y. f x y -> d x y) -> Cat f a b -> d a b+-- Free categories based on real time queues; Ideas after E.Kmett's guanxi+-- project. ----- The same performance concerns that apply to @'Control.Monad.Free.Free'@--- apply to this encoding of a free category.-data Cat :: (k -> k -> *) -> k -> k -> * where-  Id    :: Cat f a a-  (:.:) :: f b c -> Cat f a b -> Cat f a c -instance Category (Cat f) where-  id = Id-  Id         . ys = ys-  (x :.: xs) . ys = x :.: (xs . ys)--infixr 9 :.:+-- | Efficient encoding of a category for which morphism composition has+-- @O\(1\)@ complexity and fold is linear in the number of transitions.+-- +data Cat (f :: k -> k -> *) a b where+    Id   :: Cat f a a +    Cat  :: forall f a b c.+            f b c+         -> Queue (Cat f) a b+         -> Cat f a c  -instance Arrow f => Arrow (Cat f) where-  arr ab                          = arr ab :.: Id+-- | Smart constructor for embeding spanning transitions into 'Cat', the same+-- as @'liftFree2' \@'Cat'@.  It is like 'arr' for 'Arrows'.+--+arrCat :: forall (f :: k -> k -> *) a b.+         f a b+      -> Cat f a b+arrCat fab = Cat fab emptyQ -  Id *** Id                       = Id-  Id *** (fxb :.: cax)            = (arr id *** fxb) :.: (Id *** cax)-  (fxb :.: cax) *** Id            = (fxb *** arr id) :.: (cax *** Id)-  (fxb :.: cax) *** (fyb :.: cay) = (fxb *** fyb) :.: (cax *** cay)+-- | Smart constructor 'mapCat' for morphisms of @'Cat' f@ category.+--+mapCat :: forall (f :: k -> k -> *) a b c.+           f b c+        -> Cat f a b+        -> Cat f a c+mapCat fbc cab = arrCat fbc . cab -instance ArrowZero f => ArrowZero (Cat f) where-  zeroArrow = zeroArrow :.: Id+-- | Right fold of 'Cat' into a category, the same as @'foldNatFree2' \@'Cat'@.+--+-- /complexity/: @O\(n\) where @n@ is number of transition embedded in 'Cat'.+foldCat :: forall f c a b.+           Category c+        => (forall x y. f x y -> c x y)+        -> Cat f a b+        -> c a b+foldCat _nat Id = id+foldCat nat (Cat tr queue) =+    case queue of+      NilQ            -> nat tr+      ConsQ Id queue' -> nat tr . foldQ (foldCat nat) queue'+      ConsQ c  queue' -> nat tr . foldCat nat c . foldQ (foldCat nat) queue' -instance ArrowChoice f => ArrowChoice (Cat f) where-  Id +++ Id                       = Id-  Id +++ (fxb :.: cax)            = (arr id +++ fxb) :.: (Id +++ cax)-  (fxb :.: cax) +++ Id            = (fxb +++ arr id) :.: (cax +++ Id)-  (fxb :.: cax) +++ (fyb :.: cay) = (fxb +++ fyb) :.: (cax +++ cay)+-- TODO: implement foldl; it might require different representation.  Function+-- composition is applied from right to left, so it should be more efficient. -instance Semigroup (Cat f o o) where-  f <> g = g . f+-- | /complexity/ of composition @('.')@: @O\(1\)@ (worst case)+instance Category (Cat f) where+    id = Id -instance Monoid (Cat f o o) where-  mempty = Id-#if __GLASGOW_HASKELL__ < 804-  mappend = (<>)-#endif+    Id . f  = f+    f  . Id = f+    Cat f q . h = Cat f (q `snoc` h)  type instance AlgebraType0 Cat f = () type instance AlgebraType  Cat c = Category c +-- | /complexity/ of 'foldNatFree2': @O\(n\)@ where @n@ is number of+-- transitions embeded in 'Cat'.+-- instance FreeAlgebra2 Cat where-  liftFree2 = \fab -> fab :.: Id+  liftFree2 = arrCat   {-# INLINE liftFree2 #-} -  foldNatFree2 _   Id          = id-  foldNatFree2 fun (bc :.: ab) = fun bc . foldNatFree2 fun ab+  foldNatFree2 = foldCat   {-# INLINE foldNatFree2 #-}    codom2  = proof   forget2 = proof +instance Arrow f => Arrow (Cat f) where+    arr = arrCat . arr+    Cat tr queue *** Cat tr' queue' = Cat (tr *** tr') (zipWithQ (***) queue queue')+    Cat tr queue *** Id             = Cat (tr *** arr id) (zipWithQ (***) queue NilQ)+    Id           *** Cat tr' queue' = Cat (arr id *** tr') (zipWithQ (***) NilQ queue')+    Id           *** Id             = Cat (arr id *** arr id) NilQ++instance ArrowZero f => ArrowZero (Cat f) where+    zeroArrow = arrCat zeroArrow++instance ArrowChoice f => ArrowChoice (Cat f) where+    Cat fxb cax +++ Cat fyb cay+                         = Cat (fxb +++ fyb) (zipWithQ (+++) cax cay)+    Cat fxb cax +++ Id   = Cat (fxb +++ arr id) (zipWithQ (+++) cax NilQ)+    Id +++ (Cat fxb cax) = Cat (arr id +++ fxb) (zipWithQ (+++) NilQ cax)+    Id +++ Id            = Id++instance Semigroup (Cat f o o) where+    f <> g = f . g++instance Monoid (Cat f o o) where+    mempty = Id+#if __GLASGOW_HASKELL__ < 804+    mappend = (<>)+#endif++--+-- CPS style free categories+--+ -- | -- CPS style encoded free category; one can use @'FreeAlgebra2'@ class -- instance: ----- prop> liftFree2    @C :: f a b -> C f ab+-- prop> liftFree2    @C :: f a b -> C f a b -- prop> foldNatFree2 @C :: Category d => (forall x y. f x y -> d x y) -> C f a b -> d a b newtype C f a b   = C { runC :: forall r. Category r@@ -117,13 +185,13 @@ -- | -- Isomorphism from @'Cat'@ to @'C'@, which is a specialisation of -- @'hoistFreeH2'@.-toC :: Cat f a b -> C f a b+toC :: ListTr f a b -> C f a b toC = hoistFreeH2 {-# INLINE toC #-}  -- | -- Inverse of @'fromC'@, which also is a specialisatin of @'hoistFreeH2'@.-fromC :: C f a b -> Cat f a b+fromC :: C f a b -> ListTr f a b fromC = hoistFreeH2 {-# INLINE fromC #-} 

@@ -0,0 +1,222 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE GADTs             #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE PatternSynonyms   #-}+{-# LANGUAGE PolyKinds         #-}+{-# LANGUAGE RankNTypes        #-}+{-# LANGUAGE TypeFamilies      #-}+{-# LANGUAGE ViewPatterns      #-}++{-# OPTIONS_HADDOCK show-extensions #-}++#if __GLASGOW_HASKELL__ <= 802+-- ghc802 does not infer that 'cons' is used when using a bidirectional+-- pattern+{-# OPTIONS_GHC -Wno-unused-top-binds    #-}+-- the 'complete' pragma was introduced in ghc804+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}+#endif+++-- | Internal module, contains implementation of type aligned real time queues+-- (C.Okasaki 'Purely Functional Data Structures').+--+module Control.Category.Free.Internal+  ( Op (..)+  , ListTr (..)+  , Queue (NilQ, ConsQ)+  , emptyQ+  , cons+  , uncons+  , snoc+  , foldQ+  , zipWithQ+  ) where+++import           Prelude hiding (id, (.))+import           Control.Arrow+import           Control.Category (Category (..))+#if __GLASGOW_HASKELL__ < 804+import           Data.Monoid (Monoid (..))+import           Data.Semigroup (Semigroup (..))+#endif++import           Control.Algebra.Free2 ( AlgebraType0+                                       , AlgebraType+                                       , FreeAlgebra2 (..)+                                       , proof+                                       )++-- | 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 }++instance Category f => Category (Op f) where+    id = Op id+    Op f . Op g = Op (g . f)++instance Category f => Semigroup (Op f o o) where+    (<>) = (.)++instance Category f => Monoid (Op f o o) where+    mempty = id+#if __GLASGOW_HASKELL__ < 804+    mappend = (<>)+#endif++-- |+-- Free category encoded as a recursive data type, in a simlar way as+-- @'Control.Monad.Free.Free'@.  You can use @'FreeAlgebra2'@ class instance:+--+-- prop> liftFree2    @Cat :: f a b -> Cat f ab+-- prop> foldNatFree2 @Cat :: Category d => (forall x y. f x y -> d x y) -> Cat f a b -> d a b+--+-- The same performance concerns that apply to @'Control.Monad.Free.Free'@+-- apply to this encoding of a free category.+--+data ListTr :: (k -> k -> *) -> k -> k -> * where+  NilTr  :: ListTr f a a+  ConsTr :: f b c -> ListTr f a b -> ListTr f a c++instance Category (ListTr f) where+  id = NilTr+  NilTr    . ys = ys+  (ConsTr x xs) . ys = ConsTr x (xs . ys)++instance Arrow f => Arrow (ListTr f) where+  arr ab                          = arr ab `ConsTr` NilTr++  (ConsTr fxb cax) *** (ConsTr fyb cay)+                             = (fxb *** fyb)    `ConsTr` (cax *** cay)+  (ConsTr fxb cax) *** NilTr = (fxb *** arr id) `ConsTr` (cax *** NilTr)+  NilTr *** (ConsTr fxb cax) = (arr id *** fxb) `ConsTr` (NilTr *** cax)+  NilTr *** NilTr            = NilTr++instance ArrowZero f => ArrowZero (ListTr f) where+  zeroArrow = zeroArrow `ConsTr` NilTr++instance ArrowChoice f => ArrowChoice (ListTr f) where+  (ConsTr fxb cax) +++ (ConsTr fyb cay)+                             = (fxb +++ fyb)    `ConsTr` (cax +++ cay)+  (ConsTr fxb cax) +++ NilTr = (fxb +++ arr id) `ConsTr` (cax +++ NilTr)+  NilTr +++ (ConsTr fxb cax) = (arr id +++ fxb) `ConsTr` (NilTr +++ cax)+  NilTr +++ NilTr            = NilTr++instance Semigroup (ListTr f o o) where+  f <> g = g . f++instance Monoid (ListTr f o o) where+  mempty = NilTr+#if __GLASGOW_HASKELL__ < 804+  mappend = (<>)+#endif++type instance AlgebraType0 ListTr f = ()+type instance AlgebraType  ListTr c = Category c++instance FreeAlgebra2 ListTr where+  liftFree2 = \fab -> ConsTr fab NilTr+  {-# INLINE liftFree2 #-}++  foldNatFree2 _   NilTr     = id+  foldNatFree2 fun (ConsTr bc ab) = fun bc . foldNatFree2 fun ab+  {-# INLINE foldNatFree2 #-}++  codom2  = proof+  forget2 = proof+++-- | Type alligned real time queues; Based on `Purely Functinal Data Structures`+-- C.Okasaki.+--+-- Upper bounds of `cons`, `snoc`, `uncons` are @O\(1\)@ (worst case).+--+-- 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+    Queue :: forall f a c b x.+             !(ListTr f b c)+          -> !(ListTr (Op f) b a)+          -> !(ListTr f b x)+          -> Queue f a c++emptyQ :: Queue (f :: k -> k -> *) a a+emptyQ = Queue NilTr NilTr NilTr++cons :: forall (f :: k -> k -> *) a b c.+        f b c+     -> Queue f a b+     -> Queue f a c+cons fbc (Queue f r s) = Queue (ConsTr fbc f) r (ConsTr undefined s)++data ViewL f a b where+    EmptyL :: ViewL f a a+    (:<)   :: f b c -> Queue f a b -> ViewL f a c++-- | 'uncons' a 'Queue', complexity: @O\(1\)@+--+uncons :: Queue f a b+       -> ViewL f a b+uncons (Queue NilTr NilTr _)                = EmptyL+uncons (Queue (ConsTr tr f) r (ConsTr _ s)) = tr :< exec f r s+uncons _                                    = error "Queue.uncons: invariant violation"++snoc :: forall (f :: k -> k -> *) a b c.+        Queue f b c+     -> f a b+     -> Queue f a c+snoc (Queue f r s) g = exec f (ConsTr (Op g) r) s++pattern ConsQ :: f b c -> Queue f a b -> Queue f a c+pattern ConsQ a as <- (uncons -> a :< as) where+    ConsQ = cons++pattern NilQ :: () => a ~ b => Queue f a b+pattern NilQ <- (uncons -> EmptyL) where+    NilQ = emptyQ++#if __GLASGOW_HASKELL__ > 802+{-# complete NilQ, ConsQ #-}+#endif++-- | Efficient fold of a queue into a category.+--+-- /complexity/ @O\(n\)@+--+foldQ :: forall (f :: k -> k -> *) c a b.+         Category c+      => (forall x y. f x y -> c x y)+      -> Queue f a b+      -> c a b+foldQ nat queue = case queue of+    NilQ            -> id+    ConsQ tr queue' -> nat tr . foldQ nat queue'++zipWithQ :: forall f g a b a' b'.+        Arrow f+     => (forall x y x' y'. f x y -> f x' y' -> f (g x x') (g y y'))+     -> Queue f a  b+     -> Queue f a' b'+     -> Queue f (g a a') (g b b')+zipWithQ fn queueA queueB = case (queueA, queueB) of+    (NilQ, NilQ) -> NilQ+    (NilQ, ConsQ trB' queueB') -> ConsQ (id   `fn` trB') (zipWithQ fn NilQ    queueB')+    (ConsQ trA' queueA', NilQ) -> ConsQ (trA' `fn` id)   (zipWithQ fn queueA' NilQ)+    (ConsQ trA' queueA', ConsQ trB' queueB')+                               -> ConsQ (trA' `fn` trB') (zipWithQ fn queueA' queueB')++++exec :: ListTr f b c -> ListTr (Op f) b a -> ListTr f b x -> Queue f a c+exec xs ys (ConsTr _ t) = Queue xs ys t+exec xs ys NilTr        = Queue xs' NilTr xs'+  where+    xs' = rotate xs ys NilTr++rotate :: ListTr f c d -> ListTr (Op f) c b -> ListTr f a b -> ListTr f a d+rotate NilTr         (ConsTr (Op f) NilTr) a = ConsTr f a+rotate (ConsTr f fs) (ConsTr (Op g) gs)    a = ConsTr f (rotate fs gs (ConsTr g a))+rotate _             _                     _ = error "Queue.rotate: impossible happend"

@@ -1,4 +1,12 @@+{-# LANGUAGE GADTs                  #-}+{-# LANGUAGE FlexibleInstances      #-} {-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE PolyKinds              #-}+{-# LANGUAGE RankNTypes             #-}+{-# LANGUAGE TypeFamilies           #-}++{-# OPTIONS_HADDOCK show-extensions #-}+ module Control.Category.FreeEff   ( EffCategory (..)   , FreeEffCat (..)@@ -13,7 +21,7 @@ import Control.Category (Category (..)) import Data.Functor.Identity (Identity (..)) -import Control.Category.Free (Cat (..))+import Control.Category.Free (Cat) import Control.Algebra.Free2 (FreeAlgebra2 (..)) import Data.Algebra.Free (AlgebraType, AlgebraType0, proof)