diff --git a/libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs b/libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs index 8a404b8e7a31e243d04c37bcc92b8d8f13f6fcb7..bf37b5a282b282733176db9f75ecf2aeca76566d 100644 --- a/libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs +++ b/libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs @@ -93,17 +93,35 @@ class Category a => Arrow a where {-# MINIMAL arr, (first | (***)) #-} -- | Lift a function to an arrow. + -- + -- > b â•───╮ c + -- > >───┤ f ├───> + -- > ╰───╯ arr :: (b -> c) -> a b c -- | Send the first component of the input through the argument -- arrow, and copy the rest unchanged to the output. + -- + -- The default definition may be overridden with a more efficient + -- version if desired. + -- + -- > b â•─────╮ c + -- > >───┼─ f ─┼───> + -- > >───┼─────┼───> + -- > d ╰─────╯ d first :: a b c -> a (b,d) (c,d) first = (*** id) - -- | A mirror image of 'first'. + -- | Send the second component of the input through the argument + -- arrow, and copy the rest unchanged to the output. -- -- The default definition may be overridden with a more efficient -- version if desired. + -- + -- > d â•─────╮ d + -- > >───┼─────┼───> + -- > >───┼─ f ─┼───> + -- > b ╰─────╯ c second :: a b c -> a (d,b) (d,c) second = (id ***) @@ -112,6 +130,11 @@ class Category a => Arrow a where -- -- The default definition may be overridden with a more efficient -- version if desired. + -- + -- > b â•─────╮ b' + -- > >───┼─ f ─┼───> + -- > >───┼─ g ─┼───> + -- > c ╰─────╯ c' (***) :: a b c -> a b' c' -> a (b,b') (c,c') f *** g = first f >>> arr swap >>> first g >>> arr swap where swap ~(x,y) = (y,x) @@ -121,6 +144,12 @@ class Category a => Arrow a where -- -- The default definition may be overridden with a more efficient -- version if desired. + -- + -- > â•───────╮ c + -- > b │ ┌─ f ─┼───> + -- > >───┼─┤ │ + -- > │ └─ g ─┼───> + -- > ╰───────╯ c' (&&&) :: a b c -> a b c' -> a b (c,c') f &&& g = arr (\b -> (b,b)) >>> f *** g @@ -204,6 +233,9 @@ instance Monad m => Arrow (Kleisli m) where second (Kleisli f) = Kleisli (\ ~(d,b) -> f b >>= \c -> return (d,c)) -- | The identity arrow, which plays the role of 'return' in arrow notation. +-- +-- > b +-- > >───> returnA :: Arrow a => a b b returnA = id @@ -416,6 +448,15 @@ leftApp f = arr ((\b -> (arr (\() -> b) >>> f >>> arr Left, ())) ||| -- > unassoc (a,(b,c)) = ((a,b),c) -- class Arrow a => ArrowLoop a where + -- | + -- + -- > â•──────────────╮ + -- > b │ â•───╮ │ c + -- > >───┼─────┤ ├────┼───> + -- > │ ┌─┤ ├─┠│ + -- > │ d │ ╰───╯ │ │ + -- > │ └───<───┘ │ + -- > ╰──────────────╯ loop :: a (b,d) (c,d) -> a b c -- | @since base-2.01