module Data.List.Match.Private where

import Data.Maybe    (fromJust, isNothing, )
import Data.Maybe.HT (toMaybe, )
import Data.Tuple.HT (mapFst, forcePair, )
import Data.Bool.HT  (if', )

import qualified Data.List as List

import Control.Functor.HT (void, )

import Prelude hiding (take, drop, splitAt, replicate, )


{- | Make a list as long as another one -}
{-
@flip (zipWith const)@ is not as lazy,
e.g. would be @take [] undefined = undefined@,
but it should be @take [] undefined = []@.
-}
take :: [b] -> [a] -> [a]
take :: [b] -> [a] -> [a]
take = (b -> a -> a) -> [b] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((a -> b -> a) -> b -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> a
forall a b. a -> b -> a
const)

{- | Drop as many elements as the first list is long -}
drop :: [b] -> [a] -> [a]
drop :: [b] -> [a] -> [a]
drop xs :: [b]
xs ys0 :: [a]
ys0 =
   ([a] -> b -> [a]) -> [a] -> [b] -> [a]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ys :: [a]
ys _ -> [a] -> [a]
forall a. [a] -> [a]
laxTail [a]
ys) [a]
ys0 [b]
xs

{-
Shares suffix with input,
that is it is more efficient than the implementations below.
-}
dropRec :: [b] -> [a] -> [a]
dropRec :: [b] -> [a] -> [a]
dropRec (_:xs :: [b]
xs) (_:ys :: [a]
ys) = [b] -> [a] -> [a]
forall b a. [b] -> [a] -> [a]
dropRec [b]
xs [a]
ys
dropRec _ ys :: [a]
ys = [a]
ys

drop0 :: [b] -> [a] -> [a]
drop0 :: [b] -> [a] -> [a]
drop0 xs :: [b]
xs ys :: [a]
ys =
   -- catMaybes (
   (Maybe a -> a) -> [Maybe a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust ((Maybe a -> Bool) -> [Maybe a] -> [Maybe a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing
      (([b] -> a -> Maybe a) -> [[b]] -> [a] -> [Maybe a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Bool -> a -> Maybe a
forall a. Bool -> a -> Maybe a
toMaybe (Bool -> a -> Maybe a) -> ([b] -> Bool) -> [b] -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (([b] -> [b]) -> [b] -> [[b]]
forall a. (a -> a) -> a -> [a]
iterate [b] -> [b]
forall a. [a] -> [a]
laxTail [b]
xs) [a]
ys))

drop1 :: [b] -> [a] -> [a]
drop1 :: [b] -> [a] -> [a]
drop1 xs :: [b]
xs ys :: [a]
ys =
   (([b], a) -> a) -> [([b], a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ([b], a) -> a
forall a b. (a, b) -> b
snd ((([b], a) -> Bool) -> [([b], a)] -> [([b], a)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (([b], a) -> Bool) -> ([b], a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([b] -> Bool) -> (([b], a) -> [b]) -> ([b], a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([b], a) -> [b]
forall a b. (a, b) -> a
fst) ([[b]] -> [a] -> [([b], a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (([b] -> [b]) -> [b] -> [[b]]
forall a. (a -> a) -> a -> [a]
iterate [b] -> [b]
forall a. [a] -> [a]
laxTail [b]
xs) [a]
ys))

drop2 :: [b] -> [a] -> [a]
drop2 :: [b] -> [a] -> [a]
drop2 xs :: [b]
xs ys :: [a]
ys =
   ([b], [a]) -> [a]
forall a b. (a, b) -> b
snd (([b], [a]) -> [a]) -> ([b], [a]) -> [a]
forall a b. (a -> b) -> a -> b
$ [([b], [a])] -> ([b], [a])
forall a. [a] -> a
head ([([b], [a])] -> ([b], [a])) -> [([b], [a])] -> ([b], [a])
forall a b. (a -> b) -> a -> b
$
   (([b], [a]) -> Bool) -> [([b], [a])] -> [([b], [a])]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (([b], [a]) -> Bool) -> ([b], [a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([b] -> Bool) -> (([b], [a]) -> [b]) -> ([b], [a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([b], [a]) -> [b]
forall a b. (a, b) -> a
fst) ([([b], [a])] -> [([b], [a])]) -> [([b], [a])] -> [([b], [a])]
forall a b. (a -> b) -> a -> b
$
   [[b]] -> [[a]] -> [([b], [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip (([b] -> [b]) -> [b] -> [[b]]
forall a. (a -> a) -> a -> [a]
iterate [b] -> [b]
forall a. [a] -> [a]
laxTail [b]
xs) (([a] -> [a]) -> [a] -> [[a]]
forall a. (a -> a) -> a -> [a]
iterate [a] -> [a]
forall a. [a] -> [a]
laxTail [a]
ys)


{- |
@laxTail [] = []@
-}
laxTail :: [a] -> [a]
laxTail :: [a] -> [a]
laxTail xt :: [a]
xt = case [a]
xt of [] -> []; _:xs :: [a]
xs -> [a]
xs

laxTail0 :: [a] -> [a]
laxTail0 :: [a] -> [a]
laxTail0 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
List.drop 1

splitAt :: [b] -> [a] -> ([a],[a])
splitAt :: [b] -> [a] -> ([a], [a])
splitAt nt :: [b]
nt xt :: [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
$
   case ([b]
nt,[a]
xt) of
      (_:ns :: [b]
ns, x :: a
x:xs :: [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
$ [b] -> [a] -> ([a], [a])
forall b a. [b] -> [a] -> ([a], [a])
splitAt [b]
ns [a]
xs
      (_, xs :: [a]
xs) -> ([],[a]
xs)


takeRev :: [b] -> [a] -> [a]
takeRev :: [b] -> [a] -> [a]
takeRev ys :: [b]
ys xs :: [a]
xs = [a] -> [a] -> [a]
forall b a. [b] -> [a] -> [a]
drop ([b] -> [a] -> [a]
forall b a. [b] -> [a] -> [a]
drop [b]
ys [a]
xs) [a]
xs

dropRev :: [b] -> [a] -> [a]
dropRev :: [b] -> [a] -> [a]
dropRev ys :: [b]
ys xs :: [a]
xs = [a] -> [a] -> [a]
forall b a. [b] -> [a] -> [a]
take ([b] -> [a] -> [a]
forall b a. [b] -> [a] -> [a]
drop [b]
ys [a]
xs) [a]
xs

{- |
Check whether two lists with different element types have equal length.
It is equivalent to @length xs == length ys@ but more efficient.
-}
equalLength :: [a] -> [b] -> Bool
equalLength :: [a] -> [b] -> Bool
equalLength xs :: [a]
xs ys :: [b]
ys =
   [a] -> [()]
forall (f :: * -> *) a. Functor f => f a -> f ()
void [a]
xs [()] -> [()] -> Bool
forall a. Eq a => a -> a -> Bool
== [b] -> [()]
forall (f :: * -> *) a. Functor f => f a -> f ()
void [b]
ys

{- |
Compare the length of two lists over different types.
It is equivalent to @(compare (length xs) (length ys))@
but more efficient.
-}
compareLength :: [a] -> [b] -> Ordering
compareLength :: [a] -> [b] -> Ordering
compareLength xs :: [a]
xs ys :: [b]
ys =
   [()] -> [()] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([a] -> [()]
forall (f :: * -> *) a. Functor f => f a -> f ()
void [a]
xs) ([b] -> [()]
forall (f :: * -> *) a. Functor f => f a -> f ()
void [b]
ys)

{- | this one uses explicit recursion -}
compareLength0 :: [a] -> [b] -> Ordering
compareLength0 :: [a] -> [b] -> Ordering
compareLength0 =
   let recourse :: [a] -> [a] -> Ordering
recourse (_:xs :: [a]
xs) (_:ys :: [a]
ys) = [a] -> [a] -> Ordering
recourse [a]
xs [a]
ys
       recourse []     []     = Ordering
EQ
       recourse (_:_)  []     = Ordering
GT
       recourse []     (_:_)  = Ordering
LT
   in  [a] -> [b] -> Ordering
forall a a. [a] -> [a] -> Ordering
recourse

{- | strict comparison -}
compareLength1 :: [a] -> [b] -> Ordering
compareLength1 :: [a] -> [b] -> Ordering
compareLength1 xs :: [a]
xs ys :: [b]
ys =
   Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) ([b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
ys)

{- |
@lessOrEqualLength x y@ is almost the same as @compareLength x y <= EQ@,
but @lessOrEqualLength [] undefined  =  True@,
whereas @compareLength [] undefined <= EQ  =  undefined@.
-}
lessOrEqualLength :: [a] -> [b] -> Bool
lessOrEqualLength :: [a] -> [b] -> Bool
lessOrEqualLength [] _ = Bool
True
lessOrEqualLength _ [] = Bool
False
lessOrEqualLength (_:xs :: [a]
xs) (_:ys :: [b]
ys) = [a] -> [b] -> Bool
forall a b. [a] -> [b] -> Bool
lessOrEqualLength [a]
xs [b]
ys

{- |
Returns the shorter one of two lists.
It works also for infinite lists as much as possible.
E.g. @shorterList (shorterList (repeat 1) (repeat 2)) [1,2,3]@
can be computed.
The trick is, that the skeleton of the resulting list
is constructed using 'zipWith' without touching the elements.
The contents is then computed (only) if requested.
-}
shorterList :: [a] -> [a] -> [a]
shorterList :: [a] -> [a] -> [a]
shorterList xs :: [a]
xs ys :: [a]
ys =
   let useX :: Bool
useX = [a] -> [a] -> Bool
forall a b. [a] -> [b] -> Bool
lessOrEqualLength [a]
xs [a]
ys
   in  (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Bool -> a -> a -> a
forall a. Bool -> a -> a -> a
if' Bool
useX) [a]
xs [a]
ys

{- |
This is lazier than 'shorterList' in a different aspect:
It returns a common prefix
even if it is undefined, which list is the shorter one.
However, it requires a proper 'Eq' instance
and if elements are undefined, it may fail even earlier.
-}
shorterListEq :: (Eq a) => [a] -> [a] -> [a]
shorterListEq :: [a] -> [a] -> [a]
shorterListEq xs :: [a]
xs ys :: [a]
ys =
   let useX :: Bool
useX = [a] -> [a] -> Bool
forall a b. [a] -> [b] -> Bool
lessOrEqualLength [a]
xs [a]
ys
   in  (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\x :: a
x y :: a
y -> Bool -> a -> a -> a
forall a. Bool -> a -> a -> a
if' (a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
y Bool -> Bool -> Bool
|| Bool
useX) a
x a
y) [a]
xs [a]
ys


{- |
Specialisation of 'Data.Functor.$>'.
-}
replicate :: [a] -> b -> [b]
replicate :: [a] -> b -> [b]
replicate xs :: [a]
xs y :: b
y =
   [a] -> [b] -> [b]
forall b a. [b] -> [a] -> [a]
take [a]
xs (b -> [b]
forall a. a -> [a]
repeat b
y)