@@ -1,5 +1,8 @@
1+{-# LANGUAGE RankNTypes #-}
12{-# LANGUAGE TypeFamilies #-}
23{-# LANGUAGE ConstraintKinds #-}
4+{-# LANGUAGE FlexibleContexts #-}
5+{-# LANGUAGE ScopedTypeVariables #-}
36{- |
47Module : Control.SIArrow
58Description : Categories of reversible computations.
@@ -15,6 +18,7 @@ module Control.SIArrow (
1518 -- * Arrow.
1619 SIArrow(..),
1720 (^>>), (>>^), (^<<), (<<^),
21+ (#>>), (>>#), (#<<), (<<#),
1822
1923 -- * Functor and applicative.
2024 (/$/), (/$~),
@@ -30,18 +34,18 @@ module Control.SIArrow (
3034 sireplicate_
3135 ) where
3236
33−import Control.Arrow (Kleisli(..))
34−import Control.Category
35−import Control.Category.Structures
36−import Control.Lens.Cons
37−import Control.Lens.Empty
38−import Control.Lens.SemiIso
39−import Control.Monad
40−import Data.Tuple.Morph
41−import Prelude hiding (id, (.))
42−
43−infixr 1 ^>>, >>^
44−infixr 1 ^<<, <<^
37+import Control.Arrow (Kleisli(..))
38+import Control.Category
39+import Control.Category.Structures
40+import Control.Lens.Cons
41+import Control.Lens.Empty
42+import Control.Lens.SemiIso
43+import Control.Monad
44+import Data.Tuple.Morph
45+import Prelude hiding (id, (.))
46+
47+infixr 1 ^>>, ^<<, #>>, #<<
48+infixr 1 >>^, <<^, >>#, <<#
4549infixl 4 /$/, /$~
4650infixl 5 /*/, */, /*
4751infixl 3 /?/
@@ -59,6 +63,7 @@ class (Products cat, Coproducts cat, CatPlus cat) => SIArrow cat where
5963 -- in some sense minimal or \"pure\", similiar to 'pure', 'return' and
6064 -- 'arr' from "Control.Category".
6165 siarr :: ASemiIso' a b -> cat a b
66+ siarr = sipure . rev
6267
6368 -- | Reversed version of 'siarr'.
6469 --
@@ -66,6 +71,15 @@ class (Products cat, Coproducts cat, CatPlus cat) => SIArrow cat where
6671 sipure :: ASemiIso' b a -> cat a b
6772 sipure = siarr . rev
6873
74+ -- | Allows a computation to depend on a its input value.
75+ --
76+ -- I am not sure if this is the right way to get that ArrowApply or Monad
77+ -- like power. It seems quite easy to break the parser/pretty-printer inverse
78+ -- guarantee using this. On the other hand we have to be careful only when
79+ -- constructing the SemiIso using 'iso'/'semiIso' - and with an invalid SemiIso
80+ -- we could break everything anyway using 'siarr'.
81+ sibind :: ASemiIso a (cat a b) (cat a b) b -> cat a b
82+
6983 -- | @sisome v@ repeats @v@ as long as possible, but no less then once.
7084 sisome :: cat () b -> cat () [b]
7185 sisome v = _Cons /$/ v /*/ simany v
@@ -74,13 +88,17 @@ class (Products cat, Coproducts cat, CatPlus cat) => SIArrow cat where
7488 simany :: cat () b -> cat () [b]
7589 simany v = sisome v /+/ sipure _Empty
7690
77− {-# MINIMAL siarr #-}
91+ {-# MINIMAL (siarr | sipure), sibind #-}
7892
7993instance MonadPlus m => SIArrow (Kleisli m) where
8094 siarr ai = Kleisli $ either fail return . apply ai
95+ sibind ai = Kleisli $ \a -> either fail (($ a) . runKleisli) $ apply ai a
8196
8297instance SIArrow ReifiedSemiIso' where
8398 siarr = reifySemiIso
99+ sibind ai = ReifiedSemiIso' $
100+ semiIso (\a -> apply ai a >>= flip apply a . runSemiIso)
101+ (\b -> unapply ai b >>= flip unapply b . runSemiIso)
84102
85103-- | Composes a SemiIso with an arrow.
86104(^>>) :: SIArrow cat => ASemiIso' a b -> cat b c -> cat a c
@@ -98,9 +116,26 @@ f ^<< a = siarr f . a
98116(<<^) :: SIArrow cat => cat b c -> ASemiIso' a b -> cat a c
99117a <<^ f = a . siarr f
100118
101−-- | Postcomposes an arrow with a reversed SemiIso. The analogue of '<$>'.
119+-- | Composes a reversed SemiIso with an arrow.
120+(#>>) :: SIArrow cat => ASemiIso' b a -> cat b c -> cat a c
121+f #>> a = a . sipure f
122+
123+-- | Composes an arrow with a reversed SemiIso.
124+(>>#) :: SIArrow cat => cat a b -> ASemiIso' c b -> cat a c
125+a >># f = sipure f . a
126+
127+-- | Composes a reversed SemiIso with an arrow, backwards.
128+(#<<) :: SIArrow cat => ASemiIso' c b -> cat a b -> cat a c
129+f #<< a = sipure f . a
130+
131+-- | Composes an arrow with a reversed SemiIso, backwards.
132+(<<#) :: SIArrow cat => cat b c -> ASemiIso' b a -> cat a c
133+a <<# f = a . sipure f
134+
135+-- | Postcomposes an arrow with a reversed SemiIso.
136+-- The analogue of '<$>' and synonym for '#<<'.
102137(/$/) :: SIArrow cat => ASemiIso' b' b -> cat a b -> cat a b'
103−ai /$/ f = sipure ai . f
138+(/$/) = (#<<)
104139
105140-- | Convenient fmap.
106141--