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)