module Data.AlternatingList.List.Mixed (
consFirst, consSecond, (./), (/.),
snocFirst, snocSecond,
viewL, viewFirstL, viewSecondL,
viewR, viewFirstR, viewSecondR,
switchL, switchFirstL, switchSecondL,
switchR, switchFirstR, switchSecondR,
mapFirstL, mapFirstHead, mapFirstTail,
mapSecondL, mapSecondHead, mapSecondTail,
mapFirstR, mapFirstLast, mapFirstInit,
mapSecondR, mapSecondLast, mapSecondInit,
appendUniformUniform, appendDisparateUniform, appendUniformDisparate,
concatUniform, concatDisparate,
reverseUniform, reverseDisparate,
splitAtDisparateUniform, splitAtUniformDisparate, splitAtUniformUniform,
takeDisparate, takeUniform, dropDisparate, dropUniform,
) 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.Tuple.HT (mapFst, mapSnd, mapPair, )
import Prelude hiding
(null, foldr, map, concat, sequence, sequence_, )
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
snocSecond :: Disp.T b a -> b -> Uniform.T a b
snocSecond xs = appendDisparateUniform xs . Uniform.singleton
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) =
Disp.switchR
(Nothing, b0)
(\ xs a b -> (Just (consSecond b0 xs, a), b))
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) =
Disp.switchR
(Disp.empty, b0)
(\ xs a b -> (consFirst b0 (snocSecond xs a), b))
xs0
switchL :: (b -> c) -> (b -> a -> Uniform.T a b -> c) -> Uniform.T a b -> c
switchL f g =
switchSecondL (\x -> switchFirstL (f x) (g x))
switchFirstL :: c -> (a -> Uniform.T a b -> c) -> Disp.T a b -> c
switchFirstL f g =
Disp.switchL f (\ a b xs -> g a (consSecond b xs))
switchSecondL :: (b -> Disp.T a b -> c) -> Uniform.T a b -> c
switchSecondL f (Uniform.Cons b xs) = f b xs
switchR :: (b -> c) -> (Uniform.T a b -> a -> b -> c) -> Uniform.T a b -> c
switchR f g =
switchSecondR (\xs b -> switchFirstR (f b) (\ys a -> g ys a b) xs)
switchFirstR :: c -> (Uniform.T a b -> a -> c) -> Disp.T b a -> c
switchFirstR f g =
maybe f (uncurry g) . viewFirstR
switchSecondR :: (Disp.T b a -> b -> c) -> Uniform.T a b -> c
switchSecondR f = uncurry f . viewSecondR
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
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
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)
reverseUniform :: Uniform.T a b -> Uniform.T a b
reverseUniform =
Uniform.foldl (flip consFirst) (flip consSecond) Disp.empty
reverseDisparate :: Disp.T a b -> Disp.T b a
reverseDisparate =
Disp.foldl (flip consSecond) (flip consFirst) Disp.empty
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 =
switchSecondL
(\ b xs -> appendUniformDisparate b (concatDisparate xs))
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 =
switchFirstL (error "dropUniform: empty list") (flip const) .
dropDisparate (pred n)