{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE Safe #-}

module Protolude.List
  ( head,
    ordNub,
    sortOn,
    list,
    product,
    sum,
    groupBy,
  )
where

import Control.Applicative (pure)
import Data.Foldable (Foldable, foldl', foldr)
import Data.Function ((.))
import Data.Functor (fmap)
import Data.List (groupBy, sortBy)
import Data.Maybe (Maybe (Nothing))
import Data.Ord (Ord, comparing)
import qualified Data.Set as Set
import GHC.Num ((*), (+), Num)

head :: (Foldable f) => f a -> Maybe a
head :: forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x Maybe a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x) forall a. Maybe a
Nothing

sortOn :: (Ord o) => (a -> o) -> [a] -> [a]
sortOn :: forall o a. Ord o => (a -> o) -> [a] -> [a]
sortOn = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing

-- O(n * log n)
ordNub :: (Ord a) => [a] -> [a]
ordNub :: forall a. Ord a => [a] -> [a]
ordNub [a]
l = forall {a}. Ord a => Set a -> [a] -> [a]
go forall a. Set a
Set.empty [a]
l
  where
    go :: Set a -> [a] -> [a]
go Set a
_ [] = []
    go Set a
s (a
x : [a]
xs) =
      if a
x forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
s
        then Set a -> [a] -> [a]
go Set a
s [a]
xs
        else a
x forall a. a -> [a] -> [a]
: Set a -> [a] -> [a]
go (forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
s) [a]
xs

list :: [b] -> (a -> b) -> [a] -> [b]
list :: forall b a. [b] -> (a -> b) -> [a] -> [b]
list [b]
def a -> b
f [a]
xs = case [a]
xs of
  [] -> [b]
def
  [a]
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f [a]
xs

{-# INLINE product #-}
product :: (Foldable f, Num a) => f a -> a
product :: forall (f :: * -> *) a. (Foldable f, Num a) => f a -> a
product = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Num a => a -> a -> a
(*) a
1

{-# INLINE sum #-}
sum :: (Foldable f, Num a) => f a -> a
sum :: forall (f :: * -> *) a. (Foldable f, Num a) => f a -> a
sum = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Num a => a -> a -> a
(+) a
0