module Data.List.Extra(
module Data.List,
lower, upper, trim, trimStart, trimEnd, dropAround, word1, drop1,
list, uncons, unsnoc, cons, snoc,
groupSort, groupSortOn, nubOn, groupOn, sortOn,
repeatedly, for,
disjoint, allSame, anySame,
dropEnd, takeEnd, breakEnd, spanEnd, dropWhileEnd, dropWhileEnd', takeWhileEnd, stripSuffix,
concatUnzip, concatUnzip3,
merge, mergeBy, replace, wordsBy, linesBy, firstJust,
breakOn, breakOnEnd, splitOn, split, chunksOf
) where
import Data.List
import Data.Function
import Data.Ord
import Data.Char
import Data.Tuple.Extra
repeatedly :: ([a] -> (b, [a])) -> [a] -> [b]
repeatedly f [] = []
repeatedly f as = b : repeatedly f as'
where (b, as') = f as
for :: [a] -> (a -> b) -> [b]
for = flip map
disjoint :: Eq a => [a] -> [a] -> Bool
disjoint xs = null . intersect xs
anySame :: Eq a => [a] -> Bool
anySame xs = length xs /= length (nub xs)
allSame :: Eq a => [a] -> Bool
allSame xs = length (nub xs) <= 1
list :: b -> (a -> [a] -> b) -> [a] -> b
list nil cons [] = nil
list nil cons (x:xs) = cons x xs
uncons :: [a] -> Maybe (a, [a])
uncons [] = Nothing
uncons (x:xs) = Just (x,xs)
unsnoc :: [a] -> Maybe ([a], a)
unsnoc [] = Nothing
unsnoc [x] = Just ([], x)
unsnoc (x:xs) = Just (x:a, b)
where Just (a,b) = unsnoc xs
cons :: a -> [a] -> [a]
cons = (:)
snoc :: [a] -> a -> [a]
snoc xs x = xs ++ [x]
takeEnd :: Int -> [a] -> [a]
takeEnd i = reverse . take i . reverse
dropEnd :: Int -> [a] -> [a]
dropEnd i = reverse . drop i . reverse
concatUnzip :: [([a], [b])] -> ([a], [b])
concatUnzip = (concat *** concat) . unzip
concatUnzip3 :: [([a],[b],[c])] -> ([a],[b],[c])
concatUnzip3 xs = (concat a, concat b, concat c)
where (a,b,c) = unzip3 xs
takeWhileEnd :: (a -> Bool) -> [a] -> [a]
takeWhileEnd f = reverse . takeWhile f . reverse
trim, trimStart, trimEnd :: String -> String
trimStart = dropWhile isSpace
trimEnd = dropWhileEnd isSpace
trim = dropAround isSpace
lower :: String -> String
lower = map toLower
upper :: String -> String
upper = map toUpper
dropAround :: (a -> Bool) -> [a] -> [a]
dropAround f = dropWhileEnd f . dropWhile f
word1 :: String -> (String, String)
word1 x = second (dropWhile isSpace) $ break isSpace $ dropWhile isSpace x
sortOn :: Ord b => (a -> b) -> [a] -> [a]
sortOn f = sortBy (comparing f)
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn f = groupBy ((==) `on` f)
nubOn :: Eq b => (a -> b) -> [a] -> [a]
nubOn f = nubBy ((==) `on` f)
groupSort :: Ord k => [(k, v)] -> [(k, [v])]
groupSort = groupSortOn id
groupSortOn :: Ord a => (k -> a) -> [(k, v)] -> [(k, [v])]
groupSortOn f = map (\x -> (fst $ head x, map snd x)) . groupOn (f . fst) . sortOn (f . fst)
merge :: Ord a => [a] -> [a] -> [a]
merge = mergeBy compare
mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
mergeBy f xs [] = xs
mergeBy f [] ys = ys
mergeBy f (x:xs) (y:ys)
| f x y /= GT = x : mergeBy f xs (y:ys)
| otherwise = y : mergeBy f (x:xs) ys
replace :: Eq a => [a] -> [a] -> [a] -> [a]
replace from to xs | Just xs <- stripPrefix from xs = to ++ replace from to xs
replace from to (x:xs) = x : replace from to xs
replace from to [] = []
breakEnd :: (a -> Bool) -> [a] -> ([a], [a])
breakEnd f = swap . both reverse . break f . reverse
spanEnd :: (a -> Bool) -> [a] -> ([a], [a])
spanEnd f = breakEnd (not . f)
wordsBy :: (a -> Bool) -> [a] -> [[a]]
wordsBy f s = case dropWhile f s of
[] -> []
x:xs -> (x:w) : wordsBy f (drop1 z)
where (w,z) = break f xs
linesBy :: (a -> Bool) -> [a] -> [[a]]
linesBy f [] = []
linesBy f s = cons $ case break f s of
(l, s) -> (l,) $ case s of
[] -> []
_:s -> linesBy f s
where
cons ~(h, t) = h : t
firstJust :: (a -> Maybe b) -> [a] -> Maybe b
firstJust p [] = Nothing
firstJust p (x:xs) = maybe (firstJust p xs) Just (p x)
drop1 :: [a] -> [a]
drop1 [] = []
drop1 (x:xs) = xs
breakOn :: Eq a => [a] -> [a] -> ([a], [a])
breakOn needle haystack | needle `isPrefixOf` haystack = ([], haystack)
breakOn needle [] = ([], [])
breakOn needle (x:xs) = first (x:) $ breakOn needle xs
breakOnEnd :: Eq a => [a] -> [a] -> ([a], [a])
breakOnEnd needle haystack = (reverse *** reverse) $ swap $ breakOn (reverse needle) (reverse haystack)
splitOn :: Eq a => [a] -> [a] -> [[a]]
splitOn [] _ = error "splitOn, needle may not be empty"
splitOn _ [] = [[]]
splitOn needle haystack = a : if null b then [] else splitOn needle $ drop (length needle) b
where (a,b) = breakOn needle haystack
split :: (a -> Bool) -> [a] -> [[a]]
split f [] = [[]]
split f (x:xs) | f x = [] : split f xs
split f (x:xs) | y:ys <- split f xs = (x:y) : ys
#if __GLASGOW_HASKELL__ < 704
dropWhileEnd :: (a -> Bool) -> [a] -> [a]
dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []
#endif
dropWhileEnd' :: (a -> Bool) -> [a] -> [a]
dropWhileEnd' p = foldr (\x xs -> if null xs && p x then [] else x : xs) []
stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
stripSuffix a b = fmap reverse $ stripPrefix (reverse a) (reverse b)
chunksOf :: Int -> [a] -> [[a]]
chunksOf i xs | i <= 0 = error $ "chunksOf, number must be positive, got " ++ show i
chunksOf i xs = repeatedly (splitAt i) xs