1{-# LANGUAGE NoImplicitPrelude #-}
2{-# LANGUAGE Safe #-}
3
4module Protolude.List
5  ( head,
6    ordNub,
7    sortOn,
8    list,
9    product,
10    sum,
11    groupBy,
12  )
13where
14
15import Control.Applicative (pure)
16import Data.Foldable (Foldable, foldl', foldr)
17import Data.Function ((.))
18import Data.Functor (fmap)
19import Data.List (groupBy, sortBy)
20import Data.Maybe (Maybe (Nothing))
21import Data.Ord (Ord, comparing)
22import qualified Data.Set as Set
23import GHC.Num ((*), (+), Num)
24
25head :: (Foldable f) => f a -> Maybe a
26head = foldr (\x _ -> pure x) Nothing
27
28sortOn :: (Ord o) => (a -> o) -> [a] -> [a]
29sortOn = sortBy . comparing
30
31-- O(n * log n)
32ordNub :: (Ord a) => [a] -> [a]
33ordNub l = go Set.empty l
34  where
35    go _ [] = []
36    go s (x : xs) =
37      if x `Set.member` s
38        then go s xs
39        else x : go (Set.insert x s) xs
40
41list :: [b] -> (a -> b) -> [a] -> [b]
42list def f xs = case xs of
43  [] -> def
44  _ -> fmap f xs
45
46{-# INLINE product #-}
47product :: (Foldable f, Num a) => f a -> a
48product = foldl' (*) 1
49
50{-# INLINE sum #-}
51sum :: (Foldable f, Num a) => f a -> a
52sum = foldl' (+) 0
53