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 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 = zipWith (flip const)

{- | Drop as many elements as the first list is long -}
drop :: [b] -> [a] -> [a]
drop xs ys =
   -- catMaybes (
   map fromJust (dropWhile isNothing
      (zipWith (toMaybe . null) (iterate laxTail xs) ys))

drop' :: [b] -> [a] -> [a]
drop' xs ys =
   map snd (dropWhile (not . null . fst) (zip (iterate laxTail xs) ys))

drop'' :: [b] -> [a] -> [a]
drop'' xs ys =
   snd $ head $
   dropWhile (not . null . fst) $
   zip (iterate laxTail xs) (iterate laxTail ys)

{- |
Shares suffix with input, that is it is more efficient.
-}
drop''' :: [b] -> [a] -> [a]
drop''' (_:xs) (_:ys) = drop''' xs ys
drop''' _ ys = ys

{- |
@laxTail [] = []@
-}
laxTail :: [a] -> [a]
laxTail = List.drop 1

propTake :: (Eq a) => [b] -> [a] -> Bool
propTake xs ys =
   take xs ys == List.take (length xs) ys

propDrop :: (Eq a) => [b] -> [a] -> Bool
propDrop xs ys =
   drop xs ys == List.drop (length xs) ys

propDropAlt :: (Eq a) => [b] -> [a] -> Bool
propDropAlt xs ys =
   drop xs ys == drop'   xs ys &&
   drop xs ys == drop''  xs ys &&
   drop xs ys == drop''' xs ys

propTakeDrop :: (Eq a) => [b] -> [a] -> Bool
propTakeDrop xs ys =
   take xs ys ++ drop xs ys == ys


splitAt :: [b] -> [a] -> ([a],[a])
splitAt nt xt =
   forcePair $
   case (nt,xt) of
      (_:ns, x:xs) -> mapFst (x:) $ splitAt ns xs
      (_, xs) -> ([],xs)

propSplitAt :: (Eq a) => [b] -> [a] -> Bool
propSplitAt xs ys =
   (take xs ys, drop xs ys) == splitAt xs 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 (_:xs) (_:ys) = compareLength xs ys
compareLength []     []     = EQ
compareLength (_:_)  []     = GT
compareLength []     (_:_)  = LT

{- | efficient like compareLength, but without pattern matching -}
compareLength' :: [a] -> [b] -> Ordering
compareLength' xs ys =
   let boolList zs = replicate zs True ++ repeat False
   -- we rely in the order of Bool constructors False and True here
   in  uncurry compare (head
          (dropWhile (uncurry (&&)) (zip (boolList xs) (boolList ys))))

compareLength'' :: [a] -> [b] -> Ordering
compareLength'' xs ys =
   compare (length xs) (length ys)

propCompareLength :: [Integer] -> [Int] -> Bool
propCompareLength xs ys =
   compareLength xs ys == compareLength'  xs ys &&
   compareLength xs ys == compareLength'' xs 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 [] _ = True
lessOrEqualLength _ [] = False
lessOrEqualLength (_:xs) (_:ys) = lessOrEqualLength xs ys

{- |
Returns the shorter one of two lists.
It works also for infinite lists as much as possible.
E.g. @shortList (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 xs ys =
   let useX = lessOrEqualLength xs ys
   in  zipWith (if' useX) xs ys

{- |
This 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 xs ys =
   let useX = lessOrEqualLength xs ys
   in  zipWith (\x y -> if' (x==y || useX) x y) xs ys


replicate :: [a] -> b -> [b]
replicate xs y =
   take xs (repeat y)