mirror of
https://github.com/KevinMidboe/linguist.git
synced 2025-10-29 17:50:22 +00:00
35 lines
911 B
Plaintext
35 lines
911 B
Plaintext
module Control.Arrow where
|
|
|
|
import Data.Tuple
|
|
|
|
class Arrow a where
|
|
arr :: forall b c. (b -> c) -> a b c
|
|
first :: forall b c d. a b c -> a (Tuple b d) (Tuple c d)
|
|
|
|
instance arrowFunction :: Arrow (->) where
|
|
arr f = f
|
|
first f (Tuple b d) = Tuple (f b) d
|
|
|
|
second :: forall a b c d. (Category a, Arrow a) => a b c -> a (Tuple d b) (Tuple d c)
|
|
second f = arr swap >>> first f >>> arr swap
|
|
|
|
swap :: forall a b. Tuple a b -> Tuple b a
|
|
swap (Tuple x y) = Tuple y x
|
|
|
|
infixr 3 ***
|
|
infixr 3 &&&
|
|
|
|
(***) :: forall a b b' c c'. (Category a, Arrow a) => a b c -> a b' c' -> a (Tuple b b') (Tuple c c')
|
|
(***) f g = first f >>> second g
|
|
|
|
(&&&) :: forall a b b' c c'. (Category a, Arrow a) => a b c -> a b c' -> a b (Tuple c c')
|
|
(&&&) f g = arr (\b -> Tuple b b) >>> (f *** g)
|
|
|
|
class ArrowZero a where
|
|
zeroArrow :: forall b c. a b c
|
|
|
|
infixr 5 <+>
|
|
|
|
class ArrowPlus a where
|
|
(<+>) :: forall b c. a b c -> a b c -> a b c
|