event-list-0.0.5: src/Data/AlternatingList/List/Mixed.hs
{- |
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
-}