@@ -33,18 +33,20 @@ module Control.SIArrow (
3333 sireplicate_
3434 ) where
3535
36−import Control.Arrow
36+import Control.Arrow (Kleisli(..))
3737import Control.Category
38+import Control.Category.Structures
3839import Control.Lens.Cons
3940import Control.Lens.Empty
4041import Control.Lens.Iso
4142import Control.Lens.SemiIso
4243import Control.Monad
4344import Control.Tuple.Morph
45+import Data.Semigroupoid.Dual
4446import Prelude hiding (id, (.))
4547
46−infixr 1 #>>, #<<
47−infixr 1 >>#, <<#
48+infixr 1 ^>>, ^<<, #>>, #<<
49+infixr 1 >>^, <<^, >>#, <<#
4850infixl 4 /$/, /$~
4951infixl 5 /*/, */, /*
5052infixl 3 /?/
@@ -57,7 +59,7 @@ infixl 3 /?/
5759--
5860-- The category @cat@ should contain @SemiIso@ as a sort of
5961-- \"subcategory of pure computations\".
60−class (Arrow cat, ArrowChoice cat, ArrowPlus cat) => SIArrow cat where
62+class (Products cat, Coproducts cat, CatPlus cat) => SIArrow cat where
6163 -- | Allows you to lift a SemiIso into @cat@. The resulting arrow should be
6264 -- in some sense minimal or \"pure\", similiar to 'pure', 'return' and
6365 -- 'arr' from "Control.Category".
@@ -85,7 +87,7 @@ class (Arrow cat, ArrowChoice cat, ArrowPlus cat) => SIArrow cat where
8587
8688 -- | @simany v@ repeats @v@ as long as possible.
8789 simany :: cat () b -> cat () [b]
88− simany v = sisome v <+> sipure _Empty
90+ simany v = sisome v /+/ sipure _Empty
8991
9092 {-# MINIMAL (siarr | sipure), sibind #-}
9193
@@ -93,12 +95,32 @@ instance MonadPlus m => SIArrow (Kleisli m) where
9395 siarr ai = Kleisli $ either fail return . apply ai
9496 sibind ai = Kleisli $ \a -> either fail (($ a) . runKleisli) $ apply ai a
9597
98+instance SIArrow cat => SIArrow (Dual cat) where
99+ siarr = Dual . sipure
100+ sibind ai = Dual $ sibind (iso id getDual . rev ai . iso getDual id)
101+
96102instance SIArrow ReifiedSemiIso' where
97103 siarr = reifySemiIso
98104 sibind ai = ReifiedSemiIso' $
99105 semiIso (\a -> apply ai a >>= flip apply a . runSemiIso)
100106 (\b -> unapply ai b >>= flip unapply b . runSemiIso)
101107
108+-- | Composes a SemiIso with an arrow.
109+(^>>) :: SIArrow cat => ASemiIso' a b -> cat b c -> cat a c
110+f ^>> a = a . siarr f
111+
112+-- | Composes an arrow with a SemiIso.
113+(>>^) :: SIArrow cat => cat a b -> ASemiIso' b c -> cat a c
114+a >>^ f = siarr f . a
115+
116+-- | Composes a SemiIso with an arrow, backwards.
117+(^<<) :: SIArrow cat => ASemiIso' b c -> cat a b -> cat a c
118+f ^<< a = siarr f . a
119+
120+-- | Composes an arrow with a SemiIso, backwards.
121+(<<^) :: SIArrow cat => cat b c -> ASemiIso' a b -> cat a c
122+a <<^ f = a . siarr f
123+
102124-- | Composes a reversed SemiIso with an arrow.
103125(#>>) :: SIArrow cat => ASemiIso' b a -> cat b c -> cat a c
104126f #>> a = a . sipure f
@@ -149,7 +171,7 @@ ai /$<~> h = cloneSemiIso ai . reorderMorphed /$/ h
149171--
150172-- The uncurried analogue of '<*>'.
151173(/*/) :: SIArrow cat => cat () b -> cat () c -> cat () (b, c)
152−a /*/ b = siarr unit >>> (a *** b)
174+a /*/ b = unit ^>> (a *** b)
153175
154176-- | The product of two arrows, where the second one has no input and no output
155177-- (but can have side effects), with duplicate units removed. Side effect are
@@ -173,7 +195,7 @@ sifail = siarr . alwaysFailing
173195
174196-- | Provides an error message in the case of failure.
175197(/?/) :: SIArrow cat => cat a b -> String -> cat a b
176−f /?/ msg = f <+> sifail msg
198+f /?/ msg = f /+/ sifail msg
177199
178200-- | Equivalent of 'sequence'.
179201sisequence :: SIArrow cat => [cat () a] -> cat () [a]