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

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.Uniform
   (T(Cons),
    map, mapFirst, mapSecond,
    zipWithFirst, zipWithSecond,
    concatMonoid, concatMapMonoid,
    sequence, sequence_,
    traverse, traverse_, traverseFirst, traverseSecond,
    getFirsts, getSeconds, length, genericLength,
    fromFirstList, fromSecondList, fromEitherList,
    singleton, isSingleton,
    cons, snoc, reverse,
    mapSecondHead, forceSecondHead,
    foldr, foldl,
    format,
    filterFirst, partitionFirst, partitionMaybeFirst,
    partitionEitherFirst, unzipEitherFirst,
    filterSecond, partitionSecond, partitionMaybeSecond,
    partitionEitherSecond, unzipEitherSecond,

    catMaybesFirst, catMaybesSecond,
   ) where

import qualified Data.AlternatingList.List.Disparate as Disp

import qualified Control.Monad as Monad
import qualified Control.Applicative as Applicative
import qualified Data.List as List

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.Tuple.HT (mapFst, mapSnd, mapPair, )
import Data.Maybe.HT (toMaybe, )
import Data.Functor (fmap, )
import Data.Either (Either(Left, Right), either, )
import Data.Maybe (Maybe, maybe, )
import Data.Tuple (uncurry, )
import Data.Ord (Ord, (>=), )
{- this way we cannot access (:) in Hugs -}
import Prelude (Integral, Int, String, Bool, error, Eq, )


{- |
The constructor is only exported for use in "Data.AlternatingList.List.Mixed".
-}
data T a b = Cons {
   forall a b. T a b -> b
_lead :: b,
   forall a b. T a b -> T a b
disp  :: Disp.T a b
   }
   deriving (T a b -> T a b -> Bool
(T a b -> T a b -> Bool) -> (T a b -> T a b -> Bool) -> Eq (T a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq b, Eq a) => T a b -> T a b -> Bool
$c== :: forall a b. (Eq b, Eq a) => T a b -> T a b -> Bool
== :: T a b -> T a b -> Bool
$c/= :: forall a b. (Eq b, Eq a) => T a b -> T a b -> Bool
/= :: T a b -> T a b -> Bool
Eq, Eq (T a b)
Eq (T a b) =>
(T a b -> T a b -> Ordering)
-> (T a b -> T a b -> Bool)
-> (T a b -> T a b -> Bool)
-> (T a b -> T a b -> Bool)
-> (T a b -> T a b -> Bool)
-> (T a b -> T a b -> T a b)
-> (T a b -> T a b -> T a b)
-> Ord (T a b)
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 b, Ord a) => Eq (T a b)
forall a b. (Ord b, Ord a) => T a b -> T a b -> Bool
forall a b. (Ord b, Ord a) => T a b -> T a b -> Ordering
forall a b. (Ord b, Ord a) => T a b -> T a b -> T a b
$ccompare :: forall a b. (Ord b, Ord a) => T a b -> T a b -> Ordering
compare :: T a b -> T a b -> Ordering
$c< :: forall a b. (Ord b, Ord a) => T a b -> T a b -> Bool
< :: T a b -> T a b -> Bool
$c<= :: forall a b. (Ord b, Ord a) => T a b -> T a b -> Bool
<= :: T a b -> T a b -> Bool
$c> :: forall a b. (Ord b, Ord a) => T a b -> T a b -> Bool
> :: T a b -> T a b -> Bool
$c>= :: forall a b. (Ord b, Ord a) => T a b -> T a b -> Bool
>= :: T a b -> T a b -> Bool
$cmax :: forall a b. (Ord b, Ord a) => T a b -> T a b -> T a b
max :: T a b -> T a b -> T a b
$cmin :: forall a b. (Ord b, Ord a) => T a b -> T a b -> T a b
min :: T a b -> T a b -> T a b
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
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
5) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
   (String -> T a b -> String) -> T a b -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> ShowS) -> (b -> ShowS) -> String -> T a b -> String
forall a c d b. (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> c
foldr
      (\a
a -> Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
5 a
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
first)
      (\b
b -> Int -> b -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
5 b
b ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
second))
      T a b
xs ShowS -> ShowS -> ShowS
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 = String -> String -> Int -> T a b -> ShowS
forall a b.
(Show a, Show b) =>
String -> String -> Int -> T a b -> ShowS
format String
" /. " String
" ./ "


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



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 (Cons b0
b T a0 b0
xs) = b1 -> T a1 b1 -> T a1 b1
forall a b. b -> T a b -> T a b
Cons (b0 -> b1
g b0
b) ((a0 -> a1) -> (b0 -> b1) -> T a0 b0 -> T a1 b1
forall a0 a1 b0 b1. (a0 -> a1) -> (b0 -> b1) -> T a0 b0 -> T a1 b1
Disp.map a0 -> a1
f b0 -> b1
g T a0 b0
xs)

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 (Cons b
b T a0 b
xs) = b -> T a1 b -> T a1 b
forall a b. b -> T a b -> T a b
Cons b
b ((a0 -> a1) -> T a0 b -> T a1 b
forall a0 a1 b. (a0 -> a1) -> T a0 b -> T a1 b
Disp.mapFirst a0 -> a1
f T a0 b
xs)

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 (Cons b0
b T a b0
xs) = b1 -> T a b1 -> T a b1
forall a b. b -> T a b -> T a b
Cons (b0 -> b1
g b0
b) ((b0 -> b1) -> T a b0 -> T a b1
forall b0 b1 a. (b0 -> b1) -> T a b0 -> T a b1
Disp.mapSecond b0 -> b1
g T a b0
xs)


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 (Cons b
a T a1 b
bs) =
   b -> T a2 b -> T a2 b
forall a b. b -> T a b -> T a b
Cons b
a (T a2 b -> T a2 b) -> T a2 b -> T a2 b
forall a b. (a -> b) -> a -> b
$ (a0 -> a1 -> a2) -> [a0] -> T a1 b -> T a2 b
forall a0 a1 a2 b. (a0 -> a1 -> a2) -> [a0] -> T a1 b -> T a2 b
Disp.zipWithFirst a0 -> a1 -> a2
f [a0]
xs T a1 b
bs

zipWithSecond :: (b0 -> b1 -> b2) -> (b0,[b0]) -> T a b1 -> T a b2
zipWithSecond :: forall b0 b1 b2 a.
(b0 -> b1 -> b2) -> (b0, [b0]) -> T a b1 -> T a b2
zipWithSecond b0 -> b1 -> b2
f (b0
x,[b0]
xs) (Cons b1
a T a b1
bs) =
   b2 -> T a b2 -> T a b2
forall a b. b -> T a b -> T a b
Cons (b0 -> b1 -> b2
f b0
x b1
a) (T a b2 -> T a b2) -> T a b2 -> T a b2
forall a b. (a -> b) -> a -> b
$ (b0 -> b1 -> b2) -> [b0] -> T a b1 -> T a b2
forall b0 b1 b2 a. (b0 -> b1 -> b2) -> [b0] -> T a b1 -> T a b2
Disp.zipWithSecond b0 -> b1 -> b2
f [b0]
xs T a b1
bs



concatMonoid :: Monoid m =>
   T m m -> m
concatMonoid :: forall m. Monoid m => T m m -> m
concatMonoid =
   (m -> m -> m) -> (m -> m -> m) -> m -> T m m -> m
forall a c d b. (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> c
foldr m -> m -> m
forall a. Monoid a => a -> a -> a
mappend m -> m -> m
forall a. Monoid a => a -> a -> a
mappend m
forall a. Monoid a => a
mempty

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 =
   T m m -> m
forall m. Monoid m => T m m -> m
concatMonoid (T m m -> m) -> (T time body -> T m m) -> T time body -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (time -> m) -> (body -> m) -> T time body -> T m m
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 (Cons m b
b T (m a) (m b)
xs) =
   (b -> T a b -> T a b) -> m b -> m (T a b) -> m (T a b)
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Applicative.liftA2 b -> T a b -> T a b
forall a b. b -> T a b -> T a b
Cons m b
b (T (m a) (m b) -> m (T a b)
forall (m :: * -> *) a b.
Applicative m =>
T (m a) (m b) -> m (T a b)
Disp.sequence T (m a) (m b)
xs)

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_ (Cons m d
b T (m d) (m d)
xs) =
   (d -> d -> d) -> m d -> m d -> m d
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Applicative.liftA2 d -> d -> d
forall a. Monoid a => a -> a -> a
mappend m d
b (m d -> m d) -> m d -> m d
forall a b. (a -> b) -> a -> b
$ T (m d) (m d) -> m d
forall (m :: * -> *) d.
(Applicative m, Monoid d) =>
T (m d) (m d) -> m d
Disp.sequence_ T (m d) (m d)
xs


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 =
   T (m a1) (m b1) -> m (T a1 b1)
forall (m :: * -> *) a b.
Applicative m =>
T (m a) (m b) -> m (T a b)
sequence (T (m a1) (m b1) -> m (T a1 b1))
-> (T a0 b0 -> T (m a1) (m b1)) -> T a0 b0 -> m (T a1 b1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a0 -> m a1) -> (b0 -> m b1) -> T a0 b0 -> T (m a1) (m b1)
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 =
   T (m d) (m d) -> m d
forall (m :: * -> *) d.
(Applicative m, Monoid d) =>
T (m d) (m d) -> m d
sequence_ (T (m d) (m d) -> m d) -> (T a b -> T (m d) (m d)) -> T a b -> m d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m d) -> (b -> m d) -> T a b -> T (m d) (m d)
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 =
   (a0 -> m a1) -> (b -> m b) -> T a0 b -> m (T a1 b)
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 b -> m b
forall a. a -> m a
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 =
   (a -> m a) -> (b0 -> m b1) -> T a b0 -> m (T a b1)
forall (m :: * -> *) a0 a1 b0 b1.
Applicative m =>
(a0 -> m a1) -> (b0 -> m b1) -> T a0 b0 -> m (T a1 b1)
traverse a -> m a
forall a. a -> m a
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 = T a b -> [a]
forall a b. T a b -> [a]
Disp.getFirsts (T a b -> [a]) -> (T a b -> T a b) -> T a b -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a b -> T a b
forall a b. T a b -> T a b
disp

getSeconds :: T a b -> [b]
getSeconds :: forall a b. T a b -> [b]
getSeconds (Cons b
b T a b
xs) = b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
: T a b -> [b]
forall a b. T a b -> [b]
Disp.getSeconds T a b
xs

length :: T a b -> Int
length :: forall a b. T a b -> Int
length = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length ([a] -> Int) -> (T a b -> [a]) -> T a b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a b -> [a]
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 = [a] -> i
forall i a. Num i => [a] -> i
List.genericLength ([a] -> i) -> (T a b -> [a]) -> T a b -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a b -> [a]
forall a b. T a b -> [a]
getFirsts


fromFirstList :: b -> [a] -> T a b
fromFirstList :: forall b a. b -> [a] -> T a b
fromFirstList b
b [a]
as =
   b -> T a b -> T a b
forall a b. b -> T a b -> T a b
Cons b
b ((a -> T a b -> T a b) -> T a b -> [a] -> T a b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr ((a -> b -> T a b -> T a b) -> b -> a -> T a b -> T a b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> T a b -> T a b
forall a b. a -> b -> T a b -> T a b
Disp.cons b
b) T a b
forall a b. T a b
Disp.empty [a]
as)

fromSecondList :: a -> [b] -> T a b
fromSecondList :: forall a b. a -> [b] -> T a b
fromSecondList a
a (b
b:[b]
bs) =
   b -> T a b -> T a b
forall a b. b -> T a b -> T a b
Cons b
b ((b -> T a b -> T a b) -> T a b -> [b] -> T a b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr (a -> b -> T a b -> T a b
forall a b. a -> b -> T a b -> T a b
Disp.cons a
a) T a b
forall a b. T a b
Disp.empty [b]
bs)
fromSecondList a
_ [] = String -> T a b
forall a. HasCallStack => String -> a
error String
"fromSecondList: empty list"

fromEitherList :: [Either a b] -> T a [b]
fromEitherList :: forall a b. [Either a b] -> T a [b]
fromEitherList =
   (Either a b -> T a [b] -> T a [b])
-> T a [b] -> [Either a b] -> T a [b]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr
      ((a -> T a [b] -> T a [b])
-> (b -> T a [b] -> T a [b]) -> Either a b -> T a [b] -> T a [b]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
         ([b] -> a -> T a [b] -> T a [b]
forall b a. b -> a -> T a b -> T a b
cons [])
         (([b] -> [b]) -> T a [b] -> T a [b]
forall b a. (b -> b) -> T a b -> T a b
mapSecondHead (([b] -> [b]) -> T a [b] -> T a [b])
-> (b -> [b] -> [b]) -> b -> T a [b] -> T a [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:)))
      ([b] -> T a [b]
forall b a. b -> T a b
singleton [])


singleton :: b -> T a b
singleton :: forall b a. b -> T a b
singleton b
b = b -> T a b -> T a b
forall a b. b -> T a b -> T a b
Cons b
b T a b
forall a b. T a b
Disp.empty

isSingleton :: T a b -> Bool
isSingleton :: forall a b. T a b -> Bool
isSingleton = T a b -> Bool
forall a b. T a b -> Bool
Disp.null (T a b -> Bool) -> (T a b -> T a b) -> T a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a b -> T a b
forall a b. T a b -> T a b
disp


cons :: b -> a -> T a b -> T a b
cons :: forall b a. b -> a -> T a b -> T a b
cons b
b0 a
a ~(Cons b
b1 T a b
xs) = b -> T a b -> T a b
forall a b. b -> T a b -> T a b
Cons b
b0 (a -> b -> T a b -> T a b
forall a b. a -> b -> T a b -> T a b
Disp.cons a
a b
b1 T a b
xs)


snoc :: T a b -> a -> b -> T a b
snoc :: forall a b. T a b -> a -> b -> T a b
snoc (Cons b
b0 T a b
xs) a
a b
b1 = b -> T a b -> T a b
forall a b. b -> T a b -> T a b
Cons b
b0 (T a b -> a -> b -> T a b
forall a b. T a b -> a -> b -> T a b
Disp.snoc T a b
xs a
a b
b1)


mapSecondHead :: (b -> b) -> T a b -> T a b
mapSecondHead :: forall b a. (b -> b) -> T a b -> T a b
mapSecondHead b -> b
f ~(Cons b
b T a b
xs) = b -> T a b -> T a b
forall a b. b -> T a b -> T a b
Cons (b -> b
f b
b) T a b
xs

forceSecondHead :: T a b -> T a b
forceSecondHead :: forall a b. T a b -> T a b
forceSecondHead = (b -> b) -> T a b -> T a b
forall b a. (b -> b) -> T a b -> T a b
mapSecondHead b -> b
forall a. a -> a
id



foldr :: (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> c
foldr :: forall a c d b. (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> c
foldr a -> c -> d
f b -> d -> c
g d
d (Cons b
b T a b
xs) = b -> d -> c
g b
b (d -> c) -> d -> c
forall a b. (a -> b) -> a -> b
$ (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> d
forall a c d b. (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> d
Disp.foldr a -> c -> d
f b -> d -> c
g d
d T a b
xs
{-
The lazy pattern match leads to a space leak in synthesizer-alsa:testArrangeSpaceLeak
I would like to reproduce this in a small test,
but I did not achieve this so far.
-}
-- foldr f g d ~(Cons b xs) = g b $ Disp.foldr f g d xs

foldl :: (c -> a -> d) -> (d -> b -> c) -> d -> T a b -> c
foldl :: forall c a d b. (c -> a -> d) -> (d -> b -> c) -> d -> T a b -> c
foldl c -> a -> d
f d -> b -> c
g d
d0 T a b
xs =
   (a -> (d -> c) -> c -> c)
-> (b -> (c -> c) -> d -> c) -> (c -> c) -> T a b -> d -> c
forall a c d b. (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> c
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)) c -> c
forall a. a -> a
id T a b
xs d
d0

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


filterFirst :: (a -> Bool) -> T a b -> T a [b]
filterFirst :: forall a b. (a -> Bool) -> T a b -> T a [b]
filterFirst a -> Bool
p =
   T (Maybe a) b -> T a [b]
forall a b. T (Maybe a) b -> T a [b]
catMaybesFirst (T (Maybe a) b -> T a [b])
-> (T a b -> T (Maybe a) b) -> T a b -> T a [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe a) -> T a b -> T (Maybe a) b
forall a0 a1 b. (a0 -> a1) -> T a0 b -> T a1 b
mapFirst (\a
a -> Bool -> a -> Maybe a
forall a. Bool -> a -> Maybe a
toMaybe (a -> Bool
p a
a) a
a)

filterSecond :: (b -> Bool) -> T a b -> T b [a]
filterSecond :: forall b a. (b -> Bool) -> T a b -> T b [a]
filterSecond b -> Bool
p =
   T a (Maybe b) -> T b [a]
forall a b. T a (Maybe b) -> T b [a]
catMaybesSecond (T a (Maybe b) -> T b [a])
-> (T a b -> T a (Maybe b)) -> T a b -> T b [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Maybe b) -> T a b -> T a (Maybe b)
forall b0 b1 a. (b0 -> b1) -> T a b0 -> T a b1
mapSecond (\b
a -> Bool -> b -> Maybe b
forall a. Bool -> a -> Maybe a
toMaybe (b -> Bool
p b
a) b
a)

partitionFirst :: (a -> Bool) -> T a b -> (T a [b], T a [b])
partitionFirst :: forall a b. (a -> Bool) -> T a b -> (T a [b], T a [b])
partitionFirst a -> Bool
p =
   T (Either a a) b -> (T a [b], T a [b])
forall a0 a1 b. T (Either a0 a1) b -> (T a0 [b], T a1 [b])
unzipEitherFirst (T (Either a a) b -> (T a [b], T a [b]))
-> (T a b -> T (Either a a) b) -> T a b -> (T a [b], T a [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (a -> Either a a) -> T a b -> T (Either a a) b
forall a0 a1 b. (a0 -> a1) -> T a0 b -> T a1 b
mapFirst (\a
a -> if a -> Bool
p a
a then a -> Either a a
forall a b. a -> Either a b
Left a
a else a -> Either a a
forall a b. b -> Either a b
Right a
a)

partitionSecond :: (b -> Bool) -> T a b -> (T b [a], T b [a])
partitionSecond :: forall b a. (b -> Bool) -> T a b -> (T b [a], T b [a])
partitionSecond b -> Bool
p =
   T a (Either b b) -> (T b [a], T b [a])
forall a b0 b1. T a (Either b0 b1) -> (T b0 [a], T b1 [a])
unzipEitherSecond (T a (Either b b) -> (T b [a], T b [a]))
-> (T a b -> T a (Either b b)) -> T a b -> (T b [a], T b [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (b -> Either b b) -> T a b -> T a (Either b b)
forall b0 b1 a. (b0 -> b1) -> T a b0 -> T a b1
mapSecond (\b
b -> if b -> Bool
p b
b then b -> Either b b
forall a b. a -> Either a b
Left b
b else b -> Either b b
forall a b. b -> Either a b
Right b
b)

partitionMaybeFirst :: (a0 -> Maybe a1) -> T a0 b -> (T a1 [b], T a0 [b])
partitionMaybeFirst :: forall a0 a1 b. (a0 -> Maybe a1) -> T a0 b -> (T a1 [b], T a0 [b])
partitionMaybeFirst a0 -> Maybe a1
f =
   T (Either a1 a0) b -> (T a1 [b], T a0 [b])
forall a0 a1 b. T (Either a0 a1) b -> (T a0 [b], T a1 [b])
unzipEitherFirst (T (Either a1 a0) b -> (T a1 [b], T a0 [b]))
-> (T a0 b -> T (Either a1 a0) b) -> T a0 b -> (T a1 [b], T a0 [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a0 -> Either a1 a0) -> T a0 b -> T (Either a1 a0) b
forall a0 a1 b. (a0 -> a1) -> T a0 b -> T a1 b
mapFirst (\a0
a0 -> Either a1 a0 -> (a1 -> Either a1 a0) -> Maybe a1 -> Either a1 a0
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a0 -> Either a1 a0
forall a b. b -> Either a b
Right a0
a0) a1 -> Either a1 a0
forall a b. a -> Either a b
Left (a0 -> Maybe a1
f a0
a0))

partitionMaybeSecond :: (b0 -> Maybe b1) -> T a b0 -> (T b1 [a], T b0 [a])
partitionMaybeSecond :: forall b0 b1 a. (b0 -> Maybe b1) -> T a b0 -> (T b1 [a], T b0 [a])
partitionMaybeSecond b0 -> Maybe b1
f =
   T a (Either b1 b0) -> (T b1 [a], T b0 [a])
forall a b0 b1. T a (Either b0 b1) -> (T b0 [a], T b1 [a])
unzipEitherSecond (T a (Either b1 b0) -> (T b1 [a], T b0 [a]))
-> (T a b0 -> T a (Either b1 b0)) -> T a b0 -> (T b1 [a], T b0 [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b0 -> Either b1 b0) -> T a b0 -> T a (Either b1 b0)
forall b0 b1 a. (b0 -> b1) -> T a b0 -> T a b1
mapSecond (\b0
b0 -> Either b1 b0 -> (b1 -> Either b1 b0) -> Maybe b1 -> Either b1 b0
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (b0 -> Either b1 b0
forall a b. b -> Either a b
Right b0
b0) b1 -> Either b1 b0
forall a b. a -> Either a b
Left (b0 -> Maybe b1
f b0
b0))

partitionEitherFirst :: (a -> Either a0 a1) -> T a b -> (T a0 [b], T a1 [b])
partitionEitherFirst :: forall a a0 a1 b.
(a -> Either a0 a1) -> T a b -> (T a0 [b], T a1 [b])
partitionEitherFirst a -> Either a0 a1
f =
   T (Either a0 a1) b -> (T a0 [b], T a1 [b])
forall a0 a1 b. T (Either a0 a1) b -> (T a0 [b], T a1 [b])
unzipEitherFirst (T (Either a0 a1) b -> (T a0 [b], T a1 [b]))
-> (T a b -> T (Either a0 a1) b) -> T a b -> (T a0 [b], T a1 [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either a0 a1) -> T a b -> T (Either a0 a1) b
forall a0 a1 b. (a0 -> a1) -> T a0 b -> T a1 b
mapFirst a -> Either a0 a1
f

partitionEitherSecond :: (b -> Either b0 b1) -> T a b -> (T b0 [a], T b1 [a])
partitionEitherSecond :: forall b b0 b1 a.
(b -> Either b0 b1) -> T a b -> (T b0 [a], T b1 [a])
partitionEitherSecond b -> Either b0 b1
f =
   T a (Either b0 b1) -> (T b0 [a], T b1 [a])
forall a b0 b1. T a (Either b0 b1) -> (T b0 [a], T b1 [a])
unzipEitherSecond (T a (Either b0 b1) -> (T b0 [a], T b1 [a]))
-> (T a b -> T a (Either b0 b1)) -> T a b -> (T b0 [a], T b1 [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Either b0 b1) -> T a b -> T a (Either b0 b1)
forall b0 b1 a. (b0 -> b1) -> T a b0 -> T a b1
mapSecond b -> Either b0 b1
f

unzipEitherFirst :: T (Either a0 a1) b -> (T a0 [b], T a1 [b])
unzipEitherFirst :: forall a0 a1 b. T (Either a0 a1) b -> (T a0 [b], T a1 [b])
unzipEitherFirst =
   (Either a0 a1 -> (T a0 [b], T a1 [b]) -> (T a0 [b], T a1 [b]))
-> (b -> (T a0 [b], T a1 [b]) -> (T a0 [b], T a1 [b]))
-> (T a0 [b], T a1 [b])
-> T (Either a0 a1) b
-> (T a0 [b], T a1 [b])
forall a c d b. (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> c
foldr
      ((a0 -> (T a0 [b], T a1 [b]) -> (T a0 [b], T a1 [b]))
-> (a1 -> (T a0 [b], T a1 [b]) -> (T a0 [b], T a1 [b]))
-> Either a0 a1
-> (T a0 [b], T a1 [b])
-> (T a0 [b], T a1 [b])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
          ((T a0 [b] -> T a0 [b])
-> (T a0 [b], T a1 [b]) -> (T a0 [b], T a1 [b])
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst ((T a0 [b] -> T a0 [b])
 -> (T a0 [b], T a1 [b]) -> (T a0 [b], T a1 [b]))
-> (a0 -> T a0 [b] -> T a0 [b])
-> a0
-> (T a0 [b], T a1 [b])
-> (T a0 [b], T a1 [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> a0 -> T a0 [b] -> T a0 [b]
forall b a. b -> a -> T a b -> T a b
cons [])
          ((T a1 [b] -> T a1 [b])
-> (T a0 [b], T a1 [b]) -> (T a0 [b], T a1 [b])
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((T a1 [b] -> T a1 [b])
 -> (T a0 [b], T a1 [b]) -> (T a0 [b], T a1 [b]))
-> (a1 -> T a1 [b] -> T a1 [b])
-> a1
-> (T a0 [b], T a1 [b])
-> (T a0 [b], T a1 [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> a1 -> T a1 [b] -> T a1 [b]
forall b a. b -> a -> T a b -> T a b
cons []))
      (\b
b -> (T a0 [b] -> T a0 [b], T a1 [b] -> T a1 [b])
-> (T a0 [b], T a1 [b]) -> (T a0 [b], T a1 [b])
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (([b] -> [b]) -> T a0 [b] -> T a0 [b]
forall b a. (b -> b) -> T a b -> T a b
mapSecondHead (b
bb -> [b] -> [b]
forall a. a -> [a] -> [a]
:), ([b] -> [b]) -> T a1 [b] -> T a1 [b]
forall b a. (b -> b) -> T a b -> T a b
mapSecondHead (b
bb -> [b] -> [b]
forall a. a -> [a] -> [a]
:)))
      ([b] -> T a0 [b]
forall b a. b -> T a b
singleton [], [b] -> T a1 [b]
forall b a. b -> T a b
singleton [])

unzipEitherSecond :: T a (Either b0 b1) -> (T b0 [a], T b1 [a])
unzipEitherSecond :: forall a b0 b1. T a (Either b0 b1) -> (T b0 [a], T b1 [a])
unzipEitherSecond =
   (a -> (T b0 [a], T b1 [a]) -> (T b0 [a], T b1 [a]))
-> (Either b0 b1 -> (T b0 [a], T b1 [a]) -> (T b0 [a], T b1 [a]))
-> (T b0 [a], T b1 [a])
-> T a (Either b0 b1)
-> (T b0 [a], T b1 [a])
forall a c d b. (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> c
foldr
      (\a
a -> (T b0 [a] -> T b0 [a], T b1 [a] -> T b1 [a])
-> (T b0 [a], T b1 [a]) -> (T b0 [a], T b1 [a])
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (([a] -> [a]) -> T b0 [a] -> T b0 [a]
forall b a. (b -> b) -> T a b -> T a b
mapSecondHead (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:), ([a] -> [a]) -> T b1 [a] -> T b1 [a]
forall b a. (b -> b) -> T a b -> T a b
mapSecondHead (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)))
      ((b0 -> (T b0 [a], T b1 [a]) -> (T b0 [a], T b1 [a]))
-> (b1 -> (T b0 [a], T b1 [a]) -> (T b0 [a], T b1 [a]))
-> Either b0 b1
-> (T b0 [a], T b1 [a])
-> (T b0 [a], T b1 [a])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
          ((T b0 [a] -> T b0 [a])
-> (T b0 [a], T b1 [a]) -> (T b0 [a], T b1 [a])
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst ((T b0 [a] -> T b0 [a])
 -> (T b0 [a], T b1 [a]) -> (T b0 [a], T b1 [a]))
-> (b0 -> T b0 [a] -> T b0 [a])
-> b0
-> (T b0 [a], T b1 [a])
-> (T b0 [a], T b1 [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> b0 -> T b0 [a] -> T b0 [a]
forall b a. b -> a -> T a b -> T a b
cons [])
          ((T b1 [a] -> T b1 [a])
-> (T b0 [a], T b1 [a]) -> (T b0 [a], T b1 [a])
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((T b1 [a] -> T b1 [a])
 -> (T b0 [a], T b1 [a]) -> (T b0 [a], T b1 [a]))
-> (b1 -> T b1 [a] -> T b1 [a])
-> b1
-> (T b0 [a], T b1 [a])
-> (T b0 [a], T b1 [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> b1 -> T b1 [a] -> T b1 [a]
forall b a. b -> a -> T a b -> T a b
cons []))
      ([a] -> T b0 [a]
forall b a. b -> T a b
singleton [], [a] -> T b1 [a]
forall b a. b -> T a b
singleton [])

catMaybesFirst :: T (Maybe a) b -> T a [b]
catMaybesFirst :: forall a b. T (Maybe a) b -> T a [b]
catMaybesFirst =
   (Maybe a -> T a [b] -> T a [b])
-> (b -> T a [b] -> T a [b]) -> T a [b] -> T (Maybe a) b -> T a [b]
forall a c d b. (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> c
foldr
      ((T a [b] -> T a [b])
-> (a -> T a [b] -> T a [b]) -> Maybe a -> T a [b] -> T a [b]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe T a [b] -> T a [b]
forall a. a -> a
id ([b] -> a -> T a [b] -> T a [b]
forall b a. b -> a -> T a b -> T a b
cons []))
      (([b] -> [b]) -> T a [b] -> T a [b]
forall b a. (b -> b) -> T a b -> T a b
mapSecondHead (([b] -> [b]) -> T a [b] -> T a [b])
-> (b -> [b] -> [b]) -> b -> T a [b] -> T a [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:))
      ([b] -> T a [b]
forall b a. b -> T a b
singleton [])

catMaybesSecond :: T a (Maybe b) -> T b [a]
catMaybesSecond :: forall a b. T a (Maybe b) -> T b [a]
catMaybesSecond =
   (a -> T b [a] -> T b [a])
-> (Maybe b -> T b [a] -> T b [a])
-> T b [a]
-> T a (Maybe b)
-> T b [a]
forall a c d b. (a -> c -> d) -> (b -> d -> c) -> d -> T a b -> c
foldr
      (([a] -> [a]) -> T b [a] -> T b [a]
forall b a. (b -> b) -> T a b -> T a b
mapSecondHead (([a] -> [a]) -> T b [a] -> T b [a])
-> (a -> [a] -> [a]) -> a -> T b [a] -> T b [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:))
      ((T b [a] -> T b [a])
-> (b -> T b [a] -> T b [a]) -> Maybe b -> T b [a] -> T b [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe T b [a] -> T b [a]
forall a. a -> a
id ([a] -> b -> T b [a] -> T b [a]
forall b a. b -> a -> T a b -> T a b
cons []))
      ([a] -> T b [a]
forall b a. b -> T a b
singleton [])