1module Data.List.Match.Private where 2 3import Data.Maybe (fromJust, isNothing, ) 4import Data.Maybe.HT (toMaybe, ) 5import Data.Tuple.HT (mapFst, forcePair, ) 6import Data.Bool.HT (if', ) 7 8import qualified Data.List as List 9 10import Control.Functor.HT (void, ) 11 12import Prelude hiding (take, drop, splitAt, replicate, ) 13 14 15{- | Make a list as long as another one -} 16{- 17@flip (zipWith const)@ is not as lazy, 18e.g. would be @take [] undefined = undefined@, 19but it should be @take [] undefined = []@. 20-} 21take :: [b] -> [a] -> [a] 22take = zipWith (flip const) 23 24{- | Drop as many elements as the first list is long -} 25drop :: [b] -> [a] -> [a] 26drop xs ys0 = 27 foldl (\ys _ -> laxTail ys) ys0 xs 28 29{- 30Shares suffix with input, 31that is it is more efficient than the implementations below. 32-} 33dropRec :: [b] -> [a] -> [a] 34dropRec (_:xs) (_:ys) = dropRec xs ys 35dropRec _ ys = ys 36 37drop0 :: [b] -> [a] -> [a] 38drop0 xs ys = 39 -- catMaybes ( 40 map fromJust (dropWhile isNothing 41 (zipWith (toMaybe . null) (iterate laxTail xs) ys)) 42 43drop1 :: [b] -> [a] -> [a] 44drop1 xs ys = 45 map snd (dropWhile (not . null . fst) (zip (iterate laxTail xs) ys)) 46 47drop2 :: [b] -> [a] -> [a] 48drop2 xs ys = 49 snd $ head $ 50 dropWhile (not . null . fst) $ 51 zip (iterate laxTail xs) (iterate laxTail ys) 52 53 54{- | 55@laxTail [] = []@ 56-} 57laxTail :: [a] -> [a] 58laxTail xt = case xt of [] -> []; _:xs -> xs 59 60laxTail0 :: [a] -> [a] 61laxTail0 = List.drop 1 62 63splitAt :: [b] -> [a] -> ([a],[a]) 64splitAt nt xt = 65 forcePair $ 66 case (nt,xt) of 67 (_:ns, x:xs) -> mapFst (x:) $ splitAt ns xs 68 (_, xs) -> ([],xs) 69 70 71takeRev :: [b] -> [a] -> [a] 72takeRev ys xs = drop (drop ys xs) xs 73 74dropRev :: [b] -> [a] -> [a] 75dropRev ys xs = take (drop ys xs) xs 76 77{- | 78Check whether two lists with different element types have equal length. 79It is equivalent to @length xs == length ys@ but more efficient. 80-} 81equalLength :: [a] -> [b] -> Bool 82equalLength xs ys = 83 void xs == void ys 84 85{- | 86Compare the length of two lists over different types. 87It is equivalent to @(compare (length xs) (length ys))@ 88but more efficient. 89-} 90compareLength :: [a] -> [b] -> Ordering 91compareLength xs ys = 92 compare (void xs) (void ys) 93 94{- | this one uses explicit recursion -} 95compareLength0 :: [a] -> [b] -> Ordering 96compareLength0 = 97 let recourse (_:xs) (_:ys) = recourse xs ys 98 recourse [] [] = EQ 99 recourse (_:_) [] = GT 100 recourse [] (_:_) = LT 101 in recourse 102 103{- | strict comparison -} 104compareLength1 :: [a] -> [b] -> Ordering 105compareLength1 xs ys = 106 compare (length xs) (length ys) 107 108{- | 109@lessOrEqualLength x y@ is almost the same as @compareLength x y <= EQ@, 110but @lessOrEqualLength [] undefined = True@, 111whereas @compareLength [] undefined <= EQ = undefined@. 112-} 113lessOrEqualLength :: [a] -> [b] -> Bool 114lessOrEqualLength [] _ = True 115lessOrEqualLength _ [] = False 116lessOrEqualLength (_:xs) (_:ys) = lessOrEqualLength xs ys 117 118{- | 119Returns the shorter one of two lists. 120It works also for infinite lists as much as possible. 121E.g. @shorterList (shorterList (repeat 1) (repeat 2)) [1,2,3]@ 122can be computed. 123The trick is, that the skeleton of the resulting list 124is constructed using 'zipWith' without touching the elements. 125The contents is then computed (only) if requested. 126-} 127shorterList :: [a] -> [a] -> [a] 128shorterList xs ys = 129 let useX = lessOrEqualLength xs ys 130 in zipWith (if' useX) xs ys 131 132{- | 133This is lazier than 'shorterList' in a different aspect: 134It returns a common prefix 135even if it is undefined, which list is the shorter one. 136However, it requires a proper 'Eq' instance 137and if elements are undefined, it may fail even earlier. 138-} 139shorterListEq :: (Eq a) => [a] -> [a] -> [a] 140shorterListEq xs ys = 141 let useX = lessOrEqualLength xs ys 142 in zipWith (\x y -> if' (x==y || useX) x y) xs ys 143 144 145{- | 146Specialisation of 'Data.Functor.$>'. 147-} 148replicate :: [a] -> b -> [b] 149replicate xs y = 150 take xs (repeat y) 151