Add Inject/Project

Iso/Deriving.hs

@@ -5,6 +5,8 @@ module Iso.Deriving
 ( As(..)
 , As1(..)
 , As2(..)
+, Inject(..)
+, Project(..)
 , Isomorphic(..)
 )
 where
@@ -53,20 +55,23 @@ newtype As1 f g a   = As1 { getAs1 :: g a }
 -- type As2 :: k1 -> (k2 -> k3 -> Type) -> k2 -> k3 -> Type
 newtype As2 f g a b = As2 (g a b)
 
+
+class Inject a b where
+  inj :: a -> b
+
+class Project a b where
+  prj :: b -> a
+
 -- |
 -- Laws: 'isom' is an isomorphism, that is:
 --
 -- @
 -- view isom . view (from isom) = id = view (from isom) . view isom
 -- @
-class Isomorphic a b  where
+class (Inject a b, Project a b) => Isomorphic a b where
   isom :: Iso' a b
   isom = iso inj prj
 
-  -- TODO superclasses
-  inj :: a -> b
-  prj :: b -> a
-
 instance (Isomorphic a b, Num a) => Num (As a b) where
    (As a) + (As b) =
       As $ inj @a @b $ (prj a) + (prj b)

test/Spec.hs

@@ -27,10 +27,14 @@ data Point a = Point { x :: a, y :: a }
 
 type Squared = Ap ((->) Bool)
 
-instance Isomorphic (Squared a) (Point a) where
-  prj (Point x y) = coerce $ \p -> if not p then x else y
+instance Inject (Squared a) (Point a) where
   inj x = Point (coerce x $ False) (coerce x $ True)
 
+instance Project (Squared a) (Point a) where
+  prj (Point x y) = coerce $ \p -> if not p then x else y
+
+instance Isomorphic (Squared a) (Point a) where
+
 
 data NoneOrMore
   = None
@@ -40,12 +44,16 @@ data NoneOrMore
   deriving (Semigroup, Monoid)
     via (Any `As` NoneOrMore)
 
-instance Isomorphic Any NoneOrMore where
+instance Inject Any NoneOrMore where
   inj (Any False)    = None
   inj (Any True)     = OneOrMore
+
+instance Project Any NoneOrMore where
   prj None           = Any False
   prj OneOrMore      = Any True
 
+instance Isomorphic Any NoneOrMore
+
 data These a b = This a | That b | These a b
   deriving stock (Functor)
   deriving (Applicative, Monad)
@@ -53,11 +61,14 @@ data These a b = This a | That b | These a b
 
 type TheseMonad a = WriterT (Maybe a) (Either a)
 
-instance Isomorphic (TheseMonad a b) (These a b) where
+instance Project (TheseMonad a b) (These a b) where
   prj (This a) = WriterT (Left a)
   prj (That b) = WriterT (Right (b, Nothing))
   prj (These a b) = WriterT (Right (b, Just a))
 
+instance Inject (TheseMonad a b) (These a b) where
   inj (WriterT (Left a)) = This a
   inj (WriterT (Right (b, Nothing))) = That b
   inj (WriterT (Right (b, Just a))) = These a b
+
+instance Isomorphic (TheseMonad a b) (These a b) where