diff --git a/changelog.md b/changelog.md
--- a/changelog.md
+++ b/changelog.md
@@ -1,3 +1,7 @@
+0.0.3
+
+* Generalise data types over the Profunctor and not (->)
+
 0.0.2
 
 * Fix typo in cabal file
diff --git a/src/Data/Valuation/BinaryFunction.hs b/src/Data/Valuation/BinaryFunction.hs
--- a/src/Data/Valuation/BinaryFunction.hs
+++ b/src/Data/Valuation/BinaryFunction.hs
@@ -49,7 +49,7 @@
 import Data.Profunctor (Choice (..), Profunctor (..), Strong (..))
 import Data.Profunctor.Closed (Closed (..))
 import Data.Valuation.Semigroup
-  ( Semigroup,
+  ( Semigroup',
     applySemigroup,
     runSemigroup,
   )
@@ -107,10 +107,10 @@
 instance AsBinaryFunctionT (BinaryFunctionT f a b) f a b where
   _BinaryFunctionT = id
 
-instance HasBinaryFunctionT (Semigroup a) Identity a a where
+instance HasBinaryFunctionT (Semigroup' a) Identity a a where
   binaryFunctionT = applySemigroup . from binaryFunction
 
-instance AsBinaryFunctionT (Semigroup a) Identity a a where
+instance AsBinaryFunctionT (Semigroup' a) Identity a a where
   _BinaryFunctionT = applySemigroup . from binaryFunction
 
 -- | Iso between a 'BinaryFunction' and its underlying binary function.
@@ -299,7 +299,7 @@
 -- |
 -- >>> let BinaryFunctionT f = runSemigroup semigroupBinaryFunctionT (BinaryFunctionT (\_ _ -> [1, 2]) :: BinaryFunctionT [] Int Int) (BinaryFunctionT (\_ _ -> [10, 20])) in f 0 0
 -- [1,2,10,20]
-semigroupBinaryFunctionT :: (Prelude.Semigroup (f b)) => Semigroup (BinaryFunctionT f a b)
+semigroupBinaryFunctionT :: (Prelude.Semigroup (f b)) => Semigroup' (BinaryFunctionT f a b)
 semigroupBinaryFunctionT = review applySemigroup (\(BinaryFunctionT h1) (BinaryFunctionT h2) -> BinaryFunctionT (\a1 a2 -> h1 a1 a2 <> h2 a1 a2))
 
 -- |
diff --git a/src/Data/Valuation/DomainLattice.hs b/src/Data/Valuation/DomainLattice.hs
--- a/src/Data/Valuation/DomainLattice.hs
+++ b/src/Data/Valuation/DomainLattice.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# OPTIONS_GHC -Wall -Werror #-}
@@ -56,7 +57,7 @@
 
 -- |
 -- >>> import qualified Data.Set as Set
--- >>> let lat = setDomainLattice :: DomainLattice (Set Int) (Set Int)
+-- >>> let lat = setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)
 -- >>> runDomainJoin lat (Set.fromList [1,2]) (Set.fromList [2,3])
 -- fromList [1,2,3]
 -- >>> runDomainMeet lat (Set.fromList [1,2]) (Set.fromList [2,3])
@@ -67,67 +68,67 @@
 -- False
 -- >>> runDomainCompare lat (Set.fromList [1,2]) (Set.fromList [2,3])
 -- Nothing
-data DomainLattice sg p
+data DomainLattice p sg o
   = DomainLattice
       -- | join (\/ / supremum)
-      (Semigroup sg)
+      (Semigroup p sg)
       -- | meet (/\ / infimum)
-      (Semigroup sg)
+      (Semigroup p sg)
       -- | partial order
-      (PartialOrder p)
+      (PartialOrder o)
 
 type DomainLattice' x =
-  DomainLattice x x
+  DomainLattice (->) x x
 
 -- | Classy lens for types that contain a 'DomainLattice'.
-class HasDomainLattice c sg p | c -> sg p where
-  domainLattice :: Lens' c (DomainLattice sg p)
-  domainLatticeJoin :: Lens' c (Semigroup sg)
+class HasDomainLattice c p sg o | c -> p sg o where
+  domainLattice :: Lens' c (DomainLattice p sg o)
+  domainLatticeJoin :: Lens' c (Semigroup p sg)
   domainLatticeJoin = domainLattice . domainLatticeJoin
-  domainLatticeMeet :: Lens' c (Semigroup sg)
+  domainLatticeMeet :: Lens' c (Semigroup p sg)
   domainLatticeMeet = domainLattice . domainLatticeMeet
 
-instance HasDomainLattice (DomainLattice sg p) sg p where
+instance HasDomainLattice (DomainLattice p sg o) p sg o where
   domainLattice = id
   domainLatticeJoin f (DomainLattice j m o) = fmap (\j' -> DomainLattice j' m o) (f j)
   domainLatticeMeet f (DomainLattice j m o) = fmap (\m' -> DomainLattice j m' o) (f m)
 
 -- | Classy prism for types that can be constructed from a 'DomainLattice'.
-class AsDomainLattice c sg p | c -> sg p where
-  _DomainLattice :: Prism' c (DomainLattice sg p)
+class AsDomainLattice c p sg o | c -> p sg o where
+  _DomainLattice :: Prism' c (DomainLattice p sg o)
 
-instance AsDomainLattice (DomainLattice sg p) sg p where
+instance AsDomainLattice (DomainLattice p sg o) p sg o where
   _DomainLattice = id
 
-instance HasPartialOrder (DomainLattice sg p) p where
+instance HasPartialOrder (DomainLattice p sg o) o where
   partialOrder f (DomainLattice j m o) = fmap (DomainLattice j m) (f o)
 
 -- | Apply the domain join (\/): the supremum of two domains.
 {-# SPECIALIZE runDomainJoin ::
-  DomainLattice sg p -> sg -> sg -> sg
+  DomainLattice (->) sg o -> sg -> sg -> sg
   #-}
-runDomainJoin :: (HasDomainLattice lat sg p) => lat -> sg -> sg -> sg
+runDomainJoin :: (HasDomainLattice lat (->) sg o) => lat -> sg -> sg -> sg
 runDomainJoin = runSemigroup . view domainLatticeJoin
 
 -- | Apply the domain meet (/\): the infimum of two domains.
 {-# SPECIALIZE runDomainMeet ::
-  DomainLattice sg p -> sg -> sg -> sg
+  DomainLattice (->) sg o -> sg -> sg -> sg
   #-}
-runDomainMeet :: (HasDomainLattice lat sg p) => lat -> sg -> sg -> sg
+runDomainMeet :: (HasDomainLattice lat (->) sg o) => lat -> sg -> sg -> sg
 runDomainMeet = runSemigroup . view domainLatticeMeet
 
 -- | Compare two domains using the partial order.
 -- Returns 'Nothing' for incomparable elements.
 --
 -- >>> import qualified Data.Set as Set
--- >>> runDomainCompare (setDomainLattice :: DomainLattice (Set Int) (Set Int)) (Set.fromList [1]) (Set.fromList [1,2])
+-- >>> runDomainCompare (setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)) (Set.fromList [1]) (Set.fromList [1,2])
 -- Just LT
--- >>> runDomainCompare (setDomainLattice :: DomainLattice (Set Int) (Set Int)) (Set.fromList [1,2]) (Set.fromList [1,2])
+-- >>> runDomainCompare (setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)) (Set.fromList [1,2]) (Set.fromList [1,2])
 -- Just EQ
--- >>> runDomainCompare (setDomainLattice :: DomainLattice (Set Int) (Set Int)) (Set.fromList [1,2]) (Set.fromList [2,3])
+-- >>> runDomainCompare (setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)) (Set.fromList [1,2]) (Set.fromList [2,3])
 -- Nothing
 {-# SPECIALIZE runDomainCompare ::
-  DomainLattice sg p -> p -> p -> Maybe Ordering
+  DomainLattice p sg o -> o -> o -> Maybe Ordering
   #-}
 runDomainCompare :: (HasPartialOrder lat p) => lat -> p -> p -> Maybe Ordering
 runDomainCompare = runPartialOrder . view partialOrder
@@ -136,12 +137,12 @@
 -- Returns 'False' for incomparable elements.
 --
 -- >>> import qualified Data.Set as Set
--- >>> runDomainLeq (setDomainLattice :: DomainLattice (Set Int) (Set Int)) (Set.fromList [1]) (Set.fromList [1,2])
+-- >>> runDomainLeq (setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)) (Set.fromList [1]) (Set.fromList [1,2])
 -- True
--- >>> runDomainLeq (setDomainLattice :: DomainLattice (Set Int) (Set Int)) (Set.fromList [1,2]) (Set.fromList [2,3])
+-- >>> runDomainLeq (setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)) (Set.fromList [1,2]) (Set.fromList [2,3])
 -- False
 {-# SPECIALIZE runDomainLeq ::
-  DomainLattice sg p -> p -> p -> Bool
+  DomainLattice p sg o -> o -> o -> Bool
   #-}
 runDomainLeq :: (HasPartialOrder lat p) => lat -> p -> p -> Bool
 runDomainLeq = partialOrderLeq . view partialOrder
@@ -150,7 +151,7 @@
 -- intersection as meet, and subset as the partial order.
 --
 -- >>> import qualified Data.Set as Set
--- >>> let lat = setDomainLattice :: DomainLattice (Set String) (Set String)
+-- >>> let lat = setDomainLattice :: DomainLattice (->) (Set String) (Set String)
 -- >>> runDomainJoin lat (Set.fromList ["x","y"]) (Set.fromList ["y","z"])
 -- fromList ["x","y","z"]
 -- >>> runDomainMeet lat (Set.fromList ["x","y"]) (Set.fromList ["y","z"])
@@ -168,80 +169,80 @@
 
 -- |
 -- >>> import qualified Data.Set as Set
--- >>> lawJoinAssociative (setDomainLattice :: DomainLattice (Set Int) (Set Int)) (Set.fromList [1,2]) (Set.fromList [2,3]) (Set.fromList [3,4])
+-- >>> lawJoinAssociative (setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)) (Set.fromList [1,2]) (Set.fromList [2,3]) (Set.fromList [3,4])
 -- True
-lawJoinAssociative :: (Eq sg) => DomainLattice sg p -> sg -> sg -> sg -> Bool
+lawJoinAssociative :: (Eq sg) => DomainLattice (->) sg o -> sg -> sg -> sg -> Bool
 lawJoinAssociative lat a b c =
   let j = runDomainJoin lat
    in j (j a b) c == j a (j b c)
 
 -- |
 -- >>> import qualified Data.Set as Set
--- >>> lawMeetAssociative (setDomainLattice :: DomainLattice (Set Int) (Set Int)) (Set.fromList [1,2]) (Set.fromList [2,3]) (Set.fromList [3,4])
+-- >>> lawMeetAssociative (setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)) (Set.fromList [1,2]) (Set.fromList [2,3]) (Set.fromList [3,4])
 -- True
-lawMeetAssociative :: (Eq sg) => DomainLattice sg p -> sg -> sg -> sg -> Bool
+lawMeetAssociative :: (Eq sg) => DomainLattice (->) sg o -> sg -> sg -> sg -> Bool
 lawMeetAssociative lat a b c =
   let m = runDomainMeet lat
    in m (m a b) c == m a (m b c)
 
 -- |
 -- >>> import qualified Data.Set as Set
--- >>> lawJoinCommutative (setDomainLattice :: DomainLattice (Set Int) (Set Int)) (Set.fromList [1,2]) (Set.fromList [2,3])
+-- >>> lawJoinCommutative (setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)) (Set.fromList [1,2]) (Set.fromList [2,3])
 -- True
-lawJoinCommutative :: (Eq sg) => DomainLattice sg p -> sg -> sg -> Bool
+lawJoinCommutative :: (Eq sg) => DomainLattice (->) sg o -> sg -> sg -> Bool
 lawJoinCommutative lat a b =
   runDomainJoin lat a b == runDomainJoin lat b a
 
 -- |
 -- >>> import qualified Data.Set as Set
--- >>> lawMeetCommutative (setDomainLattice :: DomainLattice (Set Int) (Set Int)) (Set.fromList [1,2]) (Set.fromList [2,3])
+-- >>> lawMeetCommutative (setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)) (Set.fromList [1,2]) (Set.fromList [2,3])
 -- True
-lawMeetCommutative :: (Eq sg) => DomainLattice sg p -> sg -> sg -> Bool
+lawMeetCommutative :: (Eq sg) => DomainLattice (->) sg o -> sg -> sg -> Bool
 lawMeetCommutative lat a b =
   runDomainMeet lat a b == runDomainMeet lat b a
 
 -- | Absorption law 1: @a \/ (a /\ b) = a@.
 --
 -- >>> import qualified Data.Set as Set
--- >>> lawAbsorption1 (setDomainLattice :: DomainLattice (Set Int) (Set Int)) (Set.fromList [1,2]) (Set.fromList [2,3])
+-- >>> lawAbsorption1 (setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)) (Set.fromList [1,2]) (Set.fromList [2,3])
 -- True
-lawAbsorption1 :: (Eq sg) => DomainLattice sg p -> sg -> sg -> Bool
+lawAbsorption1 :: (Eq sg) => DomainLattice (->) sg o -> sg -> sg -> Bool
 lawAbsorption1 lat a b =
   runDomainJoin lat a (runDomainMeet lat a b) == a
 
 -- | Absorption law 2: @a /\ (a \/ b) = a@.
 --
 -- >>> import qualified Data.Set as Set
--- >>> lawAbsorption2 (setDomainLattice :: DomainLattice (Set Int) (Set Int)) (Set.fromList [1,2]) (Set.fromList [2,3])
+-- >>> lawAbsorption2 (setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)) (Set.fromList [1,2]) (Set.fromList [2,3])
 -- True
-lawAbsorption2 :: (Eq sg) => DomainLattice sg p -> sg -> sg -> Bool
+lawAbsorption2 :: (Eq sg) => DomainLattice (->) sg o -> sg -> sg -> Bool
 lawAbsorption2 lat a b =
   runDomainMeet lat a (runDomainJoin lat a b) == a
 
 -- | Join idempotence: @a \/ a = a@.
 --
 -- >>> import qualified Data.Set as Set
--- >>> lawJoinIdempotent (setDomainLattice :: DomainLattice (Set Int) (Set Int)) (Set.fromList [1,2])
+-- >>> lawJoinIdempotent (setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)) (Set.fromList [1,2])
 -- True
-lawJoinIdempotent :: (Eq sg) => DomainLattice sg p -> sg -> Bool
+lawJoinIdempotent :: (Eq sg) => DomainLattice (->) sg o -> sg -> Bool
 lawJoinIdempotent lat a =
   runDomainJoin lat a a == a
 
 -- | Meet idempotence: @a /\ a = a@.
 --
 -- >>> import qualified Data.Set as Set
--- >>> lawMeetIdempotent (setDomainLattice :: DomainLattice (Set Int) (Set Int)) (Set.fromList [1,2])
+-- >>> lawMeetIdempotent (setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)) (Set.fromList [1,2])
 -- True
-lawMeetIdempotent :: (Eq sg) => DomainLattice sg p -> sg -> Bool
+lawMeetIdempotent :: (Eq sg) => DomainLattice (->) sg o -> sg -> Bool
 lawMeetIdempotent lat a =
   runDomainMeet lat a a == a
 
 -- | Consistency of partial order with join: @a <= b@ iff @a \/ b = b@.
 --
 -- >>> import qualified Data.Set as Set
--- >>> lawLeqFromJoin (setDomainLattice :: DomainLattice (Set Int) (Set Int)) (Set.fromList [1]) (Set.fromList [1,2])
+-- >>> lawLeqFromJoin (setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)) (Set.fromList [1]) (Set.fromList [1,2])
 -- True
--- >>> lawLeqFromJoin (setDomainLattice :: DomainLattice (Set Int) (Set Int)) (Set.fromList [1,3]) (Set.fromList [1,2])
+-- >>> lawLeqFromJoin (setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)) (Set.fromList [1,3]) (Set.fromList [1,2])
 -- True
 lawLeqFromJoin :: (Eq d) => DomainLattice' d -> d -> d -> Bool
 lawLeqFromJoin lat a b =
diff --git a/src/Data/Valuation/PartialOrder.hs b/src/Data/Valuation/PartialOrder.hs
--- a/src/Data/Valuation/PartialOrder.hs
+++ b/src/Data/Valuation/PartialOrder.hs
@@ -55,7 +55,7 @@
     HasBinaryFunctionT (..),
   )
 import Data.Valuation.Semigroup
-  ( Semigroup,
+  ( Semigroup',
     applySemigroup,
     runSemigroup,
   )
@@ -195,7 +195,7 @@
 -- Just LT
 -- >>> runPartialOrder (runSemigroup semigroupPartialOrder po po) 2 2
 -- Just EQ
-semigroupPartialOrder :: Semigroup (PartialOrder a)
+semigroupPartialOrder :: Semigroup' (PartialOrder a)
 semigroupPartialOrder = review applySemigroup $ \(PartialOrder f) (PartialOrder g) -> PartialOrder $ \a b ->
   case f a b of
     Just EQ -> g a b
diff --git a/src/Data/Valuation/PresheafValuationAlgebra.hs b/src/Data/Valuation/PresheafValuationAlgebra.hs
--- a/src/Data/Valuation/PresheafValuationAlgebra.hs
+++ b/src/Data/Valuation/PresheafValuationAlgebra.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# OPTIONS_GHC -Wall -Werror #-}
@@ -16,6 +17,7 @@
 -- operations that work directly on 'Valuation' values.
 module Data.Valuation.PresheafValuationAlgebra
   ( PresheafValuationAlgebra (..),
+    PresheafValuationAlgebra',
     SetPresheafValuationAlgebra,
     HasPresheafValuationAlgebra (..),
     AsPresheafValuationAlgebra (..),
@@ -49,7 +51,7 @@
   )
 import Data.Valuation.Semigroup
   ( HasSemigroup (..),
-    Semigroup,
+    Semigroup',
     applySemigroup,
     runSemigroup,
   )
@@ -75,52 +77,55 @@
 -- >>> import Prelude hiding (Semigroup)
 
 -- |
--- >>> let lat = setDomainLattice :: DomainLattice (Set Int) (Set Int)
+-- >>> let lat = setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)
 -- >>> let sva = SemiValuationAlgebra (review applySemigroup (+)) (ProjectValuation (\_ v -> v))
--- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra Int Set Int
+-- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra (->) Int Set Int
 -- >>> let pva = PresheafValuationAlgebra lat va
 -- >>> let v1 = Valuation (Set.fromList [1,2]) 10 :: Valuation Set Int Int
 -- >>> let v2 = Valuation (Set.fromList [2,3]) 20
 -- >>> combine pva v1 v2
 -- Valuation (fromList [1,2,3]) 30
-data PresheafValuationAlgebra v set var
+data PresheafValuationAlgebra p v set var
   = PresheafValuationAlgebra
       -- | lattice structure on domains
-      (DomainLattice (set var) (set var))
+      (DomainLattice p (set var) (set var))
       -- | the valuation algebra
-      (ValuationAlgebra v set var)
+      (ValuationAlgebra p v set var)
 
+type PresheafValuationAlgebra' v set var =
+  PresheafValuationAlgebra (->) v set var
+
 -- | A 'PresheafValuationAlgebra' specialised to 'Set'.
-type SetPresheafValuationAlgebra v var =
-  PresheafValuationAlgebra v Set var
+type SetPresheafValuationAlgebra p v var =
+  PresheafValuationAlgebra p v Set var
 
 -- | Classy lens for types that contain a 'PresheafValuationAlgebra'.
-class HasPresheafValuationAlgebra c v set var | c -> v set var where
-  presheafValuationAlgebra :: Lens' c (PresheafValuationAlgebra v set var)
+class HasPresheafValuationAlgebra c p v set var | c -> p v set var where
+  presheafValuationAlgebra :: Lens' c (PresheafValuationAlgebra p v set var)
 
-instance HasPresheafValuationAlgebra (PresheafValuationAlgebra v set var) v set var where
+instance HasPresheafValuationAlgebra (PresheafValuationAlgebra p v set var) p v set var where
   presheafValuationAlgebra = id
 
 -- | Classy prism for types that can be constructed from a 'PresheafValuationAlgebra'.
-class AsPresheafValuationAlgebra c v set var | c -> v set var where
-  _PresheafValuationAlgebra :: Prism' c (PresheafValuationAlgebra v set var)
+class AsPresheafValuationAlgebra c p v set var | c -> p v set var where
+  _PresheafValuationAlgebra :: Prism' c (PresheafValuationAlgebra p v set var)
 
-instance AsPresheafValuationAlgebra (PresheafValuationAlgebra v set var) v set var where
+instance AsPresheafValuationAlgebra (PresheafValuationAlgebra p v set var) p v set var where
   _PresheafValuationAlgebra = id
 
-instance HasDomainLattice (PresheafValuationAlgebra v set var) (set var) (set var) where
+instance HasDomainLattice (PresheafValuationAlgebra p v set var) p (set var) (set var) where
   domainLattice f (PresheafValuationAlgebra l a) = fmap (`PresheafValuationAlgebra` a) (f l)
 
-instance HasValuationAlgebra (PresheafValuationAlgebra v set var) v set var where
+instance HasValuationAlgebra (PresheafValuationAlgebra p v set var) p v set var where
   valuationAlgebra f (PresheafValuationAlgebra l a) = fmap (PresheafValuationAlgebra l) (f a)
 
-instance HasSemiValuationAlgebra (PresheafValuationAlgebra v set var) v set var where
+instance HasSemiValuationAlgebra (PresheafValuationAlgebra p v set var) p v set var where
   semiValuationAlgebra = valuationAlgebra . semiValuationAlgebra
 
-instance HasSemigroup (PresheafValuationAlgebra v set var) v where
+instance HasSemigroup (PresheafValuationAlgebra p v set var) p v where
   semigroup = semiValuationAlgebra . semigroup
 
-instance HasProjectValuation (PresheafValuationAlgebra v set var) v set var where
+instance HasProjectValuation (PresheafValuationAlgebra p v set var) p v set var where
   projectValuation = semiValuationAlgebra . projectValuation
 
 -- | Marginalise a valuation to a subdomain: the restriction map of the presheaf.
@@ -132,16 +137,16 @@
 --
 -- The caller should ensure @d' <= d(phi)@.
 --
--- >>> let lat = setDomainLattice :: DomainLattice (Set Int) (Set Int)
+-- >>> let lat = setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)
 -- >>> let sva = SemiValuationAlgebra (review applySemigroup (+)) (ProjectValuation (\s v -> v + Set.size s))
--- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra Int Set Int
+-- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra (->) Int Set Int
 -- >>> let pva = PresheafValuationAlgebra lat va
 -- >>> marginalise pva (Set.fromList [1]) (Valuation (Set.fromList [1,2]) 10)
 -- Valuation (fromList [1]) 11
 {-# SPECIALIZE marginalise ::
-  PresheafValuationAlgebra v set var -> set var -> Valuation set var v -> Valuation set var v
+  PresheafValuationAlgebra (->) v set var -> set var -> Valuation set var v -> Valuation set var v
   #-}
-marginalise :: (HasProjectValuation algebra v set var, HasValuation valuation set' var' v) => algebra -> set var -> valuation -> Valuation set var v
+marginalise :: (HasProjectValuation algebra (->) v set var, HasValuation valuation set' var' v) => algebra -> set var -> valuation -> Valuation set var v
 marginalise algebra targetDomain =
   Valuation targetDomain . view (projectValuation . _Wrapped) algebra targetDomain . view valuationInformation
 
@@ -152,88 +157,88 @@
 -- The information values are combined using the algebra's semigroup,
 -- and the result has the joined domain.
 --
--- >>> let lat = setDomainLattice :: DomainLattice (Set Int) (Set Int)
+-- >>> let lat = setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)
 -- >>> let sva = SemiValuationAlgebra (review applySemigroup (+)) (ProjectValuation (\_ v -> v))
--- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra Int Set Int
+-- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra (->) Int Set Int
 -- >>> let pva = PresheafValuationAlgebra lat va
 -- >>> combine pva (Valuation (Set.fromList [1,2]) 10) (Valuation (Set.fromList [2,3]) 20)
 -- Valuation (fromList [1,2,3]) 30
 --
--- >>> let lat = setDomainLattice :: DomainLattice (Set Int) (Set Int)
+-- >>> let lat = setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)
 -- >>> let sva = SemiValuationAlgebra (review applySemigroup (*)) (ProjectValuation (\_ v -> v))
--- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 1)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra Int Set Int
+-- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 1)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra (->) Int Set Int
 -- >>> let pva = PresheafValuationAlgebra lat va
 -- >>> combine pva (Valuation (Set.fromList [1]) 3) (Valuation (Set.fromList [2]) 4)
 -- Valuation (fromList [1,2]) 12
 {-# SPECIALIZE combine ::
-  PresheafValuationAlgebra v set var -> Valuation set var v -> Valuation set var v -> Valuation set var v
+  PresheafValuationAlgebra (->) v set var -> Valuation set var v -> Valuation set var v -> Valuation set var v
   #-}
 combine ::
-  (HasSemigroup s1 a, HasDomainLattice s1 (set var) p, HasValuation s2 set var a, HasValuation s3 set var a) => s1 -> s2 -> s3 -> Valuation set var a
+  (HasSemigroup s1 (->) a, HasDomainLattice s1 (->) (set var) p, HasValuation s2 set var a, HasValuation s3 set var a) => s1 -> s2 -> s3 -> Valuation set var a
 combine alg phi =
   Valuation . runSemigroup (view domainLatticeJoin alg) (view valuationDomain phi) . view valuationDomain <*> runSemigroup (view semigroup alg) (view valuationInformation phi) . view valuationInformation
 
 -- | The neutral valuation for a domain: @e_d@ such that @e_d ⊗ phi = phi@
 -- for all phi with @d(phi) <= d@.
 --
--- >>> let lat = setDomainLattice :: DomainLattice (Set Int) (Set Int)
+-- >>> let lat = setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)
 -- >>> let sva = SemiValuationAlgebra (review applySemigroup (+)) (ProjectValuation (\_ v -> v))
--- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 99)) :: ValuationAlgebra Int Set Int
+-- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 99)) :: ValuationAlgebra (->) Int Set Int
 -- >>> let pva = PresheafValuationAlgebra lat va
 -- >>> neutralValuation pva (Set.fromList [1,2])
 -- Valuation (fromList [1,2]) 0
 {-# SPECIALIZE neutralValuation ::
-  PresheafValuationAlgebra v set var -> set var -> Valuation set var v
+  PresheafValuationAlgebra (->) v set var -> set var -> Valuation set var v
   #-}
-neutralValuation :: (HasValuationAlgebra s a set var) => s -> set var -> Valuation set var a
+neutralValuation :: (HasValuationAlgebra s (->) a set var) => s -> set var -> Valuation set var a
 neutralValuation algebra =
   Valuation <*> view (valuationAlgebra . valuationAlgebraUnit . _Wrapped) algebra
 
 -- | The null/zero valuation for a domain: @z_d@ such that @z_d ⊗ phi = z_{d \/ d(phi)}@
 -- for all phi.
 --
--- >>> let lat = setDomainLattice :: DomainLattice (Set Int) (Set Int)
+-- >>> let lat = setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)
 -- >>> let sva = SemiValuationAlgebra (review applySemigroup (+)) (ProjectValuation (\_ v -> v))
--- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 99)) :: ValuationAlgebra Int Set Int
+-- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 99)) :: ValuationAlgebra (->) Int Set Int
 -- >>> let pva = PresheafValuationAlgebra lat va
 -- >>> nullValuation pva (Set.fromList [1,2])
 -- Valuation (fromList [1,2]) 99
 {-# SPECIALIZE nullValuation ::
-  PresheafValuationAlgebra v set var -> set var -> Valuation set var v
+  PresheafValuationAlgebra (->) v set var -> set var -> Valuation set var v
   #-}
-nullValuation :: (HasValuationAlgebra s a set var) => s -> set var -> Valuation set var a
+nullValuation :: (HasValuationAlgebra s (->) a set var) => s -> set var -> Valuation set var a
 nullValuation algebra =
   Valuation <*> view (valuationAlgebra . valuationAlgebraZero . _Wrapped) algebra
 
 -- | A first-class 'Semigroup' on 'Valuation' derived from the presheaf algebra's
 -- combination operation.
 --
--- >>> let lat = setDomainLattice :: DomainLattice (Set Int) (Set Int)
+-- >>> let lat = setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)
 -- >>> let sva = SemiValuationAlgebra (review applySemigroup (+)) (ProjectValuation (\_ v -> v))
--- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra Int Set Int
+-- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra (->) Int Set Int
 -- >>> let pva = PresheafValuationAlgebra lat va
 -- >>> let sg = presheafCombineSemigroup pva
 -- >>> runSemigroup sg (Valuation (Set.fromList [1]) 10) (Valuation (Set.fromList [2]) 20)
 -- Valuation (fromList [1,2]) 30
 {-# SPECIALIZE presheafCombineSemigroup ::
-  PresheafValuationAlgebra v set var -> Semigroup (Valuation set var v)
+  PresheafValuationAlgebra (->) v set var -> Semigroup' (Valuation set var v)
   #-}
-presheafCombineSemigroup :: (HasSemigroup algebra v, HasDomainLattice algebra (set var) p) => algebra -> Semigroup (Valuation set var v)
+presheafCombineSemigroup :: (HasSemigroup algebra (->) v, HasDomainLattice algebra (->) (set var) p) => algebra -> Semigroup' (Valuation set var v)
 presheafCombineSemigroup = review applySemigroup . combine
 
 -- | Transitivity of marginalisation: @(phi↓d')↓d'' = phi↓d''@ for @d'' <= d' <= d(phi)@.
 --
--- >>> let lat = setDomainLattice :: DomainLattice (Set Int) (Set Int)
+-- >>> let lat = setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)
 -- >>> let sva = SemiValuationAlgebra (review applySemigroup (+)) (ProjectValuation (\_ v -> v))
--- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra Int Set Int
+-- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra (->) Int Set Int
 -- >>> let pva = PresheafValuationAlgebra lat va
 -- >>> let phi = Valuation (Set.fromList [1,2,3]) 10
 -- >>> lawTransitivity pva (Set.fromList [1,2]) (Set.fromList [1]) phi
 -- True
 {-# SPECIALIZE lawTransitivity ::
-  (Eq v) => PresheafValuationAlgebra v set var -> set var -> set var -> Valuation set var v -> Bool
+  (Eq v) => PresheafValuationAlgebra (->) v set var -> set var -> set var -> Valuation set var v -> Bool
   #-}
-lawTransitivity :: (Eq a, HasProjectValuation p a set var, HasValuation q set' var' a) => p -> set var -> set var -> q -> Bool
+lawTransitivity :: (Eq a, HasProjectValuation p (->) a set var, HasValuation q set' var' a) => p -> set var -> set var -> q -> Bool
 lawTransitivity pva d' d'' phi =
   let step = marginalise pva d'' (marginalise pva d' phi)
       direct = marginalise pva d'' phi
@@ -242,16 +247,16 @@
 
 -- | Domain of combination: @d(phi ⊗ psi) = d(phi) \/ d(psi)@.
 --
--- >>> let lat = setDomainLattice :: DomainLattice (Set Int) (Set Int)
+-- >>> let lat = setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)
 -- >>> let sva = SemiValuationAlgebra (review applySemigroup (+)) (ProjectValuation (\_ v -> v))
--- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra Int Set Int
+-- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra (->) Int Set Int
 -- >>> let pva = PresheafValuationAlgebra lat va
 -- >>> lawCombinationDomain pva (Valuation (Set.fromList [1,2]) 10) (Valuation (Set.fromList [2,3]) 20)
 -- True
 {-# SPECIALIZE lawCombinationDomain ::
-  (Eq (set var)) => PresheafValuationAlgebra v set var -> Valuation set var v -> Valuation set var v -> Bool
+  (Eq (set var)) => PresheafValuationAlgebra (->) v set var -> Valuation set var v -> Valuation set var v -> Bool
   #-}
-lawCombinationDomain :: (HasSemigroup s1 a, Eq (set var), HasValuation s2 set var a, HasValuation s3 set var a, HasDomainLattice s1 (set var) p) => s1 -> s2 -> s3 -> Bool
+lawCombinationDomain :: (HasSemigroup s1 (->) a, Eq (set var), HasValuation s2 set var a, HasValuation s3 set var a, HasDomainLattice s1 (->) (set var) p) => s1 -> s2 -> s3 -> Bool
 lawCombinationDomain pva val1 val2 =
   let lat = view domainLattice pva
       d1 = view valuationDomain val1
@@ -261,16 +266,16 @@
 
 -- | Marginalisation identity: @phi↓d(phi) = phi@ (marginalising to own domain is identity).
 --
--- >>> let lat = setDomainLattice :: DomainLattice (Set Int) (Set Int)
+-- >>> let lat = setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)
 -- >>> let sva = SemiValuationAlgebra (review applySemigroup (+)) (ProjectValuation (\_ v -> v))
--- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra Int Set Int
+-- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra (->) Int Set Int
 -- >>> let pva = PresheafValuationAlgebra lat va
 -- >>> lawMarginalisationIdentity pva (Valuation (Set.fromList [1,2]) 42)
 -- True
 {-# SPECIALIZE lawMarginalisationIdentity ::
-  (Eq (set var), Eq v) => PresheafValuationAlgebra v set var -> Valuation set var v -> Bool
+  (Eq (set var), Eq v) => PresheafValuationAlgebra (->) v set var -> Valuation set var v -> Bool
   #-}
-lawMarginalisationIdentity :: (Eq a, Eq (set var), HasValuation s set var a, HasProjectValuation p a set var) => p -> s -> Bool
+lawMarginalisationIdentity :: (Eq a, Eq (set var), HasValuation s set var a, HasProjectValuation p (->) a set var) => p -> s -> Bool
 lawMarginalisationIdentity pva val =
   let d = view valuationDomain val
       v = view valuationInformation val
@@ -280,17 +285,17 @@
 -- | Neutral element axiom: @combine pva (neutralValuation pva d) phi = phi@
 -- when @d(phi) <= d@ (the neutral valuation is an identity for combination).
 --
--- >>> let lat = setDomainLattice :: DomainLattice (Set Int) (Set Int)
+-- >>> let lat = setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)
 -- >>> let sva = SemiValuationAlgebra (review applySemigroup (+)) (ProjectValuation (\_ v -> v))
--- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra Int Set Int
+-- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra (->) Int Set Int
 -- >>> let pva = PresheafValuationAlgebra lat va
 -- >>> let phi = Valuation (Set.fromList [1]) 42
 -- >>> lawNeutralCombination pva (Set.fromList [1,2]) phi
 -- True
 {-# SPECIALIZE lawNeutralCombination ::
-  (Eq (set var), Eq v) => PresheafValuationAlgebra v set var -> set var -> Valuation set var v -> Bool
+  (Eq (set var), Eq v) => PresheafValuationAlgebra (->) v set var -> set var -> Valuation set var v -> Bool
   #-}
-lawNeutralCombination :: (HasSemigroup s1 a, Eq a, Eq (set var), HasDomainLattice s1 (set var) (set var), HasValuation s2 set var a, HasValuationAlgebra s1 a set var) => s1 -> set var -> s2 -> Bool
+lawNeutralCombination :: (HasSemigroup s1 (->) a, Eq a, Eq (set var), HasDomainLattice s1 (->) (set var) (set var), HasValuation s2 set var a, HasValuationAlgebra s1 (->) a set var) => s1 -> set var -> s2 -> Bool
 lawNeutralCombination pva d phi =
   let lat = view domainLattice pva
       dPhi = view valuationDomain phi
@@ -302,17 +307,17 @@
 
 -- | Null element axiom: @combine pva (nullValuation pva d) phi = nullValuation pva (d \/ d(phi))@.
 --
--- >>> let lat = setDomainLattice :: DomainLattice (Set Int) (Set Int)
+-- >>> let lat = setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)
 -- >>> let sva = SemiValuationAlgebra (review applySemigroup (*)) (ProjectValuation (\_ v -> v))
--- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 1)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra Int Set Int
+-- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 1)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra (->) Int Set Int
 -- >>> let pva = PresheafValuationAlgebra lat va
 -- >>> let phi = Valuation (Set.fromList [1]) 42
 -- >>> lawNullCombination pva (Set.fromList [2]) phi
 -- True
 {-# SPECIALIZE lawNullCombination ::
-  (Eq (set var), Eq v) => PresheafValuationAlgebra v set var -> set var -> Valuation set var v -> Bool
+  (Eq (set var), Eq v) => PresheafValuationAlgebra (->) v set var -> set var -> Valuation set var v -> Bool
   #-}
-lawNullCombination :: (HasSemigroup s1 a, Eq a, Eq (set var), HasValuation s2 set var a, HasDomainLattice s1 (set var) p, HasValuationAlgebra s1 a set var) => s1 -> set var -> s2 -> Bool
+lawNullCombination :: (HasSemigroup s1 (->) a, Eq a, Eq (set var), HasValuation s2 set var a, HasDomainLattice s1 (->) (set var) p, HasValuationAlgebra s1 (->) a set var) => s1 -> set var -> s2 -> Bool
 lawNullCombination pva d phi =
   let lat = view domainLattice pva
       dPhi = view valuationDomain phi
@@ -325,16 +330,16 @@
 
 -- | Combination is commutative: @phi ⊗ psi = psi ⊗ phi@.
 --
--- >>> let lat = setDomainLattice :: DomainLattice (Set Int) (Set Int)
+-- >>> let lat = setDomainLattice :: DomainLattice (->) (Set Int) (Set Int)
 -- >>> let sva = SemiValuationAlgebra (review applySemigroup (+)) (ProjectValuation (\_ v -> v))
--- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra Int Set Int
+-- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 0)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra (->) Int Set Int
 -- >>> let pva = PresheafValuationAlgebra lat va
 -- >>> lawCombinationCommutative pva (Valuation (Set.fromList [1]) 10) (Valuation (Set.fromList [2]) 20)
 -- True
 {-# SPECIALIZE lawCombinationCommutative ::
-  (Eq (set var), Eq v) => PresheafValuationAlgebra v set var -> Valuation set var v -> Valuation set var v -> Bool
+  (Eq (set var), Eq v) => PresheafValuationAlgebra (->) v set var -> Valuation set var v -> Valuation set var v -> Bool
   #-}
-lawCombinationCommutative :: (HasSemigroup s1 a, Eq a, Eq (set var), HasDomainLattice s1 (set var) p, HasValuation s2 set var a, HasValuation s3 set var a) => s1 -> s2 -> s3 -> Bool
+lawCombinationCommutative :: (HasSemigroup s1 (->) a, Eq a, Eq (set var), HasDomainLattice s1 (->) (set var) p, HasValuation s2 set var a, HasValuation s3 set var a) => s1 -> s2 -> s3 -> Bool
 lawCombinationCommutative pva phi psi =
   let Valuation d1 v1 = combine pva phi psi
       Valuation d2 v2 = combine pva psi phi
diff --git a/src/Data/Valuation/ProjectValuation.hs b/src/Data/Valuation/ProjectValuation.hs
--- a/src/Data/Valuation/ProjectValuation.hs
+++ b/src/Data/Valuation/ProjectValuation.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -7,6 +8,7 @@
 -- | A projection function that updates a value given a set of variables.
 module Data.Valuation.ProjectValuation
   ( ProjectValuation (..),
+    ProjectValuation',
     SetProjectValuation,
 
     -- * optics
@@ -20,6 +22,7 @@
   )
 where
 
+import Control.Category (Category (..))
 import Control.Lens
   ( Lens',
     Prism',
@@ -34,14 +37,16 @@
 import Data.Functor.Contravariant.Decide (Decide (..))
 import Data.Functor.Contravariant.Divise (Divise (..))
 import Data.Functor.Contravariant.Divisible (Decidable (..), Divisible (..))
+import Data.Profunctor (Profunctor (..), Strong (..))
+import Data.Semigroupoid (Semigroupoid (..))
 import Data.Set (Set)
 import Data.Valuation.Semigroup
-  ( Semigroup,
+  ( Semigroup',
     applySemigroup,
     runSemigroup,
   )
 import Witherable (Filterable (mapMaybe))
-import Prelude hiding (Semigroup)
+import Prelude hiding (Semigroup, id, (.))
 import qualified Prelude
 
 -- $setup
@@ -54,157 +59,165 @@
 --
 -- >>> let ProjectValuation f = ProjectValuation (\s v -> v + length s) in f [1,2,3] (10 :: Int)
 -- 13
-newtype ProjectValuation v set var
-  = ProjectValuation (set var -> v -> v)
+newtype ProjectValuation p v set var
+  = ProjectValuation (p (set var) (p v v))
 
+type ProjectValuation' v set var =
+  ProjectValuation (->) v set var
+
 instance
-  (ProjectValuation v set var ~ t) =>
-  Rewrapped (ProjectValuation v' set' var') t
+  (ProjectValuation p v set var ~ t) =>
+  Rewrapped (ProjectValuation p' v' set' var') t
 
-instance Wrapped (ProjectValuation v set var) where
-  type Unwrapped (ProjectValuation v set var) = set var -> v -> v
+instance Wrapped (ProjectValuation p v set var) where
+  type Unwrapped (ProjectValuation p v set var) = p (set var) (p v v)
   _Wrapped' = iso (\(ProjectValuation x) -> x) ProjectValuation
 
 -- | Classy lens for types that contain a 'ProjectValuation'.
-class HasProjectValuation c v set var | c -> v set var where
-  projectValuation :: Lens' c (ProjectValuation v set var)
+class HasProjectValuation c p v set var | c -> p v set var where
+  projectValuation :: Lens' c (ProjectValuation p v set var)
 
-instance HasProjectValuation (ProjectValuation v set var) v set var where
+instance HasProjectValuation (ProjectValuation p v set var) p v set var where
   projectValuation = id
 
 -- | Classy prism for types that can be constructed from a 'ProjectValuation'.
-class AsProjectValuation c v set var | c -> v set var where
-  _ProjectValuation :: Prism' c (ProjectValuation v set var)
+class AsProjectValuation c p v set var | c -> p v set var where
+  _ProjectValuation :: Prism' c (ProjectValuation p v set var)
 
-instance AsProjectValuation (ProjectValuation v set var) v set var where
+instance AsProjectValuation (ProjectValuation p v set var) p v set var where
   _ProjectValuation = id
 
 -- | Lens to the underlying function of a 'HasProjectValuation'.
-applyHasProjectValuation :: (HasProjectValuation pv v set var) => Lens' pv (set var -> v -> v)
+applyHasProjectValuation :: (HasProjectValuation pv p v set var) => Lens' pv (p (set var) (p v v))
 applyHasProjectValuation = projectValuation . _Wrapped
 
 -- | Prism to the underlying function of an 'AsProjectValuation'.
-applyAsProjectValuation :: (AsProjectValuation pv v set var) => Prism' pv (set var -> v -> v)
+applyAsProjectValuation :: (AsProjectValuation pv p v set var) => Prism' pv (p (set var) (p v v))
 applyAsProjectValuation = _ProjectValuation . _Wrapped
 
 -- |
 -- >>> import Data.Functor.Contravariant (contramap)
--- >>> let pv = ProjectValuation (\s v -> v + sum s) :: ProjectValuation Int [] Int
+-- >>> let pv = ProjectValuation (\s v -> v + sum s) :: ProjectValuation (->) Int [] Int
 -- >>> let ProjectValuation f = contramap (*2) pv in f [1,2,3] 10
 -- 22
 --
 -- >>> import Data.Functor.Contravariant (contramap)
--- >>> let pv = ProjectValuation (\s v -> v + sum s) :: ProjectValuation Int [] Int
+-- >>> let pv = ProjectValuation (\s v -> v + sum s) :: ProjectValuation (->) Int [] Int
 -- >>> let ProjectValuation f = contramap negate pv in f [1,2,3] 0
 -- -6
-instance (Functor set) => Contravariant (ProjectValuation v set) where
-  contramap f (ProjectValuation g) = ProjectValuation (g . fmap f)
+instance (Functor set, Profunctor p) => Contravariant (ProjectValuation p v set) where
+  contramap f (ProjectValuation g) = ProjectValuation (lmap (fmap f) g)
 
 -- |
 -- >>> import Data.Functor.Contravariant.Divisible (conquer, divide)
--- >>> let ProjectValuation f = conquer :: ProjectValuation Int [] Int in f [1,2,3] 42
+-- >>> let ProjectValuation f = conquer :: ProjectValuation (->) Int [] Int in f [1,2,3] 42
 -- 42
 --
 -- >>> import Data.Functor.Contravariant.Divisible (conquer, divide)
--- >>> let ProjectValuation f = conquer :: ProjectValuation String [] Char in f "abc" "hello"
+-- >>> let ProjectValuation f = conquer :: ProjectValuation (->) String [] Char in f "abc" "hello"
 -- "hello"
 --
 -- >>> import Data.Functor.Contravariant.Divisible (conquer, divide)
--- >>> let pvB = ProjectValuation (\s v -> v + sum s) :: ProjectValuation Int [] Int
--- >>> let pvC = ProjectValuation (\s v -> v * length s) :: ProjectValuation Int [] Int
+-- >>> let pvB = ProjectValuation (\s v -> v + sum s) :: ProjectValuation (->) Int [] Int
+-- >>> let pvC = ProjectValuation (\s v -> v * length s) :: ProjectValuation (->) Int [] Int
 -- >>> let ProjectValuation f = divide (\x -> (x, x * 10)) pvB pvC in f [1,2,3] 5
 -- 21
 --
 -- >>> import Data.Functor.Contravariant.Divisible (conquer, divide)
--- >>> let pvB = ProjectValuation (\s v -> v + sum s) :: ProjectValuation Int [] Int
--- >>> let pvC = ProjectValuation (\s v -> v * length s) :: ProjectValuation Int [] Int
+-- >>> let pvB = ProjectValuation (\s v -> v + sum s) :: ProjectValuation (->) Int [] Int
+-- >>> let pvC = ProjectValuation (\s v -> v * length s) :: ProjectValuation (->) Int [] Int
 -- >>> let ProjectValuation f = divide (\x -> (x, x)) pvB pvC in f [1,2,3] 5
 -- 21
-instance (Functor set) => Divisible (ProjectValuation v set) where
-  conquer = ProjectValuation (const id)
+instance (Functor set, Strong p, Category p) => Divisible (ProjectValuation p v set) where
+  conquer = ProjectValuation (rmap (const id) id)
   divide split (ProjectValuation pb) (ProjectValuation pc) =
-    ProjectValuation (\fa v -> pb (fmap (fst . split) fa) (pc (fmap (snd . split) fa) v))
+    let pb' = lmap (fmap (fst . split)) pb
+        pc' = lmap (fmap (snd . split)) pc
+     in ProjectValuation (lmap (\x -> (x, x)) (rmap (uncurry (.)) (second' pc' . first' pb')))
 
 -- |
 -- >>> import Data.Functor.Contravariant.Divisible (choose, lose)
 -- >>> import Data.Void (Void, absurd)
--- >>> let ProjectValuation f = lose absurd :: ProjectValuation Int [] Void in f [] 42
+-- >>> let ProjectValuation f = lose absurd :: ProjectValuation (->) Int [] Void in f [] 42
 -- 42
 --
 -- >>> import Data.Functor.Contravariant.Divisible (choose)
--- >>> let pvB = ProjectValuation (\s v -> v + sum s) :: ProjectValuation Int [] Int
--- >>> let pvC = ProjectValuation (\s v -> v * length s) :: ProjectValuation Int [] Int
+-- >>> let pvB = ProjectValuation (\s v -> v + sum s) :: ProjectValuation (->) Int [] Int
+-- >>> let pvC = ProjectValuation (\s v -> v * length s) :: ProjectValuation (->) Int [] Int
 -- >>> let ProjectValuation f = choose (\x -> if even x then Left x else Right x) pvB pvC in f [1,2,3,4] 10
 -- 26
 --
 -- >>> import Data.Functor.Contravariant.Divisible (choose)
--- >>> let pvB = ProjectValuation (\s v -> v + sum s) :: ProjectValuation Int [] Int
--- >>> let pvC = ProjectValuation (\s v -> v * length s) :: ProjectValuation Int [] Int
+-- >>> let pvB = ProjectValuation (\s v -> v + sum s) :: ProjectValuation (->) Int [] Int
+-- >>> let pvC = ProjectValuation (\s v -> v * length s) :: ProjectValuation (->) Int [] Int
 -- >>> let ProjectValuation f = choose Left pvB pvC in f [1,2,3] 10
 -- 6
 --
 -- >>> import Data.Functor.Contravariant.Divisible (choose)
--- >>> let pvB = ProjectValuation (\s v -> v + sum s) :: ProjectValuation Int [] Int
--- >>> let pvC = ProjectValuation (\s v -> v * length s) :: ProjectValuation Int [] Int
+-- >>> let pvB = ProjectValuation (\s v -> v + sum s) :: ProjectValuation (->) Int [] Int
+-- >>> let pvC = ProjectValuation (\s v -> v * length s) :: ProjectValuation (->) Int [] Int
 -- >>> let ProjectValuation f = choose Right pvB pvC in f [1,2,3] 10
 -- 30
-instance (Filterable set) => Decidable (ProjectValuation v set) where
-  lose _ = ProjectValuation (const id)
+instance (Filterable set, Strong p, Category p) => Decidable (ProjectValuation p v set) where
+  lose _ = ProjectValuation (rmap (const id) id)
   choose ch (ProjectValuation pb) (ProjectValuation pc) =
-    ProjectValuation
-      ( \fa v ->
-          let fb = mapMaybe (either Just (const Nothing) . ch) fa
-              fc = mapMaybe (either (const Nothing) Just . ch) fa
-           in pb fb (pc fc v)
-      )
+    let pb' = lmap (mapMaybe (either Just (const Nothing) . ch)) pb
+        pc' = lmap (mapMaybe (either (const Nothing) Just . ch)) pc
+     in ProjectValuation (lmap (\x -> (x, x)) (rmap (uncurry (.)) (second' pc' . first' pb')))
 
 -- |
 -- >>> import Data.Functor.Contravariant.Divise (divise)
--- >>> let pvB = ProjectValuation (\s v -> v + sum s) :: ProjectValuation Int [] Int
--- >>> let pvC = ProjectValuation (\s v -> v * length s) :: ProjectValuation Int [] Int
+-- >>> let pvB = ProjectValuation (\s v -> v + sum s) :: ProjectValuation (->) Int [] Int
+-- >>> let pvC = ProjectValuation (\s v -> v * length s) :: ProjectValuation (->) Int [] Int
 -- >>> let ProjectValuation f = divise (\x -> (x, x * 10)) pvB pvC in f [1,2,3] 5
 -- 21
-instance (Functor set) => Divise (ProjectValuation v set) where
-  divise = divide
+instance (Functor set, Strong p, Semigroupoid p) => Divise (ProjectValuation p v set) where
+  divise split (ProjectValuation pb) (ProjectValuation pc) =
+    let pb' = lmap (fmap (fst . split)) pb
+        pc' = lmap (fmap (snd . split)) pc
+     in ProjectValuation (lmap (\x -> (x, x)) (rmap (uncurry o) (second' pc' `o` first' pb')))
 
 -- |
 -- >>> import Data.Functor.Contravariant.Decide (decide)
--- >>> let pvB = ProjectValuation (\s v -> v + sum s) :: ProjectValuation Int [] Int
--- >>> let pvC = ProjectValuation (\s v -> v * length s) :: ProjectValuation Int [] Int
+-- >>> let pvB = ProjectValuation (\s v -> v + sum s) :: ProjectValuation (->) Int [] Int
+-- >>> let pvC = ProjectValuation (\s v -> v * length s) :: ProjectValuation (->) Int [] Int
 -- >>> let ProjectValuation f = decide (\x -> if even x then Left x else Right x) pvB pvC in f [1,2,3,4] 10
 -- 26
-instance (Filterable set) => Decide (ProjectValuation v set) where
-  decide = choose
+instance (Filterable set, Strong p, Semigroupoid p) => Decide (ProjectValuation p v set) where
+  decide ch (ProjectValuation pb) (ProjectValuation pc) =
+    let pb' = lmap (mapMaybe (either Just (const Nothing) . ch)) pb
+        pc' = lmap (mapMaybe (either (const Nothing) Just . ch)) pc
+     in ProjectValuation (lmap (\x -> (x, x)) (rmap (uncurry o) (second' pc' `o` first' pb')))
 
 -- |
 -- >>> import Data.Functor.Contravariant.Conclude (conclude)
 -- >>> import Data.Void (absurd)
--- >>> let ProjectValuation f = conclude absurd :: ProjectValuation Int [] Void in f [] 42
+-- >>> let ProjectValuation f = conclude absurd :: ProjectValuation (->) Int [] Void in f [] 42
 -- 42
-instance (Filterable set) => Conclude (ProjectValuation v set) where
-  conclude _ = ProjectValuation (const id)
+instance (Filterable set, Strong p, Semigroupoid p, Category p) => Conclude (ProjectValuation p v set) where
+  conclude _ = ProjectValuation (rmap (const id) id)
 
 -- |
 -- >>> let ProjectValuation f = runSemigroup semigroupProjectValuation (ProjectValuation (\_ v -> v + 1)) (ProjectValuation (\_ v -> v * 2)) in f [] (3 :: Int)
 -- 7
-semigroupProjectValuation :: Semigroup (ProjectValuation v set var)
+semigroupProjectValuation :: Semigroup' (ProjectValuation (->) v set var)
 semigroupProjectValuation = review applySemigroup (\(ProjectValuation p1) (ProjectValuation p2) -> ProjectValuation (\s -> p1 s . p2 s))
 
 -- |
--- >>> let p1 = ProjectValuation (\s v -> v + sum s) :: ProjectValuation Int [] Int
--- >>> let p2 = ProjectValuation (\s v -> v * length s) :: ProjectValuation Int [] Int
+-- >>> let p1 = ProjectValuation (\s v -> v + sum s) :: ProjectValuation (->) Int [] Int
+-- >>> let p2 = ProjectValuation (\s v -> v * length s) :: ProjectValuation (->) Int [] Int
 -- >>> let ProjectValuation f = p1 <> p2 in f [1,2,3] 5
 -- 21
-instance Prelude.Semigroup (ProjectValuation v set var) where
+instance Prelude.Semigroup (ProjectValuation (->) v set var) where
   (<>) = runSemigroup semigroupProjectValuation
 
 -- |
--- >>> let p = ProjectValuation (\s v -> v + sum s) :: ProjectValuation Int [] Int
+-- >>> let p = ProjectValuation (\s v -> v + sum s) :: ProjectValuation (->) Int [] Int
 -- >>> let ProjectValuation f = mempty <> p in f [1,2,3] 5
 -- 11
-instance Monoid (ProjectValuation v set var) where
+instance Monoid (ProjectValuation (->) v set var) where
   mempty = ProjectValuation (const id)
 
 -- | A 'ProjectValuation' specialised to 'Set'.
-type SetProjectValuation v var =
-  ProjectValuation v Set var
+type SetProjectValuation p v var =
+  ProjectValuation p v Set var
diff --git a/src/Data/Valuation/SemiValuationAlgebra.hs b/src/Data/Valuation/SemiValuationAlgebra.hs
--- a/src/Data/Valuation/SemiValuationAlgebra.hs
+++ b/src/Data/Valuation/SemiValuationAlgebra.hs
@@ -5,6 +5,7 @@
 -- | A semi-valuation algebra: a semigroup paired with a projection.
 module Data.Valuation.SemiValuationAlgebra
   ( SemiValuationAlgebra (..),
+    SemiValuationAlgebra',
     SetSemiValuationAlgebra,
 
     -- * optics
@@ -16,6 +17,8 @@
   )
 where
 
+import Control.Arrow (Arrow (..))
+import Control.Category (Category (..))
 import Control.Lens
   ( Lens,
     Lens',
@@ -27,6 +30,8 @@
 import Data.Functor.Contravariant.Decide (Decide (..))
 import Data.Functor.Contravariant.Divise (Divise (..))
 import Data.Functor.Contravariant.Divisible (Decidable (..), Divisible (..))
+import Data.Profunctor (Profunctor (..), Strong (..))
+import Data.Semigroupoid (Semigroupoid)
 import Data.Set (Set)
 import Data.Valuation.ProjectValuation
   ( HasProjectValuation (..),
@@ -38,7 +43,7 @@
     applySemigroup,
   )
 import Witherable (Filterable)
-import Prelude hiding (Semigroup)
+import Prelude hiding (Semigroup, id, (.))
 import qualified Prelude
 
 -- $setup
@@ -49,135 +54,138 @@
 -- >>> import Prelude hiding (Semigroup)
 
 -- |
--- >>> let SemiValuationAlgebra sg (ProjectValuation p) = SemiValuationAlgebra (review applySemigroup (+)) (ProjectValuation (\s v -> v + sum s)) :: SemiValuationAlgebra Int [] Int
+-- >>> let SemiValuationAlgebra sg (ProjectValuation p) = SemiValuationAlgebra (review applySemigroup (+)) (ProjectValuation (\s v -> v + sum s)) :: SemiValuationAlgebra (->) Int [] Int
 -- >>> runSemigroup sg 3 4
 -- 7
 -- >>> p [1,2,3] 10
 -- 16
-data SemiValuationAlgebra v set var
+data SemiValuationAlgebra p v set var
   = SemiValuationAlgebra
       -- | algebra combine
-      (Semigroup v)
+      (Semigroup p v)
       -- | algebra project
-      (ProjectValuation v set var)
+      (ProjectValuation p v set var)
 
+type SemiValuationAlgebra' v set var =
+  SemiValuationAlgebra (->) v set var
+
 -- | Type-changing lens to the 'ProjectValuation' component.
-projectValuation' :: Lens (SemiValuationAlgebra v set var) (SemiValuationAlgebra v set' var') (ProjectValuation v set var) (ProjectValuation v set' var')
+projectValuation' :: Lens (SemiValuationAlgebra p v set var) (SemiValuationAlgebra p v set' var') (ProjectValuation p v set var) (ProjectValuation p v set' var')
 projectValuation' f (SemiValuationAlgebra s p) = fmap (SemiValuationAlgebra s) (f p)
 
 -- | Classy lens for types that contain a 'SemiValuationAlgebra'.
-class HasSemiValuationAlgebra c v set var | c -> v set var where
+class HasSemiValuationAlgebra c p v set var | c -> p v set var where
   semiValuationAlgebra ::
-    Lens' c (SemiValuationAlgebra v set var)
+    Lens' c (SemiValuationAlgebra p v set var)
 
-instance HasSemiValuationAlgebra (SemiValuationAlgebra v set var) v set var where
+instance HasSemiValuationAlgebra (SemiValuationAlgebra p v set var) p v set var where
   semiValuationAlgebra = id
 
 -- | Classy prism for types that can be constructed from a 'SemiValuationAlgebra'.
-class AsSemiValuationAlgebra c v set var | c -> v set var where
+class AsSemiValuationAlgebra c p v set var | c -> p v set var where
   _SemiValuationAlgebra ::
-    Prism' c (SemiValuationAlgebra v set var)
+    Prism' c (SemiValuationAlgebra p v set var)
 
-instance AsSemiValuationAlgebra (SemiValuationAlgebra v set var) v set var where
+instance AsSemiValuationAlgebra (SemiValuationAlgebra p v set var) p v set var where
   _SemiValuationAlgebra = id
 
-instance HasSemigroup (SemiValuationAlgebra v set var) v where
+instance HasSemigroup (SemiValuationAlgebra p v set var) p v where
   semigroup f (SemiValuationAlgebra s p) = fmap (`SemiValuationAlgebra` p) (f s)
 
-instance HasProjectValuation (SemiValuationAlgebra v set var) v set var where
+instance HasProjectValuation (SemiValuationAlgebra p v set var) p v set var where
   projectValuation = projectValuation'
 
 -- |
 -- >>> import Data.Functor.Contravariant (contramap)
--- >>> let sva = SemiValuationAlgebra (review applySemigroup (+)) (ProjectValuation (\s v -> v + sum s)) :: SemiValuationAlgebra Int [] Int
+-- >>> let sva = SemiValuationAlgebra (review applySemigroup (+)) (ProjectValuation (\s v -> v + sum s)) :: SemiValuationAlgebra (->) Int [] Int
 -- >>> let SemiValuationAlgebra sg (ProjectValuation p) = contramap (*2) sva
 -- >>> runSemigroup sg 3 4
 -- 7
 -- >>> p [1,2,3] 10
 -- 22
-instance (Functor set) => Contravariant (SemiValuationAlgebra v set) where
+instance (Functor set, Profunctor p) => Contravariant (SemiValuationAlgebra p v set) where
   contramap f (SemiValuationAlgebra s p) = SemiValuationAlgebra s (contramap f p)
 
 -- |
 -- >>> import Data.Functor.Contravariant.Divisible (conquer, divide)
--- >>> let SemiValuationAlgebra sg (ProjectValuation p) = conquer :: SemiValuationAlgebra [Int] [] Int
+-- >>> let SemiValuationAlgebra sg (ProjectValuation p) = conquer :: SemiValuationAlgebra (->) [Int] [] Int
 -- >>> runSemigroup sg [1,2] [3,4]
 -- [1,2,3,4]
 -- >>> p [10,20,30] [42]
 -- [42]
 --
 -- >>> import Data.Functor.Contravariant.Divisible (conquer, divide)
--- >>> let sva1 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ s)) :: SemiValuationAlgebra [Int] [] Int
--- >>> let sva2 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ reverse s)) :: SemiValuationAlgebra [Int] [] Int
+-- >>> let sva1 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ s)) :: SemiValuationAlgebra (->) [Int] [] Int
+-- >>> let sva2 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ reverse s)) :: SemiValuationAlgebra (->) [Int] [] Int
 -- >>> let SemiValuationAlgebra sg (ProjectValuation p) = divide (\x -> (x, x + 10)) sva1 sva2
 -- >>> runSemigroup sg [1] [2]
 -- [1,2]
 -- >>> p [1,2,3] [0]
 -- [0,13,12,11,1,2,3]
-instance (Functor set, Prelude.Semigroup v) => Divisible (SemiValuationAlgebra v set) where
-  conquer = SemiValuationAlgebra (review applySemigroup (<>)) conquer
+instance (Functor set, Strong p, Arrow p, Prelude.Semigroup v) => Divisible (SemiValuationAlgebra p v set) where
+  conquer = SemiValuationAlgebra (review applySemigroup (rmap arr (arr (<>)))) conquer
   divide f (SemiValuationAlgebra s p1) (SemiValuationAlgebra _ p2) =
     SemiValuationAlgebra s (divide f p1 p2)
 
 -- |
 -- >>> import Data.Functor.Contravariant.Divisible (choose, lose)
 -- >>> import Data.Void (Void, absurd)
--- >>> let SemiValuationAlgebra sg (ProjectValuation p) = lose absurd :: SemiValuationAlgebra [Int] [] Void
+-- >>> let SemiValuationAlgebra sg (ProjectValuation p) = lose absurd :: SemiValuationAlgebra (->) [Int] [] Void
 -- >>> runSemigroup sg [1,2] [3,4]
 -- [1,2,3,4]
 -- >>> p [] [42]
 -- [42]
 --
 -- >>> import Data.Functor.Contravariant.Divisible (choose)
--- >>> let sva1 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ s)) :: SemiValuationAlgebra [Int] [] Int
--- >>> let sva2 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ map negate s)) :: SemiValuationAlgebra [Int] [] Int
+-- >>> let sva1 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ s)) :: SemiValuationAlgebra (->) [Int] [] Int
+-- >>> let sva2 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ map negate s)) :: SemiValuationAlgebra (->) [Int] [] Int
 -- >>> let SemiValuationAlgebra sg (ProjectValuation p) = choose (\x -> if even x then Left x else Right x) sva1 sva2
 -- >>> runSemigroup sg [1] [2]
 -- [1,2]
 -- >>> p [1,2,3,4] [0]
 -- [0,-1,-3,2,4]
-instance (Filterable set, Prelude.Semigroup v) => Decidable (SemiValuationAlgebra v set) where
-  lose f = SemiValuationAlgebra (review applySemigroup (<>)) (lose f)
+instance (Filterable set, Strong p, Arrow p, Prelude.Semigroup v) => Decidable (SemiValuationAlgebra p v set) where
+  lose f = SemiValuationAlgebra (review applySemigroup (rmap arr (arr (<>)))) (lose f)
   choose f (SemiValuationAlgebra s p1) (SemiValuationAlgebra _ p2) =
     SemiValuationAlgebra s (choose f p1 p2)
 
 -- |
 -- >>> import Data.Functor.Contravariant.Divise (divise)
--- >>> let sva1 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ s)) :: SemiValuationAlgebra [Int] [] Int
--- >>> let sva2 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ reverse s)) :: SemiValuationAlgebra [Int] [] Int
+-- >>> let sva1 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ s)) :: SemiValuationAlgebra (->) [Int] [] Int
+-- >>> let sva2 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ reverse s)) :: SemiValuationAlgebra (->) [Int] [] Int
 -- >>> let SemiValuationAlgebra sg (ProjectValuation p) = divise (\x -> (x, x + 10)) sva1 sva2
 -- >>> runSemigroup sg [1] [2]
 -- [1,2]
 -- >>> p [1,2,3] [0]
 -- [0,13,12,11,1,2,3]
-instance (Functor set) => Divise (SemiValuationAlgebra v set) where
+instance (Functor set, Strong p, Semigroupoid p) => Divise (SemiValuationAlgebra p v set) where
   divise f (SemiValuationAlgebra s p1) (SemiValuationAlgebra _ p2) =
     SemiValuationAlgebra s (divise f p1 p2)
 
 -- |
 -- >>> import Data.Functor.Contravariant.Decide (decide)
--- >>> let sva1 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ s)) :: SemiValuationAlgebra [Int] [] Int
--- >>> let sva2 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ map negate s)) :: SemiValuationAlgebra [Int] [] Int
+-- >>> let sva1 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ s)) :: SemiValuationAlgebra (->) [Int] [] Int
+-- >>> let sva2 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ map negate s)) :: SemiValuationAlgebra (->) [Int] [] Int
 -- >>> let SemiValuationAlgebra sg (ProjectValuation p) = decide (\x -> if even x then Left x else Right x) sva1 sva2
 -- >>> runSemigroup sg [1] [2]
 -- [1,2]
 -- >>> p [1,2,3,4] [0]
 -- [0,-1,-3,2,4]
-instance (Filterable set) => Decide (SemiValuationAlgebra v set) where
+instance (Filterable set, Strong p, Semigroupoid p) => Decide (SemiValuationAlgebra p v set) where
   decide f (SemiValuationAlgebra s p1) (SemiValuationAlgebra _ p2) =
     SemiValuationAlgebra s (decide f p1 p2)
 
 -- |
 -- >>> import Data.Functor.Contravariant.Conclude (conclude)
 -- >>> import Data.Void (absurd)
--- >>> let SemiValuationAlgebra sg (ProjectValuation p) = conclude absurd :: SemiValuationAlgebra [Int] [] Void
+-- >>> let SemiValuationAlgebra sg (ProjectValuation p) = conclude absurd :: SemiValuationAlgebra (->) [Int] [] Void
 -- >>> runSemigroup sg [1,2] [3,4]
 -- [1,2,3,4]
 -- >>> p [] [42]
 -- [42]
-instance (Filterable set, Prelude.Semigroup v) => Conclude (SemiValuationAlgebra v set) where
-  conclude f = SemiValuationAlgebra (review applySemigroup (<>)) (conclude f)
+instance (Filterable set, Strong p, Semigroupoid p, Arrow p, Prelude.Semigroup v) => Conclude (SemiValuationAlgebra p v set) where
+  conclude f = SemiValuationAlgebra (review applySemigroup (rmap arr (arr (<>)))) (conclude f)
 
 -- | A 'SemiValuationAlgebra' specialised to 'Set'.
-type SetSemiValuationAlgebra v var =
-  SemiValuationAlgebra v Set var
+type SetSemiValuationAlgebra p v var =
+  SemiValuationAlgebra p v Set var
diff --git a/src/Data/Valuation/Semigroup.hs b/src/Data/Valuation/Semigroup.hs
--- a/src/Data/Valuation/Semigroup.hs
+++ b/src/Data/Valuation/Semigroup.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -7,6 +8,7 @@
 -- | First-class semigroup values, independent of the 'Prelude.Semigroup' type class.
 module Data.Valuation.Semigroup
   ( Semigroup (..),
+    Semigroup',
 
     -- * optics
     HasSemigroup (..),
@@ -122,39 +124,42 @@
 import qualified Prelude
 
 -- | A first-class semigroup: an associative binary operation on @a@.
-newtype Semigroup a
-  = Semigroup (a -> a -> a)
+newtype Semigroup p a
+  = Semigroup (p a (p a a))
 
-instance (Semigroup a ~ t) => Rewrapped (Semigroup a') t
+-- | A 'Semigroup' specialised to @(->)@.
+type Semigroup' a = Semigroup (->) a
 
-instance Wrapped (Semigroup a) where
-  type Unwrapped (Semigroup a) = a -> a -> a
+instance (Semigroup p a ~ t) => Rewrapped (Semigroup p' a') t
+
+instance Wrapped (Semigroup p a) where
+  type Unwrapped (Semigroup p a) = p a (p a a)
   _Wrapped' = iso (\(Semigroup x) -> x) Semigroup
 
 -- | Classy lens for types that contain a 'Semigroup'.
-class HasSemigroup c a | c -> a where
-  semigroup :: Lens' c (Semigroup a)
+class HasSemigroup c p a | c -> p a where
+  semigroup :: Lens' c (Semigroup p a)
 
-instance HasSemigroup (Semigroup a) a where
+instance HasSemigroup (Semigroup p a) p a where
   semigroup = id
 
 -- | Classy prism for types that can be constructed from a 'Semigroup'.
-class AsSemigroup c a | c -> a where
-  _Semigroup :: Prism' c (Semigroup a)
+class AsSemigroup c p a | c -> p a where
+  _Semigroup :: Prism' c (Semigroup p a)
 
-instance AsSemigroup (Semigroup a) a where
+instance AsSemigroup (Semigroup p a) p a where
   _Semigroup = id
 
 -- | Iso between a 'Semigroup' and its underlying binary operation.
-applySemigroup :: Iso (Semigroup a) (Semigroup a') (a -> a -> a) (a' -> a' -> a')
+applySemigroup :: Iso (Semigroup p a) (Semigroup p' a') (p a (p a a)) (p' a' (p' a' a'))
 applySemigroup = _Wrapped
 
 -- | Lens to the underlying binary operation of a 'HasSemigroup'.
-applyHasSemigroup :: (HasSemigroup s a) => Lens' s (a -> a -> a)
+applyHasSemigroup :: (HasSemigroup s (->) a) => Lens' s (a -> a -> a)
 applyHasSemigroup = semigroup . applySemigroup
 
 -- | Prism to the underlying binary operation of an 'AsSemigroup'.
-applyAsSemigroup :: (AsSemigroup s a) => Prism' s (a -> a -> a)
+applyAsSemigroup :: (AsSemigroup s (->) a) => Prism' s (a -> a -> a)
 applyAsSemigroup = _Semigroup . applySemigroup
 
 -- |
@@ -196,7 +201,7 @@
 --
 -- >>> lawAssociative second (1 :: Int) 2 3
 -- True
-lawAssociative :: (Eq a) => Semigroup a -> a -> a -> a -> Bool
+lawAssociative :: (Eq a) => Semigroup' a -> a -> a -> a -> Bool
 lawAssociative s a b c =
   let f = runSemigroup s
    in f (f a b) c == f a (f b c)
@@ -204,17 +209,17 @@
 -- |
 -- >>> runSemigroup semigroup' "ab" "cd" :: String
 -- "abcd"
-semigroup' :: (Prelude.Semigroup a) => Semigroup a
+semigroup' :: (Prelude.Semigroup a) => Semigroup' a
 semigroup' = review applySemigroup (<>)
 
 -- |
 -- >>> runSemigroup sum 3 4 :: Int
 -- 7
-runSemigroup :: Semigroup a -> a -> a -> a
+runSemigroup :: Semigroup' a -> a -> a -> a
 runSemigroup (Semigroup f) = f
 
--- | Map a 'Semigroup' through an isomorphism (unwrap, wrap).
-mapSemigroup :: (b -> a) -> (a -> b) -> Semigroup a -> Semigroup b
+-- | Map a 'Semigroup'' through an isomorphism (unwrap, wrap).
+mapSemigroup :: (b -> a) -> (a -> b) -> Semigroup' a -> Semigroup' b
 mapSemigroup unwrap wrap s = review applySemigroup (\b1 b2 -> wrap (runSemigroup s (unwrap b1) (unwrap b2)))
 
 -- |
@@ -223,13 +228,13 @@
 --
 -- >>> runSemigroup (liftSemigroup sum) (Just 3) (Just 4) :: Maybe Int
 -- Just 7
-liftSemigroup :: (Applicative f) => Semigroup a -> Semigroup (f a)
+liftSemigroup :: (Applicative f) => Semigroup' a -> Semigroup' (f a)
 liftSemigroup = review applySemigroup . liftA2 . runSemigroup
 
 -- |
 -- >>> liftRunSemigroup sum [1, 2] [10, 20] :: [Int]
 -- [11,21,12,22]
-liftRunSemigroup :: (Applicative f) => Semigroup a -> f a -> f a -> f a
+liftRunSemigroup :: (Applicative f) => Semigroup' a -> f a -> f a -> f a
 liftRunSemigroup = liftA2 . runSemigroup
 
 -- |
@@ -238,7 +243,7 @@
 --
 -- >>> runSemigroup first "a" "b"
 -- "a"
-first :: Semigroup a
+first :: Semigroup' a
 first = review applySemigroup const
 
 -- |
@@ -247,7 +252,7 @@
 --
 -- >>> runSemigroup second "a" "b"
 -- "b"
-second :: Semigroup a
+second :: Semigroup' a
 second = review applySemigroup (const id)
 
 -- |
@@ -256,7 +261,7 @@
 --
 -- >>> runSemigroup (dual second) 1 2 :: Int
 -- 1
-dual :: Semigroup a -> Semigroup a
+dual :: Semigroup' a -> Semigroup' a
 dual = review applySemigroup . flip . runSemigroup
 
 -- |
@@ -265,7 +270,7 @@
 --
 -- >>> runSemigroup min 5 3 :: Int
 -- 3
-min :: (Ord a) => Semigroup a
+min :: (Ord a) => Semigroup' a
 min = review applySemigroup Prelude.min
 
 -- |
@@ -274,7 +279,7 @@
 --
 -- >>> runSemigroup max 5 3 :: Int
 -- 5
-max :: (Ord a) => Semigroup a
+max :: (Ord a) => Semigroup' a
 max = review applySemigroup Prelude.max
 
 -- |
@@ -283,7 +288,7 @@
 --
 -- >>> runSemigroup sum 0 5 :: Int
 -- 5
-sum :: (Num a) => Semigroup a
+sum :: (Num a) => Semigroup' a
 sum = review applySemigroup (+)
 
 -- |
@@ -292,7 +297,7 @@
 --
 -- >>> runSemigroup product 1 5 :: Int
 -- 5
-product :: (Num a) => Semigroup a
+product :: (Num a) => Semigroup' a
 product = review applySemigroup (*)
 
 -- |
@@ -304,7 +309,7 @@
 --
 -- >>> runSemigroup Data.Valuation.Semigroup.all False False
 -- False
-all :: Semigroup Bool
+all :: Semigroup' Bool
 all = review applySemigroup (&&)
 
 -- |
@@ -316,7 +321,7 @@
 --
 -- >>> runSemigroup Data.Valuation.Semigroup.any False True
 -- True
-any :: Semigroup Bool
+any :: Semigroup' Bool
 any = review applySemigroup (||)
 
 -- |
@@ -325,19 +330,19 @@
 --
 -- >>> runSemigroup endo (*2) (+1) 3 :: Int
 -- 8
-endo :: Semigroup (a -> a)
+endo :: Semigroup' (a -> a)
 endo = review applySemigroup (.)
 
 -- |
 -- >>> runSemigroup endoDual (+1) (*2) 3 :: Int
 -- 8
-endoDual :: Semigroup (a -> a)
+endoDual :: Semigroup' (a -> a)
 endoDual = dual endo
 
 -- |
 -- >>> runSemigroup unit () ()
 -- ()
-unit :: Semigroup ()
+unit :: Semigroup' ()
 unit = review applySemigroup (\() () -> ())
 
 -- |
@@ -346,7 +351,7 @@
 --
 -- >>> runSemigroup (pair min max) (1, 2) (3, 4) :: (Int, Int)
 -- (1,4)
-pair :: Semigroup a -> Semigroup b -> Semigroup (a, b)
+pair :: Semigroup' a -> Semigroup' b -> Semigroup' (a, b)
 pair sa sb = review applySemigroup (\(a1, b1) (a2, b2) -> (runSemigroup sa a1 a2, runSemigroup sb b1 b2))
 
 -- |
@@ -361,7 +366,7 @@
 --
 -- >>> runSemigroup ordering GT LT
 -- GT
-ordering :: Semigroup Ordering
+ordering :: Semigroup' Ordering
 ordering = review applySemigroup (\a b -> if a /= EQ then a else b)
 
 -- |
@@ -376,7 +381,7 @@
 --
 -- >>> runSemigroup (Data.Valuation.Semigroup.maybe sum) Nothing Nothing :: Maybe Int
 -- Nothing
-maybe :: Semigroup a -> Semigroup (Maybe a)
+maybe :: Semigroup' a -> Semigroup' (Maybe a)
 maybe s = review applySemigroup (\a1 a2 -> Prelude.maybe a2 (\a1' -> Prelude.maybe a1 (Just . runSemigroup s a1') a2) a1)
 
 -- |
@@ -385,19 +390,19 @@
 --
 -- >>> runSemigroup list "ab" "cd"
 -- "abcd"
-list :: Semigroup [a]
+list :: Semigroup' [a]
 list = review applySemigroup (<>)
 
 -- |
 -- >>> runSemigroup nonEmpty (1 :| [2]) (3 :| [4]) :: NonEmpty Int
 -- 1 :| [2,3,4]
-nonEmpty :: Semigroup (NonEmpty a)
+nonEmpty :: Semigroup' (NonEmpty a)
 nonEmpty = review applySemigroup (\(a :| as) (b :| bs) -> a :| (as <> (b : bs)))
 
 -- |
 -- >>> runSemigroup (io sum) (pure 3) (pure 4) :: IO Int
 -- 7
-io :: Semigroup a -> Semigroup (IO a)
+io :: Semigroup' a -> Semigroup' (IO a)
 io = liftSemigroup
 
 -- |
@@ -412,19 +417,19 @@
 --
 -- >>> runSemigroup Data.Valuation.Semigroup.either (Left "a") (Left "b") :: Either String String
 -- Left "b"
-either :: Semigroup (Either a b)
+either :: Semigroup' (Either a b)
 either = review applySemigroup (\a b -> case a of Right _ -> a; Left _ -> b)
 
 -- | Vacuous semigroup on 'Void'.
-void :: Semigroup Void
+void :: Semigroup' Void
 void = review applySemigroup (pure . absurd)
 
 -- | Semigroup on 'ByteArray' via concatenation.
-byteArray :: Semigroup ByteArray
+byteArray :: Semigroup' ByteArray
 byteArray = semigroup'
 
 -- | Semigroup on 'Event' via bitwise OR.
-event :: Semigroup Event
+event :: Semigroup' Event
 event = semigroup'
 
 -- |
@@ -439,7 +444,7 @@
 -- >>> let cmp2 = Comparison compare
 -- >>> getComparison (runSemigroup comparison cmp1 cmp2) 1 2
 -- LT
-comparison :: Semigroup (Comparison a)
+comparison :: Semigroup' (Comparison a)
 comparison = semigroup'
 
 -- |
@@ -454,7 +459,7 @@
 -- >>> let eq2 = Equivalence (\a b -> even a == even b)
 -- >>> getEquivalence (runSemigroup equivalence eq1 eq2) 2 4
 -- False
-equivalence :: Semigroup (Equivalence a)
+equivalence :: Semigroup' (Equivalence a)
 equivalence = semigroup'
 
 -- |
@@ -475,77 +480,77 @@
 -- >>> let p2 = Predicate (> 0)
 -- >>> getPredicate (runSemigroup predicate p1 p2) (-2)
 -- False
-predicate :: Semigroup (Predicate a)
+predicate :: Semigroup' (Predicate a)
 predicate = semigroup'
 
 -- |
 -- >>> runSemigroup (Data.Valuation.Semigroup.op sum) (+ 1) (+ 2) 10 :: Int
 -- 23
-op :: Semigroup b -> Semigroup (a -> b)
+op :: Semigroup' b -> Semigroup' (a -> b)
 op = liftSemigroup
 
 -- |
 -- >>> runSemigroup Data.Valuation.Semigroup.and (0xFF :: Int) (0x0F :: Int) :: Int
 -- 15
-and :: (Bits a) => Semigroup a
+and :: (Bits a) => Semigroup' a
 and = review applySemigroup (.&.)
 
 -- |
 -- >>> runSemigroup ior (0xF0 :: Int) (0x0F :: Int) :: Int
 -- 255
-ior :: (Bits a) => Semigroup a
+ior :: (Bits a) => Semigroup' a
 ior = review applySemigroup (.|.)
 
 -- |
 -- >>> runSemigroup Data.Valuation.Semigroup.xor (0xFF :: Int) (0x0F :: Int) :: Int
 -- 240
-xor :: (Bits a) => Semigroup a
+xor :: (Bits a) => Semigroup' a
 xor = review applySemigroup Data.Bits.xor
 
 -- |
 -- >>> import Data.Word (Word8)
 -- >>> runSemigroup iff (0xFF :: Word8) (0x0F :: Word8)
 -- 15
-iff :: (FiniteBits a) => Semigroup a
+iff :: (FiniteBits a) => Semigroup' a
 iff = review applySemigroup (\a b -> complement (Data.Bits.xor a b))
 
 -- |
 -- >>> runSemigroup wrappedMonoid "ab" "cd"
 -- "abcd"
-wrappedMonoid :: (Prelude.Monoid a) => Semigroup a
+wrappedMonoid :: (Prelude.Monoid a) => Semigroup' a
 wrappedMonoid = review applySemigroup mappend
 
 -- |
 -- >>> import Data.Functor.Identity (Identity(..))
 -- >>> runSemigroup (identity sum) (Identity 3) (Identity 4)
 -- Identity 7
-identity :: Semigroup a -> Semigroup (Identity a)
+identity :: Semigroup' a -> Semigroup' (Identity a)
 identity = liftSemigroup
 
 -- |
 -- >>> runSemigroup (down sum) (Down 3) (Down 4)
 -- Down 7
-down :: Semigroup a -> Semigroup (Down a)
+down :: Semigroup' a -> Semigroup' (Down a)
 down = liftSemigroup
 
 -- |
 -- >>> runSemigroup (dualM sum) (1, 2) (3, 4) :: (Int, Int)
 -- (4,6)
-dualM :: Semigroup a -> Semigroup (a, a)
+dualM :: Semigroup' a -> Semigroup' (a, a)
 dualM s = pair s s
 
 -- |
 -- >>> runSemigroup (solo sum) (pure 3) (pure 4) :: Solo Int
 -- MkSolo 7
-solo :: Semigroup a -> Semigroup (Solo a)
+solo :: Semigroup' a -> Semigroup' (Solo a)
 solo = liftSemigroup
 
--- | Lift a 'Semigroup' through 'STM'.
-stm :: Semigroup a -> Semigroup (STM a)
+-- | Lift a 'Semigroup'' through 'STM'.
+stm :: Semigroup' a -> Semigroup' (STM a)
 stm = liftSemigroup
 
--- | Lift a 'Semigroup' through 'ST'.
-st :: Semigroup a -> Semigroup (ST s a)
+-- | Lift a 'Semigroup'' through 'ST'.
+st :: Semigroup' a -> Semigroup' (ST s a)
 st = liftSemigroup
 
 -- |
@@ -554,13 +559,13 @@
 --
 -- >>> runSemigroup (function list) words lines "hello world"
 -- ["hello","world","hello world"]
-function :: Semigroup b -> Semigroup (a -> b)
+function :: Semigroup' b -> Semigroup' (a -> b)
 function = liftSemigroup
 
 -- |
 -- >>> runSemigroup (const' sum) (Const 3) (Const 4) :: Const Int String
 -- Const 7
-const' :: Semigroup a -> Semigroup (Const a b)
+const' :: Semigroup' a -> Semigroup' (Const a b)
 const' = mapSemigroup getConst Const
 
 -- |
@@ -569,23 +574,23 @@
 --
 -- >>> runSemigroup alt Nothing (Just 1) :: Maybe Int
 -- Just 1
-alt :: (Alternative f) => Semigroup (f a)
+alt :: (Alternative f) => Semigroup' (f a)
 alt = review applySemigroup (<|>)
 
 -- |
 -- >>> runSemigroup proxy Proxy Proxy
 -- Proxy
-proxy :: Semigroup (Proxy s)
+proxy :: Semigroup' (Proxy s)
 proxy = review applySemigroup (\_ _ -> Proxy)
 
 -- | Semigroup on 'Lifetime'.
-lifetime :: Semigroup Lifetime
+lifetime :: Semigroup' Lifetime
 lifetime = semigroup'
 
 -- |
 -- >>> runSemigroup (tuple3 sum product min) (1, 2, 3) (4, 5, 6) :: (Int, Int, Int)
 -- (5,10,3)
-tuple3 :: Semigroup a -> Semigroup b -> Semigroup c -> Semigroup (a, b, c)
+tuple3 :: Semigroup' a -> Semigroup' b -> Semigroup' c -> Semigroup' (a, b, c)
 tuple3 sa sb sc =
   let f = runSemigroup sa; g = runSemigroup sb; h = runSemigroup sc
    in review applySemigroup (\(a1, b1, c1) (a2, b2, c2) -> (f a1 a2, g b1 b2, h c1 c2))
@@ -593,7 +598,7 @@
 -- |
 -- >>> runSemigroup (tuple4 sum sum sum sum) (1, 2, 3, 4) (5, 6, 7, 8) :: (Int, Int, Int, Int)
 -- (6,8,10,12)
-tuple4 :: Semigroup a -> Semigroup b -> Semigroup c -> Semigroup d -> Semigroup (a, b, c, d)
+tuple4 :: Semigroup' a -> Semigroup' b -> Semigroup' c -> Semigroup' d -> Semigroup' (a, b, c, d)
 tuple4 sa sb sc sd =
   let f = runSemigroup sa; g = runSemigroup sb; h = runSemigroup sc; i = runSemigroup sd
    in review applySemigroup (\(a1, b1, c1, d1) (a2, b2, c2, d2) -> (f a1 a2, g b1 b2, h c1 c2, i d1 d2))
@@ -601,7 +606,7 @@
 -- |
 -- >>> runSemigroup (tuple5 sum sum sum sum sum) (1, 2, 3, 4, 5) (6, 7, 8, 9, 10) :: (Int, Int, Int, Int, Int)
 -- (7,9,11,13,15)
-tuple5 :: Semigroup a -> Semigroup b -> Semigroup c -> Semigroup d -> Semigroup e -> Semigroup (a, b, c, d, e)
+tuple5 :: Semigroup' a -> Semigroup' b -> Semigroup' c -> Semigroup' d -> Semigroup' e -> Semigroup' (a, b, c, d, e)
 tuple5 sa sb sc sd se =
   let f = runSemigroup sa; g = runSemigroup sb; h = runSemigroup sc; i = runSemigroup sd; j = runSemigroup se
    in review applySemigroup (\(a1, b1, c1, d1, e1) (a2, b2, c2, d2, e2) -> (f a1 a2, g b1 b2, h c1 c2, i d1 d2, j e1 e2))
@@ -609,43 +614,43 @@
 -- |
 -- >>> runSemigroup u1 U1 U1
 -- U1
-u1 :: Semigroup (U1 p)
+u1 :: Semigroup' (U1 p)
 u1 = review applySemigroup (\_ _ -> U1)
 
 -- | Vacuous semigroup on 'V1' (uninhabited type).
-v1 :: Semigroup (V1 p)
+v1 :: Semigroup' (V1 p)
 v1 = review applySemigroup const
 
 -- |
 -- >>> runSemigroup (par1 sum) (Par1 3) (Par1 4)
 -- Par1 {unPar1 = 7}
-par1 :: Semigroup p -> Semigroup (Par1 p)
+par1 :: Semigroup' p -> Semigroup' (Par1 p)
 par1 = mapSemigroup unPar1 Par1
 
 -- |
 -- >>> runSemigroup (rec1 list) (Rec1 [1, 2]) (Rec1 [3, 4]) :: Rec1 [] Int
 -- Rec1 {unRec1 = [1,2,3,4]}
-rec1 :: Semigroup (f p) -> Semigroup (Rec1 f p)
+rec1 :: Semigroup' (f p) -> Semigroup' (Rec1 f p)
 rec1 = mapSemigroup unRec1 Rec1
 
 -- |
 -- >>> runSemigroup (k1 sum) (K1 3) (K1 4) :: K1 () Int ()
 -- K1 {unK1 = 7}
-k1 :: Semigroup c -> Semigroup (K1 i c p)
+k1 :: Semigroup' c -> Semigroup' (K1 i c p)
 k1 = mapSemigroup unK1 K1
 
 -- |
 -- >>> :set -XDataKinds
 -- >>> runSemigroup (m1 (k1 sum)) (M1 (K1 3)) (M1 (K1 4)) :: M1 () ('GHC.Generics.MetaData "" "" "" 'False) (K1 () Int) ()
 -- M1 {unM1 = K1 {unK1 = 7}}
-m1 :: Semigroup (f p) -> Semigroup (M1 i c f p)
+m1 :: Semigroup' (f p) -> Semigroup' (M1 i c f p)
 m1 = mapSemigroup unM1 M1
 
 -- |
 -- >>> :set -XTypeOperators
 -- >>> runSemigroup (productG (par1 sum) (par1 product)) (Par1 1 :*: Par1 2) (Par1 3 :*: Par1 4) :: (Par1 :*: Par1) Int
 -- Par1 {unPar1 = 4} :*: Par1 {unPar1 = 8}
-productG :: Semigroup (f p) -> Semigroup (g p) -> Semigroup ((f :*: g) p)
+productG :: Semigroup' (f p) -> Semigroup' (g p) -> Semigroup' ((f :*: g) p)
 productG sf sg =
   let f = runSemigroup sf; g = runSemigroup sg
    in review applySemigroup (\(a :*: b) (c :*: d) -> f a c :*: g b d)
@@ -654,13 +659,13 @@
 -- >>> :set -XTypeOperators
 -- >>> runSemigroup (composeG (par1 list)) (Comp1 (Par1 [1, 2])) (Comp1 (Par1 [3, 4])) :: (Par1 :.: []) Int
 -- Comp1 {unComp1 = Par1 {unPar1 = [1,2,3,4]}}
-composeG :: Semigroup (f (g p)) -> Semigroup ((f :.: g) p)
+composeG :: Semigroup' (f (g p)) -> Semigroup' ((f :.: g) p)
 composeG = mapSemigroup unComp1 Comp1
 
 -- |
 -- >>> runSemigroup (productF list list) (Pair [1] [2]) (Pair [3] [4]) :: Product [] [] Int
 -- Pair [1,3] [2,4]
-productF :: Semigroup (f a) -> Semigroup (g a) -> Semigroup (Product f g a)
+productF :: Semigroup' (f a) -> Semigroup' (g a) -> Semigroup' (Product f g a)
 productF sf sg =
   let f = runSemigroup sf; g = runSemigroup sg
    in review applySemigroup (\(Pair a b) (Pair c d) -> Pair (f a c) (g b d))
@@ -668,5 +673,5 @@
 -- |
 -- >>> runSemigroup (composeF list) (Compose [[1, 2]]) (Compose [[3, 4]]) :: Compose [] [] Int
 -- Compose [[1,2],[3,4]]
-composeF :: Semigroup (f (g a)) -> Semigroup (Compose f g a)
+composeF :: Semigroup' (f (g a)) -> Semigroup' (Compose f g a)
 composeF = mapSemigroup getCompose Compose
diff --git a/src/Data/Valuation/Valuation.hs b/src/Data/Valuation/Valuation.hs
--- a/src/Data/Valuation/Valuation.hs
+++ b/src/Data/Valuation/Valuation.hs
@@ -50,7 +50,7 @@
 import Data.Set (Set)
 import Data.Valuation.ProjectValuation (ProjectValuation (..))
 import Data.Valuation.SemiValuationAlgebra (SemiValuationAlgebra (..))
-import Data.Valuation.Semigroup (Semigroup, applySemigroup, runSemigroup, semigroup')
+import Data.Valuation.Semigroup (Semigroup', applySemigroup, runSemigroup, semigroup')
 import Data.Valuation.ValuationAlgebra (ValuationAlgebra (..))
 import Data.Valuation.ValuationAlgebraOp (ValuationAlgebraOp (..))
 import GHC.Generics (Generic, Generic1)
@@ -467,15 +467,15 @@
     Valuation <$> traverse1 f dom <.> g info
 
 -- |
--- >>> let pv = ProjectValuation (\s v -> v + sum s) :: ProjectValuation Int [] Int
+-- >>> let pv = ProjectValuation (\s v -> v + sum s) :: ProjectValuation (->) Int [] Int
 -- >>> projectVar pv (Valuation [1,2,3] 10)
 -- 16
 --
--- >>> let pv = ProjectValuation (\s v -> v * length s) :: ProjectValuation Int [] Int
+-- >>> let pv = ProjectValuation (\s v -> v * length s) :: ProjectValuation (->) Int [] Int
 -- >>> projectVar pv (Valuation [1,2,3] 5)
 -- 15
 projectVar ::
-  ProjectValuation v set var ->
+  ProjectValuation (->) v set var ->
   Valuation set var v ->
   v
 projectVar (ProjectValuation p) (Valuation dom info) =
@@ -490,8 +490,8 @@
 -- >>> combineVar S.list S.product (Valuation [1,2] 10) (Valuation [3,4] 20 :: Valuation [] Int Int)
 -- Valuation [1,2,3,4] 200
 combineVar ::
-  Semigroup (set var) ->
-  Semigroup v ->
+  Semigroup' (set var) ->
+  Semigroup' v ->
   Valuation set var v ->
   Valuation set var v ->
   Valuation set var v
@@ -501,18 +501,18 @@
 -- |
 -- >>> import Control.Lens (review)
 -- >>> import qualified Data.Valuation.Semigroup as S
--- >>> let sva = SemiValuationAlgebra (review S.applySemigroup (+)) (ProjectValuation (\s v -> v + sum s)) :: SemiValuationAlgebra Int [] Int
+-- >>> let sva = SemiValuationAlgebra (review S.applySemigroup (+)) (ProjectValuation (\s v -> v + sum s)) :: SemiValuationAlgebra (->) Int [] Int
 -- >>> combineSemiValuation S.list sva (Valuation [1,2] 10) (Valuation [3,4] 20)
 -- Valuation [1,2,3,4] 40
 --
 -- >>> import Control.Lens (review)
 -- >>> import qualified Data.Valuation.Semigroup as S
--- >>> let sva = SemiValuationAlgebra (review S.applySemigroup (*)) (ProjectValuation (\s v -> v + length s)) :: SemiValuationAlgebra Int [] Int
+-- >>> let sva = SemiValuationAlgebra (review S.applySemigroup (*)) (ProjectValuation (\s v -> v + length s)) :: SemiValuationAlgebra (->) Int [] Int
 -- >>> combineSemiValuation S.list sva (Valuation [1,2] 3) (Valuation [3] 4)
 -- Valuation [1,2,3] 15
 combineSemiValuation ::
-  Semigroup (set var) ->
-  SemiValuationAlgebra v set var ->
+  Semigroup' (set var) ->
+  SemiValuationAlgebra (->) v set var ->
   Valuation set var v ->
   Valuation set var v ->
   Valuation set var v
@@ -525,7 +525,7 @@
 -- >>> import qualified Data.Valuation.Semigroup as S
 -- >>> let sva = SemiValuationAlgebra (review S.applySemigroup (+)) (ProjectValuation (\s v -> v + sum s))
 -- >>> import Data.Valuation.ValuationAlgebraOp (ValuationAlgebraOp(..))
--- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp sum) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra Int [] Int
+-- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp sum) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra (->) Int [] Int
 -- >>> combineValuation S.list va (Valuation [1,2] 10) (Valuation [3,4] 20)
 -- Valuation [1,2,3,4] 50
 --
@@ -533,12 +533,12 @@
 -- >>> import qualified Data.Valuation.Semigroup as S
 -- >>> let sva = SemiValuationAlgebra (review S.applySemigroup (*)) (ProjectValuation (\s v -> v + length s))
 -- >>> import Data.Valuation.ValuationAlgebraOp (ValuationAlgebraOp(..))
--- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 1)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra Int [] Int
+-- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp (const 1)) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra (->) Int [] Int
 -- >>> combineValuation S.list va (Valuation [1,2] 3) (Valuation [3] 4)
 -- Valuation [1,2,3] 15
 combineValuation ::
-  Semigroup (set var) ->
-  ValuationAlgebra v set var ->
+  Semigroup' (set var) ->
+  ValuationAlgebra (->) v set var ->
   Valuation set var v ->
   Valuation set var v ->
   Valuation set var v
@@ -574,8 +574,8 @@
 -- >>> runSemigroup (semigroupValuation S.list S.sum) (Valuation [1,2] 10) (Valuation [3,4] 20 :: Valuation [] Int Int)
 -- Valuation [1,2,3,4] 30
 semigroupValuation ::
-  Semigroup (set var) ->
-  Semigroup a ->
-  Semigroup (Valuation set var a)
+  Semigroup' (set var) ->
+  Semigroup' a ->
+  Semigroup' (Valuation set var a)
 semigroupValuation sd sa =
   review applySemigroup (\(Valuation d1 a1) (Valuation d2 a2) -> Valuation (runSemigroup sd d1 d2) (runSemigroup sa a1 a2))
diff --git a/src/Data/Valuation/ValuationAlgebra.hs b/src/Data/Valuation/ValuationAlgebra.hs
--- a/src/Data/Valuation/ValuationAlgebra.hs
+++ b/src/Data/Valuation/ValuationAlgebra.hs
@@ -5,6 +5,7 @@
 -- | A valuation algebra: a semi-valuation algebra with unit and zero operations.
 module Data.Valuation.ValuationAlgebra
   ( ValuationAlgebra (..),
+    ValuationAlgebra',
     SetValuationAlgebra,
 
     -- * optics
@@ -13,12 +14,16 @@
   )
 where
 
+import Control.Arrow (Arrow (..))
+import Control.Category (Category (..))
 import Control.Lens (Lens', Prism')
 import Data.Functor.Contravariant (Contravariant (..))
 import Data.Functor.Contravariant.Conclude (Conclude (..))
 import Data.Functor.Contravariant.Decide (Decide (..))
 import Data.Functor.Contravariant.Divise (Divise (..))
 import Data.Functor.Contravariant.Divisible (Decidable (..), Divisible (..))
+import Data.Profunctor (Profunctor (..), Strong (..))
+import Data.Semigroupoid (Semigroupoid (..))
 import Data.Set (Set)
 import Data.Valuation.ProjectValuation (HasProjectValuation (..))
 import Data.Valuation.SemiValuationAlgebra
@@ -28,7 +33,7 @@
 import Data.Valuation.Semigroup (HasSemigroup (..))
 import Data.Valuation.ValuationAlgebraOp (ValuationAlgebraOp (..))
 import Witherable (Filterable (mapMaybe))
-import Prelude hiding (Semigroup)
+import Prelude hiding (Semigroup, id, (.))
 import qualified Prelude
 
 -- $setup
@@ -42,7 +47,7 @@
 -- >>> import Control.Lens (review)
 -- >>> import Data.Valuation.Semigroup (Semigroup, applySemigroup, runSemigroup)
 -- >>> let sva = SemiValuationAlgebra (review applySemigroup (+)) (ProjectValuation (\s v -> v + sum s))
--- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp sum) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra Int [] Int
+-- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp sum) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra (->) Int [] Int
 -- >>> let ValuationAlgebra (SemiValuationAlgebra sg (ProjectValuation p)) (ValuationAlgebraOp u) (ValuationAlgebraOp z) = va
 -- >>> runSemigroup sg 3 4
 -- 7
@@ -52,41 +57,44 @@
 -- 6
 -- >>> z [1,2,3]
 -- 0
-data ValuationAlgebra v set var
+data ValuationAlgebra p v set var
   = ValuationAlgebra
-      (SemiValuationAlgebra v set var)
+      (SemiValuationAlgebra p v set var)
       -- | algebra unit
-      (ValuationAlgebraOp set var v)
+      (ValuationAlgebraOp p set var v)
       -- | algebra zero
-      (ValuationAlgebraOp set var v)
+      (ValuationAlgebraOp p set var v)
 
+type ValuationAlgebra' v set var =
+  ValuationAlgebra (->) v set var
+
 -- | Classy lens for types that contain a 'ValuationAlgebra'.
-class HasValuationAlgebra c v set var | c -> v set var where
-  valuationAlgebra :: Lens' c (ValuationAlgebra v set var)
-  valuationAlgebraUnit :: Lens' c (ValuationAlgebraOp set var v)
+class HasValuationAlgebra c p v set var | c -> p v set var where
+  valuationAlgebra :: Lens' c (ValuationAlgebra p v set var)
+  valuationAlgebraUnit :: Lens' c (ValuationAlgebraOp p set var v)
   valuationAlgebraUnit = valuationAlgebra . valuationAlgebraUnit
-  valuationAlgebraZero :: Lens' c (ValuationAlgebraOp set var v)
+  valuationAlgebraZero :: Lens' c (ValuationAlgebraOp p set var v)
   valuationAlgebraZero = valuationAlgebra . valuationAlgebraZero
 
-instance HasValuationAlgebra (ValuationAlgebra v set var) v set var where
+instance HasValuationAlgebra (ValuationAlgebra p v set var) p v set var where
   valuationAlgebra = id
   valuationAlgebraUnit f (ValuationAlgebra s u z) = fmap (\u' -> ValuationAlgebra s u' z) (f u)
   valuationAlgebraZero f (ValuationAlgebra s u z) = fmap (ValuationAlgebra s u) (f z)
 
 -- | Classy prism for types that can be constructed from a 'ValuationAlgebra'.
-class AsValuationAlgebra c v set var | c -> v set var where
-  _ValuationAlgebra :: Prism' c (ValuationAlgebra v set var)
+class AsValuationAlgebra c p v set var | c -> p v set var where
+  _ValuationAlgebra :: Prism' c (ValuationAlgebra p v set var)
 
-instance AsValuationAlgebra (ValuationAlgebra v set var) v set var where
+instance AsValuationAlgebra (ValuationAlgebra p v set var) p v set var where
   _ValuationAlgebra = id
 
-instance HasSemiValuationAlgebra (ValuationAlgebra v set var) v set var where
+instance HasSemiValuationAlgebra (ValuationAlgebra p v set var) p v set var where
   semiValuationAlgebra f (ValuationAlgebra a u z) = fmap (\a' -> ValuationAlgebra a' u z) (f a)
 
-instance HasSemigroup (ValuationAlgebra v set var) v where
+instance HasSemigroup (ValuationAlgebra p v set var) p v where
   semigroup = semiValuationAlgebra . semigroup
 
-instance HasProjectValuation (ValuationAlgebra v set var) v set var where
+instance HasProjectValuation (ValuationAlgebra p v set var) p v set var where
   projectValuation = semiValuationAlgebra . projectValuation
 
 -- |
@@ -97,7 +105,7 @@
 -- >>> import Control.Lens (review)
 -- >>> import Data.Valuation.Semigroup (Semigroup, applySemigroup, runSemigroup)
 -- >>> let sva = SemiValuationAlgebra (review applySemigroup (+)) (ProjectValuation (\s v -> v + sum s))
--- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp sum) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra Int [] Int
+-- >>> let va = ValuationAlgebra sva (ValuationAlgebraOp sum) (ValuationAlgebraOp (const 0)) :: ValuationAlgebra (->) Int [] Int
 -- >>> let ValuationAlgebra (SemiValuationAlgebra sg (ProjectValuation p)) (ValuationAlgebraOp u) (ValuationAlgebraOp z) = contramap (*2) va
 -- >>> runSemigroup sg 3 4
 -- 7
@@ -107,9 +115,9 @@
 -- 12
 -- >>> z [1,2,3]
 -- 0
-instance (Functor set) => Contravariant (ValuationAlgebra v set) where
+instance (Profunctor p, Functor set) => Contravariant (ValuationAlgebra p v set) where
   contramap f (ValuationAlgebra s (ValuationAlgebraOp u) (ValuationAlgebraOp z)) =
-    ValuationAlgebra (contramap f s) (ValuationAlgebraOp (u . fmap f)) (ValuationAlgebraOp (z . fmap f))
+    ValuationAlgebra (contramap f s) (ValuationAlgebraOp (lmap (fmap f) u)) (ValuationAlgebraOp (lmap (fmap f) z))
 
 -- |
 -- >>> import Data.Functor.Contravariant.Divisible (conquer, divide)
@@ -118,7 +126,7 @@
 -- >>> import Data.Valuation.ValuationAlgebraOp (ValuationAlgebraOp(..))
 -- >>> import Control.Lens (review)
 -- >>> import Data.Valuation.Semigroup (Semigroup, applySemigroup, runSemigroup)
--- >>> let ValuationAlgebra (SemiValuationAlgebra sg (ProjectValuation p)) (ValuationAlgebraOp u) (ValuationAlgebraOp z) = conquer :: ValuationAlgebra [Int] [] Int
+-- >>> let ValuationAlgebra (SemiValuationAlgebra sg (ProjectValuation p)) (ValuationAlgebraOp u) (ValuationAlgebraOp z) = conquer :: ValuationAlgebra (->) [Int] [] Int
 -- >>> runSemigroup sg [1] [2]
 -- [1,2]
 -- >>> p [10,20] [42]
@@ -135,9 +143,9 @@
 -- >>> import Control.Lens (review)
 -- >>> import Data.Valuation.Semigroup (Semigroup, applySemigroup, runSemigroup)
 -- >>> let sva1 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ s))
--- >>> let va1 = ValuationAlgebra sva1 (ValuationAlgebraOp id) (ValuationAlgebraOp (map negate)) :: ValuationAlgebra [Int] [] Int
+-- >>> let va1 = ValuationAlgebra sva1 (ValuationAlgebraOp id) (ValuationAlgebraOp (map negate)) :: ValuationAlgebra (->) [Int] [] Int
 -- >>> let sva2 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ reverse s))
--- >>> let va2 = ValuationAlgebra sva2 (ValuationAlgebraOp reverse) (ValuationAlgebraOp (const [])) :: ValuationAlgebra [Int] [] Int
+-- >>> let va2 = ValuationAlgebra sva2 (ValuationAlgebraOp reverse) (ValuationAlgebraOp (const [])) :: ValuationAlgebra (->) [Int] [] Int
 -- >>> let ValuationAlgebra (SemiValuationAlgebra sg (ProjectValuation p)) (ValuationAlgebraOp u) (ValuationAlgebraOp z) = divide (\x -> (x, x + 10)) va1 va2
 -- >>> runSemigroup sg [1] [2]
 -- [1,2]
@@ -145,10 +153,13 @@
 -- [1,2,3,13,12,11]
 -- >>> z [1,2,3]
 -- [-1,-2,-3]
-instance (Functor set, Prelude.Semigroup v, Prelude.Monoid v) => Divisible (ValuationAlgebra v set) where
-  conquer = ValuationAlgebra conquer (ValuationAlgebraOp (const mempty)) (ValuationAlgebraOp (const mempty))
+instance (Functor set, Strong p, Arrow p, Prelude.Semigroup v, Prelude.Monoid v) => Divisible (ValuationAlgebra p v set) where
+  conquer = ValuationAlgebra conquer (ValuationAlgebraOp (rmap (const mempty) id)) (ValuationAlgebraOp (rmap (const mempty) id))
   divide f (ValuationAlgebra s1 (ValuationAlgebraOp u1) (ValuationAlgebraOp z1)) (ValuationAlgebra s2 (ValuationAlgebraOp u2) (ValuationAlgebraOp z2)) =
-    let combine g1 g2 = ValuationAlgebraOp (\fa -> g1 (fmap (fst . f) fa) <> g2 (fmap (snd . f) fa))
+    let combine g1 g2 =
+          let g1' = lmap (fmap (fst . f)) g1
+              g2' = lmap (fmap (snd . f)) g2
+           in ValuationAlgebraOp (lmap (\x -> (x, x)) (rmap (uncurry (<>)) (second' g2' . first' g1')))
      in ValuationAlgebra (divide f s1 s2) (combine u1 u2) (combine z1 z2)
 
 -- |
@@ -159,7 +170,7 @@
 -- >>> import Data.Valuation.ValuationAlgebraOp (ValuationAlgebraOp(..))
 -- >>> import Control.Lens (review)
 -- >>> import Data.Valuation.Semigroup (Semigroup, applySemigroup, runSemigroup)
--- >>> let ValuationAlgebra (SemiValuationAlgebra sg (ProjectValuation p)) (ValuationAlgebraOp u) (ValuationAlgebraOp z) = lose absurd :: ValuationAlgebra [Int] [] Void
+-- >>> let ValuationAlgebra (SemiValuationAlgebra sg (ProjectValuation p)) (ValuationAlgebraOp u) (ValuationAlgebraOp z) = lose absurd :: ValuationAlgebra (->) [Int] [] Void
 -- >>> runSemigroup sg [1] [2]
 -- [1,2]
 -- >>> p [] [42]
@@ -176,9 +187,9 @@
 -- >>> import Control.Lens (review)
 -- >>> import Data.Valuation.Semigroup (Semigroup, applySemigroup, runSemigroup)
 -- >>> let sva1 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ s))
--- >>> let va1 = ValuationAlgebra sva1 (ValuationAlgebraOp id) (ValuationAlgebraOp (map negate)) :: ValuationAlgebra [Int] [] Int
+-- >>> let va1 = ValuationAlgebra sva1 (ValuationAlgebraOp id) (ValuationAlgebraOp (map negate)) :: ValuationAlgebra (->) [Int] [] Int
 -- >>> let sva2 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ reverse s))
--- >>> let va2 = ValuationAlgebra sva2 (ValuationAlgebraOp reverse) (ValuationAlgebraOp (const [])) :: ValuationAlgebra [Int] [] Int
+-- >>> let va2 = ValuationAlgebra sva2 (ValuationAlgebraOp reverse) (ValuationAlgebraOp (const [])) :: ValuationAlgebra (->) [Int] [] Int
 -- >>> let ValuationAlgebra (SemiValuationAlgebra sg (ProjectValuation p)) (ValuationAlgebraOp u) (ValuationAlgebraOp z) = choose (\x -> if even x then Left x else Right x) va1 va2
 -- >>> runSemigroup sg [1] [2]
 -- [1,2]
@@ -186,12 +197,15 @@
 -- [2,4,3,1]
 -- >>> z [1,2,3,4]
 -- [-2,-4]
-instance (Filterable set, Prelude.Semigroup v, Prelude.Monoid v) => Decidable (ValuationAlgebra v set) where
-  lose f = ValuationAlgebra (lose f) (ValuationAlgebraOp (const mempty)) (ValuationAlgebraOp (const mempty))
+instance (Filterable set, Strong p, Arrow p, Prelude.Semigroup v, Prelude.Monoid v) => Decidable (ValuationAlgebra p v set) where
+  lose f = ValuationAlgebra (lose f) (ValuationAlgebraOp (rmap (const mempty) id)) (ValuationAlgebraOp (rmap (const mempty) id))
   choose ch (ValuationAlgebra s1 (ValuationAlgebraOp u1) (ValuationAlgebraOp z1)) (ValuationAlgebra s2 (ValuationAlgebraOp u2) (ValuationAlgebraOp z2)) =
     let lefts = mapMaybe (either Just (const Nothing) . ch)
         rights = mapMaybe (either (const Nothing) Just . ch)
-        combine g1 g2 = ValuationAlgebraOp (\fa -> g1 (lefts fa) <> g2 (rights fa))
+        combine g1 g2 =
+          let g1' = lmap lefts g1
+              g2' = lmap rights g2
+           in ValuationAlgebraOp (lmap (\x -> (x, x)) (rmap (uncurry (<>)) (second' g2' . first' g1')))
      in ValuationAlgebra (choose ch s1 s2) (combine u1 u2) (combine z1 z2)
 
 -- |
@@ -202,9 +216,9 @@
 -- >>> import Control.Lens (review)
 -- >>> import Data.Valuation.Semigroup (Semigroup, applySemigroup, runSemigroup)
 -- >>> let sva1 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ s))
--- >>> let va1 = ValuationAlgebra sva1 (ValuationAlgebraOp id) (ValuationAlgebraOp (map negate)) :: ValuationAlgebra [Int] [] Int
+-- >>> let va1 = ValuationAlgebra sva1 (ValuationAlgebraOp id) (ValuationAlgebraOp (map negate)) :: ValuationAlgebra (->) [Int] [] Int
 -- >>> let sva2 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ reverse s))
--- >>> let va2 = ValuationAlgebra sva2 (ValuationAlgebraOp reverse) (ValuationAlgebraOp (const [])) :: ValuationAlgebra [Int] [] Int
+-- >>> let va2 = ValuationAlgebra sva2 (ValuationAlgebraOp reverse) (ValuationAlgebraOp (const [])) :: ValuationAlgebra (->) [Int] [] Int
 -- >>> let ValuationAlgebra (SemiValuationAlgebra sg (ProjectValuation p)) (ValuationAlgebraOp u) (ValuationAlgebraOp z) = divise (\x -> (x, x + 10)) va1 va2
 -- >>> runSemigroup sg [1] [2]
 -- [1,2]
@@ -212,9 +226,12 @@
 -- [1,2,3,13,12,11]
 -- >>> z [1,2,3]
 -- [-1,-2,-3]
-instance (Functor set, Prelude.Semigroup v) => Divise (ValuationAlgebra v set) where
+instance (Functor set, Strong p, Semigroupoid p, Prelude.Semigroup v) => Divise (ValuationAlgebra p v set) where
   divise f (ValuationAlgebra s1 (ValuationAlgebraOp u1) (ValuationAlgebraOp z1)) (ValuationAlgebra s2 (ValuationAlgebraOp u2) (ValuationAlgebraOp z2)) =
-    let combine g1 g2 = ValuationAlgebraOp (\fa -> g1 (fmap (fst . f) fa) <> g2 (fmap (snd . f) fa))
+    let combine g1 g2 =
+          let g1' = lmap (fmap (fst . f)) g1
+              g2' = lmap (fmap (snd . f)) g2
+           in ValuationAlgebraOp (lmap (\x -> (x, x)) (rmap (uncurry (<>)) (second' g2' `o` first' g1')))
      in ValuationAlgebra (divise f s1 s2) (combine u1 u2) (combine z1 z2)
 
 -- |
@@ -225,9 +242,9 @@
 -- >>> import Control.Lens (review)
 -- >>> import Data.Valuation.Semigroup (Semigroup, applySemigroup, runSemigroup)
 -- >>> let sva1 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ s))
--- >>> let va1 = ValuationAlgebra sva1 (ValuationAlgebraOp id) (ValuationAlgebraOp (map negate)) :: ValuationAlgebra [Int] [] Int
+-- >>> let va1 = ValuationAlgebra sva1 (ValuationAlgebraOp id) (ValuationAlgebraOp (map negate)) :: ValuationAlgebra (->) [Int] [] Int
 -- >>> let sva2 = SemiValuationAlgebra (review applySemigroup (++)) (ProjectValuation (\s v -> v ++ reverse s))
--- >>> let va2 = ValuationAlgebra sva2 (ValuationAlgebraOp reverse) (ValuationAlgebraOp (const [])) :: ValuationAlgebra [Int] [] Int
+-- >>> let va2 = ValuationAlgebra sva2 (ValuationAlgebraOp reverse) (ValuationAlgebraOp (const [])) :: ValuationAlgebra (->) [Int] [] Int
 -- >>> let ValuationAlgebra (SemiValuationAlgebra sg (ProjectValuation p)) (ValuationAlgebraOp u) (ValuationAlgebraOp z) = decide (\x -> if even x then Left x else Right x) va1 va2
 -- >>> runSemigroup sg [1] [2]
 -- [1,2]
@@ -235,11 +252,14 @@
 -- [2,4,3,1]
 -- >>> z [1,2,3,4]
 -- [-2,-4]
-instance (Filterable set, Prelude.Semigroup v) => Decide (ValuationAlgebra v set) where
+instance (Filterable set, Strong p, Semigroupoid p, Prelude.Semigroup v) => Decide (ValuationAlgebra p v set) where
   decide ch (ValuationAlgebra s1 (ValuationAlgebraOp u1) (ValuationAlgebraOp z1)) (ValuationAlgebra s2 (ValuationAlgebraOp u2) (ValuationAlgebraOp z2)) =
     let lefts = mapMaybe (either Just (const Nothing) . ch)
         rights = mapMaybe (either (const Nothing) Just . ch)
-        combine g1 g2 = ValuationAlgebraOp (\fa -> g1 (lefts fa) <> g2 (rights fa))
+        combine g1 g2 =
+          let g1' = lmap lefts g1
+              g2' = lmap rights g2
+           in ValuationAlgebraOp (lmap (\x -> (x, x)) (rmap (uncurry (<>)) (second' g2' `o` first' g1')))
      in ValuationAlgebra (decide ch s1 s2) (combine u1 u2) (combine z1 z2)
 
 -- |
@@ -250,16 +270,16 @@
 -- >>> import Data.Valuation.ValuationAlgebraOp (ValuationAlgebraOp(..))
 -- >>> import Control.Lens (review)
 -- >>> import Data.Valuation.Semigroup (Semigroup, applySemigroup, runSemigroup)
--- >>> let ValuationAlgebra (SemiValuationAlgebra sg (ProjectValuation p)) (ValuationAlgebraOp u) (ValuationAlgebraOp z) = conclude absurd :: ValuationAlgebra [Int] [] Void
+-- >>> let ValuationAlgebra (SemiValuationAlgebra sg (ProjectValuation p)) (ValuationAlgebraOp u) (ValuationAlgebraOp z) = conclude absurd :: ValuationAlgebra (->) [Int] [] Void
 -- >>> runSemigroup sg [1] [2]
 -- [1,2]
 -- >>> u []
 -- []
 -- >>> z []
 -- []
-instance (Filterable set, Prelude.Semigroup v, Prelude.Monoid v) => Conclude (ValuationAlgebra v set) where
-  conclude f = ValuationAlgebra (conclude f) (ValuationAlgebraOp (const mempty)) (ValuationAlgebraOp (const mempty))
+instance (Filterable set, Strong p, Semigroupoid p, Arrow p, Prelude.Semigroup v, Prelude.Monoid v) => Conclude (ValuationAlgebra p v set) where
+  conclude f = ValuationAlgebra (conclude f) (ValuationAlgebraOp (rmap (const mempty) id)) (ValuationAlgebraOp (rmap (const mempty) id))
 
 -- | A 'ValuationAlgebra' specialised to 'Set'.
-type SetValuationAlgebra v var =
-  ValuationAlgebra v Set var
+type SetValuationAlgebra p v var =
+  ValuationAlgebra p v Set var
diff --git a/src/Data/Valuation/ValuationAlgebraOp.hs b/src/Data/Valuation/ValuationAlgebraOp.hs
--- a/src/Data/Valuation/ValuationAlgebraOp.hs
+++ b/src/Data/Valuation/ValuationAlgebraOp.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -7,6 +8,7 @@
 -- | An operation on a valuation algebra, a function from a set of variables to a value.
 module Data.Valuation.ValuationAlgebraOp
   ( ValuationAlgebraOp (..),
+    ValuationAlgebraOp',
 
     -- * optics
     HasValuationAlgebraOp (..),
@@ -36,7 +38,7 @@
 import Control.Monad.Fix (MonadFix (..))
 import Control.Monad.Reader.Class (MonadReader (..))
 import Control.Monad.Zip (MonadZip (..))
-import Control.Selective (Selective (..), selectM)
+import Control.Selective (Selective (..))
 import Data.Distributive (Distributive (..))
 import Data.Either (fromLeft, fromRight)
 import Data.Function (fix)
@@ -52,7 +54,6 @@
 import Data.Valuation.Semigroup
   ( Semigroup,
     applySemigroup,
-    runSemigroup,
   )
 import Prelude hiding (Semigroup, id, (.))
 import qualified Prelude
@@ -61,152 +62,161 @@
 -- >>> :set -Wno-name-shadowing -Wno-type-defaults
 
 -- | A function from a set of variables to a value. Isomorphic to @set var -> v@.
-newtype ValuationAlgebraOp set var v
-  = ValuationAlgebraOp (set var -> v)
+newtype ValuationAlgebraOp p set var v
+  = ValuationAlgebraOp (p (set var) v)
 
-instance (ValuationAlgebraOp set var v ~ t) => Rewrapped (ValuationAlgebraOp set' var' v') t
+type ValuationAlgebraOp' set var v =
+  ValuationAlgebraOp (->) set var v
 
-instance Wrapped (ValuationAlgebraOp set var v) where
-  type Unwrapped (ValuationAlgebraOp set var v) = set var -> v
+instance (ValuationAlgebraOp p set var v ~ t) => Rewrapped (ValuationAlgebraOp p' set' var' v') t
+
+instance Wrapped (ValuationAlgebraOp p set var v) where
+  type Unwrapped (ValuationAlgebraOp p set var v) = p (set var) v
   _Wrapped' =
     iso (\(ValuationAlgebraOp x) -> x) ValuationAlgebraOp
 
 -- | Classy lens for types that contain a 'ValuationAlgebraOp'.
-class HasValuationAlgebraOp c set var v | c -> set var v where
+class HasValuationAlgebraOp c p set var v | c -> p set var v where
   valuationAlgebraOp ::
-    Lens' c (ValuationAlgebraOp set var v)
+    Lens' c (ValuationAlgebraOp p set var v)
 
-instance HasValuationAlgebraOp (ValuationAlgebraOp set var v) set var v where
-  valuationAlgebraOp = id
+instance HasValuationAlgebraOp (ValuationAlgebraOp p set var v) p set var v where
+  valuationAlgebraOp = Prelude.id
 
 -- | Classy prism for types that can be constructed from a 'ValuationAlgebraOp'.
-class AsValuationAlgebraOp c set var v | c -> set var v where
+class AsValuationAlgebraOp c p set var v | c -> p set var v where
   _ValuationAlgebraOp ::
-    Prism' c (ValuationAlgebraOp set var v)
+    Prism' c (ValuationAlgebraOp p set var v)
 
-instance AsValuationAlgebraOp (ValuationAlgebraOp set var v) set var v where
-  _ValuationAlgebraOp = id
+instance AsValuationAlgebraOp (ValuationAlgebraOp p set var v) p set var v where
+  _ValuationAlgebraOp = Prelude.id
 
 -- | Iso between a 'ValuationAlgebraOp' producing an endomorphism and a 'ProjectValuation'.
-valuationAlgebraOpProjectValuation :: Iso (ValuationAlgebraOp set var (v -> v)) (ValuationAlgebraOp set' var' (v' -> v')) (ProjectValuation v set var) (ProjectValuation v' set' var')
+valuationAlgebraOpProjectValuation :: Iso (ValuationAlgebraOp p set var (p v v)) (ValuationAlgebraOp p' set' var' (p' v' v')) (ProjectValuation p v set var) (ProjectValuation p' v' set' var')
 valuationAlgebraOpProjectValuation =
   iso
     (\(ValuationAlgebraOp k) -> ProjectValuation k)
     (\(ProjectValuation k) -> ValuationAlgebraOp k)
 
 -- | Lens to the underlying function of a 'HasValuationAlgebraOp'.
-applyHasValuationAlgebraOp :: (HasValuationAlgebraOp op set var v) => Lens' op (set var -> v)
+applyHasValuationAlgebraOp :: (HasValuationAlgebraOp op p set var v) => Lens' op (p (set var) v)
 applyHasValuationAlgebraOp = valuationAlgebraOp . _Wrapped
 
 -- | Prism to the underlying function of an 'AsValuationAlgebraOp'.
-applyAsValuationAlgebraOp :: (AsValuationAlgebraOp op set var v) => Prism' op (set var -> v)
+applyAsValuationAlgebraOp :: (AsValuationAlgebraOp op p set var v) => Prism' op (p (set var) v)
 applyAsValuationAlgebraOp = _ValuationAlgebraOp . _Wrapped
 
 -- |
--- >>> let ValuationAlgebraOp f = fmap (*2) (ValuationAlgebraOp sum :: ValuationAlgebraOp [] Int Int)
+-- >>> let ValuationAlgebraOp f = fmap (*2) (ValuationAlgebraOp sum :: ValuationAlgebraOp (->) [] Int Int)
 -- >>> f [1,2,3]
 -- 12
-instance Functor (ValuationAlgebraOp set a) where
-  fmap f (ValuationAlgebraOp g) = ValuationAlgebraOp (f . g)
+instance (Profunctor p) => Functor (ValuationAlgebraOp p set a) where
+  fmap f (ValuationAlgebraOp g) = ValuationAlgebraOp (rmap f g)
 
 -- |
 -- >>> import Data.Functor.Apply ((<.>))
--- >>> let ValuationAlgebraOp f = (ValuationAlgebraOp (\s -> (+ sum s)) :: ValuationAlgebraOp [] Int (Int -> Int)) <.> ValuationAlgebraOp product
+-- >>> let ValuationAlgebraOp f = (ValuationAlgebraOp (\s -> (+ sum s)) :: ValuationAlgebraOp (->) [] Int (Int -> Int)) <.> ValuationAlgebraOp product
 -- >>> f [1,2,3]
 -- 12
-instance Apply (ValuationAlgebraOp set a) where
-  ValuationAlgebraOp f <.> ValuationAlgebraOp g = ValuationAlgebraOp (\sa -> f sa (g sa))
+instance (Strong p, Semigroupoid p) => Apply (ValuationAlgebraOp p set a) where
+  ValuationAlgebraOp f <.> ValuationAlgebraOp g = ValuationAlgebraOp (lmap (\x -> (x, x)) (rmap (uncurry ($)) (second' g `o` first' f)))
 
 -- |
--- >>> let ValuationAlgebraOp f = pure 42 :: ValuationAlgebraOp [] Int Int
+-- >>> let ValuationAlgebraOp f = pure 42 :: ValuationAlgebraOp (->) [] Int Int
 -- >>> f [1,2,3]
 -- 42
 --
--- >>> let ValuationAlgebraOp f = (ValuationAlgebraOp (\s -> (+ sum s)) :: ValuationAlgebraOp [] Int (Int -> Int)) <*> ValuationAlgebraOp product
+-- >>> let ValuationAlgebraOp f = (ValuationAlgebraOp (\s -> (+ sum s)) :: ValuationAlgebraOp (->) [] Int (Int -> Int)) <*> ValuationAlgebraOp product
 -- >>> f [1,2,3]
 -- 12
-instance Applicative (ValuationAlgebraOp set a) where
-  pure b = ValuationAlgebraOp (const b)
+instance (Strong p, Semigroupoid p, Category p) => Applicative (ValuationAlgebraOp p set a) where
+  pure b = ValuationAlgebraOp (rmap (const b) id)
   (<*>) = (<.>)
 
 -- |
 -- >>> import Data.Functor.Bind ((>>-))
--- >>> let ValuationAlgebraOp f = (ValuationAlgebraOp sum :: ValuationAlgebraOp [] Int Int) >>- (\n -> ValuationAlgebraOp (\s -> n + product s))
+-- >>> let ValuationAlgebraOp f = (ValuationAlgebraOp sum :: ValuationAlgebraOp (->) [] Int Int) >>- (\n -> ValuationAlgebraOp (\s -> n + product s))
 -- >>> f [1,2,3]
 -- 12
-instance Bind (ValuationAlgebraOp set a) where
-  ValuationAlgebraOp f >>- k = ValuationAlgebraOp (\sa -> let ValuationAlgebraOp g = k (f sa) in g sa)
+instance (Strong p, Semigroupoid p, Bind (p (set a))) => Bind (ValuationAlgebraOp p set a) where
+  ValuationAlgebraOp f >>- k = ValuationAlgebraOp (f >>- (\b -> let ValuationAlgebraOp g = k b in g))
 
 -- |
--- >>> let ValuationAlgebraOp f = (ValuationAlgebraOp sum :: ValuationAlgebraOp [] Int Int) >>= (\n -> ValuationAlgebraOp (\s -> n * length s))
+-- >>> let ValuationAlgebraOp f = (ValuationAlgebraOp sum :: ValuationAlgebraOp (->) [] Int Int) >>= (\n -> ValuationAlgebraOp (\s -> n * length s))
 -- >>> f [1,2,3]
 -- 18
 --
--- >>> let ValuationAlgebraOp f = return 42 :: ValuationAlgebraOp [] Int Int
+-- >>> let ValuationAlgebraOp f = return 42 :: ValuationAlgebraOp (->) [] Int Int
 -- >>> f [1,2,3]
 -- 42
-instance Monad (ValuationAlgebraOp set a) where
+instance Monad (ValuationAlgebraOp (->) set a) where
   (>>=) = (>>-)
 
 -- |
 -- >>> import Data.Semigroupoid (o)
 -- >>> import Data.List.NonEmpty (NonEmpty(..))
--- >>> let ValuationAlgebraOp f = o (ValuationAlgebraOp sum :: ValuationAlgebraOp NonEmpty Int Int) (ValuationAlgebraOp sum)
+-- >>> let ValuationAlgebraOp f = o (ValuationAlgebraOp sum :: ValuationAlgebraOp (->) NonEmpty Int Int) (ValuationAlgebraOp sum)
 -- >>> f (1 :| [2, 3])
 -- 14
-instance (Extend set) => Semigroupoid (ValuationAlgebraOp set) where
-  o (ValuationAlgebraOp g) (ValuationAlgebraOp f) = ValuationAlgebraOp (g . extended f)
+instance (Closed p, Strong p, Semigroupoid p, Extend set) => Semigroupoid (ValuationAlgebraOp p set) where
+  o (ValuationAlgebraOp g) (ValuationAlgebraOp f) =
+    let step = rmap extended (lmap (const id) (closed f))
+        ext = lmap (\x -> (x, x)) (rmap (\(h, x) -> h x) (first' step))
+     in ValuationAlgebraOp (g `o` ext)
 
 -- |
 -- >>> import Control.Category (id, (.))
 -- >>> import Data.List.NonEmpty (NonEmpty(..))
--- >>> let ValuationAlgebraOp f = id :: ValuationAlgebraOp NonEmpty Int Int
+-- >>> let ValuationAlgebraOp f = id :: ValuationAlgebraOp (->) NonEmpty Int Int
 -- >>> f (1 :| [2, 3])
 -- 1
 --
 -- >>> import Control.Category ((.))
 -- >>> import Data.List.NonEmpty (NonEmpty(..))
--- >>> let ValuationAlgebraOp f = (ValuationAlgebraOp sum :: ValuationAlgebraOp NonEmpty Int Int) . ValuationAlgebraOp sum
+-- >>> let ValuationAlgebraOp f = (ValuationAlgebraOp sum :: ValuationAlgebraOp (->) NonEmpty Int Int) . ValuationAlgebraOp sum
 -- >>> f (1 :| [2, 3])
 -- 14
-instance (Comonad set) => Category (ValuationAlgebraOp set) where
-  id = ValuationAlgebraOp extract
-  ValuationAlgebraOp g . ValuationAlgebraOp f = ValuationAlgebraOp (g . extend f)
+instance (Closed p, Strong p, Category p, Comonad set) => Category (ValuationAlgebraOp p set) where
+  id = ValuationAlgebraOp (rmap extract id)
+  ValuationAlgebraOp g . ValuationAlgebraOp f =
+    let step = rmap extend (lmap (const id) (closed f))
+        ext = lmap (\x -> (x, x)) (rmap (\(h, x) -> h x) (first' step))
+     in ValuationAlgebraOp (g . ext)
 
 -- |
 -- >>> import Control.Arrow (arr, first)
 -- >>> import Data.List.NonEmpty (NonEmpty(..))
--- >>> let ValuationAlgebraOp f = arr (*2) :: ValuationAlgebraOp NonEmpty Int Int
+-- >>> let ValuationAlgebraOp f = arr (*2) :: ValuationAlgebraOp (->) NonEmpty Int Int
 -- >>> f (3 :| [4, 5])
 -- 6
 --
 -- >>> import Control.Arrow (first)
 -- >>> import Data.List.NonEmpty (NonEmpty(..))
--- >>> let ValuationAlgebraOp f = first (ValuationAlgebraOp sum :: ValuationAlgebraOp NonEmpty Int Int)
+-- >>> let ValuationAlgebraOp f = first (ValuationAlgebraOp sum :: ValuationAlgebraOp (->) NonEmpty Int Int)
 -- >>> f ((1, "a") :| [(2, "b"), (3, "c")])
 -- (6,"a")
-instance (Comonad set) => Arrow (ValuationAlgebraOp set) where
-  arr f = ValuationAlgebraOp (f . extract)
+instance (Closed p, Strong p, Category p, Comonad set) => Arrow (ValuationAlgebraOp p set) where
+  arr f = ValuationAlgebraOp (rmap (f . extract) id)
   first = first'
 
 -- |
 -- >>> import Control.Arrow (left)
 -- >>> import Data.List.NonEmpty (NonEmpty(..))
--- >>> let ValuationAlgebraOp f = left (ValuationAlgebraOp sum :: ValuationAlgebraOp NonEmpty Int Int)
+-- >>> let ValuationAlgebraOp f = left (ValuationAlgebraOp sum :: ValuationAlgebraOp (->) NonEmpty Int Int)
 -- >>> f (Left 1 :| [Left 2, Left 3])
 -- Left 6
 -- >>> f (Right "hi" :| [Left 2])
 -- Right "hi"
-instance (Comonad set) => ArrowChoice (ValuationAlgebraOp set) where
+instance (Closed p, Strong p, Choice p, Category p, Comonad set) => ArrowChoice (ValuationAlgebraOp p set) where
   left = left'
 
 -- |
 -- >>> import Control.Arrow (app)
 -- >>> import Data.List.NonEmpty (NonEmpty(..))
--- >>> let ValuationAlgebraOp f = app :: ValuationAlgebraOp NonEmpty (ValuationAlgebraOp NonEmpty Int Int, Int) Int
+-- >>> let ValuationAlgebraOp f = app :: ValuationAlgebraOp (->) NonEmpty (ValuationAlgebraOp (->) NonEmpty Int Int, Int) Int
 -- >>> f ((ValuationAlgebraOp sum, 99) :| [(ValuationAlgebraOp product, 1)])
 -- 100
-instance (Comonad set) => ArrowApply (ValuationAlgebraOp set) where
+instance (Comonad set) => ArrowApply (ValuationAlgebraOp (->) set) where
   app = ValuationAlgebraOp $ \wpair ->
     let (ValuationAlgebraOp f, _) = extract wpair
      in f (fmap snd wpair)
@@ -214,91 +224,92 @@
 -- |
 -- >>> import Control.Arrow (loop)
 -- >>> import Data.Functor.Identity (Identity(..))
--- >>> let ValuationAlgebraOp f = loop (ValuationAlgebraOp (\(Identity (b, _)) -> (b * 2, 0))) :: ValuationAlgebraOp Identity Int Int
+-- >>> let ValuationAlgebraOp f = loop (ValuationAlgebraOp (\(Identity (b, _)) -> (b * 2, 0))) :: ValuationAlgebraOp (->) Identity Int Int
 -- >>> f (Identity 3)
 -- 6
-instance (ComonadApply set) => ArrowLoop (ValuationAlgebraOp set) where
+instance (ComonadApply set) => ArrowLoop (ValuationAlgebraOp (->) set) where
   loop (ValuationAlgebraOp f) = ValuationAlgebraOp $ \wa ->
     fst . extract $ fix $ \wbd -> extend f ((,) <$> wa <@> fmap snd wbd)
 
 -- |
 -- >>> import Control.Monad.Fix (mfix)
--- >>> let ValuationAlgebraOp f = mfix (\x -> ValuationAlgebraOp (\s -> const 42 x + sum s)) :: ValuationAlgebraOp [] Int Int
+-- >>> let ValuationAlgebraOp f = mfix (\x -> ValuationAlgebraOp (\s -> const 42 x + sum s)) :: ValuationAlgebraOp (->) [] Int Int
 -- >>> f [1,2,3]
 -- 48
-instance MonadFix (ValuationAlgebraOp set var) where
+instance MonadFix (ValuationAlgebraOp (->) set var) where
   mfix f = ValuationAlgebraOp (\s -> fix (\a -> let ValuationAlgebraOp g = f a in g s))
 
 -- |
 -- >>> import Control.Monad.Zip (mzipWith)
--- >>> let ValuationAlgebraOp f = mzipWith (+) (ValuationAlgebraOp sum) (ValuationAlgebraOp product :: ValuationAlgebraOp [] Int Int)
+-- >>> let ValuationAlgebraOp f = mzipWith (+) (ValuationAlgebraOp sum) (ValuationAlgebraOp product :: ValuationAlgebraOp (->) [] Int Int)
 -- >>> f [1,2,3]
 -- 12
-instance MonadZip (ValuationAlgebraOp set var) where
+instance MonadZip (ValuationAlgebraOp (->) set var) where
   mzipWith f (ValuationAlgebraOp g) (ValuationAlgebraOp h) = ValuationAlgebraOp (\s -> f (g s) (h s))
 
 -- |
 -- >>> import Control.Selective (select)
--- >>> let ValuationAlgebraOp f = select (ValuationAlgebraOp (\s -> Left (sum s)) :: ValuationAlgebraOp [] Int (Either Int Int)) (ValuationAlgebraOp (\_ -> (+10)))
+-- >>> let ValuationAlgebraOp f = select (ValuationAlgebraOp (\s -> Left (sum s)) :: ValuationAlgebraOp (->) [] Int (Either Int Int)) (ValuationAlgebraOp (\_ -> (+10)))
 -- >>> f [1,2,3]
 -- 16
-instance Selective (ValuationAlgebraOp set var) where
-  select = selectM
+instance (Strong p, Semigroupoid p, Category p) => Selective (ValuationAlgebraOp p set var) where
+  select (ValuationAlgebraOp feab) (ValuationAlgebraOp fab) =
+    ValuationAlgebraOp (lmap (\x -> (x, x)) (rmap (\(eab, f) -> either f Prelude.id eab) (second' fab . first' feab)))
 
 -- |
 -- >>> import Control.Monad.Reader.Class (ask, local)
--- >>> let ValuationAlgebraOp f = ask :: ValuationAlgebraOp [] Int [Int]
+-- >>> let ValuationAlgebraOp f = ask :: ValuationAlgebraOp (->) [] Int [Int]
 -- >>> f [1,2,3]
 -- [1,2,3]
 --
 -- >>> import Control.Monad.Reader.Class (ask, local)
--- >>> let ValuationAlgebraOp f = local (map (*2)) (ValuationAlgebraOp sum :: ValuationAlgebraOp [] Int Int)
+-- >>> let ValuationAlgebraOp f = local (map (*2)) (ValuationAlgebraOp sum :: ValuationAlgebraOp (->) [] Int Int)
 -- >>> f [1,2,3]
 -- 12
-instance MonadReader (set var) (ValuationAlgebraOp set var) where
-  ask = ValuationAlgebraOp id
+instance MonadReader (set var) (ValuationAlgebraOp (->) set var) where
+  ask = ValuationAlgebraOp Prelude.id
   local f (ValuationAlgebraOp g) = ValuationAlgebraOp (g . f)
 
 -- |
 -- >>> import Data.Profunctor (dimap, lmap, rmap)
--- >>> let ValuationAlgebraOp f = dimap (+1) (*2) (ValuationAlgebraOp sum :: ValuationAlgebraOp [] Int Int)
+-- >>> let ValuationAlgebraOp f = dimap (+1) (*2) (ValuationAlgebraOp sum :: ValuationAlgebraOp (->) [] Int Int)
 -- >>> f [1,2,3]
 -- 18
 --
 -- >>> import Data.Profunctor (lmap)
--- >>> let ValuationAlgebraOp f = lmap (*10) (ValuationAlgebraOp sum :: ValuationAlgebraOp [] Int Int)
+-- >>> let ValuationAlgebraOp f = lmap (*10) (ValuationAlgebraOp sum :: ValuationAlgebraOp (->) [] Int Int)
 -- >>> f [1,2,3]
 -- 60
 --
 -- >>> import Data.Profunctor (rmap)
--- >>> let ValuationAlgebraOp f = rmap show (ValuationAlgebraOp sum :: ValuationAlgebraOp [] Int Int)
+-- >>> let ValuationAlgebraOp f = rmap show (ValuationAlgebraOp sum :: ValuationAlgebraOp (->) [] Int Int)
 -- >>> f [1,2,3]
 -- "6"
-instance (Functor set) => Profunctor (ValuationAlgebraOp set) where
-  dimap f g (ValuationAlgebraOp h) = ValuationAlgebraOp (g . h . fmap f)
-  lmap f (ValuationAlgebraOp h) = ValuationAlgebraOp (h . fmap f)
-  rmap g (ValuationAlgebraOp h) = ValuationAlgebraOp (g . h)
+instance (Functor set, Profunctor p) => Profunctor (ValuationAlgebraOp p set) where
+  dimap f g (ValuationAlgebraOp h) = ValuationAlgebraOp (dimap (fmap f) g h)
+  lmap f (ValuationAlgebraOp h) = ValuationAlgebraOp (lmap (fmap f) h)
+  rmap g (ValuationAlgebraOp h) = ValuationAlgebraOp (rmap g h)
 
 -- |
 -- >>> import Data.Profunctor (Strong(..))
 -- >>> import Data.List.NonEmpty (NonEmpty(..))
--- >>> let ValuationAlgebraOp f = first' (ValuationAlgebraOp sum :: ValuationAlgebraOp NonEmpty Int Int)
+-- >>> let ValuationAlgebraOp f = first' (ValuationAlgebraOp sum :: ValuationAlgebraOp (->) NonEmpty Int Int)
 -- >>> f ((1, "a") :| [(2, "b"), (3, "c")])
 -- (6,"a")
 --
 -- >>> import Data.Profunctor (Strong(..))
 -- >>> import Data.List.NonEmpty (NonEmpty(..))
--- >>> let ValuationAlgebraOp f = second' (ValuationAlgebraOp sum :: ValuationAlgebraOp NonEmpty Int Int)
+-- >>> let ValuationAlgebraOp f = second' (ValuationAlgebraOp sum :: ValuationAlgebraOp (->) NonEmpty Int Int)
 -- >>> f (("a", 1) :| [("b", 2), ("c", 3)])
 -- ("a",6)
-instance (Comonad set) => Strong (ValuationAlgebraOp set) where
-  first' (ValuationAlgebraOp f) = ValuationAlgebraOp (\sac -> (f (fmap fst sac), snd (extract sac)))
-  second' (ValuationAlgebraOp f) = ValuationAlgebraOp (\sca -> (fst (extract sca), f (fmap snd sca)))
+instance (Comonad set, Strong p) => Strong (ValuationAlgebraOp p set) where
+  first' (ValuationAlgebraOp f) = ValuationAlgebraOp (lmap (\s -> (fmap fst s, snd (extract s))) (first' f))
+  second' (ValuationAlgebraOp f) = ValuationAlgebraOp (lmap (\s -> (fst (extract s), fmap snd s)) (second' f))
 
 -- |
 -- >>> import Data.Profunctor (Choice(..))
 -- >>> import Data.List.NonEmpty (NonEmpty(..))
--- >>> let ValuationAlgebraOp f = left' (ValuationAlgebraOp sum :: ValuationAlgebraOp NonEmpty Int Int)
+-- >>> let ValuationAlgebraOp f = left' (ValuationAlgebraOp sum :: ValuationAlgebraOp (->) NonEmpty Int Int)
 -- >>> f (Left 1 :| [Left 2, Left 3])
 -- Left 6
 -- >>> f (Right "hi" :| [Left 2])
@@ -306,68 +317,80 @@
 --
 -- >>> import Data.Profunctor (Choice(..))
 -- >>> import Data.List.NonEmpty (NonEmpty(..))
--- >>> let ValuationAlgebraOp f = right' (ValuationAlgebraOp sum :: ValuationAlgebraOp NonEmpty Int Int)
+-- >>> let ValuationAlgebraOp f = right' (ValuationAlgebraOp sum :: ValuationAlgebraOp (->) NonEmpty Int Int)
 -- >>> f (Right 1 :| [Right 2, Right 3])
 -- Right 6
 -- >>> f (Left "hi" :| [Right 2])
 -- Left "hi"
-instance (Comonad set) => Choice (ValuationAlgebraOp set) where
-  left' (ValuationAlgebraOp f) = ValuationAlgebraOp $ \seac ->
-    case extract seac of
-      Left a -> Left (f (fmap (fromLeft a) seac))
-      Right c -> Right c
-  right' (ValuationAlgebraOp f) = ValuationAlgebraOp $ \seca ->
-    case extract seca of
-      Right a -> Right (f (fmap (fromRight a) seca))
-      Left c -> Left c
+instance (Comonad set, Choice p) => Choice (ValuationAlgebraOp p set) where
+  left' (ValuationAlgebraOp f) =
+    ValuationAlgebraOp $
+      lmap
+        ( \s -> case extract s of
+            Left a -> Left (fmap (fromLeft a) s)
+            Right c -> Right c
+        )
+        (left' f)
+  right' (ValuationAlgebraOp f) =
+    ValuationAlgebraOp $
+      lmap
+        ( \s -> case extract s of
+            Right a -> Right (fmap (fromRight a) s)
+            Left c -> Left c
+        )
+        (right' f)
 
 -- |
 -- >>> import Data.Profunctor.Closed (Closed(..))
--- >>> let ValuationAlgebraOp f = closed (ValuationAlgebraOp sum :: ValuationAlgebraOp [] Int Int)
+-- >>> let ValuationAlgebraOp f = closed (ValuationAlgebraOp sum :: ValuationAlgebraOp (->) [] Int Int)
 -- >>> f [(*2), (*3)] 10
 -- 50
-instance (Functor set) => Closed (ValuationAlgebraOp set) where
-  closed (ValuationAlgebraOp f) = ValuationAlgebraOp (\sxa x -> f (fmap ($ x) sxa))
+instance (Functor set, Closed p) => Closed (ValuationAlgebraOp p set) where
+  closed (ValuationAlgebraOp f) = ValuationAlgebraOp (lmap distribute (closed f))
 
 -- |
 -- >>> import Data.Profunctor.Sieve (Cosieve(..))
--- >>> cosieve (ValuationAlgebraOp sum :: ValuationAlgebraOp [] Int Int) [1,2,3]
+-- >>> cosieve (ValuationAlgebraOp sum :: ValuationAlgebraOp (->) [] Int Int) [1,2,3]
 -- 6
-instance (Functor set) => Cosieve (ValuationAlgebraOp set) set where
+instance (Functor set) => Cosieve (ValuationAlgebraOp (->) set) set where
   cosieve (ValuationAlgebraOp f) = f
 
 -- |
 -- >>> import Data.Distributive (distribute)
--- >>> let ValuationAlgebraOp f = distribute [ValuationAlgebraOp sum, ValuationAlgebraOp product] :: ValuationAlgebraOp [] Int [Int]
+-- >>> let ValuationAlgebraOp f = distribute [ValuationAlgebraOp sum, ValuationAlgebraOp product] :: ValuationAlgebraOp (->) [] Int [Int]
 -- >>> f [1,2,3]
 -- [6,6]
-instance Distributive (ValuationAlgebraOp set var) where
+instance Distributive (ValuationAlgebraOp (->) set var) where
   distribute fs = ValuationAlgebraOp (\s -> fmap (\(ValuationAlgebraOp g) -> g s) fs)
 
 -- |
 -- >>> import Data.Functor.Rep (tabulate, index)
--- >>> let vao = tabulate (\s -> sum s * 2) :: ValuationAlgebraOp [] Int Int
+-- >>> let vao = tabulate (\s -> sum s * 2) :: ValuationAlgebraOp (->) [] Int Int
 -- >>> index vao [1,2,3]
 -- 12
-instance Representable (ValuationAlgebraOp set var) where
-  type Rep (ValuationAlgebraOp set var) = set var
+instance Representable (ValuationAlgebraOp (->) set var) where
+  type Rep (ValuationAlgebraOp (->) set var) = set var
   tabulate = ValuationAlgebraOp
   index (ValuationAlgebraOp f) = f
 
 -- |
--- >>> let ValuationAlgebraOp f = runSemigroup semigroupValuationAlgebraOp (ValuationAlgebraOp (const "hello")) (ValuationAlgebraOp (const " world") :: ValuationAlgebraOp [] Int String) in f []
+-- >>> import Data.Valuation.Semigroup (runSemigroup)
+-- >>> let ValuationAlgebraOp f = runSemigroup semigroupValuationAlgebraOp (ValuationAlgebraOp (const "hello")) (ValuationAlgebraOp (const " world") :: ValuationAlgebraOp (->) [] Int String) in f []
 -- "hello world"
-semigroupValuationAlgebraOp :: (Prelude.Semigroup v) => Semigroup (ValuationAlgebraOp set var v)
-semigroupValuationAlgebraOp = review applySemigroup (\(ValuationAlgebraOp f) (ValuationAlgebraOp g) -> ValuationAlgebraOp (\s -> f s <> g s))
+semigroupValuationAlgebraOp :: (Arrow p, Prelude.Semigroup v) => Semigroup p (ValuationAlgebraOp p set var v)
+semigroupValuationAlgebraOp =
+  let combine f g = arr (uncurry (Prelude.<>)) . (f *** g) . arr (\x -> (x, x))
+   in review applySemigroup (arr (\(ValuationAlgebraOp f) -> arr (\(ValuationAlgebraOp g) -> ValuationAlgebraOp (combine f g))))
 
 -- |
--- >>> let ValuationAlgebraOp f = ValuationAlgebraOp (const "hello") <> (ValuationAlgebraOp (const " world") :: ValuationAlgebraOp [] Int String) in f []
+-- >>> let ValuationAlgebraOp f = ValuationAlgebraOp (const "hello") <> (ValuationAlgebraOp (const " world") :: ValuationAlgebraOp (->) [] Int String) in f []
 -- "hello world"
-instance (Prelude.Semigroup v) => Prelude.Semigroup (ValuationAlgebraOp set var v) where
-  (<>) = runSemigroup semigroupValuationAlgebraOp
+instance (Strong p, Semigroupoid p, Prelude.Semigroup v) => Prelude.Semigroup (ValuationAlgebraOp p set var v) where
+  ValuationAlgebraOp f <> ValuationAlgebraOp g =
+    ValuationAlgebraOp (lmap (\x -> (x, x)) (rmap (uncurry (Prelude.<>)) (second' g `o` first' f)))
 
 -- |
--- >>> let ValuationAlgebraOp f = mempty :: ValuationAlgebraOp [] Int String in f [1,2,3]
+-- >>> let ValuationAlgebraOp f = mempty :: ValuationAlgebraOp (->) [] Int String in f [1,2,3]
 -- ""
-instance (Prelude.Monoid v) => Prelude.Monoid (ValuationAlgebraOp set var v) where
-  mempty = ValuationAlgebraOp (const mempty)
+instance (Prelude.Monoid v) => Prelude.Monoid (ValuationAlgebraOp (->) set var v) where
+  mempty = ValuationAlgebraOp (const Prelude.mempty)
diff --git a/valuations.cabal b/valuations.cabal
--- a/valuations.cabal
+++ b/valuations.cabal
@@ -1,5 +1,5 @@
 name:                 valuations
-version:              0.0.2
+version:              0.0.3
 synopsis:             Valuations
 description:          Valuations: Valuation and Valuation Algebra
 license:              BSD3