diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,4 @@
+# Changelog for subcategories
+
+## 0.1.0.0
+Initial Release
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Hiromi ISHII (c) 2018
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Hiromi ISHII nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,32 @@
+# The `subcategories` package
+
+This package provides variants of functor-like structures,
+with domain types are constrained.
+In particular, this package provides an abstraction for functorial
+containers, which can be expressed as a functor from a *full-subcategory*
+of **Hask** to **Hask** itself [^1].
+
+For example:
+
+- We can treat `Set` as if it is a `Fuctor`, `Foldable`, `Applicative`,
+  with their domain restricted to full-subcategory **Ord** of `Ord` instances
+  of **Hask**.
+- For `MonoFoldable` or `MonoTraversable` types (from `mono-traversable` package),
+  we provide `WrapMono` wrapper with zero-cost coercion. Such `mono`s can be
+  regarded as a functorial structure from the full subcategory consisting of just a single object,
+  say `Element mono`.
+
+[^1]: Strictly speaking, `CFoldable`, a constrained counterpart of `Foldable`, doesn't require a functoriality as with the original `Foldable`.
+
+## Optimisation
+This library is designed to keep the abstraction runtime overhead as minimum as possible.
+
+Some notes:
+
+- If a constrained term such as `cmap` or `czipWith` has concrete type, it must have exactly the same representation as the corresponding operation modulo (zero-cost) coercion.
+  * The same still holds if the set of required constraints coincides.
+  * Although the constructor of `WrapMono mono a` is hidden, its just a `newtype`-wrapper around `mono`;
+    hence, constrained operators must have the same representations as the corresponding combinators
+    in `mono-traversable` package.
+- OTOH, for a polymorphic term, like `cmap :: (Ord a, Ord b) => (a -> b) Set a -> Set b`
+  and `Set.map`, they can have different representations; indeed, `Set.map` doesn't require `a` to be `Ord`-instance and therefore the implementation of `cmap` discards the dictionary for `Ord a` to call `Set.map`.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/src/Control/Subcategory.hs b/src/Control/Subcategory.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Subcategory.hs
@@ -0,0 +1,17 @@
+module Control.Subcategory
+  ( module Control.Subcategory.Applicative
+  , module Control.Subcategory.Alternative
+  , module Control.Subcategory.Bind
+  , module Control.Subcategory.Functor
+  , module Control.Subcategory.Foldable
+  , module Control.Subcategory.Zip
+  , module Control.Subcategory.Pointed
+  ) where
+
+import Control.Subcategory.Alternative
+import Control.Subcategory.Applicative
+import Control.Subcategory.Bind
+import Control.Subcategory.Foldable
+import Control.Subcategory.Functor
+import Control.Subcategory.Pointed
+import Control.Subcategory.Zip
diff --git a/src/Control/Subcategory/Alternative.hs b/src/Control/Subcategory/Alternative.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Subcategory/Alternative.hs
@@ -0,0 +1,159 @@
+{-# LANGUAGE EmptyCase, ScopedTypeVariables, StandaloneDeriving #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Control.Subcategory.Alternative
+  (CAlternative(..), CChoice(..), CAlt(..)) where
+import Control.Subcategory.Alternative.Class
+import Control.Subcategory.Applicative.Class
+import Control.Subcategory.Functor
+import Control.Subcategory.Pointed
+
+import qualified Control.Applicative             as App
+import           Data.Coerce                     (coerce)
+import qualified Data.Functor.Compose            as SOP
+import qualified Data.Functor.Product            as SOP
+import           Data.Hashable                   (Hashable)
+import qualified Data.HashMap.Strict             as HM
+import qualified Data.HashSet                    as HS
+import qualified Data.IntMap                     as IM
+import           Data.List.NonEmpty              (NonEmpty)
+import qualified Data.Map                        as Map
+import           Data.MonoTraversable            (GrowingAppend, MonoFunctor)
+import qualified Data.Primitive.Array            as A
+import qualified Data.Primitive.PrimArray        as PA
+import qualified Data.Primitive.SmallArray       as SA
+import qualified Data.Semigroup                  as Sem
+import qualified Data.Sequence                   as Seq
+import qualified Data.Set                        as Set
+import qualified Data.Vector                     as V
+import qualified Data.Vector.Primitive           as P
+import qualified Data.Vector.Storable            as S
+import qualified Data.Vector.Unboxed             as U
+import           Text.ParserCombinators.ReadP    (ReadP)
+import           Text.ParserCombinators.ReadPrec (ReadPrec)
+
+instance CChoice []
+instance CChoice Maybe
+instance CChoice V.Vector
+instance CChoice U.Vector where
+  (<!>) = (<>)
+  {-# INLINE [1] (<!>) #-}
+instance CChoice S.Vector where
+  (<!>) = (<>)
+  {-# INLINE [1] (<!>) #-}
+instance CChoice P.Vector where
+  (<!>) = (<>)
+  {-# INLINE [1] (<!>) #-}
+instance CChoice PA.PrimArray where
+  (<!>) = (<>)
+  {-# INLINE [1] (<!>) #-}
+instance CChoice SA.SmallArray
+instance CChoice A.Array
+instance CChoice Seq.Seq
+instance CChoice Sem.Option
+instance CChoice NonEmpty where
+  (<!>) = (Sem.<>)
+  {-# INLINE (<!>) #-}
+instance CChoice (Either a) where
+  Left _ <!> b = b
+  a      <!> _ = a
+  {-# INLINE (<!>) #-}
+instance CChoice IM.IntMap where
+  (<!>) = IM.union
+instance CChoice ReadP
+instance CChoice ReadPrec
+instance (CChoice f, CFunctor g) => CChoice (SOP.Compose f g) where
+  SOP.Compose a <!> SOP.Compose b = SOP.Compose (a <!> b)
+  {-# INLINE (<!>) #-}
+
+instance (CChoice f, CChoice g) => CChoice (SOP.Product f g) where
+  SOP.Pair a1 b1 <!> SOP.Pair a2 b2 =
+    SOP.Pair (a1 <!> a2) (b1 <!> b2)
+  {-# INLINE (<!>) #-}
+
+instance CChoice HS.HashSet where
+  (<!>) = HS.union
+  {-# INLINE (<!>) #-}
+
+instance CChoice Set.Set where
+  (<!>) = Set.union
+  {-# INLINE (<!>) #-}
+
+instance Ord k => CChoice (Map.Map k) where
+  (<!>) = Map.union
+  {-# INLINE (<!>) #-}
+
+instance
+    (MonoFunctor mono, GrowingAppend mono, Semigroup mono)
+  => CChoice (WrapMono mono) where
+  (<!>) = (<>)
+  {-# INLINE [1] (<!>) #-}
+
+instance (Eq k, Hashable k) => CChoice (HM.HashMap k) where
+  (<!>) = HM.union
+  {-# INLINE (<!>) #-}
+
+instance CAlternative IM.IntMap where
+  cempty = IM.empty
+  {-# INLINE cempty #-}
+instance (Eq k, Hashable k) => CAlternative (HM.HashMap k) where
+  cempty = HM.empty
+  {-# INLINE cempty #-}
+instance Ord k => CAlternative (Map.Map k) where
+  cempty = Map.empty
+  {-# INLINE cempty #-}
+instance CAlternative HS.HashSet where
+  cempty = HS.empty
+  {-# INLINE cempty #-}
+instance CAlternative Set.Set where
+  cempty = Set.empty
+  {-# INLINE cempty #-}
+instance (MonoFunctor mono, Monoid mono, GrowingAppend mono)
+      => CAlternative (WrapMono mono) where
+  cempty = WrapMono mempty
+  {-# INLINE [1] cempty #-}
+
+instance (CAlternative f, CFunctor g) => CAlternative (SOP.Compose f g) where
+  cempty = SOP.Compose cempty
+  {-# INLINE cempty #-}
+
+instance (CAlternative f, CAlternative g) => CAlternative (SOP.Product f g) where
+  cempty = SOP.Pair cempty cempty
+  {-# INLINE cempty #-}
+
+instance CAlternative []
+instance CAlternative Maybe
+instance CAlternative Seq.Seq
+instance CAlternative Sem.Option
+instance CAlternative ReadP
+instance CAlternative V.Vector
+instance CAlternative U.Vector where
+  cempty = U.empty
+  {-# INLINE [1] cempty #-}
+instance CAlternative S.Vector where
+  cempty = S.empty
+  {-# INLINE [1] cempty #-}
+instance CAlternative P.Vector where
+  cempty = P.empty
+  {-# INLINE [1] cempty #-}
+instance CAlternative PA.PrimArray where
+  cempty = PA.primArrayFromListN 0 []
+  {-# INLINE [1] cempty #-}
+instance CAlternative SA.SmallArray
+instance CAlternative A.Array
+instance CAlternative ReadPrec
+
+newtype CAlt f a = CAlt { runAlt :: f a }
+  deriving newtype (Functor, Constrained, Applicative, App.Alternative)
+deriving newtype instance CFunctor f => CFunctor (CAlt f)
+deriving newtype instance CChoice f => CChoice (CAlt f)
+deriving newtype instance CAlternative f => CAlternative (CAlt f)
+deriving newtype instance CApplicative f => CApplicative (CAlt f)
+deriving newtype instance CPointed f => CPointed (CAlt f)
+
+
+instance (Dom f a, CChoice f) => Sem.Semigroup (CAlt f a) where
+  (<>) = coerce @(f a -> f a -> f a) (<!>)
+
+instance (Dom f a, CAlternative f) => Monoid (CAlt f a) where
+  mempty = coerce @(f a) cempty
+  mappend = coerce @(f a -> f a -> f a) (<!>)
diff --git a/src/Control/Subcategory/Alternative/Class.hs b/src/Control/Subcategory/Alternative/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Subcategory/Alternative/Class.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE EmptyCase, UndecidableSuperClasses #-}
+module Control.Subcategory.Alternative.Class
+  (CChoice(..), CAlternative(..)) where
+import Control.Subcategory.Functor
+
+import qualified Control.Applicative as App
+
+infixl 3 <!>
+class CFunctor f => CChoice f where
+  (<!>) :: Dom f a => f a -> f a -> f a
+  default (<!>) :: App.Alternative f => f a -> f a -> f a
+  (<!>) = (App.<|>)
+  {-# INLINE (<!>) #-}
+
+class CChoice f => CAlternative f where
+  cempty :: Dom f a => f a
+  default cempty :: App.Alternative f => f a
+  cempty = App.empty
+  {-# INLINE cempty #-}
+
diff --git a/src/Control/Subcategory/Applicative.hs b/src/Control/Subcategory/Applicative.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Subcategory/Applicative.hs
@@ -0,0 +1,168 @@
+{-# LANGUAGE EmptyCase, StandaloneDeriving, TupleSections #-}
+{-# LANGUAGE UndecidableSuperClasses                      #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Control.Subcategory.Applicative
+  ( CApplicative(..), defaultRightApply, defaultLeftApply, CApp(..)
+  ) where
+import Control.Subcategory.Alternative.Class
+import Control.Subcategory.Applicative.Class
+import Control.Subcategory.Functor
+import Control.Subcategory.Pointed
+
+import qualified Control.Applicative             as App
+import qualified Control.Monad.ST.Lazy           as LST
+import qualified Control.Monad.ST.Strict         as SST
+import           Data.Coerce                     (coerce)
+import           Data.Functor.Const              (Const)
+import           Data.Functor.Identity           (Identity)
+import qualified Data.Functor.Product            as SOP
+import           Data.Hashable                   (Hashable)
+import qualified Data.HashMap.Strict             as HM
+import qualified Data.HashSet                    as HS
+import qualified Data.IntMap                     as IM
+import           Data.List.NonEmpty              (NonEmpty)
+import qualified Data.Map                        as Map
+import qualified Data.Primitive.Array            as A
+import qualified Data.Primitive.SmallArray       as SA
+import qualified Data.Semigroup                  as Sem
+import qualified Data.Sequence                   as Seq
+import qualified Data.Set                        as Set
+import qualified Data.Tree                       as Tree
+import qualified Data.Vector                     as V
+import           GHC.Conc                        (STM)
+import           Text.ParserCombinators.ReadP    (ReadP)
+import           Text.ParserCombinators.ReadPrec (ReadPrec)
+
+defaultLeftApply :: (Dom f (b1, b2), Dom f b1, Dom f b2, CApplicative f)
+                 => f b1 -> f b2 -> f b1
+defaultLeftApply a b = uncurry const <$:> pair a b
+defaultRightApply :: (Dom f (b1, b2), Dom f b2, Dom f b1, CApplicative f)
+                  => f b1 -> f b2 -> f b2
+defaultRightApply a b = uncurry (const id) <$:> pair a b
+
+instance Semigroup w => CApplicative (Const w) where
+  pair = coerce @(w -> w -> w) (<>)
+  (<.>) = coerce @(w -> w -> w) (<>)
+  {-# INLINE (<.>) #-}
+  (<. ) = coerce @(w -> w -> w) (<>)
+  {-# INLINE (<. ) #-}
+  ( .>) = coerce @(w -> w -> w) (<>)
+  {-# INLINE ( .>) #-}
+
+instance CApplicative []
+instance CApplicative IO
+instance CApplicative STM
+instance CApplicative ReadP
+instance CApplicative V.Vector
+instance CApplicative SA.SmallArray
+instance CApplicative A.Array
+instance CApplicative ReadPrec
+instance CApplicative (SST.ST s)
+instance CApplicative (LST.ST s)
+instance CApplicative App.ZipList
+instance CApplicative Maybe
+instance CApplicative Identity
+instance CApplicative Tree.Tree
+instance CApplicative Seq.Seq
+instance CApplicative Sem.Option
+instance CApplicative NonEmpty
+instance CApplicative ((->) a)
+instance CApplicative (Either a)
+instance (CApplicative f, CApplicative g)
+      => CApplicative (SOP.Product f g) where
+  pair (SOP.Pair a b) (SOP.Pair c d) = SOP.Pair (pair a c) (pair b d)
+  SOP.Pair f g <.> SOP.Pair a b = SOP.Pair (f <.> a) (g <.> b)
+  {-# INLINE (<.>) #-}
+  SOP.Pair f g <. SOP.Pair a b = SOP.Pair (f <. a) (g <. b)
+  {-# INLINE (<.) #-}
+  SOP.Pair f g .> SOP.Pair a b = SOP.Pair (f .> a) (g .> b)
+  {-# INLINE (.>) #-}
+
+class Dom f (g a -> g b) => DomOver f g a b
+instance Dom f (g a -> g b) => DomOver f g a b
+
+instance Applicative f => CApplicative (WrapFunctor f)
+instance Semigroup w => CApplicative ((,) w) where
+  pair (w, a) (u, b) = (w <> u, (a, b))
+  {-# INLINE pair #-}
+  (w, f) <.> (u, a) = (w <> u, f a)
+  {-# INLINE (<.>) #-}
+  (w, a) <.  (u, _) = (w <> u, a)
+  {-# INLINE (<.) #-}
+  (w, _)  .> (u, b) = (w <> u, b)
+  {-# INLINE (.>) #-}
+instance CApplicative IM.IntMap where
+  pair = IM.intersectionWith (,)
+  {-# INLINE pair #-}
+  (<.>) = IM.intersectionWith id
+  {-# INLINE (<.>) #-}
+  (<.)  = IM.intersectionWith const
+  {-# INLINE (<.) #-}
+  (.>)  = IM.intersectionWith $ const id
+  {-# INLINE (.>) #-}
+
+instance Ord k => CApplicative (Map.Map k) where
+  pair = Map.intersectionWith (,)
+  {-# INLINE pair #-}
+  (<.>) = Map.intersectionWith id
+  {-# INLINE (<.>) #-}
+  (<.)  = Map.intersectionWith const
+  {-# INLINE (<.) #-}
+  (.>)  = Map.intersectionWith $ const id
+  {-# INLINE (.>) #-}
+
+instance (Eq k, Hashable k) => CApplicative (HM.HashMap k) where
+  pair = HM.intersectionWith (,)
+  {-# INLINE pair #-}
+  (<.>) = HM.intersectionWith id
+  {-# INLINE (<.>) #-}
+  (<.)  = HM.intersectionWith const
+  {-# INLINE (<.) #-}
+  (.>)  = HM.intersectionWith $ const id
+  {-# INLINE (.>) #-}
+
+instance CApplicative Set.Set where
+  pair as bs = foldMap (\b -> Set.map (,b) as) bs
+  {-# INLINE pair #-}
+  fs <.> as = foldMap (\f -> Set.map f as) fs
+  {-# INLINE (<.>) #-}
+  a <. b | Set.null b = Set.empty
+         | otherwise  = a
+  {-# INLINE (<.) #-}
+  a .> b | Set.null a = Set.empty
+         | otherwise  = b
+  {-# INLINE (.>) #-}
+
+instance CApplicative HS.HashSet where
+  pair as bs = foldMap (\b -> HS.map (,b) as) bs
+  {-# INLINE pair #-}
+  fs <.> as = foldMap (\f -> HS.map f as) fs
+  {-# INLINE (<.>) #-}
+  a <. b | HS.null b = HS.empty
+         | otherwise  = a
+  {-# INLINE (<.) #-}
+  a .> b | HS.null a = HS.empty
+         | otherwise  = b
+  {-# INLINE (.>) #-}
+
+instance Constrained f => Constrained (CApp f) where
+  type Dom (CApp f) a = Dom f a
+
+newtype CApp f a = CApp { runCApp :: f a }
+  deriving (Read, Show, Eq, Ord)
+  deriving newtype (Functor, Applicative, App.Alternative)
+
+deriving newtype instance (CFunctor f) => CFunctor (CApp f)
+deriving newtype instance (CChoice f) => CChoice (CApp f)
+deriving newtype instance (CAlternative f) => CAlternative (CApp f)
+deriving newtype instance (CApplicative f) => CApplicative (CApp f)
+deriving newtype instance (CPointed f) => CPointed (CApp f)
+
+instance (Dom f a, CApplicative f, Semigroup a, Dom f (a, a))
+       => Semigroup (CApp f a) where
+  CApp a <> CApp b = CApp $ uncurry (<>) <$:> pair a b
+
+instance (Dom f a, CPointed f, CApplicative f, Monoid a, Dom f (a, a))
+       => Monoid (CApp f a) where
+  CApp a `mappend` CApp b = CApp $ uncurry mappend <$:> pair a b
+  mempty = CApp $ cpure mempty
diff --git a/src/Control/Subcategory/Applicative/Class.hs b/src/Control/Subcategory/Applicative/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Subcategory/Applicative/Class.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE EmptyCase, UndecidableSuperClasses #-}
+module Control.Subcategory.Applicative.Class  (CApplicative(..)) where
+import Control.Subcategory.Functor
+
+import qualified Control.Applicative as App
+
+infixl 4 <.>
+class CFunctor f => CApplicative f where
+  pair :: (Dom f a, Dom f b, Dom f (a, b)) => f a -> f b -> f (a, b)
+  default pair :: (Applicative f) => f a -> f b -> f (a, b)
+  pair = App.liftA2 (,)
+  (<.>) :: (Dom f a, Dom f b, Dom f (a -> b)) => f (a -> b) -> f a -> f b
+  default (<.>) :: (Applicative f) => f (a -> b) -> f a -> f b
+  (<.>) = (<*>)
+  (.>) :: (Dom f a, Dom f b) => f a -> f b -> f b
+  default (.>) :: Applicative f
+               => f a -> f b -> f b
+  (.>) = (*>)
+  (<.) :: (Dom f a, Dom f b) => f a -> f b -> f a
+  default (<.) :: Applicative f
+               => f a -> f b -> f a
+  (<.) = (<*)
diff --git a/src/Control/Subcategory/Bind.hs b/src/Control/Subcategory/Bind.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Subcategory/Bind.hs
@@ -0,0 +1,147 @@
+module Control.Subcategory.Bind
+  (CBind(..), CMonad, creturn, (-<<)) where
+import Control.Subcategory.Functor
+import Control.Subcategory.Pointed
+
+import           Control.Monad                   (join)
+import qualified Control.Monad.ST.Lazy           as LST
+import qualified Control.Monad.ST.Strict         as SST
+import           Data.Coerce                     (coerce)
+import           Data.Functor.Identity           (Identity)
+import qualified Data.Functor.Product            as SOP
+import           Data.Hashable                   (Hashable)
+import qualified Data.HashMap.Strict             as HM
+import qualified Data.HashSet                    as HS
+import qualified Data.IntMap                     as IM
+import qualified Data.IntSet                     as IS
+import           Data.List.NonEmpty              (NonEmpty)
+import qualified Data.Map                        as Map
+import           Data.MonoTraversable
+import qualified Data.Semigroup                  as Sem
+import qualified Data.Sequence                   as Seq
+import qualified Data.Set                        as Set
+import qualified Data.Tree                       as Tree
+import           GHC.Conc                        (STM)
+import           Text.ParserCombinators.ReadP    (ReadP)
+import           Text.ParserCombinators.ReadPrec (ReadPrec)
+
+class CFunctor m => CBind m where
+  (>>-) :: (Dom m a, Dom m b) => m a -> (a -> m b) -> m b
+  default (>>-) :: (Dom m a, Dom m b, Dom m (m b)) => m a -> (a -> m b) -> m b
+  m >>- f = cjoin (cmap f m)
+  cjoin :: (Dom m (m a), Dom m a) => m (m a) -> m a
+  cjoin = (>>- id)
+
+instance (Monad m) => CBind (WrapFunctor m) where
+  (>>-) :: forall a b.
+           WrapFunctor m a
+        -> (a -> WrapFunctor m b) -> WrapFunctor m b
+  (>>-) = coerce @(m a -> (a -> m b) -> m b) (>>=)
+  cjoin :: forall a. WrapFunctor m (WrapFunctor m a) -> WrapFunctor m a
+  cjoin (WrapFunctor m) = WrapFunctor $ join (fmap coerce m)
+
+instance CBind [] where
+  (>>-) = (>>=)
+  cjoin  = concat
+
+instance CBind IO where
+  (>>-) = (>>=)
+
+instance CBind STM where
+  (>>-) = (>>=)
+
+instance CBind (SST.ST s) where
+  (>>-) = (>>=)
+
+instance CBind (LST.ST s) where
+  (>>-) = (>>=)
+
+instance CBind Identity where
+  (>>-) = (>>=)
+
+instance CBind (Either a) where
+  (>>-) = (>>=)
+
+instance CBind Tree.Tree where
+  (>>-) = (>>=)
+
+instance CBind Maybe where
+  (>>-) = (>>=)
+
+instance CBind IM.IntMap where
+  m >>- f = IM.mapMaybeWithKey (\k -> IM.lookup k . f) m
+
+instance Ord k => CBind (Map.Map k) where
+  m >>- f = Map.mapMaybeWithKey (\k -> Map.lookup k . f) m
+
+instance (Hashable k, Eq k) => CBind (HM.HashMap k) where
+  m >>- f = HM.mapMaybeWithKey (\k -> HM.lookup k . f) m
+
+instance CBind Set.Set where
+  (>>-) = flip foldMap
+  {-# INLINE (>>-) #-}
+  cjoin = foldMap id
+  {-# INLINE cjoin #-}
+
+instance CBind (WrapMono IS.IntSet) where
+  (>>-) = withMonoCoercible $ flip ofoldMap
+  {-# INLINE (>>-) #-}
+
+instance CBind NonEmpty where
+  (>>-) = (>>=)
+  {-# INLINE (>>-) #-}
+
+instance CBind Seq.Seq where
+  (>>-) = (>>=)
+  {-# INLINE (>>-) #-}
+
+instance CBind Sem.Option where
+  (>>-) = (>>=)
+  {-# INLINE (>>-) #-}
+
+instance CBind ((->) a) where
+  (>>-) = (>>=)
+  {-# INLINE (>>-) #-}
+
+instance CBind HS.HashSet where
+  (>>-) = flip foldMap
+  {-# INLINE (>>-) #-}
+  cjoin = foldMap id
+  {-# INLINE cjoin #-}
+
+instance CBind ReadP where
+  (>>-) = (>>=)
+  {-# INLINE (>>-) #-}
+
+instance CBind ReadPrec where
+  (>>-) = (>>=)
+  {-# INLINE (>>-) #-}
+
+instance Semigroup w => CBind ((,) w) where
+  (m, a) >>- f =
+    let (w, b) = f a
+    in (m <> w, b)
+  {-# INLINE (>>-) #-}
+  cjoin (w, (m, a)) = (w <> m, a)
+  {-# INLINE cjoin #-}
+
+infixl 1 >>-
+infixr 1 -<<
+
+(-<<) :: (Dom m b, Dom m a, CBind m) => (a -> m b) -> m a -> m b
+(-<<) = flip (>>-)
+{-# INLINE (-<<) #-}
+
+instance (CBind m, CBind n) => CBind (SOP.Product m n) where
+  (SOP.Pair a b) >>- f = SOP.Pair (a >>- fstP . f) (b >>- sndP . f)
+    where
+      fstP (SOP.Pair x _) = x
+      sndP (SOP.Pair _ y) = y
+  {-# INLINE (>>-) #-}
+
+class    (CBind f, CPointed f) => CMonad f
+instance (CBind f, CPointed f) => CMonad f
+
+creturn :: (Dom m a, CMonad m) => a -> m a
+creturn = cpure
+{-# INLINE creturn #-}
diff --git a/src/Control/Subcategory/Foldable.hs b/src/Control/Subcategory/Foldable.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Subcategory/Foldable.hs
@@ -0,0 +1,1606 @@
+{-# LANGUAGE BangPatterns, CPP, DefaultSignatures, DerivingVia, LambdaCase #-}
+{-# LANGUAGE OverloadedStrings, QuantifiedConstraints, StandaloneDeriving  #-}
+{-# LANGUAGE TemplateHaskell, TypeOperators                                #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Control.Subcategory.Foldable
+  ( CFoldable(..),
+    ctoList,
+    CTraversable(..),
+    CFreeMonoid(..),
+    cfromList,
+    cfolded, cfolding,
+    cctraverseFreeMonoid,
+    cctraverseZipFreeMonoid
+  ) where
+import           Control.Applicative                  (ZipList, getZipList)
+import           Control.Arrow                        (first, second, (***))
+import qualified Control.Foldl                        as L
+import           Control.Monad                        (forM)
+import           Control.Subcategory.Applicative
+import           Control.Subcategory.Functor
+import           Control.Subcategory.Pointed
+import           Control.Subcategory.Wrapper.Internal
+import           Control.Subcategory.Zip
+import           Data.Coerce
+import           Data.Complex                         (Complex)
+import           Data.Foldable
+import           Data.Functor.Const                   (Const)
+import           Data.Functor.Contravariant           (Contravariant, contramap,
+                                                       phantom)
+import           Data.Functor.Identity                (Identity)
+import qualified Data.Functor.Product                 as SOP
+import qualified Data.Functor.Sum                     as SOP
+import qualified Data.HashMap.Strict                  as HM
+import qualified Data.HashSet                         as HS
+import qualified Data.IntMap.Strict                   as IM
+import qualified Data.IntSet                          as IS
+import           Data.Kind                            (Type)
+import           Data.List                            (uncons)
+import           Data.List                            (intersperse)
+import           Data.List                            (nub)
+import qualified Data.List                            as List
+import           Data.List.NonEmpty                   (NonEmpty)
+import qualified Data.List.NonEmpty                   as NE
+import qualified Data.Map                             as M
+import           Data.Maybe
+import           Data.Monoid
+import qualified Data.Monoid                          as Mon
+import           Data.MonoTraversable                 hiding (WrappedMono,
+                                                       unwrapMono)
+import           Data.Ord                             (Down)
+import qualified Data.Primitive.Array                 as A
+import qualified Data.Primitive.PrimArray             as PA
+import qualified Data.Primitive.SmallArray            as SA
+import           Data.Proxy                           (Proxy)
+import           Data.Semigroup                       (Arg, Max (..), Min (..),
+                                                       Option)
+import qualified Data.Semigroup                       as Sem
+import qualified Data.Sequence                        as Seq
+import           Data.Sequences                       (IsSequence (indexEx))
+import qualified Data.Sequences                       as MT
+import qualified Data.Set                             as Set
+import qualified Data.Text                            as T
+import qualified Data.Vector                          as V
+import qualified Data.Vector.Algorithms.Intro         as AI
+import qualified Data.Vector.Primitive                as P
+import qualified Data.Vector.Storable                 as S
+import qualified Data.Vector.Unboxed                  as U
+import           Foreign.Ptr                          (Ptr)
+import qualified GHC.Exts                             as GHC
+import           GHC.Generics
+import           Language.Haskell.TH                  hiding (Type)
+import           Language.Haskell.TH.Syntax           hiding (Type)
+import qualified VectorBuilder.Builder                as VB
+import qualified VectorBuilder.Vector                 as VB
+
+-- See Note [Function coercion]
+(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)
+(#.) _f = coerce
+{-# INLINE (#.) #-}
+
+ctoList :: (CFoldable f, Dom f a) => f a -> [a]
+{-# INLINE [1] ctoList #-}
+ctoList = cbasicToList
+
+cfromList :: (CFreeMonoid f, Dom f a) => [a] -> f a
+{-# INLINE [1] cfromList #-}
+cfromList = cbasicFromList
+
+
+-- | Fold-optic for 'CFoldable' instances.
+--   In the terminology of lens, cfolded is a constrained
+--   variant of @folded@ optic.
+--
+--  @
+--    cfolded :: (CFoldable t, Dom t a) => Fold (t a) a
+--  @
+cfolded
+  :: (CFoldable t, Dom t a)
+  => forall f. (Contravariant f, Applicative f) => (a -> f a) -> t a -> f (t a)
+{-# INLINE cfolded #-}
+cfolded = (contramap (const ()) .) . ctraverse_
+
+class Constrained f => CFoldable f where
+  {-# MINIMAL cfoldMap | cfoldr #-}
+  cfoldMap :: (Dom f a, Monoid w) => (a -> w) -> f a -> w
+  {-# INLINE [1] cfoldMap #-}
+  cfoldMap f = cfoldr (mappend . f) mempty
+
+  cfoldMap' :: (Dom f a, Monoid m) => (a -> m) -> f a -> m
+  {-# INLINE [1] cfoldMap' #-}
+  cfoldMap' f = cfoldl' (\ acc a -> acc <> f a) mempty
+
+  cfold :: (Dom f w, Monoid w) => f w -> w
+  cfold = cfoldMap id
+
+  {-# INLINE [1] cfold #-}
+  cfoldr :: (Dom f a) => (a -> b -> b) -> b -> f a -> b
+  {-# INLINE [1] cfoldr #-}
+  cfoldr f z t = appEndo (cfoldMap (Endo #. f) t) z
+
+  cfoldlM
+    :: (Monad m, Dom f b)
+    => (a -> b -> m a) -> a -> f b -> m a
+  {-# INLINE [1] cfoldlM #-}
+  cfoldlM f z0 xs = cfoldr f' return xs z0
+    where f' x k z = f z x >>= k
+
+  cfoldlM'
+    :: (Monad m, Dom f b)
+    => (a -> b -> m a) -> a -> f b -> m a
+  {-# INLINE [1] cfoldlM' #-}
+  cfoldlM' f z0 xs = cfoldr' f' return xs z0
+    where f' !x k z = do
+            !i <- f z x
+            k i
+
+  cfoldrM
+    :: (Monad m, Dom f a)
+    => (a -> b -> m b) -> b -> f a -> m b
+  {-# INLINE [1] cfoldrM #-}
+  cfoldrM f z0 xs = cfoldl c return xs z0
+    where c k x z = f x z >>= k
+
+  cfoldrM'
+    :: (Monad m, Dom f a)
+    => (a -> b -> m b) -> b -> f a -> m b
+  {-# INLINE [1] cfoldrM' #-}
+  cfoldrM' f z0 xs = cfoldl' c return xs z0
+    where c k !x z = do
+            !i <- f x z
+            k i
+  cfoldl
+      :: (Dom f a)
+      => (b -> a -> b) -> b -> f a -> b
+  {-# INLINE [1] cfoldl #-}
+  cfoldl f z t = appEndo (getDual (cfoldMap (Dual . Endo . flip f) t)) z
+
+  cfoldr' :: (Dom f a) => (a -> b -> b) -> b -> f a -> b
+  {-# INLINE [1] cfoldr' #-}
+  cfoldr' f z0 xs = cfoldl f' id xs z0
+      where f' k x z = k $! f x z
+
+  cfoldl' :: Dom f a => (b -> a -> b) -> b -> f a -> b
+  {-# INLINE [1] cfoldl' #-}
+  cfoldl' f z0 xs = cfoldr f' id xs z0
+    where f' x k z = k $! f z x
+
+  cbasicToList :: Dom f a => f a -> [a]
+  {-# INLINE cbasicToList #-}
+  cbasicToList = cfoldr (:) []
+
+  cfoldr1 :: Dom f a => (a -> a -> a) -> f a -> a
+  {-# INLINE [1] cfoldr1 #-}
+  cfoldr1 f xs = fromMaybe (errorWithoutStackTrace "cfoldr1: empty structure")
+                    (cfoldr mf Nothing xs)
+      where
+        mf x m = Just $
+          case m of
+            Nothing -> x
+            Just y  -> f x y
+
+
+
+  cfoldl1 :: Dom f a => (a -> a -> a) -> f a -> a
+  {-# INLINE [1] cfoldl1 #-}
+  cfoldl1 f xs = fromMaybe (errorWithoutStackTrace "cfoldl1: empty structure")
+                  (cfoldl mf Nothing xs)
+    where
+      mf m y = Just $
+        case m of
+          Nothing -> y
+          Just x  -> f x y
+
+  cindex :: Dom f a => f a -> Int -> a
+  cindex xs n = case cfoldl' go (Left' 0) xs of
+    Right' x -> x
+    Left'{} -> errorWithoutStackTrace $ "cindex: index out of bound " ++ show n
+    where
+      go (Left' i) x
+        | i == n = Right' x
+        | otherwise = Left' (i + 1)
+      go r@Right'{} _ = r
+
+  cnull :: Dom f a => f a -> Bool
+  cnull = cfoldr (const $ const False) True
+
+  clength :: Dom f a => f a -> Int
+  {-# INLINE [1] clength #-}
+  clength = cfoldl' (\c _ -> c + 1) 0
+
+  cany :: Dom f a => (a -> Bool) -> f a -> Bool
+  {-# INLINE [1] cany #-}
+  cany p = cfoldl' (\b -> (||) b . p) False
+
+  call :: Dom f a => (a -> Bool) -> f a -> Bool
+  {-# INLINE [1] call #-}
+  call p = cfoldl' (\b -> (&&) b . p) True
+
+  celem :: (Eq a, Dom f a) => a -> f a -> Bool
+  {-# INLINE [1] celem #-}
+  celem = cany . (==)
+
+  cnotElem :: (Eq a, Dom f a) => a -> f a -> Bool
+  {-# INLINE [1] cnotElem #-}
+  cnotElem = call . (/=)
+
+  cminimum :: (Ord a, Dom f a) => f a -> a
+  {-# INLINE [1] cminimum #-}
+  cminimum =
+    getMin
+    . fromMaybe (errorWithoutStackTrace "minimum: empty structure")
+    . cfoldMap (Just . Min)
+
+  cmaximum :: (Ord a, Dom f a) => f a -> a
+  {-# INLINE [1] cmaximum #-}
+  cmaximum =
+    getMax
+    . fromMaybe (errorWithoutStackTrace "cmaximum: empty structure")
+    . cfoldMap (Just . Max)
+
+  csum :: (Num a, Dom f a) => f a -> a
+  {-# INLINE [1] csum #-}
+  csum = getSum #. cfoldMap Sum
+
+  cproduct :: (Num a, Dom f a) => f a -> a
+  {-# INLINE [1] cproduct #-}
+  cproduct = getProduct #. cfoldMap Product
+
+  cctraverse_
+    :: (CApplicative g, CPointed g, Dom g (), Dom f a, Dom g b)
+    => (a -> g b)
+    -> f a -> g ()
+  {-# INLINE [1] cctraverse_ #-}
+  cctraverse_ f = cfoldr c (cpure ())
+    where
+      {-# INLINE c #-}
+      c x k = f x .> k
+
+  ctraverse_
+    :: (Applicative g, Dom f a)
+    => (a -> g b)
+    -> f a -> g ()
+  {-# INLINE [1] ctraverse_ #-}
+  ctraverse_ f = cfoldr c (pure ())
+    where
+      {-# INLINE c #-}
+      c x k = f x *> k
+
+  clast :: Dom f a => f a -> a
+  {-# INLINE [1] clast #-}
+  clast = fromJust . L.foldOver cfolded L.last
+
+  chead :: Dom f a => f a -> a
+  {-# INLINE [1] chead #-}
+  chead = fromJust . L.foldOver cfolded L.head
+
+  cfind :: Dom f a => (a -> Bool) -> f a -> Maybe a
+  {-# INLINE [1] cfind #-}
+  cfind = \p -> getFirst . cfoldMap (\x -> First $ if p x then Just x else Nothing)
+
+  cfindIndex :: Dom f a => (a -> Bool) -> f a -> Maybe Int
+  {-# INLINE [1] cfindIndex #-}
+  cfindIndex = \p -> L.foldOver cfolded (L.findIndex p)
+
+  cfindIndices :: Dom f a => (a -> Bool) -> f a -> [Int]
+  {-# INLINE [1] cfindIndices #-}
+  cfindIndices = \p -> List.findIndices p . ctoList
+
+  celemIndex :: (Dom f a, Eq a) => a -> f a -> Maybe Int
+  {-# INLINE [0] celemIndex #-}
+  celemIndex = cfindIndex . (==)
+
+  celemIndices :: (Dom f a, Eq a) => a -> f a -> [Int]
+  {-# INLINE [0] celemIndices #-}
+  celemIndices = cfindIndices . (==)
+
+data Eith' a b = Left' !a | Right' !b
+
+instance Traversable f => CTraversable (WrapFunctor f) where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+
+instance Foldable f => CFoldable (WrapFunctor f) where
+  cfoldMap = foldMap
+  {-# INLINE [1] cfoldMap #-}
+#if MIN_VERSION_base(4,13,0)
+  cfoldMap' = foldMap'
+  {-# INLINE [1] cfoldMap' #-}
+#endif
+  cfold = fold
+  {-# INLINE [1] cfold #-}
+  cfoldr = foldr
+  {-# INLINE [1] cfoldr #-}
+  cfoldr' = foldr'
+  {-# INLINE [1] cfoldr' #-}
+  cfoldl = foldl
+  {-# INLINE [1] cfoldl #-}
+  cfoldl' = foldl'
+  {-# INLINE [1] cfoldl' #-}
+  cbasicToList = toList
+  {-# INLINE [1] cbasicToList #-}
+  cfoldr1 = foldr1
+  {-# INLINE [1] cfoldr1 #-}
+  cfoldl1 = foldl1
+  {-# INLINE [1] cfoldl1 #-}
+  cfoldlM = foldlM
+  {-# INLINE [1] cfoldlM #-}
+  cfoldrM = foldrM
+  {-# INLINE [1] cfoldrM #-}
+  cnull = null
+  {-# INLINE [1] cnull #-}
+  clength = length
+  {-# INLINE [1] clength #-}
+  cany = any
+  {-# INLINE [1] cany #-}
+  call = all
+  {-# INLINE [1] call #-}
+  celem = elem
+  {-# INLINE [1] celem #-}
+  cnotElem = notElem
+  {-# INLINE [1] cnotElem #-}
+  cminimum = minimum
+  {-# INLINE [1] cminimum #-}
+  cmaximum = maximum
+  {-# INLINE [1] cmaximum #-}
+  csum = sum
+  {-# INLINE [1] csum #-}
+  cproduct = product
+  {-# INLINE [1] cproduct #-}
+  ctraverse_ = traverse_
+  {-# INLINE [1] ctraverse_ #-}
+  cfind = find
+  {-# INLINE [1] cfind #-}
+  cfindIndex = L.fold . L.findIndex
+  {-# INLINE [1] cfindIndex #-}
+  celemIndex = L.fold . L.elemIndex
+  {-# INLINE [1] celemIndex #-}
+
+{-# RULES
+"cfind/List"
+  cfind = find @[]
+
+"cfindIndex/List"
+  cfindIndex = List.findIndex
+
+"cfindIndices/List"
+  cfindIndices = List.findIndices
+
+"celemIndex/List"
+  celemIndex = List.elemIndex
+
+"celemIndices/List"
+  celemIndices = List.elemIndices
+
+"cfindIndex/List"
+  cfindIndex = Seq.findIndexL
+
+"cfindIndices/Seq"
+  cfindIndices = Seq.findIndicesL
+
+"celemIndex/Seq"
+  celemIndex = Seq.elemIndexL
+
+"celemIndices/Seq"
+  celemIndices = Seq.elemIndicesL
+
+  #-}
+
+{-# RULES
+"cctraverse_/traverse_"
+  forall (f :: Applicative f => a -> f b) (tx :: Foldable t => t a).
+  cctraverse_ f tx = traverse_ f tx
+  #-}
+
+{-# RULES
+"cindex/List"
+  cindex = (!!)
+  #-}
+
+class (CFunctor f, CFoldable f) => CTraversable f where
+  -- | __N.B.__ If we require @g@ to be 'CApplicative'
+  --   we cannot directly lift plain 'Traversable' to 'CTraversable'.
+  --   This is rather annoying, so we require the strongest possible
+  --   constraint to @g@ here.
+  ctraverse
+    :: (Dom f a, Dom f b, Applicative g)
+    => (a -> g b) -> f a -> g (f b)
+
+deriving via WrapFunctor []
+  instance CFoldable []
+{-# RULES
+"ctoList/List"
+  ctoList = id
+"cfromList/List"
+  cbasicFromList = id
+"clast/List"
+  clast = last
+"chead/List"
+  chead = head
+  #-}
+
+instance CTraversable [] where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor Maybe
+  instance CFoldable Maybe
+instance CTraversable Maybe where
+  ctraverse = traverse
+deriving via WrapFunctor (Either e)
+  instance CFoldable (Either e)
+instance CTraversable (Either e) where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor IM.IntMap
+  instance CFoldable IM.IntMap
+instance CTraversable IM.IntMap where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor (M.Map k)
+  instance CFoldable (M.Map k)
+instance Ord k => CTraversable (M.Map k) where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor (HM.HashMap k)
+  instance CFoldable (HM.HashMap k)
+instance CTraversable (HM.HashMap k) where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor Seq.Seq
+  instance CFoldable Seq.Seq
+instance CTraversable Seq.Seq where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+{-# RULES
+"cindex/Seq"
+  cindex = Seq.index
+  #-}
+
+deriving via WrapFunctor Par1
+  instance CFoldable Par1
+instance CTraversable Par1 where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor NonEmpty
+  instance CFoldable NonEmpty
+instance CTraversable NonEmpty where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+{-# RULES
+"cindex/NonEmpty"
+  cindex = (NE.!!)
+  #-}
+
+deriving via WrapFunctor Down
+  instance CFoldable Down
+instance CTraversable Down where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor Mon.Last
+  instance CFoldable Mon.Last
+instance CTraversable Mon.Last where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor Mon.First
+  instance CFoldable Mon.First
+instance CTraversable Mon.First where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor Sem.Last
+  instance CFoldable Sem.Last
+instance CTraversable Sem.Last where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor Sem.First
+  instance CFoldable Sem.First
+instance CTraversable Sem.First where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor Identity
+  instance CFoldable Identity
+instance CTraversable Identity where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor ZipList
+  instance CFoldable ZipList
+instance CTraversable ZipList where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+{-# RULES
+"cindex/ZipList"
+  cindex = (!!) . getZipList
+  #-}
+
+deriving via WrapFunctor Option
+  instance CFoldable Option
+instance CTraversable Option where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor Min
+  instance CFoldable Min
+instance CTraversable Min where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor Max
+  instance CFoldable Max
+instance CTraversable Max where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor Complex
+  instance CFoldable Complex
+instance CTraversable Complex where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor (V1 :: Type -> Type)
+  instance CFoldable (V1 :: Type -> Type)
+instance CTraversable (V1 :: Type -> Type) where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor (U1 :: Type -> Type)
+  instance CFoldable (U1 :: Type -> Type)
+instance CTraversable (U1 :: Type -> Type) where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor ((,) a)
+  instance CFoldable ((,) a)
+instance CTraversable ((,) a) where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor (Proxy :: Type -> Type)
+  instance CFoldable (Proxy :: Type -> Type)
+instance CTraversable (Proxy :: Type -> Type) where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor (Arg a)
+  instance CFoldable (Arg a)
+instance CTraversable (Arg a) where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor (Rec1 (f :: Type -> Type))
+  instance Foldable f => CFoldable (Rec1 (f :: Type -> Type))
+deriving via WrapFunctor (URec Char :: Type -> Type)
+  instance CFoldable (URec Char :: Type -> Type)
+instance CTraversable (URec Char :: Type -> Type) where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor (URec Double :: Type -> Type)
+  instance CFoldable (URec Double :: Type -> Type)
+instance CTraversable (URec Double :: Type -> Type) where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor (URec Float :: Type -> Type)
+  instance CFoldable (URec Float :: Type -> Type)
+instance CTraversable (URec Float :: Type -> Type) where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor (URec Int :: Type -> Type)
+  instance CFoldable (URec Int :: Type -> Type)
+instance CTraversable (URec Int :: Type -> Type) where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor (URec Word :: Type -> Type)
+  instance CFoldable (URec Word :: Type -> Type)
+instance CTraversable (URec Word :: Type -> Type) where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor (URec (Ptr ()) :: Type -> Type)
+  instance CFoldable (URec (Ptr ()) :: Type -> Type)
+instance CTraversable (URec (Ptr ()) :: Type -> Type) where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving newtype
+  instance CFoldable f => CFoldable (Alt f)
+deriving newtype
+  instance CFoldable f => CFoldable (Ap f)
+deriving via WrapFunctor (Const m :: Type -> Type)
+  instance CFoldable (Const m :: Type -> Type)
+instance CTraversable (Const m :: Type -> Type) where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+deriving via WrapFunctor (K1 i c :: Type -> Type)
+  instance CFoldable (K1 i c :: Type -> Type)
+instance CTraversable (K1 i c :: Type -> Type) where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+
+instance (CFoldable f, CFoldable g) => CFoldable (f :+: g) where
+  {-# INLINE [1] cfoldMap #-}
+  cfoldMap f = \case
+    L1 x -> cfoldMap f x
+    R1 x -> cfoldMap f x
+
+  {-# INLINE [1] cfoldr #-}
+  cfoldr f z = \case
+    L1 x -> cfoldr f z x
+    R1 x -> cfoldr f z x
+
+  cfoldMap' = \f -> \case
+    L1 x -> cfoldMap' f x
+    R1 x -> cfoldMap' f x
+  {-# INLINE [1] cfoldMap' #-}
+  cfold = \case
+    L1 x -> cfold x
+    R1 x -> cfold x
+  {-# INLINE [1] cfold #-}
+  cfoldr' = \f z -> \case
+    L1 x -> cfoldr' f z x
+    R1 x -> cfoldr' f z x
+  {-# INLINE [1] cfoldr' #-}
+  cfoldl = \f z -> \case
+    L1 x -> cfoldl f z x
+    R1 x -> cfoldl f z x
+  {-# INLINE [1] cfoldl #-}
+  cfoldl' = \f z -> \case
+    L1 x -> cfoldl' f z x
+    R1 x -> cfoldl' f z x
+  {-# INLINE [1] cfoldl' #-}
+  cbasicToList = \case
+    L1 x -> ctoList x
+    R1 x -> ctoList x
+  {-# INLINE cbasicToList #-}
+  cfoldr1 = \f -> \case
+    L1 x -> cfoldr1 f x
+    R1 x -> cfoldr1 f x
+  {-# INLINE [1] cfoldr1 #-}
+  cfoldl1 = \f -> \case
+    L1 x -> cfoldl1 f x
+    R1 x -> cfoldl1 f x
+  {-# INLINE [1] cfoldl1 #-}
+  cnull = \case
+    L1 x -> cnull x
+    R1 x -> cnull x
+  {-# INLINE [1] cnull #-}
+  clength = \case
+    L1 x -> clength x
+    R1 x -> clength x
+  {-# INLINE [1] clength #-}
+  cany = \f -> \case
+    L1 x -> cany f x
+    R1 x -> cany f x
+  {-# INLINE [1] cany #-}
+  call = \f -> \case
+    L1 x -> call f x
+    R1 x -> call f x
+  {-# INLINE [1] call #-}
+  celem = \x -> \case
+    L1 xs -> celem x xs
+    R1 xs -> celem x xs
+  {-# INLINE [1] celem #-}
+  cminimum = \case
+    L1 xs -> cminimum xs
+    R1 xs -> cminimum xs
+  {-# INLINE [1] cminimum #-}
+  cmaximum = \case
+    L1 xs -> cmaximum xs
+    R1 xs -> cmaximum xs
+  {-# INLINE [1] cmaximum #-}
+  csum = \case
+    L1 xs -> csum xs
+    R1 xs -> csum xs
+  {-# INLINE [1] csum #-}
+  cproduct = \case
+    L1 xs -> cproduct xs
+    R1 xs -> cproduct xs
+  {-# INLINE [1] cproduct #-}
+  ctraverse_ f = \case
+    L1 xs -> ctraverse_ f xs
+    R1 xs -> ctraverse_ f xs
+  {-# INLINE [1] ctraverse_ #-}
+
+instance (CTraversable f, CTraversable g) => CTraversable (f :+: g) where
+  ctraverse f = \case
+    L1 xs -> L1 <$> ctraverse f xs
+    R1 xs -> R1 <$> ctraverse f xs
+  {-# INLINE [1] ctraverse #-}
+
+instance (CFoldable f, CFoldable g) => CFoldable (f :*: g) where
+  {-# INLINE [1] cfoldMap #-}
+  cfoldMap f (l :*: r) = cfoldMap f l <> cfoldMap f r
+
+  cfoldMap' f (l :*: r) = cfoldMap' f l <> cfoldMap' f r
+  {-# INLINE [1] cfoldMap' #-}
+  cfold (l :*: r) = cfold l <> cfold r
+  {-# INLINE [1] cfold #-}
+  cnull (l :*: r) = cnull l && cnull r
+  {-# INLINE [1] cnull #-}
+  clength (l :*: r) = clength l + clength r
+  {-# INLINE [1] clength #-}
+  cany f (l :*: r) = cany f l || cany f r
+  {-# INLINE [1] cany #-}
+  call f (l :*: r) = call f l && call f r
+  {-# INLINE [1] call #-}
+  celem x (l :*: r) = celem x l || celem x r
+  {-# INLINE [1] celem #-}
+  csum (l :*: r) = csum l + csum r
+  {-# INLINE [1] csum #-}
+  cproduct (l :*: r) = cproduct l * cproduct r
+  {-# INLINE [1] cproduct #-}
+  ctraverse_ f (l :*: r) = ctraverse_ f l *> ctraverse_ f r
+  {-# INLINE [1] ctraverse_ #-}
+
+instance (CTraversable f, CTraversable g) => CTraversable (f :*: g) where
+  ctraverse f (l :*: r) =
+    (:*:) <$> ctraverse f l <*> ctraverse f r
+
+instance (CFoldable f, CFoldable g) => CFoldable (SOP.Sum f g) where
+  {-# INLINE [1] cfoldMap #-}
+  cfoldMap f = \case
+    SOP.InL x -> cfoldMap f x
+    SOP.InR x -> cfoldMap f x
+
+  {-# INLINE [1] cfoldr #-}
+  cfoldr f z = \case
+    SOP.InL x -> cfoldr f z x
+    SOP.InR x -> cfoldr f z x
+
+  cfoldMap' = \f -> \case
+    SOP.InL x -> cfoldMap' f x
+    SOP.InR x -> cfoldMap' f x
+  {-# INLINE [1] cfoldMap' #-}
+  cfold = \case
+    SOP.InL x -> cfold x
+    SOP.InR x -> cfold x
+  {-# INLINE [1] cfold #-}
+  cfoldr' = \f z -> \case
+    SOP.InL x -> cfoldr' f z x
+    SOP.InR x -> cfoldr' f z x
+  {-# INLINE [1] cfoldr' #-}
+  cfoldl = \f z -> \case
+    SOP.InL x -> cfoldl f z x
+    SOP.InR x -> cfoldl f z x
+  {-# INLINE [1] cfoldl #-}
+  cfoldl' = \f z -> \case
+    SOP.InL x -> cfoldl' f z x
+    SOP.InR x -> cfoldl' f z x
+  {-# INLINE [1] cfoldl' #-}
+  cbasicToList = \case
+    SOP.InL x -> ctoList x
+    SOP.InR x -> ctoList x
+  {-# INLINE cbasicToList #-}
+  cfoldr1 = \f -> \case
+    SOP.InL x -> cfoldr1 f x
+    SOP.InR x -> cfoldr1 f x
+  {-# INLINE [1] cfoldr1 #-}
+  cfoldl1 = \f -> \case
+    SOP.InL x -> cfoldl1 f x
+    SOP.InR x -> cfoldl1 f x
+  {-# INLINE [1] cfoldl1 #-}
+  cnull = \case
+    SOP.InL x -> cnull x
+    SOP.InR x -> cnull x
+  {-# INLINE [1] cnull #-}
+  clength = \case
+    SOP.InL x -> clength x
+    SOP.InR x -> clength x
+  {-# INLINE [1] clength #-}
+  cany = \f -> \case
+    SOP.InL x -> cany f x
+    SOP.InR x -> cany f x
+  {-# INLINE [1] cany #-}
+  call = \f -> \case
+    SOP.InL x -> call f x
+    SOP.InR x -> call f x
+  {-# INLINE [1] call #-}
+  celem = \x -> \case
+    SOP.InL xs -> celem x xs
+    SOP.InR xs -> celem x xs
+  {-# INLINE [1] celem #-}
+  cminimum = \case
+    SOP.InL xs -> cminimum xs
+    SOP.InR xs -> cminimum xs
+  {-# INLINE [1] cminimum #-}
+  cmaximum = \case
+    SOP.InL xs -> cmaximum xs
+    SOP.InR xs -> cmaximum xs
+  {-# INLINE [1] cmaximum #-}
+  csum = \case
+    SOP.InL xs -> csum xs
+    SOP.InR xs -> csum xs
+  {-# INLINE [1] csum #-}
+  cproduct = \case
+    SOP.InL xs -> cproduct xs
+    SOP.InR xs -> cproduct xs
+  {-# INLINE [1] cproduct #-}
+  ctraverse_ f = \case
+    SOP.InL xs -> ctraverse_ f xs
+    SOP.InR xs -> ctraverse_ f xs
+  {-# INLINE [1] ctraverse_ #-}
+
+instance (CTraversable f, CTraversable g) => CTraversable (SOP.Sum f g) where
+  ctraverse f = \case
+    SOP.InL xs -> SOP.InL <$> ctraverse f xs
+    SOP.InR xs -> SOP.InR <$> ctraverse f xs
+  {-# INLINE [1] ctraverse #-}
+
+instance (CFoldable f, CFoldable g) => CFoldable (SOP.Product f g) where
+  {-# INLINE [1] cfoldMap #-}
+  cfoldMap f (SOP.Pair l r) = cfoldMap f l <> cfoldMap f r
+
+  cfoldMap' f (SOP.Pair l r) = cfoldMap' f l <> cfoldMap' f r
+  {-# INLINE [1] cfoldMap' #-}
+  cfold (SOP.Pair l r) = cfold l <> cfold r
+  {-# INLINE [1] cfold #-}
+  cnull (SOP.Pair l r) = cnull l && cnull r
+  {-# INLINE [1] cnull #-}
+  clength (SOP.Pair l r) = clength l + clength r
+  {-# INLINE [1] clength #-}
+  cany f (SOP.Pair l r) = cany f l || cany f r
+  {-# INLINE [1] cany #-}
+  call f (SOP.Pair l r) = call f l && call f r
+  {-# INLINE [1] call #-}
+  celem x (SOP.Pair l r) = celem x l || celem x r
+  {-# INLINE [1] celem #-}
+  csum (SOP.Pair l r) = csum l + csum r
+  {-# INLINE [1] csum #-}
+  cproduct (SOP.Pair l r) = cproduct l * cproduct r
+  {-# INLINE [1] cproduct #-}
+  ctraverse_ f (SOP.Pair l r) =
+    ctraverse_ f l *> ctraverse_ f r
+  {-# INLINE ctraverse_ #-}
+
+deriving via WrapFunctor SA.SmallArray instance CFoldable SA.SmallArray
+deriving via WrapFunctor A.Array instance CFoldable A.Array
+
+instance CFoldable PA.PrimArray where
+  cfoldr = PA.foldrPrimArray
+  {-# INLINE [1] cfoldr #-}
+  cfoldl' = PA.foldlPrimArray'
+  {-# INLINE [1] cfoldl' #-}
+  cfoldlM' = PA.foldlPrimArrayM'
+  {-# INLINE [1] cfoldlM' #-}
+  cfoldl = PA.foldlPrimArray
+  {-# INLINE [1] cfoldl #-}
+  clength = PA.sizeofPrimArray
+  {-# INLINE [1] clength #-}
+  csum = PA.foldlPrimArray' (+) 0
+  {-# INLINE [1] csum #-}
+  cproduct = PA.foldlPrimArray' (*) 1
+  {-# INLINE [1] cproduct #-}
+  ctraverse_ = PA.traversePrimArray_
+  {-# INLINE [1] ctraverse_ #-}
+
+instance CTraversable PA.PrimArray where
+  ctraverse = PA.traversePrimArray
+  {-# INLINE [1] ctraverse #-}
+
+instance CTraversable SA.SmallArray where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+
+instance CTraversable A.Array where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+
+instance (CTraversable f, CTraversable g) => CTraversable (SOP.Product f g) where
+  {-# INLINE [1] ctraverse #-}
+  ctraverse f (SOP.Pair l r) =
+    SOP.Pair <$> ctraverse f l <*> ctraverse f r
+
+instance CFoldable Set.Set where
+  cfoldMap = ofoldMap
+  {-# INLINE [1] cfoldMap #-}
+  cfoldr = Set.foldr
+  {-# INLINE [1] cfoldr #-}
+  cfoldl = Set.foldl
+  {-# INLINE [1] cfoldl #-}
+  cfoldr' = Set.foldr'
+  {-# INLINE [1] cfoldr' #-}
+  cfoldl' = Set.foldl'
+  {-# INLINE [1] cfoldl' #-}
+  cminimum = Set.findMin
+  {-# INLINE [1] cminimum #-}
+  cmaximum = Set.findMax
+  {-# INLINE [1] cmaximum #-}
+  celem = Set.member
+  {-# INLINE [1] celem #-}
+  cnotElem = Set.notMember
+  {-# INLINE [1] cnotElem #-}
+  cbasicToList = Set.toList
+  {-# INLINE cbasicToList #-}
+  celemIndex = Set.lookupIndex
+  {-# INLINE [1] celemIndex #-}
+  cindex = flip Set.elemAt
+  {-# INLINE [1] cindex #-}
+
+instance CTraversable Set.Set where
+  -- TODO: more efficient implementation
+  ctraverse f =
+      fmap Set.fromList
+    . traverse f
+    . Set.toList
+  {-# INLINE [1] ctraverse #-}
+
+instance CFoldable HS.HashSet where
+  cfoldMap = ofoldMap
+  {-# INLINE [1] cfoldMap #-}
+  cfoldr = HS.foldr
+  {-# INLINE [1] cfoldr #-}
+  cfoldl' = HS.foldl'
+  {-# INLINE [1] cfoldl' #-}
+  celem = HS.member
+  {-# INLINE [1] celem #-}
+  cbasicToList = HS.toList
+  {-# INLINE cbasicToList #-}
+
+instance CTraversable HS.HashSet where
+  -- TODO: more efficient implementation
+  ctraverse f =
+      fmap HS.fromList
+    . traverse f
+    . HS.toList
+  {-# INLINE [1] ctraverse #-}
+
+{-# RULES
+"celem/IntSet"
+  celem = coerce
+    @(Int -> IS.IntSet -> Bool)
+    @(Int -> WrapMono IS.IntSet Int -> Bool)
+    IS.member
+"cnotElem/IntSet"
+  cnotElem = coerce
+    @(Int -> IS.IntSet -> Bool)
+    @(Int -> WrapMono IS.IntSet Int -> Bool)
+    IS.notMember
+"cmaximum/IntSet"
+  cmaximum = coerce @_ @(WrapMono IS.IntSet Int -> Int)
+    IS.findMax
+"cminimum/IntSet"
+  cminimum = coerce @(IS.IntSet -> Int) @(WrapMono IS.IntSet Int -> Int)
+    IS.findMin
+  #-}
+
+instance MonoFoldable mono => CFoldable (WrapMono mono) where
+  cfoldMap = ofoldMap
+  {-# INLINE [1] cfoldMap #-}
+  cfold = ofold
+  {-# INLINE [1] cfold #-}
+  cfoldr = ofoldr
+  {-# INLINE [1] cfoldr #-}
+  cfoldl' = ofoldl'
+  {-# INLINE [1] cfoldl' #-}
+  cfoldlM = ofoldlM
+  {-# INLINE [1] cfoldlM #-}
+  cbasicToList = otoList
+  {-# INLINE cbasicToList #-}
+  cfoldr1 = ofoldr1Ex
+  {-# INLINE [1] cfoldr1 #-}
+  cnull = onull
+  {-# INLINE [1] cnull #-}
+  clength = olength
+  {-# INLINE [1] clength #-}
+  cany = oany
+  {-# INLINE [1] cany #-}
+  call = oall
+  {-# INLINE [1] call #-}
+  celem = oelem
+  {-# INLINE [1] celem #-}
+  cnotElem = onotElem
+  {-# INLINE [1] cnotElem #-}
+  cminimum = minimumEx
+  {-# INLINE [1] cminimum #-}
+  cmaximum = maximumEx
+  {-# INLINE [1] cmaximum #-}
+  csum = osum
+  {-# INLINE [1] csum #-}
+  cproduct = oproduct
+  {-# INLINE [1] cproduct #-}
+  ctraverse_ = otraverse_
+  {-# INLINE [1] ctraverse_ #-}
+
+instance MonoTraversable mono => CTraversable (WrapMono mono) where
+  ctraverse = \f -> fmap WrapMono . otraverse f . unwrapMono
+
+instance CFoldable V.Vector where
+  {-# INLINE [1] cfoldMap #-}
+  cfoldMap = foldMap
+  {-# INLINE [1] cfoldr #-}
+  cfoldr = V.foldr
+  {-# INLINE [1] cfoldr' #-}
+  cfoldr' = V.foldr'
+  {-# INLINE [1] cfoldl #-}
+  cfoldl = V.foldl
+  {-# INLINE [1] cfoldl' #-}
+  cfoldl' = V.foldl'
+  {-# INLINE cfoldlM #-}
+  cfoldlM = V.foldM
+  {-# INLINE cfoldlM' #-}
+  cfoldlM' = V.foldM'
+  {-# INLINE [1] cindex #-}
+  cindex = (V.!)
+  {-# INLINE [1] celem #-}
+  celem = V.elem
+  {-# INLINE [1] cnotElem #-}
+  cnotElem = V.notElem
+  {-# INLINE [1] cany #-}
+  cany = V.any
+  {-# INLINE [1] call #-}
+  call = V.all
+  {-# INLINE [1] cfoldl1 #-}
+  cfoldl1 = V.foldl1
+  {-# INLINE [1] cfoldr1 #-}
+  cfoldr1 = V.foldr1
+  {-# INLINE [1] csum #-}
+  csum = V.sum
+  {-# INLINE [1] cproduct #-}
+  cproduct = V.product
+  {-# INLINE [1] cmaximum #-}
+  cmaximum = V.maximum
+  {-# INLINE [1] cminimum #-}
+  cminimum = V.minimum
+  {-# INLINE cbasicToList #-}
+  cbasicToList = V.toList
+  {-# INLINE [1] clast #-}
+  clast = V.last
+  {-# INLINE [1] chead #-}
+  chead = V.head
+  {-# INLINE [1] cfind #-}
+  cfind = V.find
+  {-# INLINE [1] cfindIndex #-}
+  cfindIndex = V.findIndex
+  {-# INLINE [1] cfindIndices #-}
+  cfindIndices = fmap V.toList . V.findIndices
+  {-# INLINE [1] celemIndex #-}
+  celemIndex = V.elemIndex
+  {-# INLINE [1] celemIndices #-}
+  celemIndices = fmap V.toList . V.elemIndices
+
+instance CFoldable U.Vector where
+  {-# INLINE [1] cfoldMap #-}
+  cfoldMap = ofoldMap
+  {-# INLINE [1] cfoldr #-}
+  cfoldr = U.foldr
+  {-# INLINE [1] cfoldr' #-}
+  cfoldr' = U.foldr'
+  {-# INLINE [1] cfoldl #-}
+  cfoldl = U.foldl
+  {-# INLINE [1] cfoldl' #-}
+  cfoldl' = U.foldl'
+  {-# INLINE cfoldlM #-}
+  cfoldlM = U.foldM
+  {-# INLINE cfoldlM' #-}
+  cfoldlM' = U.foldM'
+  {-# INLINE [1] cindex #-}
+  cindex = (U.!)
+  {-# INLINE [1] celem #-}
+  celem = U.elem
+  {-# INLINE [1] cnotElem #-}
+  cnotElem = U.notElem
+  {-# INLINE [1] cany #-}
+  cany = U.any
+  {-# INLINE [1] call #-}
+  call = U.all
+  {-# INLINE [1] cfoldl1 #-}
+  cfoldl1 = U.foldl1
+  {-# INLINE [1] cfoldr1 #-}
+  cfoldr1 = U.foldr1
+  {-# INLINE [1] csum #-}
+  csum = U.sum
+  {-# INLINE [1] cproduct #-}
+  cproduct = U.product
+  {-# INLINE [1] cmaximum #-}
+  cmaximum = U.maximum
+  {-# INLINE [1] cminimum #-}
+  cminimum = U.minimum
+  {-# INLINE cbasicToList #-}
+  cbasicToList = U.toList
+  {-# INLINE [1] clast #-}
+  clast = U.last
+  {-# INLINE [1] chead #-}
+  chead = U.head
+  {-# INLINE [1] cfind #-}
+  cfind = U.find
+  {-# INLINE [1] cfindIndex #-}
+  cfindIndex = U.findIndex
+  {-# INLINE [1] cfindIndices #-}
+  cfindIndices = fmap U.toList . U.findIndices
+  {-# INLINE [1] celemIndex #-}
+  celemIndex = U.elemIndex
+  {-# INLINE [1] celemIndices #-}
+  celemIndices = fmap U.toList . U.elemIndices
+
+instance CFoldable S.Vector where
+  {-# INLINE [1] cfoldr #-}
+  cfoldr = S.foldr
+  {-# INLINE [1] cfoldr' #-}
+  cfoldr' = S.foldr'
+  {-# INLINE [1] cfoldl #-}
+  cfoldl = S.foldl
+  {-# INLINE [1] cfoldl' #-}
+  cfoldl' = S.foldl'
+  {-# INLINE cfoldlM #-}
+  cfoldlM = S.foldM
+  {-# INLINE cfoldlM' #-}
+  cfoldlM' = S.foldM'
+  {-# INLINE [1] cindex #-}
+  cindex = (S.!)
+  {-# INLINE [1] celem #-}
+  celem = S.elem
+  {-# INLINE [1] cnotElem #-}
+  cnotElem = S.notElem
+  {-# INLINE [1] cany #-}
+  cany = S.any
+  {-# INLINE [1] call #-}
+  call = S.all
+  {-# INLINE [1] cfoldl1 #-}
+  cfoldl1 = S.foldl1
+  {-# INLINE [1] cfoldr1 #-}
+  cfoldr1 = S.foldr1
+  {-# INLINE [1] csum #-}
+  csum = S.sum
+  {-# INLINE [1] cproduct #-}
+  cproduct = S.product
+  {-# INLINE [1] cmaximum #-}
+  cmaximum = S.maximum
+  {-# INLINE [1] cminimum #-}
+  cminimum = S.minimum
+  {-# INLINE cbasicToList #-}
+  cbasicToList = S.toList
+  {-# INLINE [1] clast #-}
+  clast = S.last
+  {-# INLINE [1] chead #-}
+  chead = S.head
+  {-# INLINE [1] cfind #-}
+  cfind = S.find
+  {-# INLINE [1] cfindIndex #-}
+  cfindIndex = S.findIndex
+  {-# INLINE [1] cfindIndices #-}
+  cfindIndices = fmap S.toList . S.findIndices
+  {-# INLINE [1] celemIndex #-}
+  celemIndex = S.elemIndex
+  {-# INLINE [1] celemIndices #-}
+  celemIndices = fmap S.toList . S.elemIndices
+
+instance CFoldable P.Vector where
+  {-# INLINE [1] cfoldr #-}
+  cfoldr = P.foldr
+  {-# INLINE [1] cfoldr' #-}
+  cfoldr' = P.foldr'
+  {-# INLINE [1] cfoldl #-}
+  cfoldl = P.foldl
+  {-# INLINE [1] cfoldl' #-}
+  cfoldl' = P.foldl'
+  {-# INLINE cfoldlM #-}
+  cfoldlM = P.foldM
+  {-# INLINE cfoldlM' #-}
+  cfoldlM' = P.foldM'
+  {-# INLINE [1] cindex #-}
+  cindex = (P.!)
+  {-# INLINE [1] celem #-}
+  celem = P.elem
+  {-# INLINE [1] cnotElem #-}
+  cnotElem = P.notElem
+  {-# INLINE [1] cany #-}
+  cany = P.any
+  {-# INLINE [1] call #-}
+  call = P.all
+  {-# INLINE [1] cfoldl1 #-}
+  cfoldl1 = P.foldl1
+  {-# INLINE [1] cfoldr1 #-}
+  cfoldr1 = P.foldr1
+  {-# INLINE [1] csum #-}
+  csum = P.sum
+  {-# INLINE [1] cproduct #-}
+  cproduct = P.product
+  {-# INLINE [1] cmaximum #-}
+  cmaximum = P.maximum
+  {-# INLINE [1] cminimum #-}
+  cminimum = P.minimum
+  {-# INLINE cbasicToList #-}
+  cbasicToList = P.toList
+  {-# INLINE [1] clast #-}
+  clast = P.last
+  {-# INLINE [1] chead #-}
+  chead = P.head
+  {-# INLINE [1] cfind #-}
+  cfind = P.find
+  {-# INLINE [1] cfindIndex #-}
+  cfindIndex = P.findIndex
+  {-# INLINE [1] cfindIndices #-}
+  cfindIndices = fmap P.toList . P.findIndices
+  {-# INLINE [1] celemIndex #-}
+  celemIndex = P.elemIndex
+  {-# INLINE [1] celemIndices #-}
+  celemIndices = fmap P.toList . P.elemIndices
+
+instance CTraversable V.Vector where
+  ctraverse = traverse
+  {-# INLINE [1] ctraverse #-}
+
+instance CTraversable U.Vector where
+  ctraverse = \f -> fmap S.convert . traverse f . U.convert @_ @_ @V.Vector
+  {-# INLINE [1] ctraverse #-}
+
+instance CTraversable S.Vector where
+  ctraverse = \f -> fmap S.convert . traverse f . U.convert @_ @_ @V.Vector
+  {-# INLINE [1] ctraverse #-}
+
+instance CTraversable P.Vector where
+  ctraverse = \f -> fmap P.convert . traverse f . U.convert @_ @_ @V.Vector
+  {-# INLINE [1] ctraverse #-}
+
+{-# RULES
+"cindex/IsSequence" forall (xs :: (MT.Index mono ~ Int, IsSequence mono) => WrapMono mono b).
+  cindex xs = withMonoCoercible (coerce @(mono -> Int -> Element mono) indexEx xs)
+  #-}
+
+{-# RULES
+"cfromList/ctoList" [~1]
+  cfromList . ctoList = id
+"cfromList/ctoList" [~1] forall xs.
+  cfromList (ctoList xs) = xs
+  #-}
+
+{-# RULES
+"ctoList/cfromList" [~1]
+  ctoList . cfromList = id
+"ctoList/cfromList" forall xs.
+  ctoList (cfromList xs) = xs
+  #-}
+-- | Free monoid functor from fullsubcategory.
+--   It must be a pointed foldable functor with the property
+--   that for any 'Monoid' @w@ and @f :: a -> w@,
+--   @'cfoldMap' f@ must be a monoid homomorphism and the following
+--   must be hold:
+--
+--    @
+--       'cfoldMap' f . 'cpure' == f
+--    @
+--
+--   Hence, @'Set's@ cannot be a free monoid functor;
+class (CFunctor f, forall x. Dom f x => Monoid (f x), CPointed f, CFoldable f)
+  => CFreeMonoid f where
+  cbasicFromList :: Dom f a => [a] -> f a
+  cbasicFromList = foldr ((<>) . cpure) mempty
+  {-# INLINE cbasicFromList #-}
+
+  ccons :: Dom f a => a -> f a -> f a
+  {-# INLINE [1] ccons #-}
+  ccons = (<>) . cpure
+
+  csnoc :: Dom f a => f a -> a -> f a
+  {-# INLINE [1] csnoc #-}
+  csnoc = (. cpure) . (<>)
+
+  {- |
+    The 'cfromListN' function takes the input list's length as a hint. Its behaviour should be equivalent to 'cfromList'. The hint can be used to construct the structure l more efficiently compared to 'cfromList'.
+    If the given hint does not equal to the input list's length the behaviour of fromListN is not specified.
+  -}
+  cfromListN :: Dom f a => Int -> [a] -> f a
+  cfromListN = const cfromList
+  {-# INLINE [1] cfromListN #-}
+
+  ctake :: Dom f a => Int -> f a -> f a
+  {-# INLINE [1] ctake #-}
+  ctake n = cfromList . take n . ctoList
+
+  cdrop :: Dom f a => Int -> f a -> f a
+  {-# INLINE [1] cdrop #-}
+  cdrop n = cfromList . drop n . ctoList
+
+  cinit :: Dom f a => f a -> f a
+  {-# INLINE [1] cinit #-}
+  cinit = cfromList . init . ctoList
+
+  ctail :: Dom f a => f a -> f a
+  ctail = cfromList . tail . ctoList
+
+  csplitAt :: Dom f a => Int -> f a -> (f a, f a)
+  {-# INLINE [1] csplitAt #-}
+  csplitAt n = (\(a, b) -> (cfromList a, cfromList b)) . splitAt n . ctoList
+
+  creplicate :: Dom f a => Int -> a -> f a
+  {-# INLINE [1] creplicate #-}
+  creplicate n = cfromList . replicate n
+
+  cgenerate :: Dom f a => Int -> (Int -> a) -> f a
+  {-# INLINE [1] cgenerate #-}
+  cgenerate = \n f ->
+    cfromList [f i | i <- [0.. n - 1]]
+
+  cgenerateM :: (Dom f a, Monad m) => Int -> (Int -> m a) -> m (f a)
+  {-# INLINE [1] cgenerateM #-}
+  cgenerateM = \n f ->
+    cfromList <$> mapM f [0..n-1]
+
+  cgenerateA :: (Dom f a, Applicative g) => Int -> (Int -> g a) -> g (f a)
+  {-# INLINE [1] cgenerateA #-}
+  cgenerateA = \n f ->
+    cfromList <$> traverse f [0..n-1]
+
+  cuncons :: Dom f a => f a -> Maybe (a, f a)
+  {-# INLINE [1] cuncons #-}
+  cuncons = fmap (second cfromList) . uncons . ctoList
+
+  cunsnoc :: Dom f a => f a -> Maybe (f a, a)
+  {-# INLINE [1] cunsnoc #-}
+  cunsnoc = fmap (first cfromList) . MT.unsnoc . ctoList
+
+  creverse :: Dom f a => f a -> f a
+  {-# INLINE [1] creverse #-}
+  creverse = cfromList . reverse . ctoList
+
+  cintersperse :: Dom f a => a -> f a -> f a
+  cintersperse = \a -> cfromList . intersperse a . ctoList
+
+  cnub :: (Dom f a, Eq a) => f a -> f a
+  {-# INLINE [1] cnub #-}
+  cnub = cfromList . nub . ctoList
+
+  cnubOrd :: (Dom f a, Ord a) => f a -> f a
+  {-# INLINE [1] cnubOrd #-}
+  cnubOrd = cfromList . L.foldOver cfolded L.nub
+
+  csort :: (Dom f a, Ord a) => f a -> f a
+  {-# INLINE [1] csort #-}
+  csort = cfromList . List.sort . ctoList
+
+  csortBy :: (Dom f a) => (a -> a -> Ordering) -> f a -> f a
+  {-# INLINE [1] csortBy #-}
+  csortBy = \f -> cfromList . List.sortBy f . ctoList
+
+  cinsert :: (Dom f a, Ord a) => a -> f a -> f a
+  {-# INLINE [1] cinsert #-}
+  cinsert = \a -> cfromList . List.insert a . ctoList
+
+  cinsertBy :: (Dom f a) => (a -> a -> Ordering) -> a -> f a -> f a
+  {-# INLINE [1] cinsertBy #-}
+  cinsertBy = \f a -> cfromList . List.insertBy f a . ctoList
+
+  ctakeWhile :: Dom f a => (a -> Bool) -> f a -> f a
+  {-# INLINE [1] ctakeWhile #-}
+  ctakeWhile = \f -> cfromList . takeWhile f . ctoList
+
+  cdropWhile :: Dom f a => (a -> Bool) -> f a -> f a
+  {-# INLINE [1] cdropWhile #-}
+  cdropWhile = \f -> cfromList . dropWhile f . ctoList
+
+  cspan :: Dom f a => (a -> Bool) -> f a -> (f a, f a)
+  {-# INLINE [1] cspan #-}
+  cspan = \f -> (cfromList *** cfromList) . span f . ctoList
+
+  cbreak :: Dom f a => (a -> Bool) -> f a -> (f a, f a)
+  {-# INLINE [1] cbreak #-}
+  cbreak = \f -> (cfromList *** cfromList) . break f . ctoList
+
+  cfilter :: Dom f a => (a -> Bool) -> f a -> f a
+  {-# INLINE [1] cfilter #-}
+  cfilter = \f -> cfromList . filter f . ctoList
+
+  cpartition :: Dom f a => (a -> Bool) -> f a -> (f a, f a)
+  {-# INLINE [1] cpartition #-}
+  cpartition = \f -> (cfromList *** cfromList) . List.partition f . ctoList
+
+  -- TODO: more ListLike equivalent functions here
+
+instance CFreeMonoid [] where
+  cbasicFromList = id
+  {-# INLINE cbasicFromList #-}
+  cfromListN = take
+  {-# INLINE [1] cfromListN #-}
+  ccons = (:)
+  {-# INLINE [1] ccons #-}
+  csnoc = \xs x -> xs ++ [x]
+  {-# INLINE [1] csnoc #-}
+  ctake = take
+  {-# INLINE [1] ctake #-}
+  cdrop = drop
+  {-# INLINE [1] cdrop #-}
+  cinit = init
+  {-# INLINE [1] cinit #-}
+  ctail = tail
+  {-# INLINE [1] ctail #-}
+  csplitAt = splitAt
+  {-# INLINE [1] csplitAt #-}
+  creplicate = replicate
+  {-# INLINE [1] creplicate #-}
+  cgenerateM = \n f -> mapM f [0..n-1]
+  {-# INLINE [1] cgenerateM #-}
+  cgenerateA = \n f -> traverse f [0..n-1]
+  {-# INLINE [1] cgenerateA #-}
+  cuncons = uncons
+  {-# INLINE [1] cuncons #-}
+  cunsnoc = MT.unsnoc
+  {-# INLINE [1] cunsnoc #-}
+  creverse = reverse
+  {-# INLINE [1] creverse #-}
+  cintersperse = intersperse
+  {-# INLINE [1] cintersperse #-}
+  cnub = cnub
+  {-# INLINE [1] cnub #-}
+  csort = List.sort
+  {-# INLINE [1] csort #-}
+  csortBy = List.sortBy
+  {-# INLINE [1] csortBy #-}
+  ctakeWhile = takeWhile
+  {-# INLINE [1] ctakeWhile #-}
+  cdropWhile = dropWhile
+  {-# INLINE [1] cdropWhile #-}
+  cspan = span
+  {-# INLINE [1] cspan #-}
+  cbreak = break
+  {-# INLINE [1] cbreak #-}
+  cfilter = filter
+  {-# INLINE [1] cfilter #-}
+  cpartition = List.partition
+  {-# INLINE [1] cpartition #-}
+
+fmap concat $ forM
+  [''V.Vector, ''U.Vector, ''S.Vector, ''P.Vector]
+  $ \vecTy@(Name _ (NameG _ pkg modl0@(ModName mn))) ->
+    let modl = maybe modl0 (ModName . T.unpack)
+          $ T.stripSuffix ".Base" $ T.pack mn
+        modFun fun = varE $
+          Name (OccName fun) (NameG VarName pkg modl)
+    in [d|
+    instance CFreeMonoid $(conT vecTy) where
+      cbasicFromList = $(modFun "fromList")
+      {-# INLINE cbasicFromList #-}
+      cfromListN = $(modFun "fromListN")
+      {-# INLINE [1] cfromListN #-}
+      ccons = $(modFun "cons")
+      {-# INLINE [1] ccons #-}
+      csnoc = $(modFun "snoc")
+      {-# INLINE [1] csnoc #-}
+      ctake = $(modFun "take")
+      {-# INLINE [1] ctake #-}
+      cdrop = $(modFun "drop")
+      {-# INLINE [1] cdrop #-}
+      cinit = $(modFun "init")
+      {-# INLINE [1] cinit #-}
+      ctail = $(modFun "tail")
+      {-# INLINE [1] ctail #-}
+      csplitAt = $(modFun "splitAt")
+      {-# INLINE [1] csplitAt #-}
+      creplicate = $(modFun "replicate")
+      {-# INLINE [1] creplicate #-}
+      cgenerate = $(modFun "generate")
+      {-# INLINE [1] cgenerate #-}
+      cgenerateM = $(modFun "generateM")
+      {-# INLINE [1] cgenerateM #-}
+      cgenerateA = \n f ->
+        fmap VB.build
+        $ getAp $ foldMap (Ap . fmap VB.singleton . f) [0..n-1]
+      {-# INLINE [1] cgenerateA #-}
+      cuncons = \xs ->
+        if $(modFun "null") xs
+        then Nothing
+        else Just ($(modFun "head") xs, $(modFun "tail") xs)
+      {-# INLINE [1] cuncons #-}
+      cunsnoc = \xs ->
+        if $(modFun "null") xs
+        then Nothing
+        else Just ($(modFun "init") xs, $(modFun "last") xs)
+      {-# INLINE [1] cunsnoc #-}
+      creverse = $(modFun "reverse")
+      {-# INLINE [1] creverse #-}
+      cnubOrd = $(modFun "uniq") . $(modFun "modify") AI.sort
+      {-# INLINE cnubOrd #-}
+      csort = $(modFun "modify") AI.sort
+      {-# INLINE [1] csort #-}
+      csortBy = \f -> $(modFun "modify") $ AI.sortBy f
+      {-# INLINE [1] csortBy #-}
+      ctakeWhile = $(modFun "takeWhile")
+      {-# INLINE [1] ctakeWhile #-}
+      cdropWhile = $(modFun "dropWhile")
+      {-# INLINE [1] cdropWhile #-}
+      cspan = $(modFun "span")
+      {-# INLINE [1] cspan #-}
+      cbreak = $(modFun "break")
+      {-# INLINE [1] cbreak #-}
+      cfilter = $(modFun "filter")
+      {-# INLINE [1] cfilter #-}
+      cpartition = $(modFun "partition")
+      {-# INLINE [1] cpartition #-}
+    |]
+
+instance CFreeMonoid PA.PrimArray where
+  cbasicFromList = PA.primArrayFromList
+  {-# INLINE cbasicFromList #-}
+  cfromListN = PA.primArrayFromListN
+  {-# INLINE [1] cfromListN #-}
+  cgenerate = PA.generatePrimArray
+  {-# INLINE [1] cgenerate #-}
+  cgenerateM = PA.generatePrimArrayA
+  {-# INLINE [1] cgenerateM #-}
+  cgenerateA = PA.generatePrimArrayA
+  {-# INLINE [1] cgenerateA #-}
+  cfilter = PA.filterPrimArray
+  {-# INLINE [1] cfilter #-}
+  creplicate = PA.replicatePrimArray
+  {-# INLINE [1] creplicate #-}
+
+instance CFreeMonoid SA.SmallArray where
+  cbasicFromList = SA.smallArrayFromList
+  {-# INLINE cbasicFromList #-}
+  cfromListN = SA.smallArrayFromListN
+  {-# INLINE [1] cfromListN #-}
+
+instance CFreeMonoid A.Array where
+  cbasicFromList = A.fromList
+  {-# INLINE cbasicFromList #-}
+  cfromListN = A.fromListN
+  {-# INLINE [1] cfromListN #-}
+instance CFreeMonoid Seq.Seq where
+  cbasicFromList = Seq.fromList
+  {-# INLINE cbasicFromList #-}
+  cfromListN = GHC.fromListN
+  {-# INLINE [1] cfromListN #-}
+
+instance MT.IsSequence mono
+      => CFreeMonoid (WrapMono mono) where
+  cbasicFromList = coerce $ MT.fromList @mono
+  {-# INLINE cbasicFromList #-}
+  cfromListN = \n -> coerce $ MT.take (fromIntegral n) . MT.fromList @mono
+  {-# INLINE [1] cfromListN #-}
+  ctake = coerce . MT.take @mono . fromIntegral
+  {-# INLINE [1] ctake #-}
+  cdrop = coerce . MT.drop @mono . fromIntegral
+  {-# INLINE [1] cdrop #-}
+  ccons = coerce $ MT.cons @mono
+  {-# INLINE ccons #-}
+  csnoc = coerce $ MT.snoc @mono
+  {-# INLINE [1] csnoc #-}
+  cuncons = coerce $ MT.uncons @mono
+  {-# INLINE [1] cuncons #-}
+  cunsnoc = coerce $ MT.unsnoc @mono
+  {-# INLINE [1] cunsnoc #-}
+  ctail = coerce $ MT.tailEx @mono
+  {-# INLINE [1] ctail #-}
+  cinit = coerce $ MT.initEx @mono
+  {-# INLINE [1] cinit #-}
+  csplitAt = coerce $ \(n :: Int) ->
+      MT.splitAt @mono (fromIntegral n :: MT.Index mono)
+  {-# INLINE [1] csplitAt #-}
+  creplicate = coerce $ \(n :: Int) ->
+      MT.replicate @mono (fromIntegral n :: MT.Index mono)
+  {-# INLINE [1] creplicate #-}
+  creverse = coerce $ MT.reverse @mono
+  {-# INLINE [1] creverse #-}
+  cintersperse = coerce $ MT.intersperse @mono
+  {-# INLINE [1] cintersperse #-}
+  csort = coerce $ MT.sort @mono
+  {-# INLINE [1] csort #-}
+  csortBy = coerce $ MT.sortBy @mono
+  {-# INLINE [1] csortBy #-}
+  ctakeWhile = coerce $ MT.takeWhile @mono
+  {-# INLINE [1] ctakeWhile #-}
+  cdropWhile = coerce $ MT.dropWhile @mono
+  {-# INLINE [1] cdropWhile #-}
+  cbreak = coerce $ MT.break @mono
+  {-# INLINE [1] cbreak #-}
+  cspan = coerce $ MT.span @mono
+  {-# INLINE [1] cspan #-}
+  cfilter = coerce $ MT.filter @mono
+  {-# INLINE [1] cfilter #-}
+  cpartition = coerce $ MT.partition @mono
+  {-# INLINE [1] cpartition #-}
+
+cctraverseFreeMonoid
+  ::  ( CFreeMonoid t, CApplicative f, CPointed f,
+        Dom t a, Dom f (t b), Dom f b, Dom t b,
+        Dom f (t b, t b)
+      )
+  => (a -> f b) -> t a -> f (t b)
+cctraverseFreeMonoid f =
+  runCApp . cfoldMap (CApp . cmap cpure . f)
+
+cctraverseZipFreeMonoid
+  :: ( CFreeMonoid t, CRepeat f,
+        Dom t a, Dom f (t b), Dom f b, Dom t b,
+        Dom f (t b, t b)
+      )
+  => (a -> f b) -> t a -> f (t b)
+cctraverseZipFreeMonoid f =
+  runCZippy . cfoldMap (CZippy . cmap cpure . f)
+
+-- | Lifts 'CFoldable' along given function.
+--
+--  @
+--    cfolding :: (CFoldable t, Dom t a) => (s -> t a) -> Fold s a
+--  @
+cfolding
+  :: (CFoldable t, Dom t a, Contravariant f, Applicative f)
+  => (s -> t a)
+  -> (a -> f a) -> s -> f s
+{-# INLINE cfolding #-}
+cfolding = \sfa agb -> phantom . ctraverse_ agb . sfa
diff --git a/src/Control/Subcategory/Functor.hs b/src/Control/Subcategory/Functor.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Subcategory/Functor.hs
@@ -0,0 +1,375 @@
+{-# LANGUAGE CPP, DerivingVia, GADTs, InstanceSigs, KindSignatures    #-}
+{-# LANGUAGE PatternSynonyms, RankNTypes, RoleAnnotations             #-}
+{-# LANGUAGE ScopedTypeVariables, StandaloneDeriving, TemplateHaskell #-}
+{-# LANGUAGE TypeApplications, TypeFamilies, TypeOperators            #-}
+{-# LANGUAGE UndecidableSuperClasses                                  #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Control.Subcategory.Functor
+  ( Constrained(..), Dom(), CFunctor (..),
+    (<$:>),
+    defaultCmapConst,
+    WrapFunctor (..),
+    WrapMono (WrapMono, unwrapMono),
+    coerceToMono, withMonoCoercible,
+  )
+where
+import qualified Control.Applicative                  as App
+import           Control.Arrow                        (Arrow, ArrowMonad)
+import           Control.Exception                    (Handler)
+import qualified Control.Monad.ST.Lazy                as LST
+import qualified Control.Monad.ST.Strict              as SST
+import           Control.Subcategory.Wrapper.Internal
+import           Data.Coerce
+import           Data.Complex                         (Complex)
+import qualified Data.Functor.Compose                 as SOP
+import           Data.Functor.Const                   (Const)
+import           Data.Functor.Identity                (Identity)
+import qualified Data.Functor.Product                 as SOP
+import qualified Data.Functor.Sum                     as SOP
+import           Data.Hashable                        (Hashable)
+import qualified Data.HashMap.Strict                  as HM
+import qualified Data.HashSet                         as HS
+import qualified Data.IntMap                          as IM
+import           Data.Kind                            (Constraint, Type)
+import           Data.List.NonEmpty                   (NonEmpty)
+import qualified Data.Map                             as Map
+import qualified Data.Monoid                          as Mon
+import           Data.MonoTraversable                 (Element,
+                                                       MonoFunctor (..))
+#if MIN_VERSION_mono_traversable(1,0,14)
+import Data.MonoTraversable (WrappedMono)
+#endif
+
+import qualified Data.IntSet                     as IS
+import           Data.Ord                        (Down (..))
+import qualified Data.Primitive.Array            as A
+import qualified Data.Primitive.PrimArray        as PA
+import qualified Data.Primitive.SmallArray       as SA
+import           Data.Proxy                      (Proxy)
+import qualified Data.Semigroup                  as Sem
+import qualified Data.Sequence                   as Seq
+import qualified Data.Set                        as Set
+import qualified Data.Tree                       as Tree
+import qualified Data.Vector                     as V
+import qualified Data.Vector.Primitive           as P
+import qualified Data.Vector.Storable            as S
+import qualified Data.Vector.Unboxed             as U
+import           Foreign.Ptr                     (Ptr)
+import           GHC.Conc                        (STM)
+import           GHC.Generics                    ((:*:) (..), (:+:) (..),
+                                                  (:.:) (..), K1, M1, Par1,
+                                                  Rec1, U1, URec, V1)
+import qualified System.Console.GetOpt           as GetOpt
+import           Text.ParserCombinators.ReadP    (ReadP)
+import           Text.ParserCombinators.ReadPrec (ReadPrec)
+
+infixl 4 <$:
+
+class Constrained (f :: Type -> Type) where
+  type Dom f (a :: Type) :: Constraint
+  type Dom f a = ()
+
+class Constrained f => CFunctor f where
+  cmap :: (Dom f a, Dom f b) => (a -> b) -> f a -> f b
+  default cmap :: Functor f => (a -> b) -> f a -> f b
+  cmap = fmap
+  {-# INLINE cmap #-}
+  (<$:) :: (Dom f a, Dom f b) => a -> f b -> f a
+  (<$:) = cmap . const
+  {-# INLINE (<$:) #-}
+
+defaultCmapConst :: (CFunctor f, Dom f a, Dom f b) => a -> f b -> f a
+defaultCmapConst = cmap . const
+{-# INLINE defaultCmapConst #-}
+
+instance Constrained (WrapFunctor f) where
+  type Dom (WrapFunctor f) a = ()
+
+instance Functor f => CFunctor (WrapFunctor f) where
+  cmap :: (a -> b) -> WrapFunctor f a -> WrapFunctor f b
+  cmap = fmap
+  {-# INLINE cmap #-}
+  (<$:) :: a -> WrapFunctor f b -> WrapFunctor f a
+  (<$:) = (<$)
+  {-# INLINE (<$:) #-}
+
+instance Constrained []
+instance CFunctor []
+instance Constrained Maybe
+instance CFunctor Maybe
+instance Constrained IO
+instance CFunctor IO
+instance Constrained Par1
+instance CFunctor Par1
+instance Constrained NonEmpty
+instance CFunctor NonEmpty
+instance Constrained ReadP
+instance CFunctor ReadP
+instance Constrained ReadPrec
+instance CFunctor ReadPrec
+
+
+instance Constrained Down
+instance CFunctor Down
+instance Constrained Mon.Product
+instance CFunctor Mon.Product
+
+instance Constrained Mon.Sum
+instance CFunctor Mon.Sum
+instance Constrained Mon.Dual
+instance CFunctor Mon.Dual
+
+instance Constrained Mon.Last
+instance CFunctor Mon.Last
+instance Constrained Mon.First
+instance CFunctor Mon.First
+
+instance Constrained STM
+instance CFunctor STM
+instance Constrained Handler
+instance CFunctor Handler
+
+instance Constrained Identity
+instance CFunctor Identity
+instance Constrained App.ZipList
+instance CFunctor App.ZipList
+instance Constrained GetOpt.ArgDescr
+instance CFunctor GetOpt.ArgDescr
+instance Constrained GetOpt.OptDescr
+instance CFunctor GetOpt.OptDescr
+instance Constrained GetOpt.ArgOrder
+instance CFunctor GetOpt.ArgOrder
+instance Constrained Sem.Option
+instance CFunctor Sem.Option
+
+instance Constrained Sem.Last
+instance CFunctor Sem.Last
+instance Constrained Sem.First
+instance CFunctor Sem.First
+
+instance Constrained Sem.Max
+instance CFunctor Sem.Max
+instance Constrained Sem.Min
+instance CFunctor Sem.Min
+
+instance Constrained Complex
+instance CFunctor Complex
+instance Constrained (Either a)
+instance CFunctor (Either a)
+
+instance Constrained V1
+instance CFunctor V1
+instance Constrained U1
+instance CFunctor U1
+
+instance Constrained ((,) a)
+instance CFunctor ((,) a)
+instance Constrained (SST.ST s)
+instance CFunctor (SST.ST s)
+
+instance Constrained (LST.ST s)
+instance CFunctor (LST.ST s)
+instance Constrained Proxy
+instance CFunctor Proxy
+
+instance Constrained (ArrowMonad a)
+instance Arrow a => CFunctor (ArrowMonad a)
+instance Constrained (App.WrappedMonad m)
+instance Monad m => CFunctor (App.WrappedMonad m)
+
+instance Constrained (Sem.Arg a)
+instance CFunctor (Sem.Arg a)
+instance Constrained (Rec1 f)
+instance Functor f => CFunctor (Rec1 f)
+
+instance Constrained (URec Char)
+instance CFunctor (URec Char)
+instance Constrained (URec Double)
+instance CFunctor (URec Double)
+
+instance Constrained (URec Float)
+instance CFunctor (URec Float)
+instance Constrained (URec Int)
+instance CFunctor (URec Int)
+
+instance Constrained (URec Word)
+instance CFunctor (URec Word)
+instance Constrained (URec (Ptr ()))
+instance CFunctor (URec (Ptr ()))
+
+instance Constrained f => Constrained (Mon.Ap f) where
+  type Dom (Mon.Ap f) a = Dom f a
+
+deriving newtype instance CFunctor f => CFunctor (Mon.Ap f)
+
+instance Constrained (Mon.Alt f) where
+  type Dom (Mon.Alt f) a = Dom f a
+deriving newtype instance CFunctor f => CFunctor (Mon.Alt f)
+
+instance Constrained (Const m)
+instance CFunctor (Const m)
+instance Constrained (App.WrappedArrow a b)
+instance Arrow a => CFunctor (App.WrappedArrow a b)
+
+instance Constrained ((->) r)
+instance CFunctor ((->) r)
+instance Constrained (K1 i c)
+instance CFunctor (K1 i c)
+
+instance Constrained (f :+: g) where
+  type Dom (f :+: g) a = (Dom f a, Dom g a)
+instance (CFunctor f, CFunctor g) => CFunctor (f :+: g) where
+  cmap f (L1 xs) = L1 $ cmap f xs
+  cmap f (R1 xs) = R1 $ cmap f xs
+  {-# INLINE [1] cmap #-}
+instance Constrained (f :*: g) where
+  type Dom (f :*: g) a = (Dom f a, Dom g a)
+instance (CFunctor f, CFunctor g) => CFunctor (f :*: g) where
+  cmap f (l :*: r) = cmap f l :*: cmap f r
+  {-# INLINE cmap #-}
+
+instance Constrained (f :.: (g :: Type -> Type)) where
+  type Dom (f :.: g) a = (Dom f (g a), Dom g a)
+instance (CFunctor f, CFunctor g) => CFunctor (f :.: g) where
+  cmap f gfa = Comp1 $ cmap (cmap f) $ unComp1 gfa
+  {-# INLINE cmap #-}
+instance (Constrained f, Constrained g) => Constrained (SOP.Sum f g) where
+  type Dom (SOP.Sum f g) a = (Dom f a, Dom g a)
+
+instance (CFunctor f, CFunctor g) => CFunctor (SOP.Sum f g) where
+  cmap f (SOP.InL a) = SOP.InL $ cmap f a
+  cmap f (SOP.InR b) = SOP.InR $ cmap f b
+  {-# INLINE cmap #-}
+
+  (<$:) = defaultCmapConst
+  {-# INLINE (<$:) #-}
+
+instance (Constrained f, Constrained g) => Constrained (SOP.Product f g) where
+  type Dom (SOP.Product f g) a = (Dom f a, Dom g a)
+
+instance (CFunctor f, CFunctor g) => CFunctor (SOP.Product f g) where
+  cmap f (SOP.Pair a b) = SOP.Pair (cmap f a) (cmap f b)
+  {-# INLINE cmap #-}
+
+  (<$:) = defaultCmapConst
+  {-# INLINE (<$:) #-}
+
+instance (Constrained (f ::Type -> Type), Constrained (g :: Type -> Type))
+  => Constrained (SOP.Compose f g) where
+  type Dom (SOP.Compose f g) a = (Dom g a, Dom f (g a))
+
+instance (CFunctor f, CFunctor g) => CFunctor (SOP.Compose f g) where
+  cmap f (SOP.Compose a) = SOP.Compose $ cmap (cmap f) a
+  (<$:) = defaultCmapConst
+
+  {-# INLINE (<$:) #-}
+
+instance Constrained (M1 i c f)
+instance Functor f => CFunctor (M1 i c f)
+
+instance Constrained Seq.Seq
+instance CFunctor Seq.Seq
+
+#if MIN_VERSION_mono_traversable(1,0,14)
+instance Constrained (WrappedMono mono) where
+  type Dom (WrappedMono mono) a = a ~ Element mono
+
+instance MonoFunctor IS.IntSet where
+  omap = IS.map
+
+instance MonoFunctor mono => CFunctor (WrappedMono mono) where
+  cmap = omap
+  (<$:) = omap . const
+#endif
+
+instance Constrained (WrapMono mono) where
+  type Dom (WrapMono mono) b = b ~ Element mono
+
+instance {-# OVERLAPPABLE #-} MonoFunctor a
+      => CFunctor (WrapMono a) where
+  cmap = coerce @((Element a -> Element a) -> a -> a) omap
+  {-# INLINE [1] cmap #-}
+
+  (<$:) = defaultCmapConst
+  {-# INLINE [1] (<$:) #-}
+
+
+instance Constrained IM.IntMap
+instance CFunctor IM.IntMap
+
+instance Constrained (Map.Map k)
+instance Ord k => CFunctor (Map.Map k)
+
+instance Constrained Set.Set where
+  type Dom Set.Set a = Ord a
+
+instance CFunctor Set.Set where
+  cmap = Set.map
+  {-# INLINE [1] cmap #-}
+  (<$:) = flip $ \s ->
+    if Set.null s
+    then const Set.empty else Set.singleton
+  {-# INLINE [1] (<$:) #-}
+
+instance Constrained HS.HashSet where
+  type Dom HS.HashSet a = (Hashable a, Eq a)
+
+instance CFunctor HS.HashSet where
+  cmap :: (Hashable b, Eq b) => (a -> b) -> HS.HashSet a -> HS.HashSet b
+  cmap = HS.map
+  {-# INLINE [1] cmap #-}
+  (<$:) = flip $ \s -> if HS.null s
+    then const HS.empty else HS.singleton
+  {-# INLINE (<$:) #-}
+
+instance Constrained (HM.HashMap k)
+instance CFunctor (HM.HashMap k)
+instance Constrained Tree.Tree
+instance CFunctor Tree.Tree
+
+
+infixl 4 <$:>
+(<$:>) :: (CFunctor f, Dom f a, Dom f b) => (a -> b) -> f a -> f b
+(<$:>) = cmap
+{-# INLINE [1] (<$:>) #-}
+
+instance Constrained V.Vector where
+  type Dom V.Vector a = ()
+
+instance CFunctor V.Vector where
+  cmap = V.map
+  {-# INLINE [1] cmap #-}
+
+instance Constrained U.Vector where
+  type Dom U.Vector a = U.Unbox a
+instance CFunctor U.Vector where
+  cmap = U.map
+  {-# INLINE [1] cmap #-}
+instance Constrained S.Vector where
+  type Dom S.Vector a = S.Storable a
+instance CFunctor S.Vector where
+  cmap = S.map
+  {-# INLINE [1] cmap #-}
+
+instance Constrained P.Vector where
+  type Dom P.Vector a = P.Prim a
+instance CFunctor P.Vector where
+  cmap = P.map
+  {-# INLINE [1] cmap #-}
+
+instance Constrained PA.PrimArray where
+  type Dom PA.PrimArray a = P.Prim a
+
+instance CFunctor PA.PrimArray where
+  cmap = PA.mapPrimArray
+  {-# INLINE [1] cmap #-}
+
+deriving via WrapFunctor SA.SmallArray
+  instance Constrained SA.SmallArray
+deriving via WrapFunctor SA.SmallArray
+  instance CFunctor SA.SmallArray
+
+deriving via WrapFunctor A.Array
+  instance Constrained A.Array
+deriving via WrapFunctor A.Array
+  instance CFunctor A.Array
diff --git a/src/Control/Subcategory/Pointed.hs b/src/Control/Subcategory/Pointed.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Subcategory/Pointed.hs
@@ -0,0 +1,131 @@
+{-# LANGUAGE DerivingVia, StandaloneDeriving, TypeOperators #-}
+module Control.Subcategory.Pointed where
+import Control.Subcategory.Functor
+
+import qualified Control.Applicative             as App
+import qualified Control.Monad.ST.Lazy           as LST
+import qualified Control.Monad.ST.Strict         as SST
+import qualified Data.Functor.Compose            as SOP
+import           Data.Functor.Identity           (Identity)
+import qualified Data.Functor.Product            as SOP
+import qualified Data.HashSet                    as HS
+import qualified Data.IntSet                     as IS
+import           Data.List.NonEmpty              (NonEmpty)
+import qualified Data.Monoid                     as Mon
+import           Data.MonoTraversable            (MonoPointed, opoint)
+import           Data.Ord                        (Down)
+import qualified Data.Pointed                    as Pt
+import qualified Data.Primitive.Array            as A
+import qualified Data.Primitive.PrimArray        as PA
+import qualified Data.Primitive.SmallArray       as SA
+import           Data.Proxy                      (Proxy)
+import qualified Data.Semigroup                  as Sem
+import qualified Data.Sequence                   as Seq
+import qualified Data.Set                        as Set
+import qualified Data.Tree                       as Tree
+import qualified Data.Vector                     as V
+import qualified Data.Vector.Primitive           as P
+import qualified Data.Vector.Storable            as S
+import qualified Data.Vector.Unboxed             as U
+import           GHC.Conc                        (STM)
+import           GHC.Generics                    ((:*:) (..), (:.:) (..))
+import           GHC.Generics                    (Par1, Rec1, U1)
+import           Text.ParserCombinators.ReadP    (ReadP)
+import           Text.ParserCombinators.ReadPrec (ReadPrec)
+
+class Constrained f => CPointed f where
+  cpure :: Dom f a => a -> f a
+  default cpure :: App.Applicative f => a -> f a
+  cpure = pure
+
+instance (Functor f, Pt.Pointed f) => CPointed (WrapFunctor f) where
+  cpure = Pt.point
+  {-# INLINE cpure #-}
+
+instance CPointed []
+instance CPointed Maybe
+instance CPointed IO
+instance CPointed (SST.ST s)
+instance CPointed (LST.ST s)
+instance CPointed Par1
+instance CPointed Sem.Min
+instance CPointed Sem.Max
+instance CPointed Mon.First
+instance CPointed Mon.Last
+instance CPointed Sem.First
+instance CPointed Sem.Last
+instance CPointed Sem.Option
+instance CPointed NonEmpty
+instance CPointed App.ZipList
+instance CPointed Identity
+instance CPointed STM
+instance CPointed Sem.Dual
+instance CPointed Sem.Sum
+instance CPointed Sem.Product
+instance CPointed Down
+instance CPointed Tree.Tree
+instance CPointed Seq.Seq
+instance CPointed Set.Set where
+  cpure = Set.singleton
+  {-# INLINE cpure #-}
+instance CPointed (Either a)
+instance CPointed U1
+instance CPointed Proxy
+instance (Pt.Pointed f) => CPointed (Rec1 f) where
+  cpure = Pt.point
+  {-# INLINE cpure #-}
+instance (Pt.Pointed p, Pt.Pointed q)
+      => CPointed (p :*: q) where
+  cpure a = (:*:) (Pt.point a) (Pt.point a)
+  {-# INLINE cpure #-}
+instance (Pt.Pointed p, Pt.Pointed q)
+      => CPointed (p :.: q) where
+  cpure a = Comp1 $ Pt.point $ Pt.point a
+  {-# INLINE cpure #-}
+instance (Constrained p, Constrained q, Pt.Pointed p, Pt.Pointed q)
+      => CPointed (SOP.Compose p q) where
+  cpure a = SOP.Compose $ Pt.point $ Pt.point a
+  {-# INLINE cpure #-}
+instance (CPointed p, CPointed q)
+      => CPointed (SOP.Product p q) where
+  cpure a = SOP.Pair (cpure a) (cpure a)
+  {-# INLINE cpure #-}
+instance CPointed ReadP
+instance CPointed ReadPrec
+instance CPointed (WrapMono IS.IntSet) where
+  cpure = WrapMono . IS.singleton
+  {-# INLINE cpure #-}
+instance CPointed HS.HashSet where
+  cpure = HS.singleton
+  {-# INLINE cpure #-}
+
+instance MonoPointed mono => CPointed (WrapMono mono) where
+  cpure = opoint
+
+instance CPointed V.Vector where
+  cpure = V.singleton
+  {-# INLINE [1] cpure #-}
+
+instance CPointed U.Vector where
+  cpure = U.singleton
+  {-# INLINE [1] cpure #-}
+
+instance CPointed S.Vector where
+  cpure = S.singleton
+  {-# INLINE [1] cpure #-}
+
+instance CPointed P.Vector where
+  cpure = P.singleton
+  {-# INLINE [1] cpure #-}
+
+instance CPointed PA.PrimArray where
+  cpure = PA.replicatePrimArray 1
+  {-# INLINE [1] cpure #-}
+
+instance CPointed SA.SmallArray where
+  cpure = SA.smallArrayFromListN 1 . pure
+  {-# INLINE [1] cpure #-}
+
+instance CPointed A.Array where
+  cpure = A.fromListN 1 . pure
+  {-# INLINE [1] cpure #-}
diff --git a/src/Control/Subcategory/RebindableSyntax.hs b/src/Control/Subcategory/RebindableSyntax.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Subcategory/RebindableSyntax.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+module Control.Subcategory.RebindableSyntax
+  ( ifThenElse, Eq(..), Num(..)
+  , (>>=), (>>), fromLabel, return
+  , module Control.Arrow
+  ) where
+import Control.Subcategory.Applicative
+import Control.Subcategory.Bind
+import Control.Subcategory.Functor
+import Control.Subcategory.Pointed
+
+import Control.Arrow
+import GHC.OverloadedLabels
+import Prelude              (Bool (..), Eq (..), Num (..))
+
+ifThenElse :: Bool -> a -> a -> a
+ifThenElse True t _  = t
+ifThenElse False _ f = f
+{-# INLINE ifThenElse #-}
+
+(>>=) :: (Dom m a, Dom m b, CBind m)
+      => m a -> (a -> m b) -> m b
+(>>=) = (>>-)
+{-# INLINE (>>=) #-}
+
+(>>) :: (Dom m a, Dom m b, CApplicative m)
+      => m a -> m b -> m b
+(>>) = (.>)
+{-# INLINE (>>) #-}
+
+return :: (Dom m a, CPointed m) => a -> m a
+return = cpure
+{-# INLINE return #-}
diff --git a/src/Control/Subcategory/Semialign.hs b/src/Control/Subcategory/Semialign.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Subcategory/Semialign.hs
@@ -0,0 +1,302 @@
+{-# LANGUAGE BangPatterns, CPP, DerivingStrategies, DerivingVia         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiWayIf, StandaloneDeriving #-}
+{-# LANGUAGE TypeOperators                                              #-}
+module Control.Subcategory.Semialign
+  ( CSemialign(..), CAlign(..),
+    csalign, cpadZip, cpadZipWith
+  ) where
+import           Control.Applicative                  (ZipList)
+import           Control.Monad                        (forM_)
+import           Control.Monad.ST.Strict              (runST)
+import           Control.Subcategory.Functor
+import           Control.Subcategory.Wrapper.Internal
+import           Data.Bifunctor                       (Bifunctor (bimap))
+import           Data.Coerce
+import           Data.Containers
+import           Data.Functor.Compose                 (Compose (..))
+import           Data.Functor.Identity                (Identity)
+import qualified Data.Functor.Product                 as SOP
+import           Data.Hashable                        (Hashable)
+import           Data.HashMap.Strict                  (HashMap)
+import           Data.IntMap.Strict                   (IntMap)
+import qualified Data.IntSet                          as IS
+import           Data.List.NonEmpty                   (NonEmpty)
+import           Data.Map                             (Map)
+import           Data.MonoTraversable
+import qualified Data.Primitive.Array                 as A
+import qualified Data.Primitive.PrimArray             as PA
+import qualified Data.Primitive.SmallArray            as SA
+import           Data.Proxy                           (Proxy)
+import           Data.Semialign
+import           Data.Semigroup                       (Option (..))
+import           Data.Sequence                        (Seq)
+import qualified Data.Sequences                       as MT
+import           Data.These                           (These (..), fromThese,
+                                                       mergeThese)
+import           Data.Tree                            (Tree)
+import qualified Data.Vector                          as V
+import qualified Data.Vector.Primitive                as P
+import qualified Data.Vector.Storable                 as S
+import qualified Data.Vector.Unboxed                  as U
+import           GHC.Generics                         ((:*:) (..), (:.:) (..))
+
+class CFunctor f => CSemialign f where
+  {-# MINIMAL calignWith #-}
+  calignWith
+    :: (Dom f a, Dom f b, Dom f c)
+    => (These a b -> c) -> f a -> f b -> f c
+  calign
+    :: (Dom f a, Dom f b, Dom f (These a b))
+    => f a -> f b -> f (These a b)
+  {-# INLINE [1] calign #-}
+  calign = calignWith id
+
+instance Semialign f => CSemialign (WrapFunctor f) where
+  calignWith = alignWith
+  {-# INLINE [1] calignWith #-}
+  calign = align
+  {-# INLINE [1] calign #-}
+
+instance {-# OVERLAPPING #-}  CSemialign (WrapMono IS.IntSet) where
+  calignWith f = withMonoCoercible @IS.IntSet $
+    coerce @(IS.IntSet -> IS.IntSet -> IS.IntSet) $ \ l r ->
+    let ints = l `IS.intersection` r
+    in IS.unions
+          [ IS.map (f . This) l
+          , IS.map (f . That) r
+          , IS.map (\x -> f $ These x x) ints
+          ]
+  {-# INLINE [1] calignWith #-}
+
+class CSemialign f => CAlign f where
+  cnil :: Dom f a => f a
+
+instance Align f => CAlign (WrapFunctor f) where
+  cnil = WrapFunctor nil
+  {-# INLINE [1] cnil #-}
+
+deriving via WrapFunctor [] instance CSemialign []
+deriving via WrapFunctor [] instance CAlign []
+deriving via WrapFunctor Maybe instance CSemialign Maybe
+deriving via WrapFunctor Maybe instance CAlign Maybe
+#if MIN_VERSION_semialign(1,1,0)
+deriving via WrapFunctor Option instance CSemialign Option
+deriving via WrapFunctor Option instance CAlign Option
+#else
+deriving newtype instance CSemialign Option
+deriving newtype instance CAlign Option
+#endif
+
+deriving via WrapFunctor ZipList instance CSemialign ZipList
+deriving via WrapFunctor ZipList instance CAlign ZipList
+deriving via WrapFunctor Identity instance CSemialign Identity
+deriving via WrapFunctor NonEmpty instance CSemialign NonEmpty
+deriving via WrapFunctor IntMap instance CSemialign IntMap
+deriving via WrapFunctor IntMap instance CAlign IntMap
+deriving via WrapFunctor Tree instance CSemialign Tree
+deriving via WrapFunctor Seq instance CSemialign Seq
+deriving via WrapFunctor Seq instance CAlign Seq
+deriving via WrapFunctor V.Vector instance CSemialign V.Vector
+deriving via WrapFunctor V.Vector instance CAlign V.Vector
+deriving via WrapFunctor Proxy instance CSemialign Proxy
+deriving via WrapFunctor Proxy instance CAlign Proxy
+deriving via WrapFunctor (Map k) instance Ord k => CSemialign (Map k)
+deriving via WrapFunctor (Map k) instance Ord k => CAlign (Map k)
+deriving via WrapFunctor (HashMap k)
+  instance (Eq k, Hashable k) => CSemialign (HashMap k)
+deriving via WrapFunctor (HashMap k)
+  instance (Eq k, Hashable k) => CAlign (HashMap k)
+deriving via WrapFunctor ((->) s) instance CSemialign ((->) s)
+
+instance (CSemialign f, CSemialign g) => CSemialign (SOP.Product f g) where
+  calign (SOP.Pair a b) (SOP.Pair c d) = SOP.Pair (calign a c) (calign b d)
+  {-# INLINE [1] calign #-}
+  calignWith f (SOP.Pair a b) (SOP.Pair c d) =
+    SOP.Pair (calignWith f a c) (calignWith f b d)
+  {-# INLINE [1] calignWith #-}
+
+instance (CAlign f, CAlign g) => CAlign (SOP.Product f g) where
+  cnil = SOP.Pair cnil cnil
+  {-# INLINE [1] cnil #-}
+
+instance (CSemialign f, CSemialign g) => CSemialign (f :*: g) where
+  calign ((:*:) a b) ((:*:) c d) = (:*:) (calign a c) (calign b d)
+  {-# INLINE [1] calign #-}
+  calignWith f ((:*:) a b) ((:*:) c d) =
+    (:*:) (calignWith f a c) (calignWith f b d)
+  {-# INLINE [1] calignWith #-}
+
+instance (CAlign f, CAlign g) => CAlign (f :*: g) where
+  cnil = cnil :*: cnil
+  {-# INLINE [1] cnil #-}
+
+instance (CSemialign f, CSemialign g) => CSemialign (Compose f g) where
+  calignWith f (Compose x) (Compose y) = Compose (calignWith g x y)
+    where
+      g (This ga)     = cmap (f . This) ga
+      g (That gb)     = cmap (f . That) gb
+      g (These ga gb) = calignWith f ga gb
+  {-# INLINE [1] calignWith #-}
+
+instance (CAlign f, CSemialign g) => CAlign (Compose f g) where
+  cnil = Compose cnil
+  {-# INLINE [1] cnil #-}
+
+instance (CSemialign f, CSemialign g) => CSemialign ((:.:) f g) where
+  calignWith f (Comp1 x) (Comp1 y) = Comp1 (calignWith g x y)
+    where
+      g (This ga)     = cmap (f . This) ga
+      g (That gb)     = cmap (f . That) gb
+      g (These ga gb) = calignWith f ga gb
+  {-# INLINE [1] calignWith #-}
+
+instance (CAlign f, CSemialign g) => CAlign ((:.:) f g) where
+  cnil = Comp1 cnil
+  {-# INLINE [1] cnil #-}
+
+instance CSemialign U.Vector where
+  calignWith = alignVectorWith
+  {-# INLINE [1] calignWith #-}
+
+instance CAlign U.Vector where
+  cnil = U.empty
+  {-# INLINE [1] cnil #-}
+
+instance CSemialign S.Vector where
+  calignWith = alignVectorWith
+  {-# INLINE [1] calignWith #-}
+
+instance CAlign S.Vector where
+  cnil = S.empty
+  {-# INLINE [1] cnil #-}
+
+instance CSemialign P.Vector where
+  calignWith = alignVectorWith
+  {-# INLINE [1] calignWith #-}
+
+instance CAlign P.Vector where
+  cnil = P.empty
+  {-# INLINE [1] cnil #-}
+
+instance CSemialign SA.SmallArray where
+  calignWith f l r = runST $ do
+    let !lenL = length l
+        !lenR = length r
+        (isLftShort, thresh, len)
+          | lenL < lenR = (True, lenL, lenR)
+          | otherwise = (False, lenR, lenL)
+    sa <- SA.newSmallArray len (error "Uninitialised element")
+    forM_ [0..len-1] $ \n ->
+      if  | n == len -> pure ()
+          | n < thresh ->
+            SA.writeSmallArray sa n
+            $ f $ These
+              (SA.indexSmallArray l n)
+              (SA.indexSmallArray r n)
+          | isLftShort ->
+            SA.writeSmallArray sa n
+            $ f $ That $ SA.indexSmallArray r n
+          | otherwise ->
+            SA.writeSmallArray sa n
+            $ f $ This $ SA.indexSmallArray l n
+    SA.unsafeFreezeSmallArray sa
+  {-# INLINE [1] calignWith #-}
+
+instance CAlign SA.SmallArray where
+  cnil = SA.smallArrayFromListN 0 []
+  {-# INLINE [1] cnil #-}
+
+instance CSemialign A.Array where
+  calignWith f l r = runST $ do
+    let !lenL = length l
+        !lenR = length r
+        (isLftShort, thresh, len)
+          | lenL < lenR = (True, lenL, lenR)
+          | otherwise = (False, lenR, lenL)
+    sa <- A.newArray len (error "Uninitialised element")
+    forM_ [0..len-1] $ \n ->
+      if  | n == len -> pure ()
+          | n < thresh ->
+            A.writeArray sa n
+            $ f $ These
+              (A.indexArray l n)
+              (A.indexArray r n)
+          | isLftShort ->
+            A.writeArray sa n
+            $ f $ That $ A.indexArray r n
+          | otherwise ->
+            A.writeArray sa n
+            $ f $ This $ A.indexArray l n
+    A.unsafeFreezeArray sa
+  {-# INLINE [1] calignWith #-}
+
+instance CAlign A.Array where
+  cnil = A.fromListN 0 []
+  {-# INLINE [1] cnil #-}
+
+instance CSemialign PA.PrimArray where
+  calignWith f l r = runST $ do
+    let !lenL = PA.sizeofPrimArray l
+        !lenR = PA.sizeofPrimArray r
+        (isLftShort, thresh, len)
+          | lenL < lenR = (True, lenL, lenR)
+          | otherwise = (False, lenR, lenL)
+    sa <- PA.newPrimArray len
+    forM_ [0..len-1] $ \n ->
+      if  | n == len -> pure ()
+          | n < thresh ->
+            PA.writePrimArray sa n
+            $ f $ These
+              (PA.indexPrimArray l n)
+              (PA.indexPrimArray r n)
+          | isLftShort ->
+            PA.writePrimArray sa n
+            $ f $ That $ PA.indexPrimArray r n
+          | otherwise ->
+            PA.writePrimArray sa n
+            $ f $ This $ PA.indexPrimArray l n
+    PA.unsafeFreezePrimArray sa
+  {-# INLINE [1] calignWith #-}
+
+instance CAlign PA.PrimArray where
+  cnil = PA.primArrayFromListN 0 []
+  {-# INLINE [1] cnil #-}
+
+instance (MT.IsSequence mono, MonoZip mono)
+  => CSemialign (WrapMono mono) where
+  calignWith f = coerce go
+    where
+      go :: mono -> mono -> mono
+      go ls rs
+        | lenL == lenR = ozipWith (fmap f . These) ls rs
+        | lenL < lenR  =
+            ozipWith (fmap f . These) ls rs
+            <> omap (f . That) (MT.drop (fromIntegral lenL) rs)
+        | otherwise  =
+            ozipWith (fmap f . These) ls rs
+            <> omap (f . This) (MT.drop (fromIntegral lenL) ls)
+        where lenL = olength ls
+              lenR = olength rs
+
+instance (MT.IsSequence mono, MonoZip mono)
+  => CAlign (WrapMono mono) where
+  cnil = WrapMono mempty
+
+csalign :: (CSemialign f, Dom f a, Semigroup a)
+  => f a -> f a -> f a
+{-# INLINE [1] csalign #-}
+csalign = calignWith $ mergeThese (<>)
+
+cpadZip
+  :: (CSemialign f, Dom f a, Dom f b, Dom f (Maybe a, Maybe b))
+  => f a -> f b -> f (Maybe a, Maybe b)
+{-# INLINE [1] cpadZip #-}
+cpadZip = calignWith (fromThese Nothing Nothing . bimap Just Just)
+
+cpadZipWith
+  :: (CSemialign f, Dom f a, Dom f b, Dom f c)
+  => (Maybe a -> Maybe b -> c)
+  -> f a -> f b -> f c
+{-# INLINE [1] cpadZipWith #-}
+cpadZipWith f = calignWith $
+  uncurry f . fromThese Nothing Nothing . bimap Just Just
diff --git a/src/Control/Subcategory/Wrapper/Internal.hs b/src/Control/Subcategory/Wrapper/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Subcategory/Wrapper/Internal.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE CPP, GADTs, InstanceSigs, KindSignatures, PatternSynonyms #-}
+{-# LANGUAGE RankNTypes, RoleAnnotations, ScopedTypeVariables          #-}
+{-# LANGUAGE StandaloneDeriving, TemplateHaskell, TypeApplications     #-}
+{-# LANGUAGE TypeFamilies, TypeOperators, UndecidableSuperClasses      #-}
+module Control.Subcategory.Wrapper.Internal where
+import Control.Applicative
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 808
+import Control.Monad.Fail
+#endif
+import Control.Monad.Fix    (MonadFix)
+import Control.Monad.Zip    (MonadZip)
+import Data.Coerce
+import Data.Kind            (Type)
+import Data.MonoTraversable
+import Data.Pointed
+import Data.Semialign       (Align, Unalign)
+import Data.Zip             (Semialign, Unzip, Zip)
+import GHC.Base             (MonadPlus)
+
+newtype WrapFunctor f (a :: Type) = WrapFunctor {runFunctor :: f a}
+  deriving newtype (Functor, Applicative, Alternative, Monad, Foldable)
+  deriving newtype (MonadPlus, MonadFix, MonadFail)
+  deriving newtype (Pointed, MonadZip, Unalign, Align, Semialign, Zip,  Unzip)
+
+instance Traversable f => Traversable (WrapFunctor f) where
+  traverse f = fmap WrapFunctor . traverse f . runFunctor
+
+
+type role WrapMono representational nominal
+-- | Similar to 'WrappedMono' from @mono-traversable,
+--   but uses @newtype@ instaed of GADTs, which is efficient.
+--   To restrict the construction, we hide genuine constructor
+--   and expose the constrained pattern synonym 'WrapMono' and
+--   specifies type roles tightly (note: the role for @mono@
+--   should NOT be representational honestly; indeed, @WrapMono mono a@
+--   could be coerced to @WrapMono mono' a@ iff @mono@ and @mono' are
+--   representationally equivalent __AND__ @Element a ~ Element a@.)
+newtype WrapMono mono b = WrapMono' mono
+  deriving newtype (MonoFoldable, MonoFunctor, Monoid, Semigroup, MonoPointed)
+  deriving newtype (GrowingAppend)
+
+type instance Element (WrapMono mono b) = Element mono
+
+pattern WrapMono :: b ~ Element mono => b ~ Element mono => mono -> WrapMono mono b
+pattern WrapMono {unwrapMono} = WrapMono' unwrapMono
+
+coerceToMono :: WrapMono mono (Element mono) -> mono
+{-# INLINE coerceToMono #-}
+coerceToMono = coerce
+
+withMonoCoercible
+  :: (Coercible (WrapMono mono (Element mono)) mono => r)
+  -> r
+{-# INLINE withMonoCoercible #-}
+withMonoCoercible = id
diff --git a/src/Control/Subcategory/Zip.hs b/src/Control/Subcategory/Zip.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Subcategory/Zip.hs
@@ -0,0 +1,386 @@
+{-# LANGUAGE CPP, DerivingVia, StandaloneDeriving, TypeOperators #-}
+module Control.Subcategory.Zip
+  ( CZip(..),
+    CUnzip(..),
+    cunzipDefault,
+    CZippy(..),
+    CRepeat(..),
+    module Control.Subcategory.Semialign
+  ) where
+import           Control.Applicative                  (ZipList (..))
+import           Control.Arrow                        (Arrow ((&&&)), (***))
+import           Control.Monad.Zip                    (MonadZip (mzip),
+                                                       mzipWith)
+import           Control.Subcategory.Functor
+import           Control.Subcategory.Semialign
+import           Control.Subcategory.Wrapper.Internal
+import           Data.Coerce                          (coerce)
+import           Data.Containers
+import           Data.Functor.Compose                 (Compose (..))
+import           Data.Functor.Identity
+import qualified Data.Functor.Product                 as SOP
+import           Data.Hashable                        (Hashable)
+import qualified Data.HashMap.Strict                  as HM
+import qualified Data.IntMap.Strict                   as IM
+import qualified Data.List.NonEmpty                   as NE
+import qualified Data.Map.Strict                      as M
+import           Data.MonoTraversable
+import qualified Data.Primitive.Array                 as A
+import qualified Data.Primitive.PrimArray             as PA
+import qualified Data.Primitive.SmallArray            as SA
+import           Data.Proxy
+import           Data.Semigroup                       (Option (..))
+import qualified Data.Sequence                        as Seq
+import qualified Data.Sequences                       as MT
+import           Data.Tree
+import qualified Data.Vector                          as V
+import qualified Data.Vector.Generic                  as G
+import qualified Data.Vector.Primitive                as Prim
+import qualified Data.Vector.Primitive                as PV
+import qualified Data.Vector.Storable                 as S
+import qualified Data.Vector.Unboxed                  as U
+import           Data.Zip
+import           GHC.Generics                         ((:*:) (..), (:.:) (..))
+import           Prelude                              hiding (repeat, unzip,
+                                                       zip, zipWith)
+import qualified Prelude                              as P
+
+class CSemialign f => CZip f where
+  czipWith
+    :: (Dom f a, Dom f b, Dom f c)
+    => (a -> b -> c) -> f a -> f b -> f c
+  czip
+    :: (Dom f a, Dom f b, Dom f (a, b))
+    => f a -> f b -> f (a, b)
+  {-# INLINE [1] czip #-}
+  czip = czipWith (,)
+
+instance Zip f => CZip (WrapFunctor f) where
+  czip = zip
+  {-# INLINE [1] czip #-}
+  czipWith = zipWith
+  {-# INLINE [1] czipWith #-}
+
+deriving via WrapFunctor [] instance CZip []
+deriving via WrapFunctor Maybe instance CZip Maybe
+deriving newtype instance CZip Option
+deriving via WrapFunctor ZipList instance CZip ZipList
+deriving via WrapFunctor Identity instance CZip Identity
+deriving via WrapFunctor NE.NonEmpty instance CZip NE.NonEmpty
+deriving via WrapFunctor Tree instance CZip Tree
+deriving via WrapFunctor ((->) e) instance CZip ((->) e)
+
+#if MIN_VERSION_semialign(1,1,0)
+deriving via WrapFunctor Seq.Seq instance CZip Seq.Seq
+deriving via WrapFunctor (M.Map k) instance Ord k => CZip (M.Map k)
+deriving via WrapFunctor (HM.HashMap k)
+  instance (Eq k, Hashable k)
+  => CZip (HM.HashMap k)
+deriving via WrapFunctor IM.IntMap instance CZip IM.IntMap
+#else
+instance CZip Seq.Seq where
+  czipWith = Seq.zipWith
+  {-# INLINE [1] czipWith #-}
+  czip = Seq.zip
+  {-# INLINE [1] czip #-}
+instance Ord k => CZip (M.Map k) where
+  czipWith = M.intersectionWith
+  {-# INLINE [1] czipWith #-}
+instance (Eq k, Hashable k) => CZip (HM.HashMap k) where
+  czipWith = HM.intersectionWith
+  {-# INLINE [1] czipWith #-}
+instance CZip IM.IntMap where
+  czipWith = IM.intersectionWith
+  {-# INLINE [1] czipWith #-}
+#endif
+
+
+instance CZip V.Vector where
+  czip = V.zip
+  {-# INLINE [1] czip #-}
+  czipWith = V.zipWith
+  {-# INLINE [1] czipWith #-}
+
+instance CZip U.Vector where
+  czip = U.zip
+  {-# INLINE [1] czip #-}
+  czipWith = U.zipWith
+  {-# INLINE [1] czipWith #-}
+
+instance CZip S.Vector where
+  czipWith = S.zipWith
+  {-# INLINE [1] czipWith #-}
+
+instance CZip Prim.Vector where
+  czipWith = Prim.zipWith
+  {-# INLINE [1] czipWith #-}
+
+instance CZip Proxy where
+  czip = const $ const Proxy
+  {-# INLINE czip #-}
+  czipWith = const $ const $ const Proxy
+  {-# INLINE czipWith #-}
+
+instance (CZip f, CZip g) => CZip (SOP.Product f g) where
+  czipWith f (SOP.Pair a b) (SOP.Pair c d) =
+    SOP.Pair (czipWith f a c) (czipWith f b d)
+  {-# INLINE [1] czipWith #-}
+  czip (SOP.Pair a b) (SOP.Pair c d) =
+    SOP.Pair (czip a c) (czip b d)
+  {-# INLINE [1] czip #-}
+
+instance (CZip f, CZip g) => CZip (f :*: g) where
+  czipWith f (a :*: b) (c :*: d) =
+    czipWith f a c :*: czipWith f b d
+  {-# INLINE [1] czipWith #-}
+  czip (a :*: b) (c :*: d) =
+    czip a c :*: czip b d
+  {-# INLINE [1] czip #-}
+
+instance (CZip f, CZip g) => CZip (Compose f g) where
+  czipWith f (Compose a) (Compose b) =
+    Compose $ czipWith (czipWith f) a b
+  {-# INLINE [1] czipWith #-}
+  czip (Compose a) (Compose b) =
+    Compose $ czipWith czip a b
+  {-# INLINE [1] czip #-}
+
+instance (CZip f, CZip g) => CZip (f :.: g) where
+  czipWith f (Comp1 a) (Comp1 b) =
+    Comp1 $ czipWith (czipWith f) a b
+  {-# INLINE [1] czipWith #-}
+  czip (Comp1 a) (Comp1 b) =
+    Comp1 $ czipWith czip a b
+  {-# INLINE [1] czip #-}
+
+{-# RULES
+"czip/List"
+  czip = P.zip
+"czipWith/List"
+  czipWith = P.zipWith
+"czip/NonEmpty"
+  czip = NE.zip
+"czipWith/NonEmpty"
+  czipWith = NE.zipWith
+"czip/Seq"
+  czip = Seq.zip
+"czipWith/Seq"
+  czipWith = Seq.zipWith
+  #-}
+
+class CZip f => CRepeat f where
+  crepeat :: Dom f a => a -> f a
+
+newtype CZippy f a = CZippy { runCZippy :: f a }
+  deriving (Show, Read)
+  deriving newtype (Functor, Zip, Semialign, Eq, Ord)
+  deriving newtype (Constrained)
+#if MIN_VERSION_semialign(1,1,0)
+  deriving newtype (Repeat)
+#endif
+
+instance CFunctor f => CFunctor (CZippy f) where
+  cmap = coerce $ cmap @f @a @b
+    :: forall a b. (Dom f a, Dom f b) => (a -> b) -> CZippy f a -> CZippy f b
+  {-# INLINE [1] cmap #-}
+
+instance CSemialign f => CSemialign (CZippy f) where
+  calignWith = \f -> coerce $ calignWith @f f
+  {-# INLINE [1] calignWith #-}
+
+instance CZip f => CZip (CZippy f) where
+  czipWith f = coerce $ czipWith @f f
+  {-# INLINE [1] czipWith #-}
+
+instance CRepeat f => CRepeat (CZippy f) where
+  crepeat = CZippy . crepeat
+  {-# INLINE [1] crepeat #-}
+
+instance (CZip f, Dom f a, Semigroup a) => Semigroup (CZippy f a) where
+  (<>) = coerce $ czipWith @f ((<>) @a)
+  {-# INLINE [1] (<>) #-}
+
+instance (CRepeat f, Dom f a, Monoid a) => Monoid (CZippy f a) where
+  mempty = coerce $ crepeat @f (mempty @a)
+  {-# INLINE [1] mempty #-}
+
+#if MIN_VERSION_semialign(1,1,0)
+instance Repeat f => CRepeat (WrapFunctor f) where
+  crepeat = coerce $ repeat @f @a
+    :: forall a. a -> WrapFunctor f a
+  {-# INLINE [1] crepeat #-}
+deriving via WrapFunctor [] instance CRepeat []
+deriving via WrapFunctor Maybe instance CRepeat Maybe
+deriving newtype instance CRepeat Option
+deriving via WrapFunctor ZipList instance CRepeat ZipList
+deriving via WrapFunctor Identity instance CRepeat Identity
+deriving via WrapFunctor NE.NonEmpty instance CRepeat NE.NonEmpty
+deriving via WrapFunctor Tree instance CRepeat Tree
+deriving via WrapFunctor ((->) e) instance CRepeat ((->) e)
+#else
+instance CRepeat [] where
+  crepeat = P.repeat
+  {-# INLINE [1] crepeat #-}
+instance CRepeat Maybe where
+  crepeat = Just
+  {-# INLINE [1] crepeat #-}
+deriving newtype instance CRepeat Option
+deriving newtype instance CRepeat ZipList
+instance CRepeat Identity where
+  crepeat = Identity
+  {-# INLINE [1] crepeat #-}
+instance CRepeat NE.NonEmpty where
+  crepeat = NE.repeat
+  {-# INLINE [1] crepeat #-}
+instance CRepeat Tree where
+  crepeat x = n where n = Node x (P.repeat n)
+  {-# INLINE [1] crepeat #-}
+instance CRepeat Proxy where
+  crepeat = const Proxy
+  {-# INLINE [1] crepeat #-}
+instance CRepeat ((->) e) where
+  crepeat = const
+  {-# INLINE [1] crepeat #-}
+#endif
+
+instance CZip SA.SmallArray where
+  czip = mzip
+  {-# INLINE [1] czip #-}
+  czipWith = mzipWith
+  {-# INLINE [1] czipWith #-}
+
+instance CZip A.Array where
+  czip = mzip
+  {-# INLINE [1] czip #-}
+  czipWith = mzipWith
+  {-# INLINE [1] czipWith #-}
+
+instance CZip PA.PrimArray where
+  czipWith f l r =
+    PA.generatePrimArray
+      (PA.sizeofPrimArray l `min` PA.sizeofPrimArray r) $ \n ->
+        f (PA.indexPrimArray l n) (PA.indexPrimArray r n)
+  {-# INLINE [1] czipWith #-}
+
+class CZip f => CUnzip f where
+  cunzip
+    :: (Dom f (a, b), Dom f a, Dom f b)
+    => f (a, b) -> (f a, f b)
+  {-# INLINE [1] cunzip #-}
+  cunzip = cunzipWith id
+
+  cunzipWith
+    :: (Dom f c, Dom f a, Dom f b)
+    => (c -> (a, b)) -> f c -> (f a, f b)
+
+cunzipDefault
+  :: (CFunctor f, Dom f (a, b), Dom f a, Dom f b)
+  => f (a, b) -> (f a, f b)
+{-# INLINE cunzipDefault #-}
+cunzipDefault = cmap fst &&& cmap snd
+
+#if MIN_VERSION_semialign(1,1,0)
+instance Unzip f => CUnzip (WrapFunctor f) where
+#else
+instance (Zip f, Unzip f) => CUnzip (WrapFunctor f) where
+#endif
+  cunzip :: forall a b. WrapFunctor f (a, b) -> (WrapFunctor f a, WrapFunctor f b)
+  {-# INLINE cunzip #-}
+  cunzip = coerce $ unzip @f @a @b
+  {-# INLINE cunzipWith #-}
+  cunzipWith = coerce $ unzipWith @f @c @a @b
+    :: forall a b c. (c -> (a, b)) -> WrapFunctor f c -> (WrapFunctor f a, WrapFunctor f b)
+
+instance CUnzip [] where
+  cunzip = P.unzip
+  {-# INLINE [1] cunzip #-}
+  cunzipWith = \f -> P.unzip . map f
+  {-# INLINE [1] cunzipWith #-}
+
+deriving via WrapFunctor Maybe instance CUnzip Maybe
+#if MIN_VERSION_semialign(1,1,0)
+deriving via WrapFunctor Option instance CUnzip Option
+#endif
+deriving via [] instance CUnzip ZipList
+deriving via WrapFunctor Identity instance CUnzip Identity
+deriving via WrapFunctor NE.NonEmpty instance CUnzip NE.NonEmpty
+deriving via WrapFunctor Tree instance CUnzip Tree
+instance CUnzip V.Vector where
+  cunzip = V.unzip
+  {-# INLINE [1] cunzip #-}
+  cunzipWith = \f -> V.unzip . V.map f
+  {-# INLINE [1] cunzipWith #-}
+instance CUnzip U.Vector where
+  cunzip = U.unzip
+  {-# INLINE [1] cunzip #-}
+  cunzipWith = \f -> U.unzip . U.map f
+  {-# INLINE [1] cunzipWith #-}
+
+instance CUnzip PV.Vector where
+  cunzip = G.unzip
+  {-# INLINE [1] cunzip #-}
+  cunzipWith = \f ->
+    (G.convert *** G.convert)  . cunzipWith @V.Vector f . V.convert
+  {-# INLINE [1] cunzipWith #-}
+
+instance CUnzip S.Vector where
+  cunzip = G.unzip
+  {-# INLINE [1] cunzip #-}
+  cunzipWith = \f ->
+    (G.convert *** G.convert)  . cunzipWith @V.Vector f . V.convert
+  {-# INLINE [1] cunzipWith #-}
+deriving via WrapFunctor Proxy instance CUnzip Proxy
+#if MIN_VERSION_semialign(1,1,0)
+deriving via WrapFunctor Seq.Seq instance CUnzip Seq.Seq
+deriving via WrapFunctor (M.Map k) instance Ord k => CUnzip (M.Map k)
+deriving via WrapFunctor IM.IntMap instance CUnzip IM.IntMap
+deriving via WrapFunctor (HM.HashMap k)
+  instance (Eq k, Hashable k) => CUnzip (HM.HashMap k)
+#endif
+
+instance (CUnzip f, CUnzip g) => CUnzip (SOP.Product f g) where
+  cunzipWith f (SOP.Pair a b)  =
+    (SOP.Pair al bl, SOP.Pair ar br)
+    where
+      ~(al, ar) = cunzipWith f a
+      ~(bl, br) = cunzipWith f b
+  {-# INLINE [1] cunzipWith #-}
+  cunzip (SOP.Pair a b)  =
+    (SOP.Pair al bl, SOP.Pair ar br)
+    where
+      ~(al, ar) = cunzip a
+      ~(bl, br) = cunzip b
+  {-# INLINE [1] cunzip #-}
+
+instance (CUnzip f, CUnzip g) => CUnzip (f :*: g) where
+  cunzipWith f (a :*: b)  =
+    (al :*: bl, ar :*: br)
+    where
+      ~(al, ar) = cunzipWith f a
+      ~(bl, br) = cunzipWith f b
+  {-# INLINE [1] cunzipWith #-}
+  cunzip (a :*: b)  =
+    (al :*: bl, ar :*: br)
+    where
+      ~(al, ar) = cunzip a
+      ~(bl, br) = cunzip b
+  {-# INLINE [1] cunzip #-}
+
+instance (CUnzip f, CUnzip g) => CUnzip (Compose f g) where
+  cunzipWith f (Compose a) = (Compose y, Compose z) where
+    ~(y, z) = cunzipWith (cunzipWith f) a
+  {-# INLINE [1] cunzipWith #-}
+
+instance (CUnzip f, CUnzip g) => CUnzip (f :.: g) where
+  cunzipWith f (Comp1 a) = (Comp1 y, Comp1 z) where
+    ~(y, z) = cunzipWith (cunzipWith f) a
+  {-# INLINE [1] cunzipWith #-}
+
+instance (MT.IsSequence mono, MonoZip mono)
+  => CZip (WrapMono mono) where
+    czipWith f = coerce $ ozipWith @mono f
+    {-# INLINE [1] czipWith #-}
+
+instance (MT.IsSequence mono, MonoZip mono)
+  => CUnzip (WrapMono mono) where
+    cunzipWith f = coerce $ omap @mono (fst . f) &&& omap @mono (snd . f)
diff --git a/subcategories.cabal b/subcategories.cabal
new file mode 100644
--- /dev/null
+++ b/subcategories.cabal
@@ -0,0 +1,112 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.33.0.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: 06bb5130d08da403db0bdee15f708a050dca4d9ba1adb757dd932c9586b3b0c2
+
+name:           subcategories
+version:        0.1.0.0
+synopsis:       Subcategories induced by class constraints
+description:    Please see the README on GitHub at <https://github.com/konn/subcategories#readme>
+category:       Data
+homepage:       https://github.com/konn/subcategories#readme
+bug-reports:    https://github.com/konn/subcategories/issues
+author:         Hiromi ISHII
+maintainer:     konn.jinro _at_ gmail.com
+copyright:      2018 (c) Hiromi ISHII
+license:        BSD3
+license-file:   LICENSE
+tested-with:    GHC == 8.6.5, GHC == 8.8.3, GHC == 8.10.1
+build-type:     Simple
+extra-source-files:
+    README.md
+    ChangeLog.md
+
+source-repository head
+  type: git
+  location: https://github.com/konn/subcategories
+
+library
+  exposed-modules:
+      Control.Subcategory
+      Control.Subcategory.Alternative
+      Control.Subcategory.Alternative.Class
+      Control.Subcategory.Applicative
+      Control.Subcategory.Applicative.Class
+      Control.Subcategory.Bind
+      Control.Subcategory.Foldable
+      Control.Subcategory.Functor
+      Control.Subcategory.Pointed
+      Control.Subcategory.RebindableSyntax
+      Control.Subcategory.Semialign
+      Control.Subcategory.Zip
+  other-modules:
+      Control.Subcategory.Wrapper.Internal
+  hs-source-dirs:
+      src
+  default-extensions: ConstraintKinds DataKinds DefaultSignatures DerivingStrategies FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures MultiParamTypeClasses PolyKinds ScopedTypeVariables TypeApplications TypeFamilies TypeInType UndecidableInstances
+  ghc-options: -Wall
+  build-depends:
+      base >=4.7 && <5
+    , containers
+    , data-default
+    , foldl
+    , hashable
+    , mono-traversable
+    , pointed
+    , primitive
+    , reflection
+    , semialign
+    , template-haskell
+    , text
+    , these
+    , unordered-containers
+    , vector
+    , vector-algorithms
+    , vector-builder
+  default-language: Haskell2010
+
+test-suite subcategories-test
+  type: exitcode-stdio-1.0
+  main-is: spec.hs
+  other-modules:
+      Control.Subcategory.FoldableSpec
+      Control.Subcategory.FunctorSpec
+      Control.Subcategory.ZipSpec
+      Shared
+      Paths_subcategories
+  hs-source-dirs:
+      test
+  default-extensions: ConstraintKinds DataKinds DefaultSignatures DerivingStrategies FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures MultiParamTypeClasses PolyKinds ScopedTypeVariables TypeApplications TypeFamilies TypeInType UndecidableInstances
+  ghc-options: -Wall -fno-hpc
+  build-tool-depends:
+      tasty-discover:tasty-discover
+  build-depends:
+      QuickCheck
+    , base >=4.7 && <5
+    , bytestring
+    , containers
+    , data-default
+    , foldl
+    , hashable
+    , inspection-testing
+    , mono-traversable
+    , pointed
+    , primitive
+    , reflection
+    , semialign
+    , subcategories
+    , tasty
+    , tasty-expected-failure
+    , tasty-hunit
+    , tasty-quickcheck
+    , template-haskell
+    , text
+    , these
+    , unordered-containers
+    , vector
+    , vector-algorithms
+    , vector-builder
+  default-language: Haskell2010
diff --git a/test/Control/Subcategory/FoldableSpec.hs b/test/Control/Subcategory/FoldableSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Control/Subcategory/FoldableSpec.hs
@@ -0,0 +1,208 @@
+{-# LANGUAGE AllowAmbiguousTypes, TemplateHaskell #-}
+{-# OPTIONS_GHC -dsuppress-idinfo -dsuppress-coercions
+      -dsuppress-type-applications
+      -dsuppress-module-prefixes -dsuppress-type-signatures
+      -dsuppress-uniques #-}
+module Control.Subcategory.FoldableSpec where
+import Control.Subcategory.Foldable
+import Control.Subcategory.Functor
+
+import           Data.MonoTraversable
+import qualified Data.Vector           as V
+import qualified Data.Vector.Generic   as G
+import qualified Data.Vector.Primitive as P
+import qualified Data.Vector.Storable  as S
+import qualified Data.Vector.Unboxed   as U
+import           Shared
+import           Test.Inspection
+import           Test.Tasty
+
+cfoldr_uvec :: (Int -> b -> b) -> b -> U.Vector Int -> b
+cfoldr_uvec = cfoldr
+
+cfoldr_uvec_poly :: U.Unbox a => (a -> b -> b) -> b -> U.Vector a -> b
+cfoldr_uvec_poly = cfoldr
+
+foldr_uvec :: (Int -> b -> b) -> b -> U.Vector Int -> b
+foldr_uvec = U.foldr
+
+cfoldr_svec :: (Int -> b -> b) -> b -> S.Vector Int -> b
+cfoldr_svec = cfoldr
+
+cfoldr_svec_poly :: S.Storable a => (a -> b -> b) -> b -> S.Vector a -> b
+cfoldr_svec_poly = cfoldr
+
+foldr_svec :: (Int -> b -> b) -> b -> S.Vector Int -> b
+foldr_svec = S.foldr
+
+cfoldr_pvec :: (Int -> b -> b) -> b -> P.Vector Int -> b
+cfoldr_pvec = cfoldr
+
+cfoldr_pvec_poly :: P.Prim a => (a -> b -> b) -> b -> P.Vector a -> b
+cfoldr_pvec_poly = cfoldr
+
+foldr_pvec :: (Int -> b -> b) -> b -> P.Vector Int -> b
+foldr_pvec = P.foldr
+
+cfoldr_bvec :: (a -> b -> b) -> b -> V.Vector a -> b
+cfoldr_bvec = cfoldr
+
+foldr_bvec :: (a -> b -> b) -> b -> V.Vector a -> b
+foldr_bvec = V.foldr
+
+cfoldr_list :: (a -> b -> b) -> b -> [a] -> b
+cfoldr_list = cfoldr
+
+foldr_list :: (a -> b -> b) -> b -> [a] -> b
+foldr_list = foldr
+
+test_cfoldr :: TestTree
+test_cfoldr = testGroup "cfoldr"
+  [ testGroup "List"
+    [ $(inspecting "has the same representation as V.foldr"
+        $ 'cfoldr_list ==- 'foldr_list
+      )
+    , $(inspecting "has no instance dictionary"
+      $ hasNoTypeClasses 'cfoldr_list
+      )
+    ]
+  , testGroup "BVector"
+    [ $(inspecting "has the same representation as V.foldr"
+        $ 'cfoldr_bvec ==- 'foldr_bvec
+      )
+    , $(inspecting "has no instance dictionary except G.Vector"
+      $ 'cfoldr_bvec `hasNoTypeClassesExcept` [''G.Vector]
+      )
+    ]
+  , testGroup "UVector"
+    [ $(inspecting "has the same representation as U.foldr (if an element is concrete)"
+        $ 'cfoldr_uvec ==- 'foldr_uvec
+      )
+    , $(inspecting "has no instance dictionary other than Unbox (if polymorphic)"
+      $ 'cfoldr_uvec_poly `hasNoTypeClassesExcept` [''U.Unbox]
+      )
+    ]
+  , testGroup "SVector"
+    [ $(inspecting "has the same representation as S.foldr (if an element is concrete)"
+        $ 'cfoldr_svec ==- 'foldr_svec
+      )
+    , $(inspecting "has no instance dictionary other than Storable (if polymorphic)"
+      $ 'cfoldr_svec_poly `hasNoTypeClassesExcept` [''S.Storable]
+      )
+    ]
+  , testGroup "PVector"
+    [ $(inspecting "has the same representation as P.foldr (if an element is concrete)"
+        $ 'cfoldr_pvec ==- 'foldr_pvec
+      )
+    , $(inspecting "has no instance dictionary other than Storable (if polymorphic)"
+      $ 'cfoldr_pvec_poly `hasNoTypeClassesExcept` [''P.Prim]
+      )
+    ]
+  ]
+
+cfoldMap_uvec :: Monoid w => (Int -> w) -> U.Vector Int -> w
+cfoldMap_uvec = cfoldMap
+
+ofoldMap_uvec :: Monoid w => (Int -> w) -> U.Vector Int -> w
+ofoldMap_uvec = ofoldMap
+
+test_cfoldMap :: TestTree
+test_cfoldMap = testGroup "cfoldMap"
+    [ testGroup "UVector"
+      [ $(inspecting "has the same rep as ofoldMap (if elements concrete)"
+        $ 'cfoldMap_uvec ==- 'ofoldMap_uvec
+        )
+      ]
+    ]
+
+cinit_list :: [a] -> [a]
+cinit_list = cinit
+
+init_list :: [a] -> [a]
+{-# INLINE init_list #-}
+init_list = init
+
+test_cinit :: TestTree
+test_cinit = testGroup "cinit"
+  [ testGroup "List"
+    [ $(inspecting "has the same represeitation as Prelude.init"
+      $ 'cinit_list ==- 'init_list
+      )
+    ]
+  ]
+
+ctoList_list :: [a] -> [a]
+ctoList_list = ctoList
+
+list_id :: [a] -> [a]
+list_id = id
+
+list_id_lam :: [a] -> [a]
+list_id_lam = \x -> x
+
+cfromList_list :: [a] -> [a]
+cfromList_list = cfromList
+
+test_ctoList :: TestTree
+test_ctoList = testGroup "ctoList"
+  [ testGroup "List"
+    [ $(inspecting "has the same represeitation as Prelude.id"
+      $ 'ctoList_list ==- 'list_id
+      )
+    ]
+  ]
+
+test_cfromList :: TestTree
+test_cfromList = testGroup "cfromList"
+  [ testGroup "List"
+    [ $(inspecting "has the same represeitation as Prelude.id"
+      $ 'cfromList_list ==- 'list_id
+      )
+    ]
+  ]
+
+
+ctoFromList_list :: [a] -> [a]
+ctoFromList_list = ctoList . cfromList @[]
+
+ctoFromList_bvec :: [a] -> [a]
+ctoFromList_bvec xs = ctoList (cfromList @V.Vector xs)
+
+ctoFromList_poly :: forall f a. (CFreeMonoid f, Dom f a) => [a] -> [a]
+ctoFromList_poly xs = ctoList (cfromList @f xs)
+
+list_id_with_constr :: forall f a. (CFreeMonoid f, Dom f a) => [a] -> [a]
+list_id_with_constr = \xs -> xs
+
+test_rules :: TestTree
+test_rules = testGroup "Rewrite rules"
+  [ testGroup "ctoList . cfromList = ctoList"
+    [ $(inspecting "List"
+        $ 'ctoFromList_list ==- 'list_id_lam
+      )
+    , $(inspecting "Boxed vector"
+        $ 'ctoFromList_bvec ==- 'list_id_lam
+      )
+    , $(inspecting "Polymorphic (up to dictionary leftover)"
+        $ 'ctoFromList_poly ==- 'list_id_with_constr
+      )
+    ]
+  ]
+
+cgen_bvec, gen_bvec :: Int -> (Int -> a) -> V.Vector a
+cgen_bvec = cgenerate
+gen_bvec = V.generate
+
+test_generate :: TestTree
+test_generate = testGroup "cgenerate"
+  [ $(inspecting "Boxed Vector" $ 'cgen_bvec ==- 'gen_bvec)
+  ]
+
+crev_list, rev_list :: [a] -> [a]
+crev_list = creverse
+rev_list = reverse
+
+test_reverse :: TestTree
+test_reverse = testGroup "creverse"
+  [ $(inspecting "List" $ 'crev_list ==- 'rev_list)
+  ]
diff --git a/test/Control/Subcategory/FunctorSpec.hs b/test/Control/Subcategory/FunctorSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Control/Subcategory/FunctorSpec.hs
@@ -0,0 +1,231 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -dsuppress-idinfo -dsuppress-coercions
+      -dsuppress-type-applications
+      -dsuppress-module-prefixes -dsuppress-type-signatures
+      -dsuppress-uniques #-}
+module Control.Subcategory.FunctorSpec where
+import Control.Subcategory.Functor
+
+import qualified Data.ByteString           as BS
+import           Data.Hashable             (Hashable)
+import           Data.HashSet              (HashSet)
+import qualified Data.HashSet              as HS
+import           Data.IntSet               (IntSet)
+import qualified Data.IntSet               as IS
+import qualified Data.Primitive.Array      as A
+import qualified Data.Primitive.PrimArray  as PA
+import qualified Data.Primitive.SmallArray as SA
+import qualified Data.Sequence             as Seq
+import           Data.Set                  (Set)
+import qualified Data.Set                  as Set
+import qualified Data.Text                 as T
+import qualified Data.Vector               as V
+import qualified Data.Vector.Primitive     as P
+import qualified Data.Vector.Storable      as S
+import qualified Data.Vector.Unboxed       as U
+import           Data.Word                 (Word8)
+import           Shared
+import           Test.Inspection
+import           Test.Tasty
+
+cmap_list :: (a -> b) -> [a] -> [b]
+cmap_list = cmap
+
+map_list :: (a -> b) -> [a] -> [b]
+map_list = map
+
+cmap_seq :: (a -> b) -> Seq.Seq a -> Seq.Seq b
+cmap_seq = cmap
+
+map_seq :: (a -> b) -> Seq.Seq a -> Seq.Seq b
+map_seq = fmap
+
+cmap_intset :: (Int -> Int) -> WrapMono IntSet Int -> WrapMono IntSet Int
+cmap_intset = cmap
+
+map_intset :: (Int -> Int) -> IntSet -> IntSet
+map_intset = IS.map
+
+cmap_uvec :: (Int -> Bool) -> U.Vector Int -> U.Vector Bool
+cmap_uvec = cmap
+
+map_uvec :: (Int -> Bool) -> U.Vector Int -> U.Vector Bool
+map_uvec = U.map
+
+cmap_bvec :: (a -> b) -> V.Vector a -> V.Vector b
+cmap_bvec = cmap
+
+map_bvec :: (a -> b) -> V.Vector a -> V.Vector b
+map_bvec = V.map
+
+cmap_svec :: (Int -> Bool) -> S.Vector Int -> S.Vector Bool
+cmap_svec = cmap
+
+map_svec :: (Int -> Bool) -> S.Vector Int -> S.Vector Bool
+map_svec = S.map
+
+cmap_pvec :: (Int -> Word) -> P.Vector Int -> P.Vector Word
+cmap_pvec = cmap
+
+map_pvec :: (Int -> Word) -> P.Vector Int -> P.Vector Word
+map_pvec = P.map
+
+cmap_smallarray :: (Int -> Word) -> SA.SmallArray Int -> SA.SmallArray Word
+cmap_smallarray = cmap
+
+map_smallarray :: (Int -> Word) -> SA.SmallArray Int -> SA.SmallArray Word
+map_smallarray = fmap
+
+cmap_array :: (Int -> Word) -> A.Array Int -> A.Array Word
+cmap_array = cmap
+
+map_array :: (Int -> Word) -> A.Array Int -> A.Array Word
+map_array = fmap
+
+cmap_primarray :: (Int -> Word) -> PA.PrimArray Int -> PA.PrimArray Word
+cmap_primarray = cmap
+
+map_primarray :: (Int -> Word) -> PA.PrimArray Int -> PA.PrimArray Word
+map_primarray = PA.mapPrimArray
+
+cmap_Maybe :: (a -> b) -> Maybe a -> Maybe b
+cmap_Maybe = cmap
+
+map_Maybe :: (a -> b) -> Maybe a -> Maybe b
+map_Maybe = fmap
+
+cmap_Set :: (Ord b) => (Int -> b) -> Set Int -> Set b
+cmap_Set = cmap
+
+map_Set :: Ord b => (Int -> b) -> Set Int -> Set b
+map_Set = Set.map
+
+cmap_HashSet
+  :: (Hashable b, Eq b)
+  => (String -> Maybe b) -> HashSet String -> HashSet (Maybe b)
+cmap_HashSet = cmap
+
+map_HashSet
+  :: (Hashable b, Eq b) => (String -> Maybe b) -> HashSet String -> HashSet (Maybe b)
+{-# INLINE map_HashSet #-}
+map_HashSet = HS.map
+
+cmap_MonoBS :: (Word8 -> Word8) -> WrapMono BS.ByteString Word8 -> WrapMono BS.ByteString Word8
+cmap_MonoBS = cmap
+
+map_BS :: (Word8 -> Word8) -> BS.ByteString -> BS.ByteString
+{-# INLINE map_BS #-}
+map_BS = BS.map
+
+cmap_MonoText :: (Char -> Char) -> WrapMono T.Text Char -> WrapMono T.Text Char
+cmap_MonoText = cmap
+
+map_Text :: (Char -> Char) -> T.Text -> T.Text
+{-# INLINE map_Text #-}
+map_Text = T.map
+
+test_cmap :: TestTree
+test_cmap = testGroup "cmap"
+  [ testGroup "list"
+    [ $(inspecting "has the same representation as Prelude.map"
+        $ 'cmap_list ==- 'map_list
+      )
+    ]
+  , testGroup "Seq"
+    [ $(inspecting "has the same representation as fmap"
+        $ 'cmap_seq ==- 'map_seq
+      )
+    , $(inspecting "has no instance dictionary"
+      $ hasNoTypeClasses 'cmap_seq
+      )
+    ]
+  , testGroup "IntSet"
+    [ $(inspecting "has the same representation as IntSet.map"
+        $ 'cmap_intset ==- 'map_intset
+      )
+    ]
+  , testGroup "BVector"
+    [ $(inspecting "has the same representation as V.map"
+        $ 'cmap_bvec ==- 'map_bvec
+      )
+    ]
+  , testGroup "UVector"
+    [ $(inspecting "has the same representation as U.map"
+        $ 'cmap_uvec ==- 'map_uvec
+      )
+    ]
+  , testGroup "SVector"
+    [ $(inspecting "has the same representation as S.map"
+        $ 'cmap_svec ==- 'map_svec
+      )
+    ]
+  , testGroup "PVector"
+    [ $(inspecting "has the same representation as P.map"
+        $ 'cmap_pvec ==- 'map_pvec
+      )
+    ]
+  , testGroup "SmallArray"
+    [ $(inspecting "has the same representation as fmap"
+        $ 'cmap_smallarray ==- 'map_smallarray
+      )
+    , $(inspecting "has no instance dictionary"
+      $ hasNoTypeClasses 'cmap_smallarray
+      )
+    ]
+  , testGroup "Array"
+    [ $(inspecting "has the same representation as fmap"
+        $ 'cmap_array ==- 'map_array
+      )
+    , $(inspecting "has no instance dictionary"
+      $ hasNoTypeClasses 'cmap_array
+      )
+    ]
+  , testGroup "PrimArray"
+    [ $(inspecting "has the same representation as PA.mapPrimArray"
+        $ 'cmap_primarray ==- 'map_primarray
+      )
+    , $(inspecting "has no instance dictionary"
+      $ hasNoTypeClasses 'cmap_primarray
+      )
+    ]
+  , testGroup "Maybe"
+    [ $(inspecting "has the same representation as fmap"
+      $ 'cmap_Maybe ==- 'map_Maybe
+      )
+    , $(inspecting "has no instance dictionary"
+      $ hasNoTypeClasses 'cmap_Maybe
+      )
+    ]
+  , testGroup "Set"
+    [ $(inspecting "has the same representation as Set.map"
+      $ 'cmap_Set ==- 'map_Set
+      )
+    , $(inspecting "has no instance dictionary except Ord"
+      $ 'cmap_Set `hasNoTypeClassesExcept` [''Ord]
+      )
+    ]
+  , testGroup "HashSet"
+    [ $(inspecting "has the same representation as HS.map, if the first argument is concrete"
+      $ 'cmap_HashSet ==- 'map_HashSet
+      )
+    , $(inspecting "has no instance dictionary except EQ and Hashable"
+      $ 'cmap_HashSet `hasNoTypeClassesExcept` [''Eq, ''Hashable]
+      )
+    ]
+  , testGroup "WrapMono ByteString"
+    [ $(inspecting "has the same representation as Data.ByteString.map"
+      $ 'cmap_MonoBS ==- 'map_BS
+      )
+    , $(inspecting "has no instance dictionary"
+      $ hasNoTypeClasses 'cmap_MonoBS
+      )
+    ]
+  , testGroup "WrapMono Text"
+    [ $(inspecting "has the same representation as Data.Text.map"
+      $ 'cmap_MonoText ==- 'map_Text
+      )
+    , $(inspecting "has no instance dictionary"
+      $ hasNoTypeClasses 'cmap_MonoText
+      )
+    ]
+  ]
diff --git a/test/Control/Subcategory/ZipSpec.hs b/test/Control/Subcategory/ZipSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Control/Subcategory/ZipSpec.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -dsuppress-idinfo -dsuppress-coercions
+      -dsuppress-type-applications
+      -dsuppress-module-prefixes -dsuppress-type-signatures
+      -dsuppress-uniques #-}
+module Control.Subcategory.ZipSpec where
+import Control.Subcategory.Zip
+
+import qualified Data.Vector     as V
+import           Shared
+import           Test.Inspection
+import           Test.Tasty
+
+czipWith_vec :: (a -> b -> c) -> V.Vector a -> V.Vector b -> V.Vector c
+czipWith_vec = czipWith
+
+zipWith_vec :: (a -> b -> c) -> V.Vector a -> V.Vector b -> V.Vector c
+zipWith_vec = V.zipWith
+
+czipWith_list :: (a -> b -> c) -> [a] -> [b] -> [c]
+czipWith_list = czipWith
+
+zipWith_list :: (a -> b -> c) -> [a] -> [b] -> [c]
+zipWith_list = Prelude.zipWith
+
+test_czipWith :: TestTree
+test_czipWith = testGroup "czipWith"
+  [ testGroup "list"
+    [ $(inspecting "has the same representation as Prelude.zipWith"
+        $ 'czipWith_list ==- 'zipWith_list
+      )
+    ]
+  , testGroup "vector"
+    [ $(inspecting "has the same representation as Prelude.zipWith"
+        $ 'czipWith_vec ==- 'zipWith_vec
+      )
+    ]
+  ]
diff --git a/test/Shared.hs b/test/Shared.hs
new file mode 100644
--- /dev/null
+++ b/test/Shared.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Shared where
+import Control.Exception
+import Data.Maybe          (listToMaybe)
+import GHC.Stack           (callStack)
+import GHC.Stack.Types     (getCallStack)
+import Language.Haskell.TH
+import Test.Inspection
+import Test.Tasty.HUnit
+
+checkInspection
+  :: HasCallStack => Result -> Assertion
+checkInspection Success{} = pure ()
+checkInspection (Failure msg) =
+  throwIO $ HUnitFailure (fmap snd $ listToMaybe $ getCallStack callStack) msg
+
+inspecting :: String -> Obligation -> Q Exp
+inspecting desc reg =
+  [|testCase desc $ checkInspection $(inspectTest reg)|]
diff --git a/test/spec.hs b/test/spec.hs
new file mode 100644
--- /dev/null
+++ b/test/spec.hs
@@ -0,0 +1,2 @@
+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --tree-display #-}
+module Main where