Private.hs

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)


{- |
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. @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)