Add category instances for ReifiedSemiIso'.

Control/Category/Reader.hs

@@ -16,6 +16,7 @@ module Control.Category.Reader (
     ) where
 
 import Control.Category
+import Control.Category.Structures
 import Control.SIArrow
 import Prelude hiding (id, (.))
 
@@ -34,7 +35,7 @@ instance Products cat => Products (ReaderCT env cat) where
 instance Coproducts cat => Coproducts (ReaderCT env cat) where
     ReaderCT f +++ ReaderCT g = ReaderCT $ \x -> f x +++ g x
 
-instance CategoryPlus cat => CategoryPlus (ReaderCT env cat) where
+instance CatPlus cat => CatPlus (ReaderCT env cat) where
     cempty = clift cempty
     ReaderCT f /+/ ReaderCT g = ReaderCT $ \x -> f x /+/ g x
 

Control/Lens/SemiIso.hs

@@ -97,9 +97,9 @@ module Control.Lens.SemiIso (
     bifoldl1_
     ) where
 
-import Prelude hiding (id, (.))
-import Control.Arrow
+import Control.Arrow (Kleisli(..))
 import Control.Category
+import Control.Category.Structures
 import Control.Lens.Internal.SemiIso
 import Control.Lens.Iso
 import Data.Foldable
@@ -107,6 +107,7 @@ import Data.Functor.Identity
 import Data.Profunctor.Exposed
 import Data.Traversable
 import Data.Tuple.Morph
+import Prelude hiding (id, (.))
 
 -- | A semi-isomorphism is a partial isomorphism with weakened laws.
 -- 
@@ -140,11 +141,7 @@ instance Category ReifiedSemiIso' where
     id = ReifiedSemiIso' id
     ReifiedSemiIso' f . ReifiedSemiIso' g = ReifiedSemiIso' (g . f)
 
--- | This in an __/incomplete/__ instance, 'arr' and '(&&&)' are undefined.
-instance Arrow ReifiedSemiIso' where
-    arr = undefined
-    (&&&) = undefined
-
+instance Products ReifiedSemiIso' where
     -- TODO: pattern synonyms dont work here for some reason
     first (ReifiedSemiIso' ai) = withSemiIso ai $ \f g ->
         ReifiedSemiIso' $ cloneSemiIso $
@@ -161,6 +158,30 @@ instance Arrow ReifiedSemiIso' where
             semiIso (runKleisli $ Kleisli f *** Kleisli f')
                     (runKleisli $ Kleisli g *** Kleisli g')
 
+instance Coproducts ReifiedSemiIso' where
+    left (ReifiedSemiIso' ai) = withSemiIso ai $ \f g ->
+        ReifiedSemiIso' $ cloneSemiIso $
+            semiIso (runKleisli $ left $ Kleisli f)
+                    (runKleisli $ left $ Kleisli g)
+
+    right (ReifiedSemiIso' ai) = withSemiIso ai $ \f g ->
+        ReifiedSemiIso' $ cloneSemiIso $
+            semiIso (runKleisli $ right $ Kleisli f)
+                    (runKleisli $ right $ Kleisli g)
+
+    ReifiedSemiIso' ai +++ ReifiedSemiIso' ai' = ReifiedSemiIso' $
+        withSemiIso ai $ \f g -> withSemiIso ai' $ \f' g' ->
+            semiIso (runKleisli $ Kleisli f +++ Kleisli f')
+                    (runKleisli $ Kleisli g +++ Kleisli g')
+
+instance CatPlus ReifiedSemiIso' where
+    cempty = ReifiedSemiIso' $ alwaysFailing "cempty"
+
+    ReifiedSemiIso' ai /+/ ReifiedSemiIso' ai' = ReifiedSemiIso' $
+        withSemiIso ai $ \f g -> withSemiIso ai' $ \f' g' ->
+            semiIso (runKleisli $ Kleisli f /+/ Kleisli f')
+                    (runKleisli $ Kleisli g /+/ Kleisli g')
+
 -- | Constructs a semi isomorphism from a pair of functions that can
 -- fail with an error message.
 semiIso :: (s -> Either String a) -> (b -> Either String t) -> SemiIso s t a b

Control/SIArrow.hs

@@ -44,6 +44,9 @@ class (Products cat, Coproducts cat, CatPlus cat) => SIArrow cat where
 instance MonadPlus m => SIArrow (Kleisli m) where
     siarr ai = Kleisli $ either fail return . apply ai
 
+instance SIArrow ReifiedSemiIso' where
+    siarr = reifySemiIso
+
 (^>>) :: SIArrow cat => ASemiIso' a b -> cat b c -> cat a c
 f ^>> a = a . siarr f