-- |
-- Module      : FRP.Yampa.Arrow
-- Copyright   : (c) Ivan Perez, 2014-2022
--               (c) George Giorgidze, 2007-2012
--               (c) Henrik Nilsson, 2005-2006
--               (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004
-- License     : BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer  : ivan.perez@keera.co.uk
-- Stability   : provisional
-- Portability : portable
--
-- Arrow helper functions.
module FRP.Yampa.Arrow
    (
      -- * Arrow plumbing aids
      dup

      -- * Liftings
    , arr2
    , arr3
    , arr4
    , arr5
    )
  where

-- External imports
import Control.Arrow (Arrow, arr)

-- * Arrow plumbing aids

-- | Duplicate an input.
dup :: a -> (a, a)
dup :: forall a. a -> (a, a)
dup a
x = (a
x, a
x)

-- * Liftings

-- | Lift a binary function onto an arrow.
arr2 :: Arrow a => (b -> c -> d) -> a (b, c) d
arr2 :: forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c -> d) -> a (b, c) d
arr2 = ((b, c) -> d) -> a (b, c) d
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (((b, c) -> d) -> a (b, c) d)
-> ((b -> c -> d) -> (b, c) -> d) -> (b -> c -> d) -> a (b, c) d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> c -> d) -> (b, c) -> d
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

-- | Lift a 3-ary function onto an arrow.
arr3 :: Arrow a => (b -> c -> d -> e) -> a (b, c, d) e
arr3 :: forall (a :: * -> * -> *) b c d e.
Arrow a =>
(b -> c -> d -> e) -> a (b, c, d) e
arr3 = ((b, c, d) -> e) -> a (b, c, d) e
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (((b, c, d) -> e) -> a (b, c, d) e)
-> ((b -> c -> d -> e) -> (b, c, d) -> e)
-> (b -> c -> d -> e)
-> a (b, c, d) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \b -> c -> d -> e
h (b
b, c
c, d
d) -> b -> c -> d -> e
h b
b c
c d
d

-- | Lift a 4-ary function onto an arrow.
arr4 :: Arrow a => (b -> c -> d -> e -> f) -> a (b, c, d, e) f
arr4 :: forall (a :: * -> * -> *) b c d e f.
Arrow a =>
(b -> c -> d -> e -> f) -> a (b, c, d, e) f
arr4 = ((b, c, d, e) -> f) -> a (b, c, d, e) f
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (((b, c, d, e) -> f) -> a (b, c, d, e) f)
-> ((b -> c -> d -> e -> f) -> (b, c, d, e) -> f)
-> (b -> c -> d -> e -> f)
-> a (b, c, d, e) f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \b -> c -> d -> e -> f
h (b
b, c
c, d
d, e
e) -> b -> c -> d -> e -> f
h b
b c
c d
d e
e

-- | Lift a 5-ary function onto an arrow.
arr5 :: Arrow a => (b -> c -> d -> e -> f -> g) -> a (b, c, d, e, f) g
arr5 :: forall (a :: * -> * -> *) b c d e f g.
Arrow a =>
(b -> c -> d -> e -> f -> g) -> a (b, c, d, e, f) g
arr5 = ((b, c, d, e, f) -> g) -> a (b, c, d, e, f) g
forall b c. (b -> c) -> a b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (((b, c, d, e, f) -> g) -> a (b, c, d, e, f) g)
-> ((b -> c -> d -> e -> f -> g) -> (b, c, d, e, f) -> g)
-> (b -> c -> d -> e -> f -> g)
-> a (b, c, d, e, f) g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \b -> c -> d -> e -> f -> g
h (b
b, c
c, d
d, e
e, f
f) -> b -> c -> d -> e -> f -> g
h b
b c
c d
d e
e f
f