-- | 
-- Maintainer : silva.samuel@alumni.uminho.pt
-- Stability  : experimental
-- Portability: portable
-- This module implements Point-Free library
module Music.Analysis.PF where
import Data.Maybe (Maybe(..), maybe)
import Data.Either (Either(..), either)
import Data.Bool (Bool)
import Data.Tuple (uncurry, curry, fst, snd)
import Data.Function ((.), ($), id, const)
import Data.List ((++))
import Prelude () 
infix 5  ><  
infix 4  -|- 

-- * Product 
-- ** Combinators
-- | split
split :: (a -> b) -> (a -> c) -> a -> (b,c)
split f g x = (f x, g x)
-- | product
(><) :: (a -> b) -> (c -> d) -> (a,c) -> (b,d)
f >< g = split (f . p1) (g . p2)
-- | the 0-adic split 
(!) :: a -> ()
(!) = const ()

-- ** Renamings
-- | fst
p1 :: (a, b) -> a
p1        = fst
-- | snd
p2 :: (a, b) -> b
p2        = snd

-- * Coproduct 
-- ** Renamings
-- | Left
i1 :: a -> Either a b
i1      = Left
-- | Right
i2 :: b -> Either a b
i2      = Right
-- ** Combinators
-- either is predefined
-- | sum
(-|-) :: (a -> b) -> (c -> d) -> Either a c -> Either b d
f -|- g = either (i1 . f) (i2 . g)
-- | McCarthy's conditional:
cond :: (b -> Bool) -> (b -> c) -> (b -> c) -> b -> c
cond p f g = (either f g) . (grd p)

-- * Exponentiation 
-- ** Combinators
-- curry is predefined
-- | ap
ap :: (a -> b,a) -> b
ap = uncurry ($)
-- | expn
expn :: (b -> c) -> (a -> b) -> a -> c
expn f = curry (f . ap)
-- exponentiation functor is (a->) predefined 

-- * Others 
-- @const :: a -> b -> a st @
-- @const a x = a is predefined@
-- | guard
grd :: (a -> Bool) -> a -> Either a a
grd p x = if p x then Left x else Right x

-- * Natural isomorphisms 
-- | swap
swap :: (a,b) -> (b,a)
swap = split snd fst
-- | assoc right
assocr :: ((a,b),c) -> (a,(b,c))
assocr = split ( fst . fst ) (split ( snd . fst ) snd )
-- | assoc left
assocl :: (a,(b,c)) -> ((a,b),c)
assocl = split ( id >< p1 ) ( p2 . p2 )
-- | dist right
distr :: (a,Either b c) -> Either (a,b) (a,c)
distr (a, Left b) = i1 (a, b)
distr (a, Right c) = i2 (a, c)
-- | undist right
undistr :: Either (a,b) (a,c) -> (a,Either b c)
undistr = either ( id >< i1 ) ( id >< i2 )
-- | flat right
flatr :: (a,(b,c)) -> (a,b,c)
flatr (a,(b,c)) = (a,b,c)
-- | flat left
flatl :: ((a,b),c) -> (a,b,c)
flatl ((b,c),d) = (b,c,d)
-- | unflat right
unflatr :: (a,b,c) -> (a,(b,c))
unflatr (a,b,c) = (a,(b,c))
-- | unflat left
unflatl :: (a,b,c) -> ((a,b),c)
unflatl (b,c,d) = ((b,c),d)
-- | pair with nil
pwnil :: a -> (a,()) -- pwnil means 'pair with nil'
pwnil = split id (!)
-- | coswap
coswap :: Either a b -> Either b a
coswap = either i2 i1
-- | coassoc right
coassocr :: Either (Either a b) c -> Either a (Either b c)
coassocr = either (id -|- i1) (i2 . i2)

-- * More funtions
-- | maybe 2 Either
maybe2either :: Maybe a -> Either () a
maybe2either Nothing = Left ()
maybe2either (Just v) = Right v
-- | either 2 maybe
either2maybe :: Either () a -> Maybe a
either2maybe (Left ()) = Nothing
either2maybe (Right a) = Just a
-- | Binding to either2maybe
e2m :: Either () a -> Maybe a
e2m = either2maybe
-- | Binding to maybe2either
m2e :: Maybe a -> Either () a
m2e = maybe2either

-- * Algebras and Co-Algebras
-- | out
outL :: [a] -> Maybe (a, [a])
outL [] = Nothing
outL (h:t) = Just (h,t)
-- | catamorphism
cataL :: (Maybe (a, c) -> c) -> [a] -> c
cataL g = g . e2m . (id -|- id >< cataL g) . m2e . outL
-- | in
inL :: Maybe (a, [a]) -> [a]
inL Nothing = []
inL (Just v) = uncurry (:) v
-- | anamorphism
anaL :: (c -> Maybe (a, c)) -> c -> [a]
anaL g = inL . e2m . (id -|- id >< anaL g) . m2e . g
-- | hylomorphism
hyloL :: (Maybe (c, b) -> b) -> (a -> Maybe (c, a)) -> a -> b
hyloL g h = g . e2m . (id -|- id >< hyloL g h) . m2e . h

-- | mapping
mapL :: (a -> b) -> [a] -> [b]
mapL f =  cataL (maybe [] (uncurry (:) . (f >< id)))
-- | concat
concatL :: [[a]] -> [a]
concatL = cataL (maybe [] (uncurry (++)))
-- | reverse
reverseL :: [a] -> [a]
reverseL = cataL (maybe [] (uncurry (++) . swap . ((:[]). id >< id)))

-- * Algebras and Co-Algebras
-- | out
outL1 :: [a] -> Maybe (Either a (a, [a]))
outL1 [] = Nothing
outL1 [x] = Just (i1 x)
outL1 (h:t) = Just (i2 (h,t))
-- | catamorphism
cataL1 :: (Maybe (Either a (a, c)) -> c) -> [a] -> c
cataL1 g = g . e2m . (id -|- (id -|- id >< cataL1 g)) . m2e . outL1
-- | in
inL1 :: Maybe (Either a (a, [a])) -> [a]
inL1 Nothing = []
inL1 (Just v) = either (:[]) (uncurry (:)) v
-- | anamorphism
anaL1 :: (c -> Maybe (Either a (a, c))) -> c -> [a]
anaL1 g = inL1 . e2m . (id -|- (id -|- id >< anaL1 g)) . m2e . g
-- | hylomorphism
hyloL1 :: (Maybe (Either d (c, b)) -> b) -> (a -> Maybe (Either d (c, a))) -> a -> b
hyloL1 g h = g . e2m . (id -|- (id -|- id >< hyloL1 g h)) . m2e . h