diff --git a/category.cabal b/category.cabal
--- a/category.cabal
+++ b/category.cabal
@@ -1,5 +1,5 @@
 name:                category
-version:             0.2.4.2
+version:             0.2.5.0
 synopsis:            Categorical types and classes
 -- description:         
 license:             BSD3
@@ -41,9 +41,10 @@
                      , MultiParamTypeClasses
                      , FlexibleContexts
                      , FlexibleInstances
-                     , DerivingStrategies
                      , StandaloneDeriving
-                     , GeneralizedNewtypeDeriving
+                     , DerivingStrategies
+                     , DerivingVia
+                     , Safe
   ghc-options:         -Wall -Wcompat -Wredundant-constraints -Wno-name-shadowing
                        -Wincomplete-record-updates -Wincomplete-uni-patterns
                        -Werror=incomplete-patterns
diff --git a/src/Control/Categorical/Functor.hs b/src/Control/Categorical/Functor.hs
--- a/src/Control/Categorical/Functor.hs
+++ b/src/Control/Categorical/Functor.hs
@@ -4,6 +4,7 @@
 
 import Control.Category.Dual
 import Control.Category.Groupoid
+import Control.Monad.Trans.Identity (IdentityT (..))
 import qualified Data.Functor as Base
 import Data.Functor.Compose
 import Data.Functor.Identity
@@ -107,3 +108,12 @@
 
 instance (Category s, Category t, Functor s (NT (Dual t)) f) => Functor s (Dual (NT t)) f where
     map f = Dual (NT (dual (nt (map f))))
+
+instance Functor (NT (->)) (NT (->)) IdentityT where
+    map f = NT (\ (IdentityT x) -> IdentityT (nt f x))
+
+instance Functor s (->) f => Functor s (->) (IdentityT f) where
+    map f = IdentityT . map f . runIdentityT
+
+instance (Category s, Category t, Functor (NT s) (NT t) f) => Functor (NT (Dual s)) (NT (Dual t)) f where
+    map f = NT (Dual (nt (map (NT (dual (nt f))))))
diff --git a/src/Control/Categorical/Monad.hs b/src/Control/Categorical/Monad.hs
--- a/src/Control/Categorical/Monad.hs
+++ b/src/Control/Categorical/Monad.hs
@@ -1,11 +1,16 @@
-module Control.Categorical.Monad where
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ExistentialQuantification #-}
+module Control.Categorical.Monad (Monad (..), (<=<), (>=>), Kleisli (..), Comonad (..), (=<=), (=>=), Cokleisli (..)) where
 
+import qualified Control.Applicative as Base
 import qualified Control.Monad as Base
+import Control.Monad.Trans.Identity (IdentityT (..))
 import Data.Function (($), flip)
 import Data.Functor.Identity
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NE
 import Data.Semigroup (Arg (..))
+import qualified Data.Traversable as Base
 
 import Control.Categorical.Functor
 import Control.Category.Dual
@@ -38,6 +43,14 @@
     join = Base.join
     bind = (Base.=<<)
 
+instance Comonad s f => Monad (Dual s) f where
+    unit = Dual counit
+    join = Dual cut
+
+instance (Category s, Comonad (NT s) f) => Monad (NT (Dual s)) f where
+    unit = NT (Dual (nt counit))
+    join = NT (Dual (nt cut))
+
 class Endofunctor s ɯ => Comonad s ɯ where
     counit :: ɯ a `s` a
 
@@ -98,3 +111,66 @@
 
 instance Comonad s ɯ => Functor (Cokleisli s ɯ) s ɯ where
     map = cobind . cokleisli
+
+instance {-# OVERLAPPABLE #-} (Base.Traversable f, Monad (->) m) => Functor (Kleisli (->) m) (Kleisli (->) m) f where
+    map (Kleisli f) = Kleisli (unBaseMonad . Base.traverse (BaseMonad . f))
+
+data BaseMonad m a = Monad (->) m => BaseMonad { unBaseMonad :: m a }
+instance Base.Functor (BaseMonad f) where fmap = map
+instance Base.Applicative (BaseMonad m) where pure = unit; (<*>) = Base.ap
+instance Base.Monad (BaseMonad m) where (>>=) = flip bind
+
+instance Monad (->) m => Functor (NT (Kleisli (->) m)) (NT (Kleisli (->) m)) IdentityT where
+    map f = NT (Kleisli (map IdentityT . kleisli (nt f) . runIdentityT))
+
+instance Monad (Dual (->)) m => Functor (NT (Kleisli (Dual (->)) m)) (NT (Kleisli (Dual (->)) m)) IdentityT where
+    map f = NT (Kleisli (Dual (IdentityT . dual (kleisli (nt f)) . dual (map (Dual runIdentityT)))))
+
+instance Comonad (->) ɯ => Functor (NT (Cokleisli (->) ɯ)) (NT (Cokleisli (->) ɯ)) IdentityT where
+    map f = NT (Cokleisli (IdentityT . cokleisli (nt f) . map runIdentityT))
+
+instance Monad (NT (->)) IdentityT where
+    unit = NT IdentityT
+    join = NT runIdentityT
+
+instance Comonad (NT (->)) IdentityT where
+    counit = NT runIdentityT
+    cut = NT IdentityT
+
+instance Monad (->) m => Monad (NT (Kleisli (->) m)) IdentityT where
+    unit = NT (Kleisli (unit . IdentityT))
+    join = NT (Kleisli (unit . runIdentityT))
+
+instance Comonad (->) ɯ => Monad (NT (Cokleisli (->) ɯ)) IdentityT where
+    unit = NT (Cokleisli (IdentityT . counit))
+    join = NT (Cokleisli (runIdentityT . counit))
+
+instance Comonad (->) ɯ => Comonad (NT (Cokleisli (->) ɯ)) IdentityT where
+    counit = NT (Cokleisli (runIdentityT . counit))
+    cut = NT (Cokleisli (IdentityT . counit))
+
+instance Monad (->) m => Comonad (NT (Kleisli (->) m)) IdentityT where
+    counit = NT (Kleisli (unit . runIdentityT))
+    cut = NT (Kleisli (unit . IdentityT))
+
+instance Monad (->) f => Monad (->) (IdentityT f) where
+    unit = IdentityT . unit
+    join = IdentityT . bind runIdentityT . runIdentityT
+
+instance Comonad (->) f => Comonad (->) (IdentityT f) where
+    counit = counit . runIdentityT
+    cut = runIdentityT . cobind runIdentityT . IdentityT
+
+instance (Functor s (Kleisli (->) m) f, Endofunctor (->) m) =>
+         Functor s (Kleisli (->) m) (IdentityT f) where
+    map f = Kleisli (map IdentityT . kleisli (map f) . runIdentityT)
+
+instance (Functor s (Cokleisli (->) ɯ) f, Endofunctor (->) ɯ) =>
+         Functor s (Cokleisli (->) ɯ) (IdentityT f) where
+    map f = Cokleisli (IdentityT . cokleisli (map f) . map runIdentityT)
+
+instance (Monad (->) m) => Functor (Kleisli (->) m) (Kleisli (->) m) ((,) a) where
+    map (Kleisli f) = Kleisli (\ (a, b) -> (,) a <$> f b)
+
+instance (Monad (->) m) => Functor (Kleisli (->) m) (NT (Kleisli (->) m)) (,) where
+    map (Kleisli f) = NT (Kleisli (\ (a, b) -> (\ a -> (a, b)) <$> f a))
diff --git a/src/Control/Category/Const2.hs b/src/Control/Category/Const2.hs
--- a/src/Control/Category/Const2.hs
+++ b/src/Control/Category/Const2.hs
@@ -1,11 +1,20 @@
 module Control.Category.Const2 where
 
 import Algebra as A
+import Control.Categorical.Functor
+import Control.Categorical.Monad
 import Control.Category.Groupoid
+import Relation.Binary.Comparison
 
 -- | Notes: 'Const2' '()' is the indiscrete category.
-newtype Const2 a b c = Const2 a
-  deriving (Semigroup, Monoid, Group)
+newtype Const2 a b c = Const2 { getConst2 :: a }
+  deriving (Semigroup, Monoid, Group, PartialEq, Preord, Eq, PartialOrd, Ord) via a
+
+instance Functor (->) (NT (NT (->))) Const2 where
+    map f = NT (NT (\ (Const2 a) -> Const2 (f a)))
+
+instance Monad (->) m => Functor (Kleisli (->) m) (NT (NT (Kleisli (->) m))) Const2 where
+    map (Kleisli f) = NT (NT (Kleisli (\ (Const2 a) -> Const2 <$> f a)))
 
 instance (Semigroup a, Monoid a) => Category (Const2 a) where
     id = Const2 mempty
diff --git a/src/Data/Functor/Trans/Identity.hs b/src/Data/Functor/Trans/Identity.hs
--- a/src/Data/Functor/Trans/Identity.hs
+++ b/src/Data/Functor/Trans/Identity.hs
@@ -1,57 +1,3 @@
-module Data.Functor.Trans.Identity where
-
-import Control.Categorical.Functor
-import Control.Categorical.Monad
-
-newtype IdentityT f a = IdentityT { runIdentityT :: f a }
-
-instance Functor (NT (->)) (NT (->)) IdentityT where
-    map f = NT (\ (IdentityT x) -> IdentityT (nt f x))
-
-instance Monad (->) m => Functor (NT (Kleisli (->) m)) (NT (Kleisli (->) m)) IdentityT where
-    map f = NT (Kleisli (map IdentityT . kleisli (nt f) . runIdentityT))
-
-instance Comonad (->) ɯ => Functor (NT (Cokleisli (->) ɯ)) (NT (Cokleisli (->) ɯ)) IdentityT where
-    map f = NT (Cokleisli (IdentityT . cokleisli (nt f) . map runIdentityT))
-
-instance Monad (NT (->)) IdentityT where
-    unit = NT IdentityT
-    join = NT runIdentityT
-
-instance Comonad (NT (->)) IdentityT where
-    counit = NT runIdentityT
-    cut = NT IdentityT
-
-instance Monad (->) m => Monad (NT (Kleisli (->) m)) IdentityT where
-    unit = NT (Kleisli (unit . IdentityT))
-    join = NT (Kleisli (unit . runIdentityT))
-
-instance Comonad (->) ɯ => Monad (NT (Cokleisli (->) ɯ)) IdentityT where
-    unit = NT (Cokleisli (IdentityT . counit))
-    join = NT (Cokleisli (runIdentityT . counit))
-
-instance Comonad (->) ɯ => Comonad (NT (Cokleisli (->) ɯ)) IdentityT where
-    counit = NT (Cokleisli (runIdentityT . counit))
-    cut = NT (Cokleisli (IdentityT . counit))
-
-instance Monad (->) m => Comonad (NT (Kleisli (->) m)) IdentityT where
-    counit = NT (Kleisli (unit . runIdentityT))
-    cut = NT (Kleisli (unit . IdentityT))
-
-deriving instance Functor s (->) f => Functor s (->) (IdentityT f)
-
-instance Monad (->) f => Monad (->) (IdentityT f) where
-    unit = IdentityT . unit
-    join = IdentityT . bind runIdentityT . runIdentityT
-
-instance Comonad (->) f => Comonad (->) (IdentityT f) where
-    counit = counit . runIdentityT
-    cut = runIdentityT . cobind runIdentityT . IdentityT
-
-instance (Functor s (Kleisli (->) m) f, Endofunctor (->) m) =>
-         Functor s (Kleisli (->) m) (IdentityT f) where
-    map f = Kleisli (map IdentityT . kleisli (map f) . runIdentityT)
+module Data.Functor.Trans.Identity (IdentityT (..)) where
 
-instance (Functor s (Cokleisli (->) ɯ) f, Endofunctor (->) ɯ) =>
-         Functor s (Cokleisli (->) ɯ) (IdentityT f) where
-    map f = Cokleisli (IdentityT . cokleisli (map f) . map runIdentityT)
+import Control.Monad.Trans.Identity (IdentityT (..))