List.hs

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