{- |
Copyright   :  (c) Henning Thielemann 2007

Maintainer  :  haskell@henning-thielemann.de
Stability   :  stable
Portability :  Haskell 98

Functions that combine both data types,
'Data.AlternatingList.List.Disparate.T' and
'Data.AlternatingList.List.Uniform.T'
-}
module Data.AlternatingList.List.Mixed (
    consFirst, consSecond, (./), (/.),
    snocFirst, snocSecond,
    viewL, viewR, viewFirstL, viewFirstR, viewSecondL, viewSecondR,
    mapFirstL,  mapFirstHead,  mapFirstTail,
    mapSecondL, mapSecondHead, mapSecondTail,
    mapFirstR,  mapFirstLast,  mapFirstInit,
    mapSecondR, mapSecondLast, mapSecondInit,
    appendUniformUniform, appendDisparateUniform, appendUniformDisparate,
    concatUniform, concatDisparate,
    splitAtDisparateUniform, splitAtUniformDisparate, splitAtUniformUniform,
    takeDisparate, takeUniform, dropDisparate, dropUniform,
    {- spanFirst, spanSecond, spanDisparate, -}

   ) where


import qualified Data.AlternatingList.List.Disparate as Disp
import qualified Data.AlternatingList.List.Uniform as Uniform

import Data.AlternatingList.List.Uniform (mapSecondHead)

import qualified Control.Monad as Monad

import Data.EventList.Utility (mapPair, mapFst, mapSnd)

import Prelude hiding
   (null, foldr, map, concat, sequence, sequence_, mapM, mapM_)


infixr 5 ./, /.

(/.) :: a -> Uniform.T a b -> Disp.T a b
(/.) = consFirst

(./) :: b -> Disp.T a b -> Uniform.T a b
(./) = consSecond


consFirst :: a -> Uniform.T a b -> Disp.T a b
consFirst a ~(Uniform.Cons b xs) = Disp.cons a b xs

consSecond :: b -> Disp.T a b -> Uniform.T a b
consSecond = Uniform.Cons


snocFirst :: Uniform.T a b -> a -> Disp.T b a
snocFirst xs = appendUniformUniform xs . Uniform.singleton
-- snocFirst xs a = Uniform.foldr consSecond consFirst (Uniform.singleton a) xs

snocSecond :: Disp.T b a -> b -> Uniform.T a b
snocSecond xs = appendDisparateUniform xs . Uniform.singleton
-- snocSecond xs b = Disp.foldr consSecond consFirst (Uniform.singleton b) xs


viewL :: Uniform.T a b -> (b, Maybe (a, Uniform.T a b))
viewL = mapSnd viewFirstL . viewSecondL

viewFirstL :: Disp.T a b -> Maybe (a, Uniform.T a b)
viewFirstL =
   Monad.liftM (\((a,b), xs) -> (a, consSecond b xs)) . Disp.viewL

viewSecondL :: Uniform.T a b -> (b, Disp.T a b)
viewSecondL (Uniform.Cons b xs) = (b,xs)


viewR :: Uniform.T a b -> (Maybe (Uniform.T a b, a), b)
viewR (Uniform.Cons b0 xs0) =
   maybe
     (Nothing, b0)
     (\ (xs, ~(a,b)) -> (Just (consSecond b0 xs, a), b)) $
     Disp.viewR xs0

viewFirstR :: Disp.T b a -> Maybe (Uniform.T a b, a)
viewFirstR =
   Monad.liftM (\ (xs, ~(a,b)) -> (snocSecond xs a, b)) .
   Disp.viewR

viewSecondR :: Uniform.T a b -> (Disp.T b a, b)
viewSecondR (Uniform.Cons b0 xs0) =
   maybe
      (Disp.empty, b0)
      (\ (xs, ~(a,b)) -> (consFirst b0 (snocSecond xs a), b))
      (Disp.viewR xs0)


-- could also be in ListDisparate
mapFirstL ::
   (a -> a, Uniform.T a b0 -> Uniform.T a b1) ->
   Disp.T a b0 -> Disp.T a b1
mapFirstL f =
   maybe Disp.empty (uncurry consFirst . mapPair f) . viewFirstL

mapFirstHead ::
   (a -> a) ->
   Disp.T a b -> Disp.T a b
mapFirstHead f = mapFirstL (f,id)

mapFirstTail ::
   (Uniform.T a b0 -> Uniform.T a b1) ->
   Disp.T a b0 -> Disp.T a b1
mapFirstTail f = mapFirstL (id,f)


mapSecondL ::
   (b -> b, Disp.T a0 b -> Disp.T a1 b) ->
   Uniform.T a0 b -> Uniform.T a1 b
mapSecondL f = uncurry consSecond . mapPair f . viewSecondL

{-
mapSecondHead ::
   (b -> b) ->
   Uniform.T a b -> Uniform.T a b
mapSecondHead f = mapSecondL (f,id)
-}

mapSecondTail ::
   (Disp.T a0 b -> Disp.T a1 b) ->
   Uniform.T a0 b -> Uniform.T a1 b
mapSecondTail f = mapSecondL (id,f)


mapFirstR ::
   (Uniform.T a b0 -> Uniform.T a b1, a -> a) ->
   Disp.T b0 a -> Disp.T b1 a
mapFirstR f =
   maybe Disp.empty (uncurry snocFirst . mapPair f) . viewFirstR

-- could also be in ListDisparate
mapFirstLast ::
   (a -> a) ->
   Disp.T b a -> Disp.T b a
mapFirstLast f = mapFirstR (id,f)

mapFirstInit ::
   (Uniform.T a b0 -> Uniform.T a b1) ->
   Disp.T b0 a -> Disp.T b1 a
mapFirstInit f = mapFirstR (f,id)


mapSecondR ::
   (Disp.T b a0 -> Disp.T b a1, b -> b) ->
   Uniform.T a0 b -> Uniform.T a1 b
mapSecondR f = uncurry snocSecond . mapPair f . viewSecondR

mapSecondLast ::
   (b -> b) ->
   Uniform.T a b -> Uniform.T a b
mapSecondLast f = mapSecondR (id,f)

mapSecondInit ::
   (Disp.T b a0 -> Disp.T b a1) ->
   Uniform.T a0 b -> Uniform.T a1 b
mapSecondInit f = mapSecondR (f,id)




appendUniformUniform :: Uniform.T a b -> Uniform.T b a -> Disp.T b a
appendUniformUniform xs ys =
   Uniform.foldr consSecond consFirst ys xs

appendDisparateUniform :: Disp.T b a -> Uniform.T a b -> Uniform.T a b
appendDisparateUniform xs ys =
   Disp.foldr consSecond consFirst ys xs

appendUniformDisparate :: Uniform.T a b -> Disp.T a b -> Uniform.T a b
appendUniformDisparate xs ys =
   mapSecondTail (flip Disp.append ys) xs


concatDisparate :: Disp.T (Uniform.T b a) (Uniform.T a b) -> Disp.T a b
concatDisparate =
   Disp.foldr appendUniformUniform appendUniformDisparate Disp.empty

concatUniform :: Uniform.T (Uniform.T b a) (Uniform.T a b) -> Uniform.T a b
concatUniform =
   (\(b,xs) -> appendUniformDisparate b (concatDisparate xs)) .
   viewSecondL



splitAtDisparateUniform :: Int -> Uniform.T a b -> (Disp.T b a, Uniform.T a b)
splitAtDisparateUniform 0 = (,) Disp.empty
splitAtDisparateUniform n =
   (\ ~(prefix,suffix) ->
       maybe
          (error "splitAtDisparateUniform: empty list")
          (mapFst (snocFirst prefix))
          (viewFirstL suffix)) .
   splitAtUniformDisparate (pred n)

splitAtUniformDisparate :: Int -> Uniform.T a b -> (Uniform.T a b, Disp.T a b)
splitAtUniformDisparate n (Uniform.Cons b xs) =
   mapFst (consSecond b) $ Disp.splitAt n xs


splitAtUniformUniform ::
   Int -> Disp.T b a -> Maybe (Uniform.T a b, Uniform.T b a)
splitAtUniformUniform n =
   (\ ~(xs,ys) ->
        fmap
           (mapFst (snocSecond xs))
           (viewFirstL ys)) .
   Disp.splitAt n


takeDisparate :: Int -> Uniform.T a b -> Disp.T b a
takeDisparate n =
   fst . viewSecondR . takeUniform n

takeUniform :: Int -> Uniform.T a b -> Uniform.T a b
takeUniform n (Uniform.Cons b xs) =
   consSecond b $ Disp.take n xs

dropDisparate :: Int -> Uniform.T a b -> Disp.T a b
dropDisparate n = Disp.drop n . snd . viewSecondL

dropUniform :: Int -> Uniform.T a b -> Uniform.T a b
dropUniform 0 = id
dropUniform n =
   maybe (error "dropUniform: empty list") snd .
   viewFirstL . dropDisparate (pred n)


{-
breakDisparateFirst :: (a -> Bool) ->
   Disp.T a b -> (Disp.T a b, Disp.T a b)
breakDisparateFirst p = Disp.spanFirst (not . p)

breakUniformFirst :: (a -> Bool) ->
   Uniform.T a b -> (Uniform.T a b, Disp.T a b)
breakUniformFirst p =
   let recurse xs0 =
          (\(b,xs) ->
              if p b
                then (empty, xs0)
                else
                  maybe
                     (\(a,ys) ->)
                  let (as,) = recurse  xs
                  in  ) $
          viewSecondL xs0
-}

{-
spanSecond :: (b -> Bool) -> Uniform.T a b -> (Uniform.T a b, Disp.T b a)
spanSecond p (Uniform.Cons b xs) =
   mapFst (consSecond b) (Disp.span p xs)

spanDisparate :: (b -> Bool) -> Disp.T a b -> (Uniform.T b a, Uniform.T a b)
spanDisparate p =
   mapPair (consSecond, consSecond) . List.span (p . pairFirst) . toPairList
-}