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 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) = compareLength xs ys compareLength [] [] = EQ compareLength (_:_) [] = GT compareLength [] (_:_) = LT {- | efficient like compareLength, but without pattern matching -} compareLength0 :: [a] -> [b] -> Ordering compareLength0 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)))) 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)