on master help sign in
Added BaseArrow and PolyArrow
commit9b50a7359ac9326569d2a288f0dc86ad0a33c838 authoriko <ilyakooo0@gmail.com> dateSat 28 Sep 2019, 22:01 (7 years ago) parent2fd7102
3 files changed+47
src/Control/Arrow/Extra.hs+6 src/Control/Arrow/Extra/BaseArrow.hs+27 src/Control/Arrow/Extra/PolyArrow.hs+14
src/Control/Arrow/Extra.hsnew file+6
@@ -0,0 +1,6 @@
1+module Control.Arrow.Extra
2+ ( module X
3+ ) where
4+
5+import Control.Arrow.Extra.BaseArrow as X
6+import Control.Arrow.Extra.PolyArrow as X
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+14
@@ -0,0 +1,14 @@
1+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, MonoLocalBinds #-}
2+
3+module Control.Arrow.Extra.PolyArrow
4+ ( PolyArrow(..)
5+ ) where
6+
7+import qualified Control.Arrow as A
8+import Control.Arrow.Extra.BaseArrow
9+
10+class BaseArrow a => PolyArrow a p where
11+ arr :: p b c -> a b c
12+
13+instance A.Arrow a => PolyArrow a (->) where
14+ arr = A.arr