{-| Control.Concatenative brings postfix notation in the style of factor
    (see http://factorcode.org) to haskell.  Interfaces using both
    combinators and arrows are available.  
-}
module Control.Concatenative (
    -- * Postfix combinators
    bi, tri, biSp, triSp, biAp, triAp, ifte,
    -- * Postfix arrows 
    (>>@), dup, swap, both,
    (>>>), (&&&), (***), first, second
    ) where
import Control.Arrow

-- Function Interface

-- |Apply both arguments to a and combine the results
bi :: (a -> b) -> (a -> c) -> (b -> c -> d) -> a -> d
bi f g c = \x-> c (f x) (g x)

-- |Apply each of three arguments to a and combine the results
tri :: (a -> b) -> (a -> c) -> (a -> d) -> (b -> c -> d -> e) -> a -> e
tri f g h c = \x-> c (f x) (g x) (h x)

-- |Apply the first argument to a, the second to b, and combine the results
biSp :: (a -> c) -> (b -> d) -> (c -> d -> e) -> a -> b -> e
biSp f g c = \x y-> c (f x) (g y)

-- |Apply the first argument to a, the second to b, and the third to c, combining the results
triSp :: (a -> d) -> (b -> e) -> (c -> f) -> (d -> e -> f -> g) -> a -> b -> c -> g
triSp f g h c = \x y z-> c (f x) (g y) (h z)

-- |Apply a function to two values and combine the results
biAp :: (t -> t1) -> (t1 -> t1 -> t2) -> t -> t -> t2
biAp f c = \x y-> c (f x) (f y)

-- |Apply a function to three values and combine the results
triAp :: (a -> b) -> (b -> b -> b -> c) -> a -> a -> a -> c
triAp f c = \x y z-> c (f x) (f y) (f z)

ifte :: (a -> Bool) -- ^ A predicate
     -> (a -> b)    -- ^ Applied if the predicate yields True
     -> (a -> b)    -- ^ Applied if the predicate yields False
     -> a -> b
ifte test ca cb = \x ->
    if test x then ca x else cb x

-- Arrow Interface

-- |Combine with a binary function
(>>@) :: Arrow a => a b (x,y) -> (x -> y -> z) -> a b z
a >>@ f = a >>> arr (\(x,y) -> f x y)

-- |Arrow version of biAp
both :: Arrow a => a b c -> a (b,b) (c,c)
both a = first a >>> second a

dup :: Arrow a => a b (b,b)
dup = arr (\x-> (x,x))

swap :: Arrow a => a (x,y) (y,x)
swap = arr (\(x,y) -> (y,x))