module Core.Data.List
( deleteBy'
, deleteFirstsBy'
, (!?)
, (?:)
, (|>)
, maybeHead
, maybeLast
, overHead
, overLast
, dropEnd
, strip
, removeOddIdxs
, mapEvenOddIdxs
, zipPadS
, zipPadM
, zipPadLeftS
, zipPadLeftM
, zipPadWith
, splitPrefixBy
, isPermBy
, overlapsBy
) where
import Data.Bifunctor
import Data.Semigroup as S
import Data.Monoid as M
import Data.List
-- | 'deleteBy' from 'Data.List', but with a more generic type.
deleteBy' :: (a -> b -> Bool) -> a -> [b] -> [b]
deleteBy' _ _ [] = []
deleteBy' (=?=) x (y : ys)
| x =?= y = ys
| otherwise = y : deleteBy' (=?=) x ys
-- | 'deleteFirstsBy' from 'Data.List', but with a more generic type,
-- strict left-fold, and different argument ordering.
deleteFirstsBy' :: (a -> b -> Bool) -> [a] -> [b] -> [b]
deleteFirstsBy' (=?=) = flip $ foldl' $ flip $ deleteBy' (=?=)
-- | Gets the element at the index, or 'Nothing' if the list isn't large
-- enough. Fails if the index is negative.
(!?) :: [a] -> Int -> Maybe a
xs !? idx
| idx < length xs = Just $ xs !! idx
| otherwise = Nothing
-- | Conses if 'Just'.
(?:) :: Maybe a -> [a] -> [a]
Nothing ?: xs = xs
Just x ?: xs = x : xs
-- | Append an element.
(|>) :: [a] -> a -> [a]
[] |> y = [y]
(x : xs) |> y = x : (xs |> y)
-- | The head, if nonempty, otherwise nothing.
maybeHead :: [a] -> Maybe a
maybeHead [] = Nothing
maybeHead (x : _) = Just x
-- | The last item, if nonempty, otherwise nothing.
maybeLast :: [a] -> Maybe a
maybeLast [] = Nothing
maybeLast [x] = Just x
maybeLast (_ : x2 : xs) = maybeLast $ x2 : xs
-- | Transforms the first item in the list.
-- If the list is empty, does nothing.
overHead :: (a -> a) -> [a] -> [a]
overHead _ [] = []
overHead f (x : xs) = f x : xs
-- | Transforms the last item in the list.
-- If the list is empty, does nothing.
overLast :: (a -> a) -> [a] -> [a]
overLast _ [] = []
overLast f [x] = [f x]
overLast f (x : x2 : xs) = x : overLast f (x2 : xs)
-- | Removes @n@ elements from the end of the list.
dropEnd :: Int -> [a] -> [a]
dropEnd n = reverse . drop n . reverse
-- | Removes items at the start and end of the list which satisfy the
-- predicate.
strip :: (a -> Bool) -> [a] -> [a]
strip f = dropWhileEnd f . dropWhile f
-- | Transforms the items at index 0, 2, 4, etc.
-- with the first transformer, and those at 1, 3, 5, etc.
-- with the second.
mapEvenOddIdxs :: (a -> b) -> (a -> b)
-> [a] -> [b]
mapEvenOddIdxs _ _ [] = []
mapEvenOddIdxs fe _ [x] = [fe x]
mapEvenOddIdxs fe fo (xe : xo : xs)
= fe xe : fo xo : mapEvenOddIdxs fe fo xs
-- | Removes the items at index 1, 3, 5, etc.
-- Technically removes the second, fourth, etc.
-- but "odd" because indices are 0-based.
removeOddIdxs :: [a] -> [a]
removeOddIdxs [] = []
removeOddIdxs [x] = [x]
removeOddIdxs (xe : _ : xs) = xe : removeOddIdxs xs
-- | Zips the lists by appending elements. Won't discard elements at the
-- end of the longer list (so the result is as long as the longer list).
zipPadS :: (Semigroup a) => [a] -> [a] -> [a]
[] `zipPadS` [] = []
xs `zipPadS` [] = xs
[] `zipPadS` ys = ys
(x : xs) `zipPadS` (y : ys) = (x S.<> y) : (xs `zipPadS` ys)
-- | Zips the lists by appending elements. Won't discard elements at the
-- end of the longer list (so the result is as long as the longer list).
zipPadM :: (Monoid a) => [a] -> [a] -> [a]
[] `zipPadM` [] = []
xs `zipPadM` [] = xs
[] `zipPadM` ys = ys
(x : xs) `zipPadM` (y : ys) = (x M.<> y) : (xs `zipPadM` ys)
-- | Zips the lists by \prepending\ elements. The result is as long as
-- the longer list.
zipPadLeftS :: (Semigroup a) => [a] -> [a] -> [a]
xs `zipPadLeftS` ys = reverse $ reverse xs `zipPadS` reverse ys
-- | Zips the lists by \prepending\ elements. The result is as long as
-- the longer list.
zipPadLeftM :: (Monoid a) => [a] -> [a] -> [a]
xs `zipPadLeftM` ys = reverse $ reverse xs `zipPadM` reverse ys
-- | Zips the lists, appending 'mempty's to the shorter list instead of
-- discarding elements from the longer list (so the result is as long as
-- the longer list).
zipPadWith :: (Monoid a, Monoid b) => (a -> b -> c) -> [a] -> [b] -> [c]
zipPadWith _ [] [] = []
zipPadWith f (x : xs) [] = f x mempty : zipPadWith f xs []
zipPadWith f [] (y : ys) = f mempty y : zipPadWith f [] ys
zipPadWith f (x : xs) (y : ys) = f x y : zipPadWith f xs ys
-- | If every element in the first list matches the second according to
-- the given predicate, returns the matched items in the second and the
-- rest of the second. Otherwise returns 'Nothing'.
splitPrefixBy :: (a -> b -> Bool) -> [a] -> [b] -> Maybe ([b], [b])
splitPrefixBy _ [] x = Just ([], x)
splitPrefixBy _ (_ : _) [] = Nothing
splitPrefixBy f (pre : pres) (x : xs)
| not $ f pre x = Nothing
| otherwise = (first (x :)) <$> splitPrefixBy f pres xs
-- | Whether the lists share all elements, using the equality test.
isPermBy :: (a -> b -> Bool) -> [a] -> [b] -> Bool
isPermBy (=?=) xs ys = all ((`all` ys) . (=?=)) xs
-- | Whether the lists share any elements, using the equality test.
overlapsBy :: (a -> b -> Bool) -> [a] -> [b] -> Bool
overlapsBy (=?=) xs ys = any ((`any` ys) . (=?=)) xs