{- |
Copyright   :  (c) Henning Thielemann 2007-2009

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

Lists of elements of alternating type.
This module is based on the standard list type
and may benefit from list optimizations.
-}
module Data.AlternatingList.List.Disparate
   (T,
    fromPairList, toPairList,
    map, mapFirst, mapSecond,
    zipWithFirst, zipWithSecond,
    concatMonoid, concatMapMonoid,
    sequence, sequence_,
    traverse, traverse_, traverseFirst, traverseSecond,
    getFirsts, getSeconds, length, genericLength,
    empty, singleton, null,
    cons, snoc, viewL, viewR, switchL, switchR, mapHead, mapLast,
    foldr, foldrPair, foldl, reverse,
    format,
    append, concat, cycle,
    splitAt, take, drop,
    genericSplitAt, genericTake, genericDrop,
    spanFirst, spanSecond,
   ) where

import Data.Tuple.HT (mapSnd, mapPair, )

import qualified Data.List as List
import qualified Data.List.HT as ListHT
import qualified Control.Monad as Monad
import qualified Control.Applicative as Applicative
import qualified Data.Traversable as Trav

import Control.Applicative (Applicative, pure, )
import Data.Monoid (Monoid, mempty, mappend, )

import Test.QuickCheck (Arbitrary(arbitrary, shrink))

import Text.Show (Show, ShowS, showsPrec, showParen, showString, )
import Data.Function (id, flip, (.), ($), )
import Data.Functor (fmap, )
import Data.Maybe (Maybe(Just, Nothing), maybe, )
import Data.List (zipWith, (++), )
import Data.Tuple (curry, uncurry, )
import Data.Ord (Ord, (>=), )
import Prelude (Integral, Int, String, Bool, Eq, )


data Pair a b =
     Pair {forall a b. Pair a b -> a
pairFirst  :: a,
           forall a b. Pair a b -> b
pairSecond :: b}
   deriving (Pair a b -> Pair a b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Pair a b -> Pair a b -> Bool
/= :: Pair a b -> Pair a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Pair a b -> Pair a b -> Bool
== :: Pair a b -> Pair a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Pair a b -> Pair a b -> Bool
Eq, Pair a b -> Pair a b -> Bool
Pair a b -> Pair a b -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a} {b}. (Ord a, Ord b) => Eq (Pair a b)
forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Bool
forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Ordering
forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Pair a b
min :: Pair a b -> Pair a b -> Pair a b
$cmin :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Pair a b
max :: Pair a b -> Pair a b -> Pair a b
$cmax :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Pair a b
>= :: Pair a b -> Pair a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Bool
> :: Pair a b -> Pair a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Bool
<= :: Pair a b -> Pair a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Bool
< :: Pair a b -> Pair a b -> Bool
$c< :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Bool
compare :: Pair a b -> Pair a b -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Ordering
Ord, Int -> Pair a b -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Pair a b -> ShowS
forall a b. (Show a, Show b) => [Pair a b] -> ShowS
forall a b. (Show a, Show b) => Pair a b -> String
showList :: [Pair a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Pair a b] -> ShowS
show :: Pair a b -> String
$cshow :: forall a b. (Show a, Show b) => Pair a b -> String
showsPrec :: Int -> Pair a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Pair a b -> ShowS
Show)

newtype T a b = Cons {forall a b. T a b -> [Pair a b]
decons :: [Pair a b]}
   deriving (T a b -> T a b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => T a b -> T a b -> Bool
/= :: T a b -> T a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => T a b -> T a b -> Bool
== :: T a b -> T a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => T a b -> T a b -> Bool
Eq, T a b -> T a b -> Bool
T a b -> T a b -> Ordering
T a b -> T a b -> T a b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a} {b}. (Ord a, Ord b) => Eq (T a b)
forall a b. (Ord a, Ord b) => T a b -> T a b -> Bool
forall a b. (Ord a, Ord b) => T a b -> T a b -> Ordering
forall a b. (Ord a, Ord b) => T a b -> T a b -> T a b
min :: T a b -> T a b -> T a b
$cmin :: forall a b. (Ord a, Ord b) => T a b -> T a b -> T a b
max :: T a b -> T a b -> T a b
$cmax :: forall a b. (Ord a, Ord b) => T a b -> T a b -> T a b
>= :: T a b -> T a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => T a b -> T a b -> Bool
> :: T a b -> T a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => T a b -> T a b -> Bool
<= :: T a b -> T a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => T a b -> T a b -> Bool
< :: T a b -> T a b -> Bool
$c< :: forall a b. (Ord a, Ord b) => T a b -> T a b -> Bool
compare :: T a b -> T a b -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => T a b -> T a b -> Ordering
Ord)


format :: (Show a, Show b) =>
   String -> String -> Int -> T a b -> ShowS
format :: forall a b.
(Show a, Show b) =>
String -> String -> Int -> T a b -> ShowS
format String
first String
second Int
p T a b
xs =
   Bool -> ShowS -> ShowS
showParen (Int
pforall a. Ord a => a -> a -> Bool
>=Int
5) forall a b. (a -> b) -> a -> b
$
   forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a c d b. (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> d
foldr
      (\a
a -> forall a. Show a => Int -> a -> ShowS
showsPrec Int
5 a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
first)
      (\b
b -> forall a. Show a => Int -> a -> ShowS
showsPrec Int
5 b
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
second))
      T a b
xs forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> ShowS
showString String
"empty"

instance (Show a, Show b) => Show (T a b) where
   showsPrec :: Int -> T a b -> ShowS
showsPrec = forall a b.
(Show a, Show b) =>
String -> String -> Int -> T a b -> ShowS
format String
" /. " String
" ./ "


instance (Arbitrary a, Arbitrary b) =>
             Arbitrary (Pair a b) where
   arbitrary :: Gen (Pair a b)
arbitrary = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
Monad.liftM2 forall a b. a -> b -> Pair a b
Pair forall a. Arbitrary a => Gen a
arbitrary forall a. Arbitrary a => Gen a
arbitrary
   shrink :: Pair a b -> [Pair a b]
shrink (Pair a
a b
b) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. a -> b -> Pair a b
Pair) forall a b. (a -> b) -> a -> b
$ forall a. Arbitrary a => a -> [a]
shrink (a
a,b
b)

instance (Arbitrary a, Arbitrary b) =>
             Arbitrary (T a b) where
   arbitrary :: Gen (T a b)
arbitrary = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
Monad.liftM forall a b. [Pair a b] -> T a b
Cons forall a. Arbitrary a => Gen a
arbitrary
   shrink :: T a b -> [T a b]
shrink (Cons [Pair a b]
xs) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. [Pair a b] -> T a b
Cons forall a b. (a -> b) -> a -> b
$ forall a. Arbitrary a => a -> [a]
shrink [Pair a b]
xs


fromPairList :: [(a,b)] -> T a b
fromPairList :: forall a b. [(a, b)] -> T a b
fromPairList = forall a b. [Pair a b] -> T a b
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. a -> b -> Pair a b
Pair)

toPairList :: T a b -> [(a,b)]
toPairList :: forall a b. T a b -> [(a, b)]
toPairList = forall a b. (a -> b) -> [a] -> [b]
List.map (\ ~(Pair a
a b
b) -> (a
a,b
b)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> [Pair a b]
decons


lift :: ([Pair a0 b0] -> [Pair a1 b1]) -> (T a0 b0 -> T a1 b1)
lift :: forall a0 b0 a1 b1.
([Pair a0 b0] -> [Pair a1 b1]) -> T a0 b0 -> T a1 b1
lift [Pair a0 b0] -> [Pair a1 b1]
f = forall a b. [Pair a b] -> T a b
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair a0 b0] -> [Pair a1 b1]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> [Pair a b]
decons

{-# INLINE mapPairFirst #-}
mapPairFirst :: (a0 -> a1) -> Pair a0 b -> Pair a1 b
mapPairFirst :: forall a0 a1 b. (a0 -> a1) -> Pair a0 b -> Pair a1 b
mapPairFirst a0 -> a1
f Pair a0 b
e = Pair a0 b
e{pairFirst :: a1
pairFirst = a0 -> a1
f (forall a b. Pair a b -> a
pairFirst Pair a0 b
e)}

{-# INLINE mapPairSecond #-}
mapPairSecond :: (b0 -> b1) -> Pair a b0 -> Pair a b1
mapPairSecond :: forall b0 b1 a. (b0 -> b1) -> Pair a b0 -> Pair a b1
mapPairSecond b0 -> b1
f Pair a b0
e = Pair a b0
e{pairSecond :: b1
pairSecond = b0 -> b1
f (forall a b. Pair a b -> b
pairSecond Pair a b0
e)}

{-# INLINE map #-}
map :: (a0 -> a1) -> (b0 -> b1) -> T a0 b0 -> T a1 b1
map :: forall a0 a1 b0 b1. (a0 -> a1) -> (b0 -> b1) -> T a0 b0 -> T a1 b1
map a0 -> a1
f b0 -> b1
g = forall a0 b0 a1 b1.
([Pair a0 b0] -> [Pair a1 b1]) -> T a0 b0 -> T a1 b1
lift (forall a b. (a -> b) -> [a] -> [b]
List.map (forall a0 a1 b. (a0 -> a1) -> Pair a0 b -> Pair a1 b
mapPairFirst a0 -> a1
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b0 b1 a. (b0 -> b1) -> Pair a b0 -> Pair a b1
mapPairSecond b0 -> b1
g))

{-# INLINE mapFirst #-}
mapFirst :: (a0 -> a1) -> T a0 b -> T a1 b
mapFirst :: forall a0 a1 b. (a0 -> a1) -> T a0 b -> T a1 b
mapFirst a0 -> a1
f = forall a0 b0 a1 b1.
([Pair a0 b0] -> [Pair a1 b1]) -> T a0 b0 -> T a1 b1
lift (forall a b. (a -> b) -> [a] -> [b]
List.map (forall a0 a1 b. (a0 -> a1) -> Pair a0 b -> Pair a1 b
mapPairFirst a0 -> a1
f))

{-# INLINE mapSecond #-}
mapSecond :: (b0 -> b1) -> T a b0 -> T a b1
mapSecond :: forall b0 b1 a. (b0 -> b1) -> T a b0 -> T a b1
mapSecond b0 -> b1
g = forall a0 b0 a1 b1.
([Pair a0 b0] -> [Pair a1 b1]) -> T a0 b0 -> T a1 b1
lift (forall a b. (a -> b) -> [a] -> [b]
List.map (forall b0 b1 a. (b0 -> b1) -> Pair a b0 -> Pair a b1
mapPairSecond b0 -> b1
g))


zipWithFirst :: (a0 -> a1 -> a2) -> [a0] -> T a1 b -> T a2 b
zipWithFirst :: forall a0 a1 a2 b. (a0 -> a1 -> a2) -> [a0] -> T a1 b -> T a2 b
zipWithFirst a0 -> a1 -> a2
f [a0]
xs =
   forall a0 b0 a1 b1.
([Pair a0 b0] -> [Pair a1 b1]) -> T a0 b0 -> T a1 b1
lift forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a0
x (Pair a1
a b
b) -> forall a b. a -> b -> Pair a b
Pair (a0 -> a1 -> a2
f a0
x a1
a) b
b) [a0]
xs

zipWithSecond :: (b0 -> b1 -> b2) -> [b0] -> T a b1 -> T a b2
zipWithSecond :: forall b0 b1 b2 a. (b0 -> b1 -> b2) -> [b0] -> T a b1 -> T a b2
zipWithSecond b0 -> b1 -> b2
f [b0]
xs =
   forall a0 b0 a1 b1.
([Pair a0 b0] -> [Pair a1 b1]) -> T a0 b0 -> T a1 b1
lift forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\b0
x (Pair a
a b1
b) -> forall a b. a -> b -> Pair a b
Pair a
a (b0 -> b1 -> b2
f b0
x b1
b)) [b0]
xs


{- |
Counterpart to 'Foldable.fold'.
-}
concatMonoid :: Monoid m =>
   T m m -> m
concatMonoid :: forall m. Monoid m => T m m -> m
concatMonoid =
   forall a c d b. (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> d
foldr forall a. Monoid a => a -> a -> a
mappend forall a. Monoid a => a -> a -> a
mappend forall a. Monoid a => a
mempty

{- |
Counterpart to 'Foldable.foldMap'.
-}
concatMapMonoid :: Monoid m =>
   (time -> m) ->
   (body -> m) ->
   T time body -> m
concatMapMonoid :: forall m time body.
Monoid m =>
(time -> m) -> (body -> m) -> T time body -> m
concatMapMonoid time -> m
f body -> m
g =
   forall m. Monoid m => T m m -> m
concatMonoid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a0 a1 b0 b1. (a0 -> a1) -> (b0 -> b1) -> T a0 b0 -> T a1 b1
map time -> m
f body -> m
g


sequence :: Applicative m =>
   T (m a) (m b) -> m (T a b)
sequence :: forall (m :: * -> *) a b.
Applicative m =>
T (m a) (m b) -> m (T a b)
sequence =
   forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
Applicative.liftA forall a b. [Pair a b] -> T a b
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Trav.traverse (\(Pair m a
a m b
b) -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Applicative.liftA2 forall a b. a -> b -> Pair a b
Pair m a
a m b
b) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a b. T a b -> [Pair a b]
decons

sequence_ :: (Applicative m, Monoid d) =>
   T (m d) (m d) -> m d
sequence_ :: forall (m :: * -> *) d.
(Applicative m, Monoid d) =>
T (m d) (m d) -> m d
sequence_ =
   forall a c d b. (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> d
foldr (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Applicative.liftA2 forall a. Monoid a => a -> a -> a
mappend) (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Applicative.liftA2 forall a. Monoid a => a -> a -> a
mappend) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
--   Trav.traverse_ (\(Pair a b) -> Applicative.liftA2 mappend a b) . decons


traverse :: Applicative m =>
   (a0 -> m a1) -> (b0 -> m b1) ->
   T a0 b0 -> m (T a1 b1)
traverse :: forall (m :: * -> *) a0 a1 b0 b1.
Applicative m =>
(a0 -> m a1) -> (b0 -> m b1) -> T a0 b0 -> m (T a1 b1)
traverse a0 -> m a1
aAction b0 -> m b1
bAction =
   forall (m :: * -> *) a b.
Applicative m =>
T (m a) (m b) -> m (T a b)
sequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a0 a1 b0 b1. (a0 -> a1) -> (b0 -> b1) -> T a0 b0 -> T a1 b1
map a0 -> m a1
aAction b0 -> m b1
bAction

traverse_ :: (Applicative m, Monoid d) =>
   (a -> m d) -> (b -> m d) -> T a b -> m d
traverse_ :: forall (m :: * -> *) d a b.
(Applicative m, Monoid d) =>
(a -> m d) -> (b -> m d) -> T a b -> m d
traverse_ a -> m d
aAction b -> m d
bAction =
   forall (m :: * -> *) d.
(Applicative m, Monoid d) =>
T (m d) (m d) -> m d
sequence_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a0 a1 b0 b1. (a0 -> a1) -> (b0 -> b1) -> T a0 b0 -> T a1 b1
map a -> m d
aAction b -> m d
bAction


traverseFirst :: Applicative m =>
   (a0 -> m a1) -> T a0 b -> m (T a1 b)
traverseFirst :: forall (m :: * -> *) a0 a1 b.
Applicative m =>
(a0 -> m a1) -> T a0 b -> m (T a1 b)
traverseFirst a0 -> m a1
aAction =
   forall (m :: * -> *) a0 a1 b0 b1.
Applicative m =>
(a0 -> m a1) -> (b0 -> m b1) -> T a0 b0 -> m (T a1 b1)
traverse a0 -> m a1
aAction forall (f :: * -> *) a. Applicative f => a -> f a
pure

traverseSecond :: Applicative m =>
   (b0 -> m b1) -> T a b0 -> m (T a b1)
traverseSecond :: forall (m :: * -> *) b0 b1 a.
Applicative m =>
(b0 -> m b1) -> T a b0 -> m (T a b1)
traverseSecond b0 -> m b1
bAction =
   forall (m :: * -> *) a0 a1 b0 b1.
Applicative m =>
(a0 -> m a1) -> (b0 -> m b1) -> T a0 b0 -> m (T a1 b1)
traverse forall (f :: * -> *) a. Applicative f => a -> f a
pure b0 -> m b1
bAction


getFirsts :: T a b -> [a]
getFirsts :: forall a b. T a b -> [a]
getFirsts = forall a b. (a -> b) -> [a] -> [b]
List.map forall a b. Pair a b -> a
pairFirst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> [Pair a b]
decons

getSeconds :: T a b -> [b]
getSeconds :: forall a b. T a b -> [b]
getSeconds = forall a b. (a -> b) -> [a] -> [b]
List.map forall a b. Pair a b -> b
pairSecond forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> [Pair a b]
decons

length :: T a b -> Int
length :: forall a b. T a b -> Int
length = forall (t :: * -> *) a. Foldable t => t a -> Int
List.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> [a]
getFirsts

genericLength :: Integral i => T a b -> i
genericLength :: forall i a b. Integral i => T a b -> i
genericLength = forall i a. Num i => [a] -> i
List.genericLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> [a]
getFirsts



empty :: T a b
empty :: forall a b. T a b
empty = forall a b. [Pair a b] -> T a b
Cons []

singleton :: a -> b -> T a b
singleton :: forall a b. a -> b -> T a b
singleton a
a b
b = forall a b. [Pair a b] -> T a b
Cons [forall a b. a -> b -> Pair a b
Pair a
a b
b]

null :: T a b -> Bool
null :: forall a b. T a b -> Bool
null = forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> [Pair a b]
decons


cons :: a -> b -> T a b -> T a b
cons :: forall a b. a -> b -> T a b -> T a b
cons a
a b
b = forall a0 b0 a1 b1.
([Pair a0 b0] -> [Pair a1 b1]) -> T a0 b0 -> T a1 b1
lift (forall a b. a -> b -> Pair a b
Pair a
a b
b forall a. a -> [a] -> [a]
: )

snoc :: T a b -> a -> b -> T a b
snoc :: forall a b. T a b -> a -> b -> T a b
snoc (Cons [Pair a b]
xs) a
a b
b = forall a b. [Pair a b] -> T a b
Cons ([Pair a b]
xs forall a. [a] -> [a] -> [a]
++ [forall a b. a -> b -> Pair a b
Pair a
a b
b])


viewL :: T a b -> Maybe ((a, b), T a b)
viewL :: forall a b. T a b -> Maybe ((a, b), T a b)
viewL =
   forall c a b. c -> (a -> b -> T a b -> c) -> T a b -> c
switchL forall a. Maybe a
Nothing (\a
a b
b T a b
xs -> forall a. a -> Maybe a
Just ((a
a, b
b), T a b
xs))

{-# INLINE switchL #-}
switchL :: c -> (a -> b -> T a b -> c) -> T a b -> c
switchL :: forall c a b. c -> (a -> b -> T a b -> c) -> T a b -> c
switchL c
f a -> b -> T a b -> c
g (Cons [Pair a b]
ys) =
   case [Pair a b]
ys of
      (Pair a
a b
b : [Pair a b]
xs) -> a -> b -> T a b -> c
g a
a b
b (forall a b. [Pair a b] -> T a b
Cons [Pair a b]
xs)
      [] -> c
f

{-# INLINE mapHead #-}
mapHead :: ((a,b) -> (a,b)) -> T a b -> T a b
mapHead :: forall a b. ((a, b) -> (a, b)) -> T a b -> T a b
mapHead (a, b) -> (a, b)
f =
   forall c a b. c -> (a -> b -> T a b -> c) -> T a b -> c
switchL forall a b. T a b
empty (forall a b c. ((a, b) -> c) -> a -> b -> c
curry (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. a -> b -> T a b -> T a b
cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> (a, b)
f))
--   maybe empty (uncurry (uncurry cons) . mapFst f) . viewL


viewR :: T a b -> Maybe (T a b, (a, b))
viewR :: forall a b. T a b -> Maybe (T a b, (a, b))
viewR =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall a b. [Pair a b] -> T a b
Cons, \ ~(Pair a
a b
b) -> (a
a, b
b))) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a. [a] -> Maybe ([a], a)
ListHT.viewR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> [Pair a b]
decons

{-# INLINE switchR #-}
switchR :: c -> (T a b -> a -> b -> c) -> T a b -> c
switchR :: forall c a b. c -> (T a b -> a -> b -> c) -> T a b -> c
switchR c
f T a b -> a -> b -> c
g =
   forall b a. b -> (a -> b) -> Maybe a -> b
maybe c
f (\ ~([Pair a b]
xs, ~(Pair a
a b
b)) -> T a b -> a -> b -> c
g (forall a b. [Pair a b] -> T a b
Cons [Pair a b]
xs) a
a b
b) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a. [a] -> Maybe ([a], a)
ListHT.viewR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> [Pair a b]
decons

{-# INLINE mapLast #-}
mapLast :: ((a,b) -> (a,b)) -> T a b -> T a b
mapLast :: forall a b. ((a, b) -> (a, b)) -> T a b -> T a b
mapLast (a, b) -> (a, b)
f =
   forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a b. T a b
empty (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> a -> b -> T a b
snoc) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (a, b) -> (a, b)
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> Maybe (T a b, (a, b))
viewR


foldr :: (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> d
foldr :: forall a c d b. (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> d
foldr a -> c -> d
f b -> d -> c
g =
   forall a b c. (a -> b -> c -> c) -> c -> T a b -> c
foldrPair (\ a
a b
b -> a -> c -> d
f a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> d -> c
g b
b)

foldrPair :: (a -> b -> c -> c) -> c -> T a b -> c
foldrPair :: forall a b c. (a -> b -> c -> c) -> c -> T a b -> c
foldrPair a -> b -> c -> c
f c
x =
   forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr (\ ~(Pair a
a b
b) -> a -> b -> c -> c
f a
a b
b) c
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> [Pair a b]
decons

foldl :: (c -> a -> d) -> (d -> b -> c) -> c -> T a b -> c
foldl :: forall c a d b. (c -> a -> d) -> (d -> b -> c) -> c -> T a b -> c
foldl c -> a -> d
f d -> b -> c
g c
c0 T a b
xs =
   forall a c d b. (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> d
foldr (\a
a d -> c
go c
c -> d -> c
go (c -> a -> d
f c
c a
a)) (\b
b c -> c
go d
d -> c -> c
go (d -> b -> c
g d
d b
b)) forall a. a -> a
id T a b
xs c
c0


append :: T a b -> T a b -> T a b
append :: forall a b. T a b -> T a b -> T a b
append (Cons [Pair a b]
xs) = forall a0 b0 a1 b1.
([Pair a0 b0] -> [Pair a1 b1]) -> T a0 b0 -> T a1 b1
lift ([Pair a b]
xsforall a. [a] -> [a] -> [a]
++)

concat :: [T a b] -> T a b
concat :: forall a b. [T a b] -> T a b
concat = forall a b. [Pair a b] -> T a b
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
List.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map forall a b. T a b -> [Pair a b]
decons

cycle :: T a b -> T a b
cycle :: forall a b. T a b -> T a b
cycle = forall a b. [Pair a b] -> T a b
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
List.cycle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> [Pair a b]
decons

-- for a nicer implementation see Mixed
reverse :: T a b -> T b a
reverse :: forall a b. T a b -> T b a
reverse =
   forall c a d b. (c -> a -> d) -> (d -> b -> c) -> c -> T a b -> c
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip (,)) (\ ~(a
a,T b a
xs) b
b -> forall a b. a -> b -> T a b -> T a b
cons b
b a
a T b a
xs) forall a b. T a b
empty



{- |
Currently it is not checked, whether n is too big.
Don't rely on the current behaviour of @splitAt n x@ for @n > length x@.
-}
splitAt :: Int -> T a b -> (T a b, T a b)
splitAt :: forall a b. Int -> T a b -> (T a b, T a b)
splitAt Int
n = forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall a b. [Pair a b] -> T a b
Cons, forall a b. [Pair a b] -> T a b
Cons) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> ([a], [a])
List.splitAt Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> [Pair a b]
decons

take :: Int -> T a b -> T a b
take :: forall a b. Int -> T a b -> T a b
take Int
n = forall a b. [Pair a b] -> T a b
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
List.take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> [Pair a b]
decons

drop :: Int -> T a b -> T a b
drop :: forall a b. Int -> T a b -> T a b
drop Int
n = forall a b. [Pair a b] -> T a b
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
List.drop Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> [Pair a b]
decons


genericSplitAt :: Integral i => i -> T a b -> (T a b, T a b)
genericSplitAt :: forall i a b. Integral i => i -> T a b -> (T a b, T a b)
genericSplitAt i
n = forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall a b. [Pair a b] -> T a b
Cons, forall a b. [Pair a b] -> T a b
Cons) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a. Integral i => i -> [a] -> ([a], [a])
List.genericSplitAt i
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> [Pair a b]
decons

genericTake :: Integral i => i -> T a b -> T a b
genericTake :: forall i a b. Integral i => i -> T a b -> T a b
genericTake i
n = forall a b. [Pair a b] -> T a b
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a. Integral i => i -> [a] -> [a]
List.genericTake i
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> [Pair a b]
decons

genericDrop :: Integral i => i -> T a b -> T a b
genericDrop :: forall i a b. Integral i => i -> T a b -> T a b
genericDrop i
n = forall a b. [Pair a b] -> T a b
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a. Integral i => i -> [a] -> [a]
List.genericDrop i
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> [Pair a b]
decons


spanFirst :: (a -> Bool) -> T a b -> (T a b, T a b)
spanFirst :: forall a b. (a -> Bool) -> T a b -> (T a b, T a b)
spanFirst a -> Bool
p =
   forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall a b. [Pair a b] -> T a b
Cons, forall a b. [Pair a b] -> T a b
Cons) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span (a -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Pair a b -> a
pairFirst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> [Pair a b]
decons

spanSecond :: (b -> Bool) -> T a b -> (T a b, T a b)
spanSecond :: forall b a. (b -> Bool) -> T a b -> (T a b, T a b)
spanSecond b -> Bool
p =
   forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall a b. [Pair a b] -> T a b
Cons, forall a b. [Pair a b] -> T a b
Cons) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span (b -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Pair a b -> b
pairSecond) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. T a b -> [Pair a b]
decons

{-
filterFirst :: (a -> Bool) -> T a b -> T a [b]
filterFirst =
   foldr
      (\time ->
          if time==0
            then id
            else consBody [] . consTime time)
      (\body ->
          maybe
             (consBody [body] $ consTime 0 $ empty)
             (\(bodys,xs) -> consBody (body:bodys) xs) .
          viewBodyL)
      empty
-}