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)