git.iko.soy/isoparsec
on master help sign in
Merge pull request #1 from ilyakooo0/arrows

Added BaseArrow and PolyArrow

commit2fff0d296171c1246d3d615c4294cd5e42f20547 authoriko <ilyakooo0@gmail.com> dateTue 8 Oct 2019, 22:36 (7 years ago) parent2fd71029cbb38b
6 files changed+131
compare with master
unifiedsplit
src/Control/Arrow/Extra.hs+9 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/BaseArrow.hs+27 src/Control/Arrow/Extra/PolyArrow.hs+39
src/Control/Arrow/Extra.hsnew file+9
@@ -0,0 +1,9 @@
1+module Control.Arrow.Extra
2+ ( module X
3+ ) where
4+
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/BaseArrow.hsnew file+27
@@ -0,0 +1,27 @@
1+{-# LANGUAGE NoImplicitPrelude, FlexibleInstances, UndecidableInstances #-}
2+
3+module Control.Arrow.Extra.BaseArrow
4+ ( BaseArrow(..)
5+ ) where
6+
7+import qualified Control.Arrow as A
8+import Control.Category
9+
10+class Category a => BaseArrow a where
11+ {-# MINIMAL (***), (&&&) #-}
12+
13+ first :: a b c -> a (b,d) (c,d)
14+ first = (*** id)
15+
16+ second :: a b c -> a (d,b) (d,c)
17+ second = (id ***)
18+
19+ (***) :: a b c -> a b' c' -> a (b,b') (c,c')
20+
21+ (&&&) :: a b c -> a b c' -> a b (c,c')
22+
23+instance (Category a, A.Arrow a) => BaseArrow a where
24+ first = A.first
25+ second = A.second
26+ (***) = (A.***)
27+ (&&&) = (A.&&&)
src/Control/Arrow/Extra/PolyArrow.hsnew file+39
@@ -0,0 +1,39 @@
1+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, MonoLocalBinds #-}
2+
3+module Control.Arrow.Extra.PolyArrow
4+ ( PolyArrow(..)
5+ , (^>>)
6+ , (>>^)
7+ , (<<^)
8+ , (^<<)
9+ , (^>^)
10+ , (^<^)
11+ ) where
12+
13+import qualified Control.Arrow as A
14+import Control.Arrow.Extra.BaseArrow
15+import Control.Category
16+
17+class BaseArrow a => PolyArrow a p where
18+ arr :: p b c -> a b c
19+
20+instance A.Arrow a => PolyArrow a (->) where
21+ 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