module Data.List.Match.Private where

import Data.Maybe    (fromJust, isNothing, )
import Data.Maybe.HT (toMaybe, )
import Data.Tuple.HT (mapFst, )
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 -}
take :: [b] -> [a] -> [a]
take = flip (zipWith 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 (_:ns) (x:xs) =
   mapFst (x:) $ splitAt ns xs
splitAt _  [] = ([],[])
splitAt [] 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


{- |
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 = compareLength xs ys <= EQ
   in  zipWith (if' useX) xs ys


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