module Data.List.HT.Private where

import Data.List  as List  (find, transpose, unfoldr, isPrefixOf,
                            findIndices, foldl', mapAccumL, )
import Data.Maybe as Maybe (fromMaybe, catMaybes, isJust, mapMaybe, )
import Data.Maybe.HT       (toMaybe, )
import Control.Monad.HT    ((<=<), )
import Control.Monad       (guard, msum, mplus, )
import Control.Applicative ((<$>), (<*>), )
import Data.Tuple.HT       (mapPair, mapFst, mapSnd, forcePair, swap, )

import qualified Control.Functor.HT as Func

import qualified Data.List.Key.Private   as Key
import qualified Data.List.Match.Private as Match
import qualified Data.List.Reverse.StrictElement as Rev

import Prelude hiding (unzip, break, span, )


-- * Improved standard functions

{- |
This function is lazier than the one suggested in the Haskell 98 report.
It is @inits undefined = [] : undefined@,
in contrast to @Data.List.inits undefined = undefined@.
-}
{-
suggested in
<http://www.haskell.org/pipermail/libraries/2014-July/023291.html>
-}
inits :: [a] -> [[a]]
inits :: [a] -> [[a]]
inits = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. [a] -> [a]
reverse ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> a -> [a]) -> [a] -> [a] -> [[a]]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) []

{- |
As lazy as 'inits' but less efficient because of repeated 'map'.
-}
initsLazy :: [a] -> [[a]]
initsLazy :: [a] -> [[a]]
initsLazy [a]
xt =
   [] [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:
   case [a]
xt of
      [] -> []
      a
x:[a]
xs -> ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [[a]]
forall a. [a] -> [[a]]
initsLazy [a]
xs)

{- |
Suggested implementation in the Haskell 98 report.
It is not as lazy as possible.
-}
inits98 :: [a] -> [[a]]
inits98 :: [a] -> [[a]]
inits98 []     = [[]]
inits98 (a
x:[a]
xs) = [[]] [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [[a]]
forall a. [a] -> [[a]]
inits98 [a]
xs)

inits98' :: [a] -> [[a]]
inits98' :: [a] -> [[a]]
inits98' =
   (a -> [[a]] -> [[a]]) -> [[a]] -> [a] -> [[a]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x [[a]]
prefixes -> [] [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) [[a]]
prefixes) [[]]


{- |
This function is lazier than the one suggested in the Haskell 98 report.
It is @tails undefined = ([] : undefined) : undefined@,
in contrast to @Data.List.tails undefined = undefined@.
-}
tails :: [a] -> [[a]]
tails :: [a] -> [[a]]
tails [a]
xt =
   ([a] -> [[a]] -> [[a]]) -> ([a], [[a]]) -> [[a]]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) (([a], [[a]]) -> [[a]]) -> ([a], [[a]]) -> [[a]]
forall a b. (a -> b) -> a -> b
$
   case [a]
xt of
      [] -> ([],[])
      a
_:[a]
xs -> ([a]
xt, [a] -> [[a]]
forall a. [a] -> [[a]]
tails [a]
xs)

tails' :: [a] -> [[a]]
tails' :: [a] -> [[a]]
tails' = ([[a]], [[a]]) -> [[a]]
forall a b. (a, b) -> a
fst (([[a]], [[a]]) -> [[a]])
-> ([a] -> ([[a]], [[a]])) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Bool) -> [[a]] -> ([[a]], [[a]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
breakAfter [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[a]] -> ([[a]], [[a]]))
-> ([a] -> [[a]]) -> [a] -> ([[a]], [[a]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> [a] -> [[a]]
forall a. (a -> a) -> a -> [a]
iterate [a] -> [a]
forall a. [a] -> [a]
tail

tails98            :: [a] -> [[a]]
tails98 :: [a] -> [[a]]
tails98 []         = [[]]
tails98 xxs :: [a]
xxs@(a
_:[a]
xs) = [a]
xxs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
forall a. [a] -> [[a]]
tails98 [a]
xs

{- |
This function compares adjacent elements of a list.
If two adjacent elements satisfy a relation then they are put into the same sublist.
Example:

> groupBy (<) "abcdebcdef"  ==  ["abcde","bcdef"]

In contrast to that 'Data.List.groupBy' compares
the head of each sublist with each candidate for this sublist.
This yields

> List.groupBy (<) "abcdebcdef"  ==  ["abcdebcdef"]

The second @'b'@ is compared with the leading @'a'@.
Thus it is put into the same sublist as @'a'@.

The sublists are never empty.
Thus the more precise result type would be @[(a,[a])]@.
-}
groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy = (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
Key.groupBy

group :: (Eq a) => [a] -> [[a]]
group :: [a] -> [[a]]
group = (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)


{- |
Like standard 'unzip' but more lazy.
It is @Data.List.unzip undefined == undefined@,
but @unzip undefined == (undefined, undefined)@.
-}
unzip :: [(a,b)] -> ([a],[b])
unzip :: [(a, b)] -> ([a], [b])
unzip =
   ([a], [b]) -> ([a], [b])
forall a b. (a, b) -> (a, b)
forcePair (([a], [b]) -> ([a], [b]))
-> ([(a, b)] -> ([a], [b])) -> [(a, b)] -> ([a], [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ((a, b) -> ([a], [b]) -> ([a], [b]))
-> ([a], [b]) -> [(a, b)] -> ([a], [b])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ (a
x,b
y) ~([a]
xs,[b]
ys) -> (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs,b
yb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
ys)) ([],[])


{- |
'Data.List.partition' of GHC 6.2.1 fails on infinite lists.
But this one does not.
-}
{-
The lazy pattern match @(y,z)@ is necessary
since otherwise it fails on infinite lists.
-}
partition :: (a -> Bool) -> [a] -> ([a], [a])
partition :: (a -> Bool) -> [a] -> ([a], [a])
partition a -> Bool
p =
   ([a], [a]) -> ([a], [a])
forall a b. (a, b) -> (a, b)
forcePair (([a], [a]) -> ([a], [a]))
-> ([a] -> ([a], [a])) -> [a] -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (a -> ([a], [a]) -> ([a], [a])) -> ([a], [a]) -> [a] -> ([a], [a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\a
x ~([a]
y,[a]
z) ->
         if a -> Bool
p a
x
           then (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
y, [a]
z)
           else ([a]
y, a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
z))
      ([],[])

{- |
It is @Data.List.span f undefined = undefined@,
whereas @span f undefined = (undefined, undefined)@.
-}
span, break :: (a -> Bool) -> [a] -> ([a],[a])
span :: (a -> Bool) -> [a] -> ([a], [a])
span a -> Bool
p =
   let recourse :: [a] -> ([a], [a])
recourse [a]
xt =
          ([a], [a]) -> ([a], [a])
forall a b. (a, b) -> (a, b)
forcePair (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> ([a], [a])
forall a b. (a -> b) -> a -> b
$
          ([a], [a]) -> Maybe ([a], [a]) -> ([a], [a])
forall a. a -> Maybe a -> a
fromMaybe ([],[a]
xt) (Maybe ([a], [a]) -> ([a], [a])) -> Maybe ([a], [a]) -> ([a], [a])
forall a b. (a -> b) -> a -> b
$
          do (a
x,[a]
xs) <- [a] -> Maybe (a, [a])
forall a. [a] -> Maybe (a, [a])
viewL [a]
xt
             Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ a -> Bool
p a
x
             ([a], [a]) -> Maybe ([a], [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], [a]) -> Maybe ([a], [a])) -> ([a], [a]) -> Maybe ([a], [a])
forall a b. (a -> b) -> a -> b
$ ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> ([a], [a])
forall a b. (a -> b) -> a -> b
$ [a] -> ([a], [a])
recourse [a]
xs
   in  [a] -> ([a], [a])
recourse

break :: (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p =  (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)



-- * Split

{- |
Split the list at the occurrences of a separator into sub-lists.
Remove the separators.
This is somehow a generalization of 'lines' and 'words'.
But note the differences:

> Prelude Data.List.HT> words "a  a"
> ["a","a"]
> Prelude Data.List.HT> chop (' '==) "a  a"
> ["a","","a"]

> Prelude Data.List.HT> lines "a\n\na"
> ["a","","a"]
> Prelude Data.List.HT> chop ('\n'==) "a\n\na"
> ["a","","a"]

> Prelude Data.List.HT> lines "a\n"
> ["a"]
> Prelude Data.List.HT> chop ('\n'==) "a\n"
> ["a",""]

-}
chop :: (a -> Bool) -> [a] -> [[a]]
chop :: (a -> Bool) -> [a] -> [[a]]
chop a -> Bool
p =
   ([a] -> [[a]] -> [[a]]) -> ([a], [[a]]) -> [[a]]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) (([a], [[a]]) -> [[a]]) -> ([a] -> ([a], [[a]])) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (a -> ([a], [[a]]) -> ([a], [[a]]))
-> ([a], [[a]]) -> [a] -> ([a], [[a]])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ a
x ~([a]
y,[[a]]
ys) -> if a -> Bool
p a
x then ([],[a]
y[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
ys) else ((a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
y),[[a]]
ys) ) ([],[])

chop' :: (a -> Bool) -> [a] -> [[a]]
chop' :: (a -> Bool) -> [a] -> [[a]]
chop' a -> Bool
p =
   let recourse :: [a] -> [[a]]
recourse =
          ([a] -> [[a]] -> [[a]]) -> ([a], [[a]]) -> [[a]]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) (([a], [[a]]) -> [[a]]) -> ([a] -> ([a], [[a]])) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ([a] -> [[a]]) -> ([a], [a]) -> ([a], [[a]])
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ([[a]] -> (a -> [a] -> [[a]]) -> [a] -> [[a]]
forall b a. b -> (a -> [a] -> b) -> [a] -> b
switchL [] (([a] -> [[a]]) -> a -> [a] -> [[a]]
forall a b. a -> b -> a
const [a] -> [[a]]
recourse)) (([a], [a]) -> ([a], [[a]]))
-> ([a] -> ([a], [a])) -> [a] -> ([a], [[a]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p
   in  [a] -> [[a]]
recourse


chopAtRun :: (a -> Bool) -> [a] -> [[a]]
chopAtRun :: (a -> Bool) -> [a] -> [[a]]
chopAtRun a -> Bool
p =
   let recourse :: [a] -> [[a]]
recourse [] = [[]]
       recourse [a]
y =
          let ([a]
z,[a]
zs) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile a -> Bool
p [a]
y)
          in [a]
z [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
recourse [a]
zs
   in  [a] -> [[a]]
recourse


{- |
Like 'break', but splits after the matching element.
-}
breakAfter :: (a -> Bool) -> [a] -> ([a], [a])
breakAfter :: (a -> Bool) -> [a] -> ([a], [a])
breakAfter = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
breakAfterRec

breakAfterRec :: (a -> Bool) -> [a] -> ([a], [a])
breakAfterRec :: (a -> Bool) -> [a] -> ([a], [a])
breakAfterRec a -> Bool
p =
   let recourse :: [a] -> ([a], [a])
recourse [] = ([],[])
       recourse (a
x:[a]
xs) =
          ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> ([a], [a])
forall a b. (a -> b) -> a -> b
$
          if a -> Bool
p a
x
            then ([],[a]
xs)
            else [a] -> ([a], [a])
recourse [a]
xs
   in  ([a], [a]) -> ([a], [a])
forall a b. (a, b) -> (a, b)
forcePair (([a], [a]) -> ([a], [a]))
-> ([a] -> ([a], [a])) -> [a] -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ([a], [a])
recourse

{-
The use of 'foldr' might allow for fusion,
but unfortunately this simple implementation would copy the tail of the list.
-}
breakAfterFoldr :: (a -> Bool) -> [a] -> ([a], [a])
breakAfterFoldr :: (a -> Bool) -> [a] -> ([a], [a])
breakAfterFoldr a -> Bool
p =
   ([a], [a]) -> ([a], [a])
forall a b. (a, b) -> (a, b)
forcePair (([a], [a]) -> ([a], [a]))
-> ([a] -> ([a], [a])) -> [a] -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (a -> ([a], [a]) -> ([a], [a])) -> ([a], [a]) -> [a] -> ([a], [a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\a
x ([a], [a])
yzs -> ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> ([a], [a])
forall a b. (a -> b) -> a -> b
$ if a -> Bool
p a
x then ([], ([a] -> [a] -> [a]) -> ([a], [a]) -> [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) ([a], [a])
yzs) else ([a], [a])
yzs)
      ([],[])

breakAfterBreak :: (a -> Bool) -> [a] -> ([a], [a])
breakAfterBreak :: (a -> Bool) -> [a] -> ([a], [a])
breakAfterBreak a -> Bool
p [a]
xs =
   case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p [a]
xs of
      ([a]
ys, []) -> ([a]
ys, [])
      ([a]
ys, a
z:[a]
zs) -> ([a]
ys[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a
z], [a]
zs)

breakAfterTakeUntil :: (a -> Bool) -> [a] -> ([a], [a])
breakAfterTakeUntil :: (a -> Bool) -> [a] -> ([a], [a])
breakAfterTakeUntil a -> Bool
p [a]
xs =
   ([a], [a]) -> ([a], [a])
forall a b. (a, b) -> (a, b)
forcePair (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> ([a], [a])
forall a b. (a -> b) -> a -> b
$
   (\[(a, [a])]
ys -> (((a, [a]) -> a) -> [(a, [a])] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, [a]) -> a
forall a b. (a, b) -> a
fst [(a, [a])]
ys, [a]
-> (([(a, [a])], (a, [a])) -> [a])
-> Maybe ([(a, [a])], (a, [a]))
-> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((a, [a]) -> [a]
forall a b. (a, b) -> b
snd ((a, [a]) -> [a])
-> (([(a, [a])], (a, [a])) -> (a, [a]))
-> ([(a, [a])], (a, [a]))
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(a, [a])], (a, [a])) -> (a, [a])
forall a b. (a, b) -> b
snd) (Maybe ([(a, [a])], (a, [a])) -> [a])
-> Maybe ([(a, [a])], (a, [a])) -> [a]
forall a b. (a -> b) -> a -> b
$ [(a, [a])] -> Maybe ([(a, [a])], (a, [a]))
forall a. [a] -> Maybe ([a], a)
viewR [(a, [a])]
ys)) ([(a, [a])] -> ([a], [a])) -> [(a, [a])] -> ([a], [a])
forall a b. (a -> b) -> a -> b
$
   ((a, [a]) -> Bool) -> [(a, [a])] -> [(a, [a])]
forall a. (a -> Bool) -> [a] -> [a]
takeUntil (a -> Bool
p (a -> Bool) -> ((a, [a]) -> a) -> (a, [a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [a]) -> a
forall a b. (a, b) -> a
fst) ([(a, [a])] -> [(a, [a])]) -> [(a, [a])] -> [(a, [a])]
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]] -> [(a, [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs ([[a]] -> [(a, [a])]) -> [[a]] -> [(a, [a])]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [[a]]
forall a. [a] -> [a]
tail ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]]
forall a. [a] -> [[a]]
tails [a]
xs

{- |
Take all elements until one matches.
The matching element is returned, too.
This is the key difference to @takeWhile (not . p)@.
It holds @takeUntil p xs == fst (breakAfter p xs)@.
-}
takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil a -> Bool
p = (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x [a]
ys -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: if a -> Bool
p a
x then [] else [a]
ys) []


{- |
Split the list after each occurence of a terminator.
Keep the terminator.
There is always a list for the part after the last terminator.
It may be empty.
See package @non-empty@ for more precise result type.
-}
segmentAfter :: (a -> Bool) -> [a] -> [[a]]
segmentAfter :: (a -> Bool) -> [a] -> [[a]]
segmentAfter a -> Bool
p =
   ([a] -> [[a]] -> [[a]]) -> ([a], [[a]]) -> [[a]]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) (([a], [[a]]) -> [[a]]) -> ([a] -> ([a], [[a]])) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (a -> ([a], [[a]]) -> ([a], [[a]]))
-> ([a], [[a]]) -> [a] -> ([a], [[a]])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\a
x ~([a]
y,[[a]]
ys) ->
         ([a] -> [a]) -> ([a], [[a]]) -> ([a], [[a]])
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (([a], [[a]]) -> ([a], [[a]])) -> ([a], [[a]]) -> ([a], [[a]])
forall a b. (a -> b) -> a -> b
$
         if a -> Bool
p a
x then ([],[a]
y[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
ys) else ([a]
y,[[a]]
ys))
      ([],[])

segmentAfter' :: (a -> Bool) -> [a] -> [[a]]
segmentAfter' :: (a -> Bool) -> [a] -> [[a]]
segmentAfter' a -> Bool
p =
   (a -> [[a]] -> [[a]]) -> [[a]] -> [a] -> [[a]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ a
x ~yt :: [[a]]
yt@([a]
y:[[a]]
ys) -> if a -> Bool
p a
x then [a
x][a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
yt else (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
y)[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
ys) [[]]

propSegmentAfterConcat :: Eq a => (a -> Bool) -> [a] -> Bool
propSegmentAfterConcat :: (a -> Bool) -> [a] -> Bool
propSegmentAfterConcat a -> Bool
p [a]
xs =
   [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
segmentAfter a -> Bool
p [a]
xs) [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
xs

propSegmentAfterNumSeps :: (a -> Bool) -> [a] -> Bool
propSegmentAfterNumSeps :: (a -> Bool) -> [a] -> Bool
propSegmentAfterNumSeps a -> Bool
p [a]
xs =
   [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p [a]
xs) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [[a]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[a]] -> [[a]]
forall a. [a] -> [a]
tail ((a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
segmentAfter a -> Bool
p [a]
xs))

propSegmentAfterLasts :: (a -> Bool) -> [a] -> Bool
propSegmentAfterLasts :: (a -> Bool) -> [a] -> Bool
propSegmentAfterLasts a -> Bool
p =
   ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a -> Bool
p (a -> Bool) -> ([a] -> a) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
forall a. [a] -> a
last) ([[a]] -> Bool) -> ([a] -> [[a]]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [[a]]
forall a. [a] -> [a]
init ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
segmentAfter a -> Bool
p

propSegmentAfterInits :: (a -> Bool) -> [a] -> Bool
propSegmentAfterInits :: (a -> Bool) -> [a] -> Bool
propSegmentAfterInits a -> Bool
p =
   ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p) ([a] -> Bool) -> ([a] -> [a]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
init) ([[a]] -> Bool) -> ([a] -> [[a]]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [[a]]
forall a. [a] -> [a]
init ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
segmentAfter a -> Bool
p

{-
This test captures both infinitely many groups and infinitely big groups.
-}
propSegmentAfterInfinite :: (a -> Bool) -> a -> [a] -> Bool
propSegmentAfterInfinite :: (a -> Bool) -> a -> [a] -> Bool
propSegmentAfterInfinite a -> Bool
p a
x =
   (a -> Bool -> Bool) -> Bool -> a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Bool -> Bool
seq Bool
True (a -> Bool) -> ([a] -> a) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Int -> a
forall a. [a] -> Int -> a
!!Int
100) ([a] -> a) -> ([a] -> [a]) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
segmentAfter a -> Bool
p ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
cycle ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)

{- |
Split the list before each occurence of a leading character.
Keep these characters.
There is always a list for the part before the first leading character.
It may be empty.
See package @non-empty@ for more precise result type.
-}
segmentBefore :: (a -> Bool) -> [a] -> [[a]]
segmentBefore :: (a -> Bool) -> [a] -> [[a]]
segmentBefore a -> Bool
p =
--   foldr (\ x ~(y:ys) -> (if p x then ([]:) else id) ((x:y):ys)) [[]]
   ([a] -> [[a]] -> [[a]]) -> ([a], [[a]]) -> [[a]]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) (([a], [[a]]) -> [[a]]) -> ([a] -> ([a], [[a]])) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (a -> ([a], [[a]]) -> ([a], [[a]]))
-> ([a], [[a]]) -> [a] -> ([a], [[a]])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\ a
x ~([a]
y,[[a]]
ys) ->
         let xs :: [a]
xs = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
y
         in  if a -> Bool
p a
x then ([],[a]
xs[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
ys) else ([a]
xs,[[a]]
ys))
      ([],[])

segmentBefore' :: (a -> Bool) -> [a] -> [[a]]
segmentBefore' :: (a -> Bool) -> [a] -> [[a]]
segmentBefore' a -> Bool
p =
   ([a] -> [[a]] -> [[a]]) -> ([a], [[a]]) -> [[a]]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) (([a], [[a]]) -> [[a]]) -> ([a] -> ([a], [[a]])) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (\[[a]]
xst ->
      ([a], [[a]]) -> Maybe ([a], [[a]]) -> ([a], [[a]])
forall a. a -> Maybe a -> a
fromMaybe ([],[[a]]
xst) (Maybe ([a], [[a]]) -> ([a], [[a]]))
-> Maybe ([a], [[a]]) -> ([a], [[a]])
forall a b. (a -> b) -> a -> b
$ do
         ((a
x:[a]
xs):[[a]]
xss) <- [[a]] -> Maybe [[a]]
forall a. a -> Maybe a
Just [[a]]
xst
         Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Bool
p a
x
         ([a], [[a]]) -> Maybe ([a], [[a]])
forall (m :: * -> *) a. Monad m => a -> m a
return (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs, [[a]]
xss)) ([[a]] -> ([a], [[a]])) -> ([a] -> [[a]]) -> [a] -> ([a], [[a]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\a
_ a
x -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Bool
p a
x)

segmentBefore'' :: (a -> Bool) -> [a] -> [[a]]
segmentBefore'' :: (a -> Bool) -> [a] -> [[a]]
segmentBefore'' a -> Bool
p =
   (\[[a]]
xst ->
      case [[a]]
xst of
         ~([a]
xs:[[a]]
xss) ->
            [a] -> [a]
forall a. [a] -> [a]
tail [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
xss) ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\a
_ a
x -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Bool
p a
x) ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ([Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"segmentBefore: dummy element" a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)


propSegmentBeforeConcat :: Eq a => (a -> Bool) -> [a] -> Bool
propSegmentBeforeConcat :: (a -> Bool) -> [a] -> Bool
propSegmentBeforeConcat a -> Bool
p [a]
xs =
   [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
segmentBefore a -> Bool
p [a]
xs) [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
xs

propSegmentBeforeNumSeps :: (a -> Bool) -> [a] -> Bool
propSegmentBeforeNumSeps :: (a -> Bool) -> [a] -> Bool
propSegmentBeforeNumSeps a -> Bool
p [a]
xs =
   [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p [a]
xs) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [[a]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[a]] -> [[a]]
forall a. [a] -> [a]
tail ((a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
segmentBefore a -> Bool
p [a]
xs))

propSegmentBeforeHeads :: (a -> Bool) -> [a] -> Bool
propSegmentBeforeHeads :: (a -> Bool) -> [a] -> Bool
propSegmentBeforeHeads a -> Bool
p =
   ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a -> Bool
p (a -> Bool) -> ([a] -> a) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
forall a. [a] -> a
head) ([[a]] -> Bool) -> ([a] -> [[a]]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [[a]]
forall a. [a] -> [a]
tail ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
segmentBefore a -> Bool
p

propSegmentBeforeTails :: (a -> Bool) -> [a] -> Bool
propSegmentBeforeTails :: (a -> Bool) -> [a] -> Bool
propSegmentBeforeTails a -> Bool
p =
   ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p) ([a] -> Bool) -> ([a] -> [a]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
tail) ([[a]] -> Bool) -> ([a] -> [[a]]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [[a]]
forall a. [a] -> [a]
tail ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
segmentBefore a -> Bool
p

propSegmentBeforeInfinite :: (a -> Bool) -> a -> [a] -> Bool
propSegmentBeforeInfinite :: (a -> Bool) -> a -> [a] -> Bool
propSegmentBeforeInfinite a -> Bool
p a
x =
   (a -> Bool -> Bool) -> Bool -> a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Bool -> Bool
seq Bool
True (a -> Bool) -> ([a] -> a) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Int -> a
forall a. [a] -> Int -> a
!!Int
100) ([a] -> a) -> ([a] -> [a]) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
segmentBefore a -> Bool
p ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
cycle ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)

propSegmentBeforeGroupBy0 :: Eq a => (a -> Bool) -> [a] -> Bool
propSegmentBeforeGroupBy0 :: (a -> Bool) -> [a] -> Bool
propSegmentBeforeGroupBy0 a -> Bool
p [a]
xs =
   (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
segmentBefore a -> Bool
p [a]
xs [[a]] -> [[a]] -> Bool
forall a. Eq a => a -> a -> Bool
== (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
segmentBefore' a -> Bool
p [a]
xs

propSegmentBeforeGroupBy1 :: Eq a => (a -> Bool) -> [a] -> Bool
propSegmentBeforeGroupBy1 :: (a -> Bool) -> [a] -> Bool
propSegmentBeforeGroupBy1 a -> Bool
p [a]
xs =
   (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
segmentBefore a -> Bool
p [a]
xs [[a]] -> [[a]] -> Bool
forall a. Eq a => a -> a -> Bool
== (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
segmentBefore'' a -> Bool
p [a]
xs


{- |
> Data.List.HT Data.Char> segmentBeforeMaybe (\c -> toMaybe (isLetter c) (toUpper c)) "123a5345b---"
> ("123",[('A',"5345"),('B',"---")])
-}
segmentBeforeMaybe ::
   (a -> Maybe b) ->
   [a] -> ([a], [(b, [a])])
segmentBeforeMaybe :: (a -> Maybe b) -> [a] -> ([a], [(b, [a])])
segmentBeforeMaybe a -> Maybe b
f =
   ([a], [(b, [a])]) -> ([a], [(b, [a])])
forall a b. (a, b) -> (a, b)
forcePair (([a], [(b, [a])]) -> ([a], [(b, [a])]))
-> ([a] -> ([a], [(b, [a])])) -> [a] -> ([a], [(b, [a])])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (a -> ([a], [(b, [a])]) -> ([a], [(b, [a])]))
-> ([a], [(b, [a])]) -> [a] -> ([a], [(b, [a])])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\ a
x ~([a]
y,[(b, [a])]
ys) ->
         case a -> Maybe b
f a
x of
            Just b
b -> ([],(b
b,[a]
y)(b, [a]) -> [(b, [a])] -> [(b, [a])]
forall a. a -> [a] -> [a]
:[(b, [a])]
ys)
            Maybe b
Nothing -> (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
y,[(b, [a])]
ys))
      ([],[])

{- |
> Data.List.HT Data.Char> segmentAfterMaybe (\c -> toMaybe (isLetter c) (toUpper c)) "123a5345b---"
> ([("123",'A'),("5345",'B')],"---")
-}
segmentAfterMaybe ::
   (a -> Maybe b) ->
   [a] -> ([([a], b)], [a])
segmentAfterMaybe :: (a -> Maybe b) -> [a] -> ([([a], b)], [a])
segmentAfterMaybe a -> Maybe b
f =
   ([a], [([a], b)]) -> ([([a], b)], [a])
forall a b. (a, b) -> (b, a)
swap (([a], [([a], b)]) -> ([([a], b)], [a]))
-> ([a] -> ([a], [([a], b)])) -> [a] -> ([([a], b)], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ([a] -> [(b, [a])] -> ([a], [([a], b)]))
-> ([a], [(b, [a])]) -> ([a], [([a], b)])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (([a] -> (b, [a]) -> ([a], ([a], b)))
-> [a] -> [(b, [a])] -> ([a], [([a], b)])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (\[a]
as0 (b
b,[a]
as1) -> ([a]
as1, ([a]
as0,b
b)))) (([a], [(b, [a])]) -> ([a], [([a], b)]))
-> ([a] -> ([a], [(b, [a])])) -> [a] -> ([a], [([a], b)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (a -> Maybe b) -> [a] -> ([a], [(b, [a])])
forall a b. (a -> Maybe b) -> [a] -> ([a], [(b, [a])])
segmentBeforeMaybe a -> Maybe b
f


-- cf. Matroid.hs
{- |
@removeEach xs@ represents a list of sublists of @xs@,
where each element of @xs@ is removed and
the removed element is separated.
It seems to be much simpler to achieve with
@zip xs (map (flip List.delete xs) xs)@,
but the implementation of 'removeEach' does not need the 'Eq' instance
and thus can also be used for lists of functions.

See also the proposal
 <http://www.haskell.org/pipermail/libraries/2008-February/009270.html>
-}
removeEach :: [a] -> [(a, [a])]
removeEach :: [a] -> [(a, [a])]
removeEach =
   (([a], a, [a]) -> (a, [a])) -> [([a], a, [a])] -> [(a, [a])]
forall a b. (a -> b) -> [a] -> [b]
map (\([a]
ys, a
pivot, [a]
zs) -> (a
pivot,[a]
ys[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
zs)) ([([a], a, [a])] -> [(a, [a])])
-> ([a] -> [([a], a, [a])]) -> [a] -> [(a, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [([a], a, [a])]
forall a. [a] -> [([a], a, [a])]
splitEverywhere

splitEverywhere :: [a] -> [([a], a, [a])]
splitEverywhere :: [a] -> [([a], a, [a])]
splitEverywhere [a]
xs =
   (([a], [a]) -> ([a], a, [a])) -> [([a], [a])] -> [([a], a, [a])]
forall a b. (a -> b) -> [a] -> [b]
map
      (\([a]
y, [a]
zs0) ->
         case [a]
zs0 of
            a
z:[a]
zs -> ([a]
y,a
z,[a]
zs)
            [] -> [Char] -> ([a], a, [a])
forall a. HasCallStack => [Char] -> a
error [Char]
"splitEverywhere: empty list")
      ([([a], [a])] -> [([a], [a])]
forall a. [a] -> [a]
init ([[a]] -> [[a]] -> [([a], [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip ([a] -> [[a]]
forall a. [a] -> [[a]]
inits [a]
xs) ([a] -> [[a]]
forall a. [a] -> [[a]]
tails [a]
xs)))



--  * inspect ends of a list

{-# DEPRECATED splitLast "use viewR instead" #-}
{- |
It holds @splitLast xs == (init xs, last xs)@,
but 'splitLast' is more efficient
if the last element is accessed after the initial ones,
because it avoids memoizing list.
-}
splitLast :: [a] -> ([a], a)
splitLast :: [a] -> ([a], a)
splitLast [] = [Char] -> ([a], a)
forall a. HasCallStack => [Char] -> a
error [Char]
"splitLast: empty list"
splitLast [a
x] = ([], a
x)
splitLast (a
x:[a]
xs) =
   let ([a]
xs', a
lastx) = [a] -> ([a], a)
forall a. [a] -> ([a], a)
splitLast [a]
xs in (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs', a
lastx)

propSplitLast :: Eq a => [a] -> Bool
propSplitLast :: [a] -> Bool
propSplitLast [a]
xs =
   [a] -> ([a], a)
forall a. [a] -> ([a], a)
splitLast [a]
xs  ([a], a) -> ([a], a) -> Bool
forall a. Eq a => a -> a -> Bool
==  ([a] -> [a]
forall a. [a] -> [a]
init [a]
xs, [a] -> a
forall a. [a] -> a
last [a]
xs)


{- |
Should be prefered to 'head' and 'tail'.
-}
{-# INLINE viewL #-}
viewL :: [a] -> Maybe (a, [a])
viewL :: [a] -> Maybe (a, [a])
viewL (a
x:[a]
xs) = (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just (a
x,[a]
xs)
viewL []     = Maybe (a, [a])
forall a. Maybe a
Nothing

{- |
Should be prefered to 'init' and 'last'.
-}
viewR :: [a] -> Maybe ([a], a)
viewR :: [a] -> Maybe ([a], a)
viewR =
   (a -> Maybe ([a], a) -> Maybe ([a], a))
-> Maybe ([a], a) -> [a] -> Maybe ([a], a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x -> ([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just (([a], a) -> Maybe ([a], a))
-> (Maybe ([a], a) -> ([a], a)) -> Maybe ([a], a) -> Maybe ([a], a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], a) -> ([a], a)
forall a b. (a, b) -> (a, b)
forcePair (([a], a) -> ([a], a))
-> (Maybe ([a], a) -> ([a], a)) -> Maybe ([a], a) -> ([a], a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], a) -> (([a], a) -> ([a], a)) -> Maybe ([a], a) -> ([a], a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([],a
x) (([a] -> [a]) -> ([a], a) -> ([a], a)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:))) Maybe ([a], a)
forall a. Maybe a
Nothing

propViewR :: Eq a => [a] -> Bool
propViewR :: [a] -> Bool
propViewR [a]
xs =
   Bool -> (([a], a) -> Bool) -> Maybe ([a], a) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True
      (([a] -> [a]
forall a. [a] -> [a]
init [a]
xs, [a] -> a
forall a. [a] -> a
last [a]
xs) ([a], a) -> ([a], a) -> Bool
forall a. Eq a => a -> a -> Bool
== )
      ([a] -> Maybe ([a], a)
forall a. [a] -> Maybe ([a], a)
viewR [a]
xs)

{- |
Should be prefered to 'head' and 'tail'.
-}
{-# INLINE switchL #-}
switchL :: b -> (a -> [a] -> b) -> [a] -> b
switchL :: b -> (a -> [a] -> b) -> [a] -> b
switchL b
n a -> [a] -> b
_ [] = b
n
switchL b
_ a -> [a] -> b
j (a
x:[a]
xs) = a -> [a] -> b
j a
x [a]
xs

switchL' :: b -> (a -> [a] -> b) -> [a] -> b
switchL' :: b -> (a -> [a] -> b) -> [a] -> b
switchL' b
n a -> [a] -> b
j =
   b -> ((a, [a]) -> b) -> Maybe (a, [a]) -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
n ((a -> [a] -> b) -> (a, [a]) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> [a] -> b
j) (Maybe (a, [a]) -> b) -> ([a] -> Maybe (a, [a])) -> [a] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (a, [a])
forall a. [a] -> Maybe (a, [a])
viewL

{- |
Should be prefered to 'init' and 'last'.
-}
{-# INLINE switchR #-}
switchR :: b -> ([a] -> a -> b) -> [a] -> b
switchR :: b -> ([a] -> a -> b) -> [a] -> b
switchR b
n [a] -> a -> b
j =
   b -> (([a], a) -> b) -> Maybe ([a], a) -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
n (([a] -> a -> b) -> ([a], a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [a] -> a -> b
j) (Maybe ([a], a) -> b) -> ([a] -> Maybe ([a], a)) -> [a] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe ([a], a)
forall a. [a] -> Maybe ([a], a)
viewR

propSwitchR :: Eq a => [a] -> Bool
propSwitchR :: [a] -> Bool
propSwitchR [a]
xs =
   Bool -> ([a] -> a -> Bool) -> [a] -> Bool
forall b a. b -> ([a] -> a -> b) -> [a] -> b
switchR Bool
True (\[a]
ixs a
lxs -> [a]
ixs [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> [a]
forall a. [a] -> [a]
init [a]
xs Bool -> Bool -> Bool
&& a
lxs a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> a
forall a. [a] -> a
last [a]
xs) [a]
xs



-- * List processing starting at the end

{- |
@takeRev n@ is like @reverse . take n . reverse@
but it is lazy enough to work for infinite lists, too.
-}
takeRev :: Int -> [a] -> [a]
takeRev :: Int -> [a] -> [a]
takeRev Int
n [a]
xs = [a] -> [a] -> [a]
forall b a. [b] -> [a] -> [a]
Match.drop (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
xs) [a]
xs

{- |
@dropRev n@ is like @reverse . drop n . reverse@
but it is lazy enough to work for infinite lists, too.
-}
dropRev :: Int -> [a] -> [a]
dropRev :: Int -> [a] -> [a]
dropRev Int
n [a]
xs = [a] -> [a] -> [a]
forall b a. [b] -> [a] -> [a]
Match.take (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
xs) [a]
xs

{- |
@splitAtRev n xs == (dropRev n xs, takeRev n xs)@.
It holds @xs == uncurry (++) (splitAtRev n xs)@
-}
splitAtRev :: Int -> [a] -> ([a], [a])
splitAtRev :: Int -> [a] -> ([a], [a])
splitAtRev Int
n [a]
xs = [a] -> [a] -> ([a], [a])
forall b a. [b] -> [a] -> ([a], [a])
Match.splitAt (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
xs) [a]
xs


dropWhileRev :: (a -> Bool) -> [a] -> [a]
dropWhileRev :: (a -> Bool) -> [a] -> [a]
dropWhileRev a -> Bool
p =
   [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [[a]]
forall a. [a] -> [a]
init ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
segmentAfter (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)

takeWhileRev0 :: (a -> Bool) -> [a] -> [a]
takeWhileRev0 :: (a -> Bool) -> [a] -> [a]
takeWhileRev0 a -> Bool
p =
   [[a]] -> [a]
forall a. [a] -> a
last ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
segmentAfter (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)

{- |
Doesn't seem to be superior to the naive implementation.
-}
takeWhileRev1 :: (a -> Bool) -> [a] -> [a]
takeWhileRev1 :: (a -> Bool) -> [a] -> [a]
takeWhileRev1 a -> Bool
p =
   (\Maybe ([[(Bool, a)]], [(Bool, a)])
mx ->
      case Maybe ([[(Bool, a)]], [(Bool, a)])
mx of
         Just ([[(Bool, a)]]
_, xs :: [(Bool, a)]
xs@((Bool
True,a
_):[(Bool, a)]
_)) -> ((Bool, a) -> a) -> [(Bool, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, a) -> a
forall a b. (a, b) -> b
snd [(Bool, a)]
xs
         Maybe ([[(Bool, a)]], [(Bool, a)])
_ -> []) (Maybe ([[(Bool, a)]], [(Bool, a)]) -> [a])
-> ([a] -> Maybe ([[(Bool, a)]], [(Bool, a)])) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   [[(Bool, a)]] -> Maybe ([[(Bool, a)]], [(Bool, a)])
forall a. [a] -> Maybe ([a], a)
viewR ([[(Bool, a)]] -> Maybe ([[(Bool, a)]], [(Bool, a)]))
-> ([a] -> [[(Bool, a)]])
-> [a]
-> Maybe ([[(Bool, a)]], [(Bool, a)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Bool, a) -> (Bool, a) -> Bool) -> [(Bool, a)] -> [[(Bool, a)]])
-> (Bool -> Bool -> Bool) -> (a -> Bool) -> [a] -> [[(Bool, a)]]
forall key a b c.
(((key, a) -> (key, a) -> b) -> [(key, a)] -> c)
-> (key -> key -> b) -> (a -> key) -> [a] -> c
Key.aux ((Bool, a) -> (Bool, a) -> Bool) -> [(Bool, a)] -> [[(Bool, a)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
(==) a -> Bool
p

{- |
However it is more inefficient,
because of repeatedly appending single elements. :-(
-}
takeWhileRev2 :: (a -> Bool) -> [a] -> [a]
takeWhileRev2 :: (a -> Bool) -> [a] -> [a]
takeWhileRev2 a -> Bool
p =
   ([a] -> a -> [a]) -> [a] -> [a] -> [a]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\[a]
xs a
x -> if a -> Bool
p a
x then [a]
xs[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a
x] else []) []


-- * List processing with Maybe and Either

{- |
@maybePrefixOf xs ys@ is @Just zs@ if @xs@ is a prefix of @ys@,
where @zs@ is @ys@ without the prefix @xs@.
Otherwise it is @Nothing@.
It is the same as 'Data.List.stripPrefix'.
-}
maybePrefixOf :: Eq a => [a] -> [a] -> Maybe [a]
maybePrefixOf :: [a] -> [a] -> Maybe [a]
maybePrefixOf (a
x:[a]
xs) (a
y:[a]
ys) = Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
y) Maybe () -> Maybe [a] -> Maybe [a]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
maybePrefixOf [a]
xs [a]
ys
maybePrefixOf [] [a]
ys = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
ys
maybePrefixOf [a]
_  [] = Maybe [a]
forall a. Maybe a
Nothing

maybeSuffixOf :: Eq a => [a] -> [a] -> Maybe [a]
maybeSuffixOf :: [a] -> [a] -> Maybe [a]
maybeSuffixOf [a]
xs [a]
ys =
   ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> [a]
forall a. [a] -> [a]
reverse (Maybe [a] -> Maybe [a]) -> Maybe [a] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
maybePrefixOf ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs) ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys)


{- |
Partition a list into elements which evaluate to @Just@ or @Nothing@ by @f@.

It holds @mapMaybe f == fst . partitionMaybe f@
and @partition p == partitionMaybe (\ x -> toMaybe (p x) x)@.
-}
partitionMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])
partitionMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])
partitionMaybe a -> Maybe b
f =
   ([b], [a]) -> ([b], [a])
forall a b. (a, b) -> (a, b)
forcePair (([b], [a]) -> ([b], [a]))
-> ([a] -> ([b], [a])) -> [a] -> ([b], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (a -> ([b], [a]) -> ([b], [a])) -> ([b], [a]) -> [a] -> ([b], [a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\a
x -> (([b], [a]) -> ([b], [a]))
-> (b -> ([b], [a]) -> ([b], [a]))
-> Maybe b
-> ([b], [a])
-> ([b], [a])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (([a] -> [a]) -> ([b], [a]) -> ([b], [a])
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) (\b
y -> ([b] -> [b]) -> ([b], [a]) -> ([b], [a])
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (b
yb -> [b] -> [b]
forall a. a -> [a] -> [a]
:)) (a -> Maybe b
f a
x))
      ([],[])

{- |
This is the cousin of 'takeWhile'
analogously to 'catMaybes' being the cousin of 'filter'.

Example: Keep the heads of sublists until an empty list occurs.

> takeWhileJust $ map (fmap fst . viewL) xs


For consistency with 'takeWhile',
'partitionMaybe' and 'dropWhileNothing' it should have been:

> takeWhileJust_ :: (a -> Maybe b) -> a -> [b]

However, both variants are interchangeable:

> takeWhileJust_ f == takeWhileJust . map f
> takeWhileJust == takeWhileJust_ id
-}
takeWhileJust :: [Maybe a] -> [a]
takeWhileJust :: [Maybe a] -> [a]
takeWhileJust =
   (Maybe a -> [a] -> [a]) -> [a] -> [Maybe a] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Maybe a
x [a]
acc -> [a] -> (a -> [a]) -> Maybe a -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc) Maybe a
x) []

dropWhileNothing :: (a -> Maybe b) -> [a] -> Maybe (b, [a])
dropWhileNothing :: (a -> Maybe b) -> [a] -> Maybe (b, [a])
dropWhileNothing a -> Maybe b
f =
   [Maybe (b, [a])] -> Maybe (b, [a])
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe (b, [a])] -> Maybe (b, [a]))
-> ([a] -> [Maybe (b, [a])]) -> [a] -> Maybe (b, [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Maybe (b, [a])) -> [[a]] -> [Maybe (b, [a])]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Maybe b) -> (a, [a]) -> Maybe (b, [a])
forall (f :: * -> *) a c b.
Functor f =>
(a -> f c) -> (a, b) -> f (c, b)
Func.mapFst a -> Maybe b
f ((a, [a]) -> Maybe (b, [a]))
-> ([a] -> Maybe (a, [a])) -> [a] -> Maybe (b, [a])
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [a] -> Maybe (a, [a])
forall a. [a] -> Maybe (a, [a])
viewL) ([[a]] -> [Maybe (b, [a])])
-> ([a] -> [[a]]) -> [a] -> [Maybe (b, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. [a] -> [[a]]
tails

dropWhileNothingRec :: (a -> Maybe b) -> [a] -> Maybe (b, [a])
dropWhileNothingRec :: (a -> Maybe b) -> [a] -> Maybe (b, [a])
dropWhileNothingRec a -> Maybe b
f =
   let go :: [a] -> Maybe (b, [a])
go [] = Maybe (b, [a])
forall a. Maybe a
Nothing
       go (a
a:[a]
xs) = ((b -> [a] -> (b, [a])) -> [a] -> b -> (b, [a])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [a]
xs (b -> (b, [a])) -> Maybe b -> Maybe (b, [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe b
f a
a) Maybe (b, [a]) -> Maybe (b, [a]) -> Maybe (b, [a])
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [a] -> Maybe (b, [a])
go [a]
xs
   in  [a] -> Maybe (b, [a])
go

breakJust :: (a -> Maybe b) -> [a] -> ([a], Maybe (b, [a]))
breakJust :: (a -> Maybe b) -> [a] -> ([a], Maybe (b, [a]))
breakJust a -> Maybe b
f =
   let go :: [a] -> ([a], Maybe (b, [a]))
go [] = ([], Maybe (b, [a])
forall a. Maybe a
Nothing)
       go (a
a:[a]
xs) =
         case a -> Maybe b
f a
a of
            Maybe b
Nothing -> ([a] -> [a]) -> ([a], Maybe (b, [a])) -> ([a], Maybe (b, [a]))
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (([a], Maybe (b, [a])) -> ([a], Maybe (b, [a])))
-> ([a], Maybe (b, [a])) -> ([a], Maybe (b, [a]))
forall a b. (a -> b) -> a -> b
$ [a] -> ([a], Maybe (b, [a]))
go [a]
xs
            Just b
b -> ([], (b, [a]) -> Maybe (b, [a])
forall a. a -> Maybe a
Just (b
b, [a]
xs))
   in  [a] -> ([a], Maybe (b, [a]))
go

-- memory leak, because xs is hold all the time
breakJustRemoveEach :: (a -> Maybe b) -> [a] -> ([a], Maybe (b, [a]))
breakJustRemoveEach :: (a -> Maybe b) -> [a] -> ([a], Maybe (b, [a]))
breakJustRemoveEach a -> Maybe b
f [a]
xs =
   ([a], Maybe (b, [a]))
-> (([a], Maybe (b, [a]))
    -> [([a], Maybe (b, [a]))] -> ([a], Maybe (b, [a])))
-> [([a], Maybe (b, [a]))]
-> ([a], Maybe (b, [a]))
forall b a. b -> (a -> [a] -> b) -> [a] -> b
switchL ([a]
xs, Maybe (b, [a])
forall a. Maybe a
Nothing) ([a], Maybe (b, [a]))
-> [([a], Maybe (b, [a]))] -> ([a], Maybe (b, [a]))
forall a b. a -> b -> a
const ([([a], Maybe (b, [a]))] -> ([a], Maybe (b, [a])))
-> [([a], Maybe (b, [a]))] -> ([a], Maybe (b, [a]))
forall a b. (a -> b) -> a -> b
$
   (([a], a, [a]) -> Maybe ([a], Maybe (b, [a])))
-> [([a], a, [a])] -> [([a], Maybe (b, [a]))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\([a]
ys,a
a,[a]
zs) -> (\b
b -> ([a]
ys, (b, [a]) -> Maybe (b, [a])
forall a. a -> Maybe a
Just (b
b,[a]
zs))) (b -> ([a], Maybe (b, [a])))
-> Maybe b -> Maybe ([a], Maybe (b, [a]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe b
f a
a) ([([a], a, [a])] -> [([a], Maybe (b, [a]))])
-> [([a], a, [a])] -> [([a], Maybe (b, [a]))]
forall a b. (a -> b) -> a -> b
$
   [a] -> [([a], a, [a])]
forall a. [a] -> [([a], a, [a])]
splitEverywhere [a]
xs

-- needs to apply 'f' twice at the end and uses partial functions
breakJustPartial :: (a -> Maybe b) -> [a] -> ([a], Maybe (b, [a]))
breakJustPartial :: (a -> Maybe b) -> [a] -> ([a], Maybe (b, [a]))
breakJustPartial a -> Maybe b
f [a]
xs =
   let ([a]
ys,[a]
zs) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Maybe b -> Bool
forall a. Maybe a -> Bool
isJust (Maybe b -> Bool) -> (a -> Maybe b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
f) [a]
xs
   in  ([a]
ys,
        (a -> b) -> (a, [a]) -> (b, [a])
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (b -> (b -> b) -> Maybe b -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> b
forall a. HasCallStack => [Char] -> a
error [Char]
"breakJust: unexpected Nothing") b -> b
forall a. a -> a
id (Maybe b -> b) -> (a -> Maybe b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
f) ((a, [a]) -> (b, [a])) -> Maybe (a, [a]) -> Maybe (b, [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            [a] -> Maybe (a, [a])
forall a. [a] -> Maybe (a, [a])
viewL [a]
zs)


unzipEithers :: [Either a b] -> ([a], [b])
unzipEithers :: [Either a b] -> ([a], [b])
unzipEithers =
   ([a], [b]) -> ([a], [b])
forall a b. (a, b) -> (a, b)
forcePair (([a], [b]) -> ([a], [b]))
-> ([Either a b] -> ([a], [b])) -> [Either a b] -> ([a], [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (Either a b -> ([a], [b]) -> ([a], [b]))
-> ([a], [b]) -> [Either a b] -> ([a], [b])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> ([a], [b]) -> ([a], [b]))
-> (b -> ([a], [b]) -> ([a], [b]))
-> Either a b
-> ([a], [b])
-> ([a], [b])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\a
x -> ([a] -> [a]) -> ([a], [b]) -> ([a], [b])
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) (\b
y -> ([b] -> [b]) -> ([a], [b]) -> ([a], [b])
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (b
yb -> [b] -> [b]
forall a. a -> [a] -> [a]
:))) ([],[])


-- * Sieve and slice

{-| keep every k-th value from the list -}
sieve, sieve', sieve'', sieve''' :: Int -> [a] -> [a]
sieve :: Int -> [a] -> [a]
sieve Int
k =
   ([a] -> Maybe (a, [a])) -> [a] -> [a]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\[a]
xs -> Bool -> (a, [a]) -> Maybe (a, [a])
forall a. Bool -> a -> Maybe a
toMaybe (Bool -> Bool
not ([a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs)) ([a] -> a
forall a. [a] -> a
head [a]
xs, Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
k [a]
xs))

sieve' :: Int -> [a] -> [a]
sieve' Int
k = ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. [a] -> a
head ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
sliceVertical Int
k

sieve'' :: Int -> [a] -> [a]
sieve'' Int
k [a]
x = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ([a]
x[a] -> Int -> a
forall a. [a] -> Int -> a
!!) [Int
0,Int
k..([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]

sieve''' :: Int -> [a] -> [a]
sieve''' Int
k = ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. [a] -> a
head ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> [a] -> [[a]]
forall a. (a -> a) -> a -> [a]
iterate (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
k)

propSieve :: Eq a => Int -> [a] -> Bool
propSieve :: Int -> [a] -> Bool
propSieve Int
n [a]
x =
   Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
sieve Int
n [a]
x [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
sieve'  Int
n [a]
x   Bool -> Bool -> Bool
&&
   Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
sieve Int
n [a]
x [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
sieve'' Int
n [a]
x

{-
sliceHorizontal is faster than sliceHorizontal' but consumes slightly more memory
(although it needs no swapping)
-}
sliceHorizontal, sliceHorizontal', sliceHorizontal'', sliceHorizontal''' ::
   Int -> [a] -> [[a]]
sliceHorizontal :: Int -> [a] -> [[a]]
sliceHorizontal Int
n =
   ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
sieve Int
n) ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[a]] -> [[a]]
forall a. Int -> [a] -> [a]
take Int
n ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> [a] -> [[a]]
forall a. (a -> a) -> a -> [a]
iterate (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1)

sliceHorizontal' :: Int -> [a] -> [[a]]
sliceHorizontal' Int
n =
   (a -> [[a]] -> [[a]]) -> [[a]] -> [a] -> [[a]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x [[a]]
ys -> let y :: [a]
y = [[a]] -> [a]
forall a. [a] -> a
last [[a]]
ys in [[a]] -> [[a]] -> [[a]]
forall b a. [b] -> [a] -> [a]
Match.take [[a]]
ys ((a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
y)[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
ys)) (Int -> [a] -> [[a]]
forall a. Int -> a -> [a]
replicate Int
n [])

sliceHorizontal'' :: Int -> [a] -> [[a]]
sliceHorizontal'' Int
n =
   [[a]] -> [[a]]
forall a. [a] -> [a]
reverse ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [[a]] -> [[a]]) -> [[a]] -> [a] -> [[a]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x ~([a]
y:[[a]]
ys) -> [[a]]
ys [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
y]) (Int -> [a] -> [[a]]
forall a. Int -> a -> [a]
replicate Int
n [])

sliceHorizontal''' :: Int -> [a] -> [[a]]
sliceHorizontal''' Int
n =
   Int -> [[a]] -> [[a]]
forall a. Int -> [a] -> [a]
take Int
n ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
transpose ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> [a] -> [[a]]
forall a. (a -> a) -> a -> [a]
iterate (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n)

propSliceHorizontal :: Eq a => Int -> [a] -> Bool
propSliceHorizontal :: Int -> [a] -> Bool
propSliceHorizontal Int
n [a]
x =
   Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
sliceHorizontal Int
n [a]
x [[a]] -> [[a]] -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
sliceHorizontal'   Int
n [a]
x Bool -> Bool -> Bool
&&
   Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
sliceHorizontal Int
n [a]
x [[a]] -> [[a]] -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
sliceHorizontal''  Int
n [a]
x Bool -> Bool -> Bool
&&
   Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
sliceHorizontal Int
n [a]
x [[a]] -> [[a]] -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
sliceHorizontal''' Int
n [a]
x


sliceVertical, sliceVertical' :: Int -> [a] -> [[a]]
sliceVertical :: Int -> [a] -> [[a]]
sliceVertical Int
n =
   ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n) ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> [a] -> [[a]]
forall a. (a -> a) -> a -> [a]
iterate (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n)
      {- takeWhile must be performed before (map take)
         in order to handle (n==0) correctly -}

sliceVertical' :: Int -> [a] -> [[a]]
sliceVertical' Int
n =
   ([a] -> Maybe ([a], [a])) -> [a] -> [[a]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\[a]
x -> Bool -> ([a], [a]) -> Maybe ([a], [a])
forall a. Bool -> a -> Maybe a
toMaybe (Bool -> Bool
not ([a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
x)) (Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
x))

propSliceVertical :: Eq a => Int -> [a] -> Bool
propSliceVertical :: Int -> [a] -> Bool
propSliceVertical Int
n [a]
x =
   Int -> [[a]] -> [[a]]
forall a. Int -> [a] -> [a]
take Int
100000 (Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
sliceVertical Int
n [a]
x) [[a]] -> [[a]] -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> [[a]] -> [[a]]
forall a. Int -> [a] -> [a]
take Int
100000 (Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
sliceVertical' Int
n [a]
x)

propSlice :: Eq a => Int -> [a] -> Bool
propSlice :: Int -> [a] -> Bool
propSlice Int
n [a]
x =
   -- problems: sliceHorizontal 4 [] == [[],[],[],[]]
   Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
sliceHorizontal Int
n [a]
x [[a]] -> [[a]] -> Bool
forall a. Eq a => a -> a -> Bool
== [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
transpose (Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
sliceVertical  Int
n [a]
x)  Bool -> Bool -> Bool
&&
   Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
sliceVertical  Int
n [a]
x [[a]] -> [[a]] -> Bool
forall a. Eq a => a -> a -> Bool
== [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
transpose (Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
sliceHorizontal Int
n [a]
x)



-- * Search&replace

search :: (Eq a) => [a] -> [a] -> [Int]
search :: [a] -> [a] -> [Int]
search [a]
sub [a]
str = ([a] -> Bool) -> [[a]] -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices ([a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
sub) ([a] -> [[a]]
forall a. [a] -> [[a]]
tails [a]
str)

replace :: Eq a => [a] -> [a] -> [a] -> [a]
replace :: [a] -> [a] -> [a] -> [a]
replace [a]
src [a]
dst =
   let recourse :: [a] -> [a]
recourse [] = []
       recourse str :: [a]
str@(a
s:[a]
ss) =
          [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe
             (a
s a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
recourse [a]
ss)
             (([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([a]
dst[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
recourse) (Maybe [a] -> Maybe [a]) -> Maybe [a] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$
              [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
maybePrefixOf [a]
src [a]
str)
   in  [a] -> [a]
recourse

markSublists :: (Eq a) => [a] -> [a] -> [Maybe [a]]
markSublists :: [a] -> [a] -> [Maybe [a]]
markSublists [a]
sub [a]
ys =
   let ~([a]
hd', [Maybe [a]]
rest') =
          (a -> ([a], [Maybe [a]]) -> ([a], [Maybe [a]]))
-> ([a], [Maybe [a]]) -> [a] -> ([a], [Maybe [a]])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
c ~([a]
hd, [Maybe [a]]
rest) ->
                   let xs :: [a]
xs = a
ca -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
hd
                   in  case [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
maybePrefixOf [a]
sub [a]
xs of
                         Just [a]
suffix -> ([], Maybe [a]
forall a. Maybe a
Nothing Maybe [a] -> [Maybe [a]] -> [Maybe [a]]
forall a. a -> [a] -> [a]
: [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
suffix Maybe [a] -> [Maybe [a]] -> [Maybe [a]]
forall a. a -> [a] -> [a]
: [Maybe [a]]
rest)
                         Maybe [a]
Nothing -> ([a]
xs, [Maybe [a]]
rest)) ([],[]) [a]
ys
   in  [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
hd' Maybe [a] -> [Maybe [a]] -> [Maybe [a]]
forall a. a -> [a] -> [a]
: [Maybe [a]]
rest'

replace' :: (Eq a) => [a] -> [a] -> [a] -> [a]
replace' :: [a] -> [a] -> [a] -> [a]
replace' [a]
src [a]
dst [a]
xs =
   (Maybe [a] -> [a]) -> [Maybe [a]] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [a]
dst) ([a] -> [a] -> [Maybe [a]]
forall a. Eq a => [a] -> [a] -> [Maybe [a]]
markSublists [a]
src [a]
xs)

propReplaceId :: (Eq a) => [a] -> [a] -> Bool
propReplaceId :: [a] -> [a] -> Bool
propReplaceId [a]
xs [a]
ys =
   [a] -> [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace [a]
xs [a]
xs [a]
ys [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
ys

propReplaceCycle :: (Eq a) => [a] -> [a] -> Bool
propReplaceCycle :: [a] -> [a] -> Bool
propReplaceCycle [a]
xs [a]
ys =
   [a] -> [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace [a]
xs [a]
ys ([a] -> [a]
forall a. [a] -> [a]
cycle [a]
xs) [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> [a]
forall a. [a] -> [a]
cycle [a]
ys

{- | This is slightly wrong, because it re-replaces things.
     That's also the reason for inefficiency:
        The replacing can go on only when subsequent replacements are finished.
     Thus this functiob fails on infinite lists. -}
replace'' :: (Eq a) => [a] -> [a] -> [a] -> [a]
replace'' :: [a] -> [a] -> [a] -> [a]
replace'' [a]
src [a]
dst =
    (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x [a]
xs -> let y :: [a]
y=a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs
                    in  if [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
src [a]
y
                          then [a]
dst [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
src) [a]
y
                          else [a]
y) []

multiReplace :: Eq a => [([a], [a])] -> [a] -> [a]
multiReplace :: [([a], [a])] -> [a] -> [a]
multiReplace [([a], [a])]
dict =
   let recourse :: [a] -> [a]
recourse [] = []
       recourse str :: [a]
str@(a
s:[a]
ss) =
          [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe
             (a
s a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
recourse [a]
ss)
             ([Maybe [a]] -> Maybe [a]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe [a]] -> Maybe [a]) -> [Maybe [a]] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$
              (([a], [a]) -> Maybe [a]) -> [([a], [a])] -> [Maybe [a]]
forall a b. (a -> b) -> [a] -> [b]
map (\([a]
src,[a]
dst) ->
                      ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([a]
dst[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
recourse) (Maybe [a] -> Maybe [a]) -> Maybe [a] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$
                      [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
maybePrefixOf [a]
src [a]
str) [([a], [a])]
dict)
   in  [a] -> [a]
recourse

multiReplace' :: Eq a => [([a], [a])] -> [a] -> [a]
multiReplace' :: [([a], [a])] -> [a] -> [a]
multiReplace' [([a], [a])]
dict =
   let recourse :: [a] -> [a]
recourse [] = []
       recourse str :: [a]
str@(a
s:[a]
ss) =
          [a] -> (([a], [a]) -> [a]) -> Maybe ([a], [a]) -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
             (a
s a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
recourse [a]
ss)
             (\([a]
src, [a]
dst) -> [a]
dst [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
recourse ([a] -> [a] -> [a]
forall b a. [b] -> [a] -> [a]
Match.drop [a]
src [a]
str))
             ((([a], [a]) -> Bool) -> [([a], [a])] -> Maybe ([a], [a])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (([a] -> [a] -> Bool) -> [a] -> [a] -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
str ([a] -> Bool) -> (([a], [a]) -> [a]) -> ([a], [a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], [a]) -> [a]
forall a b. (a, b) -> a
fst) [([a], [a])]
dict)
   in  [a] -> [a]
recourse

propMultiReplaceSingle :: Eq a => [a] -> [a] -> [a] -> Bool
propMultiReplaceSingle :: [a] -> [a] -> [a] -> Bool
propMultiReplaceSingle [a]
src [a]
dst [a]
x =
   [a] -> [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace [a]
src [a]
dst [a]
x [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [([a], [a])] -> [a] -> [a]
forall a. Eq a => [([a], [a])] -> [a] -> [a]
multiReplace [([a]
src,[a]
dst)] [a]
x


-- * Lists of lists

{- |
Transform

> [[00,01,02,...],          [[00],
>  [10,11,12,...],   -->     [10,01],
>  [20,21,22,...],           [20,11,02],
>  ...]                      ...]

With @concat . shear@ you can perform a Cantor diagonalization,
that is an enumeration of all elements of the sub-lists
where each element is reachable within a finite number of steps.
It is also useful for polynomial multiplication (convolution).
-}
shear :: [[a]] -> [[a]]
shear :: [[a]] -> [[a]]
shear =
   ([Maybe a] -> [a]) -> [[Maybe a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes ([[Maybe a]] -> [[a]]) -> ([[a]] -> [[Maybe a]]) -> [[a]] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   [[Maybe a]] -> [[Maybe a]]
forall a. [[a]] -> [[a]]
shearTranspose ([[Maybe a]] -> [[Maybe a]])
-> ([[a]] -> [[Maybe a]]) -> [[a]] -> [[Maybe a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   [[a]] -> [[Maybe a]]
forall a. [[a]] -> [[Maybe a]]
transposeFill

transposeFill :: [[a]] -> [[Maybe a]]
transposeFill :: [[a]] -> [[Maybe a]]
transposeFill =
   ([[a]] -> Maybe ([Maybe a], [[a]])) -> [[a]] -> [[Maybe a]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\[[a]]
xs ->
      Bool -> ([Maybe a], [[a]]) -> Maybe ([Maybe a], [[a]])
forall a. Bool -> a -> Maybe a
toMaybe (Bool -> Bool
not ([[a]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[a]]
xs))
         (([[a]] -> [[a]]) -> ([Maybe a], [[a]]) -> ([Maybe a], [[a]])
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
Rev.dropWhile [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (([Maybe a], [[a]]) -> ([Maybe a], [[a]]))
-> ([Maybe a], [[a]]) -> ([Maybe a], [[a]])
forall a b. (a -> b) -> a -> b
$ [[a]] -> ([Maybe a], [[a]])
forall a. [[a]] -> ([Maybe a], [[a]])
unzipCons [[a]]
xs))

unzipCons :: [[a]] -> ([Maybe a], [[a]])
unzipCons :: [[a]] -> ([Maybe a], [[a]])
unzipCons =
   [(Maybe a, [a])] -> ([Maybe a], [[a]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Maybe a, [a])] -> ([Maybe a], [[a]]))
-> ([[a]] -> [(Maybe a, [a])]) -> [[a]] -> ([Maybe a], [[a]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ([a] -> (Maybe a, [a])) -> [[a]] -> [(Maybe a, [a])]
forall a b. (a -> b) -> [a] -> [b]
map ((\Maybe (a, [a])
my -> (((a, [a]) -> a) -> Maybe (a, [a]) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, [a]) -> a
forall a b. (a, b) -> a
fst Maybe (a, [a])
my, [a] -> ((a, [a]) -> [a]) -> Maybe (a, [a]) -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (a, [a]) -> [a]
forall a b. (a, b) -> b
snd Maybe (a, [a])
my)) (Maybe (a, [a]) -> (Maybe a, [a]))
-> ([a] -> Maybe (a, [a])) -> [a] -> (Maybe a, [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (a, [a])
forall a. [a] -> Maybe (a, [a])
viewL)

{- |
It's somehow inverse to zipCons,
but the difficult part is,
that a trailing empty list on the right side is suppressed.
-}
unzipConsSkew :: [[a]] -> ([Maybe a], [[a]])
unzipConsSkew :: [[a]] -> ([Maybe a], [[a]])
unzipConsSkew =
   let aux :: [a] -> [[a]] -> ([Maybe a], [[a]])
aux [] [] = ([],[])  -- one empty list at the end will be removed
       aux [a]
xs [[a]]
ys = ([[a]] -> [[a]]) -> ([Maybe a], [[a]]) -> ([Maybe a], [[a]])
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ([a]
xs[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:) (([Maybe a], [[a]]) -> ([Maybe a], [[a]]))
-> ([Maybe a], [[a]]) -> ([Maybe a], [[a]])
forall a b. (a -> b) -> a -> b
$ [[a]] -> ([Maybe a], [[a]])
prep [[a]]
ys
       prep :: [[a]] -> ([Maybe a], [[a]])
prep =
          ([Maybe a], [[a]]) -> ([Maybe a], [[a]])
forall a b. (a, b) -> (a, b)
forcePair (([Maybe a], [[a]]) -> ([Maybe a], [[a]]))
-> ([[a]] -> ([Maybe a], [[a]])) -> [[a]] -> ([Maybe a], [[a]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ([Maybe a], [[a]])
-> ([a] -> [[a]] -> ([Maybe a], [[a]]))
-> [[a]]
-> ([Maybe a], [[a]])
forall b a. b -> (a -> [a] -> b) -> [a] -> b
switchL ([],[])
             (\[a]
y [[a]]
ys ->
                let my :: Maybe (a, [a])
my = [a] -> Maybe (a, [a])
forall a. [a] -> Maybe (a, [a])
viewL [a]
y
                in  ([Maybe a] -> [Maybe a])
-> ([Maybe a], [[a]]) -> ([Maybe a], [[a]])
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (((a, [a]) -> a) -> Maybe (a, [a]) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, [a]) -> a
forall a b. (a, b) -> a
fst Maybe (a, [a])
my Maybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
:) (([Maybe a], [[a]]) -> ([Maybe a], [[a]]))
-> ([Maybe a], [[a]]) -> ([Maybe a], [[a]])
forall a b. (a -> b) -> a -> b
$
                    [a] -> [[a]] -> ([Maybe a], [[a]])
aux ([a] -> ((a, [a]) -> [a]) -> Maybe (a, [a]) -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (a, [a]) -> [a]
forall a b. (a, b) -> b
snd Maybe (a, [a])
my) [[a]]
ys)
   in  [[a]] -> ([Maybe a], [[a]])
forall a. [[a]] -> ([Maybe a], [[a]])
prep



shear' :: [[a]] -> [[a]]
shear' :: [[a]] -> [[a]]
shear' xs :: [[a]]
xs@([a]
_:[[a]]
_) =
   let ([a]
y:[[a]]
ys,[[a]]
zs) = [([a], [a])] -> ([[a]], [[a]])
forall a b. [(a, b)] -> ([a], [b])
unzip (([a] -> ([a], [a])) -> [[a]] -> [([a], [a])]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1) [[a]]
xs)
       zipConc :: [[a]] -> [[a]] -> [[a]]
zipConc ([a]
a:[[a]]
as) ([a]
b:[[a]]
bs) = ([a]
a[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
b) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]] -> [[a]]
zipConc [[a]]
as [[a]]
bs
       zipConc [] [[a]]
bs = [[a]]
bs
       zipConc [[a]]
as [] = [[a]]
as
   in  [a]
y [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]] -> [[a]]
forall a. [[a]] -> [[a]] -> [[a]]
zipConc [[a]]
ys ([[a]] -> [[a]]
forall a. [[a]] -> [[a]]
shear' (([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
Rev.dropWhile [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[a]]
zs))
              {- Dropping trailing empty lists is necessary,
                 otherwise finite lists are filled with empty lists. -}
shear' [] = []

{- |
Transform

> [[00,01,02,...],          [[00],
>  [10,11,12,...],   -->     [01,10],
>  [20,21,22,...],           [02,11,20],
>  ...]                      ...]

It's like 'shear' but the order of elements in the sub list is reversed.
Its implementation seems to be more efficient than that of 'shear'.
If the order does not matter, better choose 'shearTranspose'.
-}
shearTranspose :: [[a]] -> [[a]]
shearTranspose :: [[a]] -> [[a]]
shearTranspose =
   ([a] -> [[a]] -> [[a]]) -> [[a]] -> [[a]] -> [[a]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [a] -> [[a]] -> [[a]]
forall a. [a] -> [[a]] -> [[a]]
zipConsSkew []

zipConsSkew :: [a] -> [[a]] -> [[a]]
zipConsSkew :: [a] -> [[a]] -> [[a]]
zipConsSkew [a]
xt [[a]]
yss =
   ([a] -> [[a]] -> [[a]]) -> ([a], [[a]]) -> [[a]]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) (([a], [[a]]) -> [[a]]) -> ([a], [[a]]) -> [[a]]
forall a b. (a -> b) -> a -> b
$
   case [a]
xt of
      a
x:[a]
xs -> ([a
x], [a] -> [[a]] -> [[a]]
forall a. [a] -> [[a]] -> [[a]]
zipCons [a]
xs [[a]]
yss)
      [] -> ([], [[a]]
yss)

{- |
zipCons is like @zipWith (:)@ but it keeps lists which are too long
This version works also for @zipCons something undefined@.
-}
zipCons :: [a] -> [[a]] -> [[a]]
zipCons :: [a] -> [[a]] -> [[a]]
zipCons (a
x:[a]
xs) [[a]]
yt =
   let ([a]
y,[[a]]
ys) = ([a], [[a]])
-> ([a] -> [[a]] -> ([a], [[a]])) -> [[a]] -> ([a], [[a]])
forall b a. b -> (a -> [a] -> b) -> [a] -> b
switchL ([],[]) (,) [[a]]
yt
   in  (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
y) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]] -> [[a]]
forall a. [a] -> [[a]] -> [[a]]
zipCons [a]
xs [[a]]
ys
zipCons [] [[a]]
ys = [[a]]
ys

-- | zipCons' is like @zipWith (:)@ but it keeps lists which are too long
zipCons' :: [a] -> [[a]] -> [[a]]
zipCons' :: [a] -> [[a]] -> [[a]]
zipCons' (a
x:[a]
xs) ([a]
y:[[a]]
ys) = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
y) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]] -> [[a]]
forall a. [a] -> [[a]] -> [[a]]
zipCons' [a]
xs [[a]]
ys
zipCons' [] [[a]]
ys = [[a]]
ys
zipCons' [a]
xs [] = (a -> [a]) -> [a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[]) [a]
xs


{- |
Operate on each combination of elements of the first and the second list.
In contrast to the list instance of 'Monad.liftM2'
in holds the results in a list of lists.
It holds
@concat (outerProduct f xs ys)  ==  liftM2 f xs ys@
-}
outerProduct :: (a -> b -> c) -> [a] -> [b] -> [[c]]
outerProduct :: (a -> b -> c) -> [a] -> [b] -> [[c]]
outerProduct a -> b -> c
f [a]
xs [b]
ys = (a -> [c]) -> [a] -> [[c]]
forall a b. (a -> b) -> [a] -> [b]
map (((b -> c) -> [b] -> [c]) -> [b] -> (b -> c) -> [c]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (b -> c) -> [b] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map [b]
ys ((b -> c) -> [c]) -> (a -> b -> c) -> a -> [c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c
f) [a]
xs



-- * Miscellaneous

{- |
Take while first predicate holds,
then continue taking while second predicate holds,
and so on.
-}
takeWhileMulti :: [a -> Bool] -> [a] -> [a]
takeWhileMulti :: [a -> Bool] -> [a] -> [a]
takeWhileMulti [] [a]
_  = []
takeWhileMulti [a -> Bool]
_  [] = []
takeWhileMulti aps :: [a -> Bool]
aps@(a -> Bool
p:[a -> Bool]
ps) axs :: [a]
axs@(a
x:[a]
xs) =
   if a -> Bool
p a
x
      then a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a -> Bool] -> [a] -> [a]
forall a. [a -> Bool] -> [a] -> [a]
takeWhileMulti [a -> Bool]
aps [a]
xs
      else [a -> Bool] -> [a] -> [a]
forall a. [a -> Bool] -> [a] -> [a]
takeWhileMulti [a -> Bool]
ps [a]
axs

takeWhileMulti' :: [a -> Bool] -> [a] -> [a]
takeWhileMulti' :: [a -> Bool] -> [a] -> [a]
takeWhileMulti' [a -> Bool]
ps [a]
xs =
   (([a], [a]) -> [a]) -> [([a], [a])] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([a], [a]) -> [a]
forall a b. (a, b) -> a
fst ([([a], [a])] -> [([a], [a])]
forall a. [a] -> [a]
tail
      ((([a], [a]) -> (a -> Bool) -> ([a], [a]))
-> ([a], [a]) -> [a -> Bool] -> [([a], [a])]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (((a -> Bool) -> [a] -> ([a], [a]))
-> [a] -> (a -> Bool) -> ([a], [a])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ([a] -> (a -> Bool) -> ([a], [a]))
-> (([a], [a]) -> [a]) -> ([a], [a]) -> (a -> Bool) -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], [a]) -> [a]
forall a b. (a, b) -> b
snd) ([a]
forall a. HasCallStack => a
undefined,[a]
xs) [a -> Bool]
ps))

propTakeWhileMulti :: (Eq a) => [a -> Bool] -> [a] -> Bool
propTakeWhileMulti :: [a -> Bool] -> [a] -> Bool
propTakeWhileMulti [a -> Bool]
ps [a]
xs =
   [a -> Bool] -> [a] -> [a]
forall a. [a -> Bool] -> [a] -> [a]
takeWhileMulti [a -> Bool]
ps [a]
xs [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a -> Bool] -> [a] -> [a]
forall a. [a -> Bool] -> [a] -> [a]
takeWhileMulti' [a -> Bool]
ps [a]
xs

{-
Debug.QuickCheck.quickCheck (propTakeWhileMulti [(<0), (>0), odd, even, ((0::Int)==)])
-}

{- |
This is a combination of 'foldl'' and 'foldr'
in the sense of 'propFoldl'r'.
It is however more efficient
because it avoids storing the whole input list as a result of sharing.
-}
foldl'r, foldl'rStrict, foldl'rNaive ::
   (b -> a -> b) -> b -> (c -> d -> d) -> d -> [(a,c)] -> (b,d)
foldl'r :: (b -> a -> b) -> b -> (c -> d -> d) -> d -> [(a, c)] -> (b, d)
foldl'r b -> a -> b
f b
b0 c -> d -> d
g d
d0 =
--   (\(k,d1) -> (k b0, d1)) .
   ((b -> b) -> b) -> (b -> b, d) -> (b, d)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst ((b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$b
b0) ((b -> b, d) -> (b, d))
-> ([(a, c)] -> (b -> b, d)) -> [(a, c)] -> (b, d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ((a, c) -> (b -> b, d) -> (b -> b, d))
-> (b -> b, d) -> [(a, c)] -> (b -> b, d)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(a
a,c
c) ~(b -> b
k,d
d) -> (\b
b -> b -> b
k (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
b a
a, c -> d -> d
g c
c d
d)) (b -> b
forall a. a -> a
id,d
d0)

foldl'rStrict :: (b -> a -> b) -> b -> (c -> d -> d) -> d -> [(a, c)] -> (b, d)
foldl'rStrict b -> a -> b
f b
b0 c -> d -> d
g d
d0 =
   ((b -> b) -> b) -> (b -> b, d) -> (b, d)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst ((b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$b
b0) ((b -> b, d) -> (b, d))
-> ([(a, c)] -> (b -> b, d)) -> [(a, c)] -> (b, d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ((a, c) -> (b -> b, d) -> (b -> b, d))
-> (b -> b, d) -> [(a, c)] -> (b -> b, d)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(a
a,c
c) ~(b -> b
k,d
d) -> ((,) ((b -> b) -> d -> (b -> b, d)) -> (b -> b) -> d -> (b -> b, d)
forall a b. (a -> b) -> a -> b
$! (\b
b -> b -> b
k (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
b a
a)) (d -> (b -> b, d)) -> d -> (b -> b, d)
forall a b. (a -> b) -> a -> b
$! c -> d -> d
g c
c d
d) (b -> b
forall a. a -> a
id,d
d0)

foldl'rNaive :: (b -> a -> b) -> b -> (c -> d -> d) -> d -> [(a, c)] -> (b, d)
foldl'rNaive b -> a -> b
f b
b c -> d -> d
g d
d [(a, c)]
xs =
   ([a] -> b, [c] -> d) -> ([a], [c]) -> (b, d)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair ((b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> a -> b
f b
b, (c -> d -> d) -> d -> [c] -> d
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr c -> d -> d
g d
d) (([a], [c]) -> (b, d)) -> ([a], [c]) -> (b, d)
forall a b. (a -> b) -> a -> b
$ [(a, c)] -> ([a], [c])
forall a b. [(a, b)] -> ([a], [b])
unzip [(a, c)]
xs

propFoldl'r :: (Eq b, Eq d) =>
   (b -> a -> b) -> b -> (c -> d -> d) -> d -> [(a,c)] -> Bool
propFoldl'r :: (b -> a -> b) -> b -> (c -> d -> d) -> d -> [(a, c)] -> Bool
propFoldl'r b -> a -> b
f b
b c -> d -> d
g d
d [(a, c)]
xs =
   (b -> a -> b) -> b -> (c -> d -> d) -> d -> [(a, c)] -> (b, d)
forall b a c d.
(b -> a -> b) -> b -> (c -> d -> d) -> d -> [(a, c)] -> (b, d)
foldl'r b -> a -> b
f b
b c -> d -> d
g d
d [(a, c)]
xs (b, d) -> (b, d) -> Bool
forall a. Eq a => a -> a -> Bool
== (b -> a -> b) -> b -> (c -> d -> d) -> d -> [(a, c)] -> (b, d)
forall b a c d.
(b -> a -> b) -> b -> (c -> d -> d) -> d -> [(a, c)] -> (b, d)
foldl'rNaive b -> a -> b
f b
b c -> d -> d
g d
d [(a, c)]
xs

{-
The results in GHCi surprise:

*List.HT> mapSnd last $ foldl'rNaive (+) (0::Integer) (:) "" $ replicate 1000000 (1,'a')
(1000000,'a')
(0.44 secs, 141032856 bytes)

*List.HT> mapSnd last $ foldl'r (+) (0::Integer) (:) "" $ replicate 1000000 (1,'a')
(1000000,'a')
(2.64 secs, 237424948 bytes)
-}

{-
Debug.QuickCheck.quickCheck (\b d -> propFoldl'r (+) (b::Int) (++) (d::[Int]))
-}


lengthAtLeast :: Int -> [a] -> Bool
lengthAtLeast :: Int -> [a] -> Bool
lengthAtLeast Int
n =
   if Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
0
     then Bool -> [a] -> Bool
forall a b. a -> b -> a
const Bool
True
     else Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> Bool) -> ([a] -> [a]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

lengthAtMost :: Int -> [a] -> Bool
lengthAtMost :: Int -> [a] -> Bool
lengthAtMost Int
n =
   if Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0
     then Bool -> [a] -> Bool
forall a b. a -> b -> a
const Bool
False
     else [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> Bool) -> ([a] -> [a]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n

lengthAtMost0 :: Int -> [a] -> Bool
lengthAtMost0 :: Int -> [a] -> Bool
lengthAtMost0 Int
n = (Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=) (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> ([a] -> [a]) -> [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

{-
Iterate until elements start to cycle.
This implementation is inspired by Elements of Programming
but I am still not satisfied
where the iteration actually stops.
-}
iterateUntilCycle :: (Eq a) => (a -> a) -> a -> [a]
iterateUntilCycle :: (a -> a) -> a -> [a]
iterateUntilCycle a -> a
f a
a =
   let as :: [a]
as = (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate a -> a
f a
a
   in  (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ ((a, a) -> a) -> [(a, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> a
forall a b. (a, b) -> a
fst ([(a, a)] -> [a]) -> [(a, a)] -> [a]
forall a b. (a -> b) -> a -> b
$
       ((a, a) -> Bool) -> [(a, a)] -> [(a, a)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((a -> a -> Bool) -> (a, a) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=)) ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
forall a b. (a -> b) -> a -> b
$
       [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([a] -> [a]
forall a. [a] -> [a]
tail [a]
as) ((a -> [a]) -> [a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\a
ai->[a
ai,a
ai]) [a]
as)

{-
iterateUntilCycleQ :: (Eq a) => (a -> a) -> a -> [a]
iterateUntilCycleQ f a =
   let as = tail $ iterate f a
   in  (a:) $ map fst $
       takeWhile (uncurry (/=)) $
       zip as (downsample2 (tail as))
-}

iterateUntilCycleP :: (Eq a) => (a -> a) -> a -> [a]
iterateUntilCycleP :: (a -> a) -> a -> [a]
iterateUntilCycleP a -> a
f a
a =
   let as :: [a]
as = (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate a -> a
f a
a
   in  ((a, (a, a)) -> a) -> [(a, (a, a))] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, (a, a)) -> a
forall a b. (a, b) -> a
fst ([(a, (a, a))] -> [a]) -> [(a, (a, a))] -> [a]
forall a b. (a -> b) -> a -> b
$
       ((a, (a, a)) -> Bool) -> [(a, (a, a))] -> [(a, (a, a))]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(a
a1,(a
a20,a
a21)) -> a
a1a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=a
a20 Bool -> Bool -> Bool
&& a
a1a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=a
a21) ([(a, (a, a))] -> [(a, (a, a))]) -> [(a, (a, a))] -> [(a, (a, a))]
forall a b. (a -> b) -> a -> b
$
       [a] -> [(a, a)] -> [(a, (a, a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as ([a] -> [(a, a)]
forall t. [t] -> [(t, t)]
pairs ([a] -> [a]
forall a. [a] -> [a]
tail [a]
as))

pairs :: [t] -> [(t, t)]
pairs :: [t] -> [(t, t)]
pairs [] = []
pairs (t
_:[]) = [Char] -> [(t, t)]
forall a. HasCallStack => [Char] -> a
error [Char]
"pairs: odd number of elements"
pairs (t
x0:t
x1:[t]
xs) = (t
x0,t
x1) (t, t) -> [(t, t)] -> [(t, t)]
forall a. a -> [a] -> [a]
: [t] -> [(t, t)]
forall t. [t] -> [(t, t)]
pairs [t]
xs


{- | rotate left -}
rotate, rotate', rotate'' :: Int -> [a] -> [a]
rotate :: Int -> [a] -> [a]
rotate Int
n [a]
x =
   [a] -> [a] -> [a]
forall b a. [b] -> [a] -> [a]
Match.take [a]
x (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
n ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x)) ([a] -> [a]
forall a. [a] -> [a]
cycle [a]
x))

{- | more efficient implementation of rotate' -}
rotate' :: Int -> [a] -> [a]
rotate' Int
n [a]
x =
   ([a] -> [a] -> [a]) -> ([a], [a]) -> [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (([a] -> [a] -> [a]) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++))
           (Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
n ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x)) [a]
x)

rotate'' :: Int -> [a] -> [a]
rotate'' Int
n [a]
x =
   [a] -> [a] -> [a]
forall b a. [b] -> [a] -> [a]
Match.take [a]
x (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n ([a] -> [a]
forall a. [a] -> [a]
cycle [a]
x))

propRotate :: Eq a => Int -> [a] -> Bool
propRotate :: Int -> [a] -> Bool
propRotate Int
n [a]
x =
   Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
rotate Int
n [a]
x [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
rotate'  Int
n [a]
x Bool -> Bool -> Bool
&&
   Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
rotate Int
n [a]
x [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
rotate'' Int
n [a]
x
{- Debug.QuickCheck.quickCheck
      (\n x -> n>=0 Debug.QuickCheck.==>
          List.HT.propRotate n ((0::Int):x)) -}

{-|
Given two lists that are ordered
(i.e. @p x y@ holds for subsequent @x@ and @y@)
'mergeBy' them into a list that is ordered, again.
-}
mergeBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
mergeBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
mergeBy = (a -> a -> Bool) -> [a] -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
Key.mergeBy


allEqual :: Eq a => [a] -> Bool
allEqual :: [a] -> Bool
allEqual = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> ([a] -> [Bool]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Bool) -> [a] -> [Bool]
forall a b. (a -> a -> b) -> [a] -> [b]
mapAdjacent a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

isAscending :: (Ord a) => [a] -> Bool
isAscending :: [a] -> Bool
isAscending = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> ([a] -> [Bool]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [Bool]
forall a. Ord a => [a] -> [Bool]
isAscendingLazy

isAscendingLazy :: (Ord a) => [a] -> [Bool]
isAscendingLazy :: [a] -> [Bool]
isAscendingLazy = (a -> a -> Bool) -> [a] -> [Bool]
forall a b. (a -> a -> b) -> [a] -> [b]
mapAdjacent a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)

{- |
This function combines every pair of neighbour elements
in a list with a certain function.
-}
mapAdjacent :: (a -> a -> b) -> [a] -> [b]
mapAdjacent :: (a -> a -> b) -> [a] -> [b]
mapAdjacent a -> a -> b
f [a]
xs = (a -> a -> b) -> [a] -> [a] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> b
f [a]
xs ([a] -> [a]
forall a. [a] -> [a]
tail [a]
xs)

{- |
<http://mail.haskell.org/libraries/2016-April/026912.html>
-}
mapAdjacentPointfree :: (a -> a -> b) -> [a] -> [b]
mapAdjacentPointfree :: (a -> a -> b) -> [a] -> [b]
mapAdjacentPointfree a -> a -> b
f = (a -> a -> b) -> [a] -> [a] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> b
f ([a] -> [a] -> [b]) -> ([a] -> [a]) -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> [a]
forall a. [a] -> [a]
tail


{- |
> mapAdjacent f a0 [(a1,b1), (a2,b2), (a3,b3)]
> ==
> [f a0 a1 b1, f a1 a2 b2, f a2 a3 b3]
-}
mapAdjacent1 :: (a -> a -> b -> c) -> a -> [(a,b)] -> [c]
mapAdjacent1 :: (a -> a -> b -> c) -> a -> [(a, b)] -> [c]
mapAdjacent1 a -> a -> b -> c
f a
a [(a, b)]
xs =
   (a -> (a, b) -> c) -> [a] -> [(a, b)] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
a0 (a
a1,b
b) -> a -> a -> b -> c
f a
a0 a
a1 b
b) (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ((a, b) -> a) -> [(a, b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> a
forall a b. (a, b) -> a
fst [(a, b)]
xs) [(a, b)]
xs


{- |
Enumerate without Enum context.
For Enum equivalent to enumFrom.
-}
range :: Num a => Int -> [a]
range :: Int -> [a]
range Int
n = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n ((a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a -> a -> a
forall a. Num a => a -> a -> a
+a
1) a
0)


{-# INLINE padLeft #-}
padLeft :: a -> Int -> [a] -> [a]
padLeft :: a -> Int -> [a] -> [a]
padLeft  a
c Int
n [a]
xs = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) a
c [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs


{-# INLINE padRight #-}
padRight, padRight1 :: a -> Int -> [a] -> [a]
padRight :: a -> Int -> [a] -> [a]
padRight  a
c Int
n [a]
xs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a -> [a]
forall a. a -> [a]
repeat a
c
padRight1 :: a -> Int -> [a] -> [a]
padRight1 a
c Int
n [a]
xs = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) a
c

{- |
For an associative operation @op@ this computes
   @iterateAssociative op a = iterate (op a) a@
but it is even faster than @map (powerAssociative op a a) [0..]@
since it shares temporary results.

The idea is:
From the list @map (powerAssociative op a a) [0,(2*n)..]@
we compute the list @map (powerAssociative op a a) [0,n..]@,
and iterate that until @n==1@.
-}
iterateAssociative :: (a -> a -> a) -> a -> [a]
iterateAssociative :: (a -> a -> a) -> a -> [a]
iterateAssociative a -> a -> a
op a
a =
   (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
pow [a]
xs -> a
pow a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> [a]) -> [a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\a
x -> [a
x, a -> a -> a
op a
x a
pow]) [a]
xs)
         [a]
forall a. HasCallStack => a
undefined ((a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (\a
x -> a -> a -> a
op a
x a
x) a
a)

{- |
This is equal to 'iterateAssociative'.
The idea is the following:
The list we search is the fixpoint of the function:
"Square all elements of the list,
then spread it and fill the holes with successive numbers
of their left neighbour."
This also preserves log n applications per value.
However it has a space leak,
because for the value with index @n@
all elements starting at @div n 2@ must be kept.
-}
iterateLeaky :: (a -> a -> a) -> a -> [a]
iterateLeaky :: (a -> a -> a) -> a -> [a]
iterateLeaky a -> a -> a
op a
x =
   let merge :: [a] -> [a] -> [a]
merge (a
a:[a]
as) [a]
b = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge [a]
b [a]
as
       merge [a]
_ [a]
_ = [Char] -> [a]
forall a. HasCallStack => [Char] -> a
error [Char]
"iterateLeaky: an empty list cannot occur"
       sqrs :: [a]
sqrs = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\a
y -> a -> a -> a
op a
y a
y) [a]
z
       z :: [a]
z = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
merge [a]
sqrs ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
op a
x) [a]
sqrs)
   in  [a]
z