-------------------------------------------------------------------------------
-- $Id: Combinators.hs#1 2009/10/01 10:31:09 REDMOND\\satnams $
-------------------------------------------------------------------------------

module Lava.Combinators
where

import Lava.Serial

infixl 6 `vpar2`
infixl 6 `hpar2`

-------------------------------------------------------------------------------

listToPair :: Monad m => [a] -> m (a, a)
listToPair [a, b] = return (a, b)
listToPair other 
  = error ("listToPair called with a list of length " ++ show (length other))

-------------------------------------------------------------------------------

pairToList :: Monad m => (a, a) -> m [a]
pairToList (a, b) = return [a, b]

-------------------------------------------------------------------------------

fork2 :: Monad m => a -> m (a, a)
fork2 a = return (a, a)

-------------------------------------------------------------------------------

par2 :: Monad m => (a -> m b) -> (c -> m d) -> (a, c) -> m (b, d)
par2 circuit1 circuit2 (input1, input2)
  = do output1 <- circuit1 input1
       output2 <- circuit2 input2
       return (output1, output2)

-------------------------------------------------------------------------------

hpar2 :: Monad m => (a -> m b) -> (c -> m d) -> (a, c) -> m (b, d)
hpar2 = par2

-------------------------------------------------------------------------------

vpar2 :: Monad m => (a -> m b) -> (c -> m d) -> (a, c) -> m (b, d)
vpar2 = par2

-------------------------------------------------------------------------------

ziP :: Monad m => ([a], [b]) -> m [(a,b)]
ziP (a,b) = return (zip a b)

-------------------------------------------------------------------------------

unziP :: Monad m => [(a,b)] -> m ([a], [b])
unziP list = return (unzip list)

-------------------------------------------------------------------------------

zipList :: Monad m => [[a]] -> m [[a]]
zipList [[], _] = return []
zipList [_, []] = return []
zipList [a:as, b:bs] 
  = do rest <- zipList [as, bs]
       return ([a,b] : rest) 

-------------------------------------------------------------------------------

unzipList :: Monad m => [[a]] -> m [[a]]
unzipList list = return [map fstListPair list, map sndListPair list]

-------------------------------------------------------------------------------

fstListPair :: [a] -> a
fstListPair [a, _] = a 

-------------------------------------------------------------------------------

sndListPair :: [a] -> a
sndListPair [_, b] = b 

-------------------------------------------------------------------------------
-- This makes pairs out of consequetive members of an even length list.

pair :: Monad m => [a] -> m [[a]]
pair [] = return []
pair lst | odd (length lst) 
  = error ("pair given odd length list of size " ++ show (length lst))
pair (a:b:rest) 
  = do rest <- pair rest
       return ([a,b]:rest)

-------------------------------------------------------------------------------

unpair :: Monad m => [[a]] -> m [a]
unpair list = return (concat list)

-------------------------------------------------------------------------------

halve :: Monad m => [a] -> m ([a], [a])
halve l
  = return (take n l, drop n l)
    where
    n = length l `div` 2
 
-------------------------------------------------------------------------------

unhalve :: Monad m => ([a], [a]) -> m [a]
unhalve (a, b) = return (a ++ b)

-------------------------------------------------------------------------------

halveList :: Monad m => [a] -> m [[a]]
halveList l
  = return [take n l, drop n l]
    where
    n = length l `div` 2
 
-------------------------------------------------------------------------------

unhalveList :: Monad m => [[a]] -> m [a]
unhalveList [a, b] = return (a ++ b)

-------------------------------------------------------------------------------

chop :: Monad m => Int -> [a] -> m [[a]]
chop n [] = return []
chop n l 
  = do rest <- chop n (drop n l)
       return ((take n l) : rest)

-------------------------------------------------------------------------------

concaT :: Monad m => [[a]] -> m [a]
concaT list = return (concat list)

-------------------------------------------------------------------------------

sndList :: Monad m => ([a] -> m [a]) -> [a] -> m [a]
sndList f = halve >-> snD f >-> unhalve

-------------------------------------------------------------------------------

fsT :: Monad m => (a -> m b) -> (a, c) -> m (b, c)
fsT f (a, b) 
  = do c <- f a
       return (c, b)

-------------------------------------------------------------------------------

snD :: Monad m => (b -> m c) -> (a, b) -> m (a, c)
snD f (a, b) 
  = do c <- f b
       return (a, c)

-------------------------------------------------------------------------------

reversE :: Monad m => [a] -> m [a]
reversE list = return (reverse list)

-------------------------------------------------------------------------------