---------------------------------------------------------------------
--
-- Module      :  Uniform.Pointless
--              collecting some of the operations for a 
--              pointless (pairs based) programming style  
--              demonstrated in the book by
--              Bird \& deMoore \"The Algebra of Programming\"
--          which is available from hackage 
--         https://hackage.haskell.org/package/aop-prelude-0.4.1.1 
----------------------------------------------------------------------

module Uniform.Pointless (module Uniform.Pointless
                    -- , module AOPPrelude
                    ) where


-- import AOPPrelude (outl, outr, swap, assocl, assocr, dupl
--     , pair, cross, cond )
-- code copied from aop-prelude (partial)
    
-- const :: a -> b -> a
-- const k a = k
-- id :: a -> a
-- id a      = a
-- id and const are imported from regular prelude

outl :: (a, b) -> a
outl :: forall a b. (a, b) -> a
outl (a
a, b
_) = a
a
outr :: (a, b) -> b
outr :: forall a b. (a, b) -> b
outr (a
_, b
b) = b
b
swap :: (a, b) -> (b, a)
swap :: forall a b. (a, b) -> (b, a)
swap (a
a, b
b) = (b
b, a
a)

assocl :: (a, (b, c)) -> ((a, b), c)
assocl :: forall a b c. (a, (b, c)) -> ((a, b), c)
assocl (a
a, (b
b, c
c)) = ((a
a, b
b), c
c)
assocr :: ((a, b), c) -> (a, (b, c))
assocr :: forall a b c. ((a, b), c) -> (a, (b, c))
assocr ((a
a, b
b), c
c) = (a
a, (b
b, c
c))

dupl :: (a, (b, c)) -> ((a, b), (a, c))
dupl :: forall a b c. (a, (b, c)) -> ((a, b), (a, c))
dupl (a
a, (b
b, c
c)) = ((a
a, b
b), (a
a, c
c))
dupr :: ((a, b), c) -> ((a, c), (b, c))
dupr :: forall a b c. ((a, b), c) -> ((a, c), (b, c))
dupr ((a
a, b
b), c
c) = ((a
a, c
c), (b
b, c
c))

pair :: (a -> b, a -> c) -> a -> (b, c)
pair :: forall a b c. (a -> b, a -> c) -> a -> (b, c)
pair (a -> b
f, a -> c
g) a
a       = (a -> b
f a
a, a -> c
g a
a)
cross :: (a -> c, b -> d) -> (a, b) -> (c, d)
cross :: forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
cross (a -> c
f, b -> d
g) (a
a, b
b) = (a -> c
f a
a, b -> d
g b
b)
cond :: (a -> Bool) -> (a -> b, a -> b) -> a -> b
cond :: forall a b. (a -> Bool) -> (a -> b, a -> b) -> a -> b
cond a -> Bool
p (a -> b
f, a -> b
g) a
a     = if a -> Bool
p a
a then a -> b
f a
a else a -> b
g a
a

curry :: ((a, b) -> c) -> a -> b -> c
curry :: forall a b c. ((a, b) -> c) -> a -> b -> c
curry (a, b) -> c
f a
a b
b      = (a, b) -> c
f (a
a, b
b)
uncurry :: (a -> b -> c) -> (a, b) -> c
uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c
f (a
a, b
b) = a -> b -> c
f a
a b
b
-- pair :: (t -> b) -> (t, t) -> (b, b)

-- my old different definitions (with prime):

pair' :: (a->b) -> (a,a) -> (b,b)
pair' :: forall a b. (a -> b) -> (a, a) -> (b, b)
pair' a -> b
f (a
a, a
b) = (a -> b
f a
a, a -> b
f a
b) 
-- ^ replace wth both

swapPair :: (b, a) -> (a, b)
-- | replace with swap
swapPair :: forall a b. (a, b) -> (b, a)
swapPair (b
a, a
b) = (a
b, b
a)

dup :: b -> (b, b)
-- make a pair from a value
dup :: forall b. b -> (b, b)
dup b
a = (b
a,b
a)