module Extra.List
( consperse
, surround
, changePrefix
, dropPrefix
, cartesianProduct
, wordsBy
, empty
, sortByMapped
, sortByMappedM
, partitionM
, listIntersection
, isSublistOf
) where
import Control.Monad
import Data.List
consperse :: [a] -> [[a]] -> [a]
consperse s l = concat . intersperse s $ l
surround :: [a] -> [a] -> [[a]] -> [a]
surround prefix suffix items = concat $ map ((prefix ++) . (++ suffix)) items
changePrefix :: (Eq a) => [a] -> [a] -> [a] -> Maybe [a]
changePrefix old new s = maybe Nothing (Just . (new ++)) (dropPrefix old s)
dropPrefix :: (Eq a) => [a] -> [a] -> Maybe [a]
dropPrefix prefix s =
case isPrefixOf prefix s of
True -> Just (drop (length prefix) s)
False -> Nothing
cartesianProduct :: [[a]] -> [[a]]
cartesianProduct [] = []
cartesianProduct [xs] = map (: []) xs
cartesianProduct (xs : yss) =
distribute xs (cartesianProduct yss)
where distribute xs yss = concat (map (\ x -> map (x :) yss) xs)
wordsBy :: Eq a => (a -> Bool) -> [a] -> [[a]]
wordsBy p s =
case (break p s) of
(s, []) -> [s]
(h, t) -> h : wordsBy p (drop 1 t)
empty :: b -> ([a] -> b) -> [a] -> b
empty e _ [] = e
empty _ f l = f l
sortByMapped :: (a -> b) -> (b -> b -> Ordering) -> [a] -> [a]
sortByMapped f compare list =
map fst sorted
where
sorted = sortBy (\ (_, x) (_, y) -> compare x y) pairs
pairs = zip list (map f list)
sortByMappedM :: (a -> IO b) -> (b -> b -> Ordering) -> [a] -> IO [a]
sortByMappedM f compare list =
do
pairs <- mapM f list >>= return . (zip list)
let sorted = sortBy (\ (_, x) (_, y) -> compare x y) pairs
return (map fst sorted)
partitionM :: (Monad m) => (a -> m Bool) -> [a] -> m ([a], [a])
partitionM p xs =
foldM f ([], []) xs
where f (a, b) x = p x >>= (\ flag -> return $ if flag then (x : a, b) else (a, x : b))
listIntersection :: Eq a => [[a]] -> [a]
listIntersection [] = []
listIntersection (first : rest) = foldr intersect first rest
isSublistOf :: Eq a => [a] -> [a] -> Maybe Int
isSublistOf sub lst =
maybe Nothing (\ s -> Just (length s length sub))
(find (isSuffixOf sub) (inits lst))