git.iko.soy/isoparsec
on master help sign in
Added some more arrows
commit9cbb38b4f05588d66826b7f0ff3f56b7c3c51ac6 authoriko <ilyakooo0@gmail.com> dateSat 28 Sep 2019, 22:30 (7 years ago) parent9b50a73
5 files changed+86−2
compare with master
unifiedsplit
src/Control/Arrow/Extra.hs+5−2 src/Control/Arrow/Extra/ArrowChoice.hs+28 src/Control/Arrow/Extra/ArrowPlus.hs+14 src/Control/Arrow/Extra/ArrowZero.hs+14 src/Control/Arrow/Extra/PolyArrow.hs+25
src/Control/Arrow/Extra.hs+5−2
@@ -2,5 +2,8 @@ module Control.Arrow.Extra
22 ( module X
33 ) where
44
5−import Control.Arrow.Extra.BaseArrow as X
6−import Control.Arrow.Extra.PolyArrow as X
5+import Control.Arrow.Extra.ArrowChoice as X
6+import Control.Arrow.Extra.ArrowPlus as X
7+import Control.Arrow.Extra.ArrowZero as X
8+import Control.Arrow.Extra.BaseArrow as X
9+import Control.Arrow.Extra.PolyArrow as X
src/Control/Arrow/Extra/ArrowChoice.hsnew file+28
@@ -0,0 +1,28 @@
1+{-# LANGUAGE FlexibleInstances, UndecidableInstances, MonoLocalBinds, NoImplicitPrelude #-}
2+
3+module Control.Arrow.Extra.ArrowChoice
4+ ( ArrowChoice(..)
5+ ) where
6+
7+import qualified Control.Arrow as A
8+import Control.Arrow.Extra.BaseArrow
9+import Control.Category
10+import Data.Either
11+
12+
13+class BaseArrow a => ArrowChoice a where
14+ left :: a b c -> a (Either b d) (Either c d)
15+ left = (+++ id)
16+
17+ right :: a b c -> a (Either d b) (Either d c)
18+ right = (id +++)
19+
20+ (+++) :: a b c -> a b' c' -> a (Either b b') (Either c c')
21+
22+ (|||) :: a b d -> a c d -> a (Either b c) d
23+
24+instance A.ArrowChoice a => ArrowChoice a where
25+ left = A.left
26+ right = A.right
27+ (+++) = (A.+++)
28+ (|||) = (A.|||)
src/Control/Arrow/Extra/ArrowPlus.hsnew file+14
@@ -0,0 +1,14 @@
1+{-# LANGUAGE FlexibleInstances, UndecidableInstances, MonoLocalBinds #-}
2+
3+module Control.Arrow.Extra.ArrowPlus
4+ ( ArrowPlus(..)
5+ ) where
6+
7+import qualified Control.Arrow as A
8+import Control.Arrow.Extra.ArrowZero
9+
10+class ArrowZero a => ArrowPlus a where
11+ (<+>) :: a b c -> a b c -> a b c
12+
13+instance A.ArrowPlus a => ArrowPlus a where
14+ (<+>) = (A.<+>)
src/Control/Arrow/Extra/ArrowZero.hsnew file+14
@@ -0,0 +1,14 @@
1+{-# LANGUAGE FlexibleInstances, UndecidableInstances, MonoLocalBinds #-}
2+
3+module Control.Arrow.Extra.ArrowZero
4+ ( ArrowZero(..)
5+ ) where
6+
7+import qualified Control.Arrow as A
8+import Control.Arrow.Extra.BaseArrow
9+
10+class BaseArrow a => ArrowZero a where
11+ zeroArrow :: a b c
12+
13+instance A.ArrowZero a => ArrowZero a where
14+ zeroArrow = A.zeroArrow
src/Control/Arrow/Extra/PolyArrow.hs+25
@@ -2,13 +2,38 @@
22
33module Control.Arrow.Extra.PolyArrow
44 ( PolyArrow(..)
5+ , (^>>)
6+ , (>>^)
7+ , (<<^)
8+ , (^<<)
9+ , (^>^)
10+ , (^<^)
511 ) where
612
713import qualified Control.Arrow as A
814import Control.Arrow.Extra.BaseArrow
15+import Control.Category
916
1017class BaseArrow a => PolyArrow a p where
1118 arr :: p b c -> a b c
1219
1320instance A.Arrow a => PolyArrow a (->) where
1421 arr = A.arr
22+
23+(^>>) :: PolyArrow a p => p b c -> a c d -> a b d
24+f ^>> a = arr f >>> a
25+
26+(>>^) :: PolyArrow a p => a b c -> p c d -> a b d
27+a >>^ f = a >>> arr f
28+
29+(<<^) :: PolyArrow a p => a c d -> p b c -> a b d
30+a <<^ f = a <<< arr f
31+
32+(^<<) :: PolyArrow a p => p c d -> a b c -> a b d
33+f ^<< a = arr f <<< a
34+
35+(^>^) :: PolyArrow a p => p b c -> p c d -> a b d
36+a ^>^ b = arr a >>> arr b
37+
38+(^<^) :: PolyArrow a p => p c d -> p b c -> a b d
39+a ^<^ b = arr a <<< arr b