{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Relude.Extra.Foldable1
( Foldable1 (..)
, foldl1'
, average1
) where
import Relude hiding (Product (..), Sum (..))
import Relude.Extra.Newtype ((#.))
import Data.Functor.Product (Product (..))
import Data.Functor.Sum (Sum (..))
import GHC.TypeLits (ErrorMessage (..), TypeError)
import qualified Data.Semigroup as SG
class Foldable f => Foldable1 f where
{-# MINIMAL foldMap1 #-}
foldMap1 :: Semigroup m => (a -> m) -> f a -> m
fold1 :: Semigroup m => f m -> m
fold1 = forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 forall a. a -> a
id
foldr1 :: (a -> b -> b) -> b -> f a -> b
foldr1 a -> b -> b
f b
accum f a
as = forall a. Endo a -> a -> a
appEndo (forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 (forall a. (a -> a) -> Endo a
Endo forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> b -> b
f) f a
as) b
accum
{-# INLINE foldr1 #-}
toNonEmpty :: f a -> NonEmpty a
toNonEmpty = forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 (forall a. a -> [a] -> NonEmpty a
:|[])
head1 :: f a -> a
head1 = forall a. First a -> a
SG.getFirst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 forall a. a -> First a
SG.First
last1 :: f a -> a
last1 = forall a. Last a -> a
SG.getLast forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 forall a. a -> Last a
SG.Last
maximum1 :: Ord a => f a -> a
maximum1 = forall a. Max a -> a
SG.getMax forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 forall a. a -> Max a
SG.Max
minimum1 :: Ord a => f a -> a
minimum1 = forall a. Min a -> a
SG.getMin forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 forall a. a -> Min a
SG.Min
maximumOn1 :: Ord b => (a -> b) -> f a -> a
maximumOn1 a -> b
f = forall (f :: * -> *) b a.
(Foldable1 f, Ord b) =>
(a -> b) -> f a -> a
maximumOn1 a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Foldable1 f => f a -> NonEmpty a
toNonEmpty
{-# INLINE maximumOn1 #-}
minimumOn1 :: Ord b => (a -> b) -> f a -> a
minimumOn1 a -> b
f = forall (f :: * -> *) b a.
(Foldable1 f, Ord b) =>
(a -> b) -> f a -> a
minimumOn1 a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Foldable1 f => f a -> NonEmpty a
toNonEmpty
{-# INLINE minimumOn1 #-}
instance Foldable1 NonEmpty where
fold1 :: Semigroup m => NonEmpty m -> m
fold1 :: forall m. Semigroup m => NonEmpty m -> m
fold1 = forall m. Semigroup m => NonEmpty m -> m
sconcat
{-# INLINE fold1 #-}
foldMap1 :: forall m a . Semigroup m => (a -> m) -> NonEmpty a -> m
foldMap1 :: forall m a. Semigroup m => (a -> m) -> NonEmpty a -> m
foldMap1 a -> m
f (a
a :| [a]
as) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (a -> m) -> a -> m
go a -> m
f [a]
as a
a
where
go :: a -> (a -> m) -> a -> m
go :: a -> (a -> m) -> a -> m
go a
b a -> m
g a
x = a -> m
f a
x forall a. Semigroup a => a -> a -> a
<> a -> m
g a
b
{-# INLINE foldMap1 #-}
toNonEmpty :: NonEmpty a -> NonEmpty a
toNonEmpty :: forall a. NonEmpty a -> NonEmpty a
toNonEmpty = forall a. a -> a
id
{-# INLINE toNonEmpty #-}
head1, last1 :: NonEmpty a -> a
head1 :: forall a. NonEmpty a -> a
head1 = forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head
last1 :: forall a. NonEmpty a -> a
last1 = forall (f :: * -> *) a. IsNonEmpty f a a "last" => f a -> a
last
{-# INLINE head1 #-}
{-# INLINE last1 #-}
maximum1, minimum1 :: Ord a => NonEmpty a -> a
maximum1 :: forall a. Ord a => NonEmpty a -> a
maximum1 = forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1' forall a. Ord a => a -> a -> a
max
minimum1 :: forall a. Ord a => NonEmpty a -> a
minimum1 = forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1' forall a. Ord a => a -> a -> a
min
{-# INLINE maximum1 #-}
{-# INLINE minimum1 #-}
maximumOn1 :: forall a b. Ord b => (a -> b) -> NonEmpty a -> a
maximumOn1 :: forall a b. Ord b => (a -> b) -> NonEmpty a -> a
maximumOn1 a -> b
func = forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1' forall a b. (a -> b) -> a -> b
$ a -> a -> a
cmpOn
where
cmpOn :: a -> a -> a
cmpOn :: a -> a -> a
cmpOn a
a a
b = case a -> b
func a
a forall a. Ord a => a -> a -> Ordering
`compare` a -> b
func a
b of
Ordering
GT -> a
a
Ordering
_ -> a
b
{-# INLINE maximumOn1 #-}
minimumOn1 :: forall a b. Ord b => (a -> b) -> NonEmpty a -> a
minimumOn1 :: forall a b. Ord b => (a -> b) -> NonEmpty a -> a
minimumOn1 a -> b
func = forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1' forall a b. (a -> b) -> a -> b
$ a -> a -> a
cmpOn
where
cmpOn :: a -> a -> a
cmpOn :: a -> a -> a
cmpOn a
a a
b = case a -> b
func a
a forall a. Ord a => a -> a -> Ordering
`compare` a -> b
func a
b of
Ordering
LT -> a
a
Ordering
_ -> a
b
{-# INLINE minimumOn1 #-}
instance Foldable1 Identity where
foldMap1 :: Semigroup m => (a -> m) -> Identity a -> m
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Identity a -> m
foldMap1 = coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE foldMap1 #-}
fold1 :: Semigroup m => Identity m -> m
fold1 :: forall m. Semigroup m => Identity m -> m
fold1 = coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE fold1 #-}
toNonEmpty :: Identity a -> NonEmpty a
toNonEmpty :: forall a. Identity a -> NonEmpty a
toNonEmpty = (forall a. a -> [a] -> NonEmpty a
:|[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE toNonEmpty #-}
head1 :: Identity a -> a
head1 :: forall a. Identity a -> a
head1 = coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE head1 #-}
last1 :: Identity a -> a
last1 :: forall a. Identity a -> a
last1 = coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE last1 #-}
maximum1 :: Ord a => Identity a -> a
maximum1 :: forall a. Ord a => Identity a -> a
maximum1 = coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE maximum1 #-}
minimum1 :: Ord a => Identity a -> a
minimum1 :: forall a. Ord a => Identity a -> a
minimum1 = coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE minimum1 #-}
maximumOn1 :: Ord b => (a -> b) -> Identity a -> a
maximumOn1 :: forall b a. Ord b => (a -> b) -> Identity a -> a
maximumOn1 = forall a b. a -> b -> a
const coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE maximumOn1 #-}
minimumOn1 :: Ord b => (a -> b) -> Identity a -> a
minimumOn1 :: forall b a. Ord b => (a -> b) -> Identity a -> a
minimumOn1 = forall a b. a -> b -> a
const coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE minimumOn1 #-}
instance Foldable1 ((,) c) where
foldMap1 :: Semigroup m => (a -> m) -> (c, a) -> m
foldMap1 :: forall m a. Semigroup m => (a -> m) -> (c, a) -> m
foldMap1 a -> m
f = a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a. (c, a) -> a
snd
{-# INLINE foldMap1 #-}
fold1 :: Semigroup m => (c, m) -> m
fold1 :: forall m. Semigroup m => (c, m) -> m
fold1 = forall c a. (c, a) -> a
snd
{-# INLINE fold1 #-}
toNonEmpty :: (c, a) -> NonEmpty a
toNonEmpty :: forall a. (c, a) -> NonEmpty a
toNonEmpty (c
_, a
y) = (a
y forall a. a -> [a] -> NonEmpty a
:| [])
{-# INLINE toNonEmpty #-}
head1, last1 :: (c, a) -> a
head1 :: forall a. (c, a) -> a
head1 = forall c a. (c, a) -> a
snd
last1 :: forall a. (c, a) -> a
last1 = forall c a. (c, a) -> a
snd
{-# INLINE head1 #-}
{-# INLINE last1 #-}
maximum1, minimum1 :: Ord a => (c, a) -> a
maximum1 :: forall a. Ord a => (c, a) -> a
maximum1 = forall c a. (c, a) -> a
snd
minimum1 :: forall a. Ord a => (c, a) -> a
minimum1 = forall c a. (c, a) -> a
snd
{-# INLINE maximum1 #-}
{-# INLINE minimum1 #-}
maximumOn1, minimumOn1 :: Ord b => (a -> b) -> (c, a) -> a
maximumOn1 :: forall b a. Ord b => (a -> b) -> (c, a) -> a
maximumOn1 = forall a b. a -> b -> a
const forall c a. (c, a) -> a
snd
minimumOn1 :: forall b a. Ord b => (a -> b) -> (c, a) -> a
minimumOn1 = forall a b. a -> b -> a
const forall c a. (c, a) -> a
snd
{-# INLINE maximumOn1 #-}
{-# INLINE minimumOn1 #-}
instance (Foldable1 f, Foldable1 g) => Foldable1 (Compose f g) where
foldMap1 :: Semigroup m => (a -> m) -> Compose f g a -> m
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Compose f g a -> m
foldMap1 a -> m
f = forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 (forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 a -> m
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
{-# INLINE foldMap1 #-}
head1 :: Compose f g a -> a
head1 :: forall a. Compose f g a -> a
head1 = forall (f :: * -> *) a. Foldable1 f => f a -> a
head1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Foldable1 f => f a -> a
head1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
{-# INLINE head1 #-}
last1 :: Compose f g a -> a
last1 :: forall a. Compose f g a -> a
last1 = forall (f :: * -> *) a. Foldable1 f => f a -> a
last1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Foldable1 f => f a -> a
last1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
{-# INLINE last1 #-}
instance (Foldable1 f, Foldable1 g) => Foldable1 (Product f g) where
foldMap1 :: Semigroup m => (a -> m) -> Product f g a -> m
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Product f g a -> m
foldMap1 a -> m
f (Pair f a
a g a
b) = forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 a -> m
f f a
a forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 a -> m
f g a
b
{-# INLINE foldMap1 #-}
instance (Foldable1 f, Foldable1 g) => Foldable1 (Sum f g) where
foldMap1 :: Semigroup m => (a -> m) -> Sum f g a -> m
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Sum f g a -> m
foldMap1 a -> m
f (InL f a
x) = forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 a -> m
f f a
x
foldMap1 a -> m
f (InR g a
y) = forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 a -> m
f g a
y
{-# INLINE foldMap1 #-}
type family IsListError :: Constraint
where
IsListError = TypeError
( 'Text "The methods of the 'Foldable1' type class work with non-empty containers."
':$$: 'Text "However, one of the 'Foldable1' functions is applied to the List."
':$$: 'Text ""
':$$: 'Text "Possible fixes:"
':$$: 'Text " * Replace []"
':$$: 'Text " with one of the: 'NonEmpty', 'Identity', '(c,)', 'Compose f g', 'Product f g', 'Sum f g'"
':$$: 'Text " * Or use 'Foldable' class for your own risk."
)
instance IsListError => Foldable1 [] where
foldMap1 :: Semigroup m => (a -> m) -> [a] -> m
foldMap1 :: forall m a. Semigroup m => (a -> m) -> [a] -> m
foldMap1 a -> m
_ [a]
_ = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Unreachable list instance of Foldable1"
foldr1 :: (Foldable1 f) => (a -> b -> b) -> b -> f a -> b
foldr1 :: forall (f :: * -> *) a b.
Foldable1 f =>
(a -> b -> b) -> b -> f a -> b
foldr1 a -> b -> b
_ b
_ = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Unreachable list instance of Foldable1"
fold1 :: Semigroup m => [m] -> m
fold1 :: forall m. Semigroup m => [m] -> m
fold1 [m]
_ = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Unreachable list instance of Foldable1"
toNonEmpty :: [a] -> NonEmpty a
toNonEmpty :: forall a. [a] -> NonEmpty a
toNonEmpty [a]
_ = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Unreachable list instance of Foldable1"
head1 :: [a] -> a
head1 :: forall a. [a] -> a
head1 [a]
_ = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Unreachable list instance of Foldable1"
last1 :: [a] -> a
last1 :: forall a. [a] -> a
last1 [a]
_ = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Unreachable list instance of Foldable1"
maximum1 :: Ord a => [a] -> a
maximum1 :: forall a. Ord a => [a] -> a
maximum1 [a]
_ = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Unreachable list instance of Foldable1"
minimum1 :: Ord a => [a] -> a
minimum1 :: forall a. Ord a => [a] -> a
minimum1 [a]
_ = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Unreachable list instance of Foldable1"
maximumOn1 :: (Ord b, Foldable1 f) => (a -> b) -> f a -> a
maximumOn1 :: forall b (f :: * -> *) a.
(Ord b, Foldable1 f) =>
(a -> b) -> f a -> a
maximumOn1 a -> b
_ f a
_ = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Unreachable list instance of Foldable1"
minimumOn1 :: (Ord b, Foldable1 f) => (a -> b) -> f a -> a
minimumOn1 :: forall b (f :: * -> *) a.
(Ord b, Foldable1 f) =>
(a -> b) -> f a -> a
minimumOn1 a -> b
_ f a
_ = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Unreachable list instance of Foldable1"
foldl1' :: (a -> a -> a) -> NonEmpty a -> a
foldl1' :: forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1' a -> a -> a
_ (a
x :| []) = a
x
foldl1' a -> a -> a
f (a
x :| (a
y:[a]
ys)) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
f (a -> a -> a
f a
x a
y) [a]
ys
{-# INLINE foldl1' #-}
average1 :: forall a f . (Foldable1 f, Fractional a) => f a -> a
average1 :: forall a (f :: * -> *). (Foldable1 f, Fractional a) => f a -> a
average1 = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Fractional a => a -> a -> a
(/) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(!a
total, !a
count) a
x -> (a
total forall a. Num a => a -> a -> a
+ a
x, a
count forall a. Num a => a -> a -> a
+ a
1)) (a
0,a
0)
{-# INLINE average1 #-}