diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -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
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -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
diff --git a/free-category.cabal b/free-category.cabal
--- a/free-category.cabal
+++ b/free-category.cabal
@@ -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
diff --git a/src/Control/Arrow/Free.hs b/src/Control/Arrow/Free.hs
--- a/src/Control/Arrow/Free.hs
+++ b/src/Control/Arrow/Free.hs
@@ -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))
diff --git a/src/Control/Category/Free.hs b/src/Control/Category/Free.hs
--- a/src/Control/Category/Free.hs
+++ b/src/Control/Category/Free.hs
@@ -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 #-}
 
diff --git a/src/Control/Category/Free/Internal.hs b/src/Control/Category/Free/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Category/Free/Internal.hs
@@ -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"
diff --git a/src/Control/Category/FreeEff.hs b/src/Control/Category/FreeEff.hs
--- a/src/Control/Category/FreeEff.hs
+++ b/src/Control/Category/FreeEff.hs
@@ -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)