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

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

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

    drop0 :: [b] -> [a] -> [a]
    drop0 xs ys =
       -- catMaybes (
       map fromJust (dropWhile isNothing
          (zipWith (toMaybe . null) (iterate laxTail xs) ys))

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

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

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

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

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

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

    dropRev :: [b] -> [a] -> [a]
    dropRev ys xs = take (drop ys xs) 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 xs ys =
       void xs == void 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 =
       compare (void xs) (void ys)

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

    {- | strict comparison -}
    compareLength1 :: [a] -> [b] -> Ordering
    compareLength1 xs ys =
       compare (length xs) (length 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. @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 xs ys =
       let useX = lessOrEqualLength xs ys
       in  zipWith (if' useX) xs 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 xs ys =
       let useX = lessOrEqualLength xs ys
       in  zipWith (\x y -> if' (x==y || useX) x y) xs ys

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