module Util.List
( safeHead, returnOnJustM, groupings, cartProd
, selections, safeSingleton, safeLast, appLast, modifyAt
, index
, concatMapM
, groupBy'
, orderBy
) where
import Data.Function (on)
import Data.List (elemIndex, sortBy, groupBy)
import Control.Arrow (second, (&&&))
safeHead :: [a] -> Maybe a
safeHead [] = Nothing
safeHead (x:_) = Just x
safeLast :: [a] -> Maybe a
safeLast = foldl (\_ a -> Just a) Nothing
appLast :: (a -> a) -> [a] -> [a]
appLast _ [] = []
appLast f [a] = [f a]
appLast f (x:xs) = x : appLast f xs
modifyAt :: Int -> (a -> a) -> [a] -> [a]
modifyAt _ _ [] = []
modifyAt n f (x:xs)
| n == 0 = f x : xs
| otherwise = x : modifyAt (n-1) f xs
safeSingleton :: [a] -> Maybe a
safeSingleton [a] = Just a
safeSingleton _ = Nothing
cartProd :: [a] -> [b] -> [(a,b)]
cartProd xs ys = do
x <- xs
y <- ys
return (x,y)
selections :: [a] -> [(a,[a])]
selections [] = []
selections (x:xs) = (x,xs) : map (second (x:)) (selections xs)
returnOnJustM :: (Monad m, Show a) => (a -> m (Maybe b)) -> [a] -> m (Maybe (b, [a]))
returnOnJustM _ [] = return Nothing
returnOnJustM f input =
returnAndRetain f [] input
where
returnAndRetain _ _ [] = return Nothing
returnAndRetain f old new@(x:xs) = do
fx <- f x
case fx of
Nothing -> returnAndRetain f (old ++ [x]) xs
Just b -> return $ Just (b, old ++ new)
groupings :: [a] -> [b] -> [[(a,b)]]
groupings [] _ = [[]]
groupings _ [] = [[]]
groupings (a:as) bs = concatMap (\(x,xs) -> map ((a,x):) $ groupings as xs) $ selections bs
index :: Eq a => [a] -> a -> Maybe Int
index list = flip elemIndex list
concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM f xs = concat <$> mapM f xs
groupBy' :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy' _ [] = []
groupBy' _ [x] = [[x]]
groupBy' predicate (x:y:xs)
| predicate x y = let sameGroup:diffGroups = groupBy' predicate (y:xs)
in (x:sameGroup):diffGroups
| otherwise = [x] : groupBy' predicate (y:xs)
orderBy :: (Ord b) => (a->b) -> [a] -> [(b,[a])]
orderBy attribute
= map (fst . head &&& map snd)
. groupBy ((==) `on` fst)
. sortBy (compare `on` fst)
. map (attribute &&& id)