{-# 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 = (m -> m) -> f m -> m
forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 m -> m
forall a. a -> a
id
foldr1 :: (a -> b -> b) -> b -> f a -> b
foldr1 a -> b -> b
f b
accum f a
as = Endo b -> b -> b
forall a. Endo a -> a -> a
appEndo ((a -> Endo b) -> f a -> Endo b
forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 ((b -> b) -> Endo b
forall a. (a -> a) -> Endo a
Endo ((b -> b) -> Endo b) -> (a -> b -> b) -> a -> Endo b
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 = (a -> NonEmpty a) -> f a -> NonEmpty a
forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 (a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|[])
head1 :: f a -> a
head1 = First a -> a
forall a. First a -> a
SG.getFirst (First a -> a) -> (f a -> First a) -> f a -> a
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (a -> First a) -> f a -> First a
forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 a -> First a
forall a. a -> First a
SG.First
last1 :: f a -> a
last1 = Last a -> a
forall a. Last a -> a
SG.getLast (Last a -> a) -> (f a -> Last a) -> f a -> a
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (a -> Last a) -> f a -> Last a
forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 a -> Last a
forall a. a -> Last a
SG.Last
maximum1 :: Ord a => f a -> a
maximum1 = Max a -> a
forall a. Max a -> a
SG.getMax (Max a -> a) -> (f a -> Max a) -> f a -> a
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (a -> Max a) -> f a -> Max a
forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 a -> Max a
forall a. a -> Max a
SG.Max
minimum1 :: Ord a => f a -> a
minimum1 = Min a -> a
forall a. Min a -> a
SG.getMin (Min a -> a) -> (f a -> Min a) -> f a -> a
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (a -> Min a) -> f a -> Min a
forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 a -> Min a
forall a. a -> Min a
SG.Min
maximumOn1 :: Ord b => (a -> b) -> f a -> a
maximumOn1 a -> b
f = (a -> b) -> NonEmpty a -> a
forall (f :: * -> *) b a.
(Foldable1 f, Ord b) =>
(a -> b) -> f a -> a
maximumOn1 a -> b
f (NonEmpty a -> a) -> (f a -> NonEmpty a) -> f a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> NonEmpty a
forall (f :: * -> *) a. Foldable1 f => f a -> NonEmpty a
toNonEmpty
{-# INLINE maximumOn1 #-}
minimumOn1 :: Ord b => (a -> b) -> f a -> a
minimumOn1 a -> b
f = (a -> b) -> NonEmpty a -> a
forall (f :: * -> *) b a.
(Foldable1 f, Ord b) =>
(a -> b) -> f a -> a
minimumOn1 a -> b
f (NonEmpty a -> a) -> (f a -> NonEmpty a) -> f a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> NonEmpty a
forall (f :: * -> *) a. Foldable1 f => f a -> NonEmpty a
toNonEmpty
{-# INLINE minimumOn1 #-}
instance Foldable1 NonEmpty where
fold1 :: Semigroup m => NonEmpty m -> m
fold1 :: NonEmpty m -> m
fold1 = NonEmpty m -> m
forall m. Semigroup m => NonEmpty m -> m
sconcat
{-# INLINE fold1 #-}
foldMap1 :: forall m a . Semigroup m => (a -> m) -> NonEmpty a -> m
foldMap1 :: (a -> m) -> NonEmpty a -> m
foldMap1 a -> m
f (a
a :| [a]
as) = (a -> (a -> m) -> a -> m) -> (a -> m) -> [a] -> a -> m
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 m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
g a
b
{-# INLINE foldMap1 #-}
toNonEmpty :: NonEmpty a -> NonEmpty a
toNonEmpty :: NonEmpty a -> NonEmpty a
toNonEmpty = NonEmpty a -> NonEmpty a
forall a. a -> a
id
{-# INLINE toNonEmpty #-}
head1, last1 :: NonEmpty a -> a
head1 :: NonEmpty a -> a
head1 = NonEmpty a -> a
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head
last1 :: NonEmpty a -> a
last1 = NonEmpty a -> a
forall (f :: * -> *) a. IsNonEmpty f a a "last" => f a -> a
last
{-# INLINE head1 #-}
{-# INLINE last1 #-}
maximum1, minimum1 :: Ord a => NonEmpty a -> a
maximum1 :: NonEmpty a -> a
maximum1 = (a -> a -> a) -> NonEmpty a -> a
forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1' a -> a -> a
forall a. Ord a => a -> a -> a
max
minimum1 :: NonEmpty a -> a
minimum1 = (a -> a -> a) -> NonEmpty a -> a
forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1' a -> a -> a
forall a. Ord a => a -> a -> a
min
{-# INLINE maximum1 #-}
{-# INLINE minimum1 #-}
maximumOn1 :: forall a b. Ord b => (a -> b) -> NonEmpty a -> a
maximumOn1 :: (a -> b) -> NonEmpty a -> a
maximumOn1 a -> b
func = (a -> a -> a) -> NonEmpty a -> a
forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1' ((a -> a -> a) -> NonEmpty a -> a)
-> (a -> a -> a) -> NonEmpty a -> a
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 b -> b -> Ordering
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 :: (a -> b) -> NonEmpty a -> a
minimumOn1 a -> b
func = (a -> a -> a) -> NonEmpty a -> a
forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1' ((a -> a -> a) -> NonEmpty a -> a)
-> (a -> a -> a) -> NonEmpty a -> a
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 b -> b -> Ordering
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 :: (a -> m) -> Identity a -> m
foldMap1 = (a -> m) -> Identity a -> m
coerce
{-# INLINE foldMap1 #-}
fold1 :: Semigroup m => Identity m -> m
fold1 :: Identity m -> m
fold1 = Identity m -> m
coerce
{-# INLINE fold1 #-}
toNonEmpty :: Identity a -> NonEmpty a
toNonEmpty :: Identity a -> NonEmpty a
toNonEmpty = (a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|[]) (a -> NonEmpty a) -> (Identity a -> a) -> Identity a -> NonEmpty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
coerce
{-# INLINE toNonEmpty #-}
head1 :: Identity a -> a
head1 :: Identity a -> a
head1 = Identity a -> a
coerce
{-# INLINE head1 #-}
last1 :: Identity a -> a
last1 :: Identity a -> a
last1 = Identity a -> a
coerce
{-# INLINE last1 #-}
maximum1 :: Ord a => Identity a -> a
maximum1 :: Identity a -> a
maximum1 = Identity a -> a
coerce
{-# INLINE maximum1 #-}
minimum1 :: Ord a => Identity a -> a
minimum1 :: Identity a -> a
minimum1 = Identity a -> a
coerce
{-# INLINE minimum1 #-}
maximumOn1 :: Ord b => (a -> b) -> Identity a -> a
maximumOn1 :: (a -> b) -> Identity a -> a
maximumOn1 = (Identity a -> a) -> (a -> b) -> Identity a -> a
forall a b. a -> b -> a
const Identity a -> a
coerce
{-# INLINE maximumOn1 #-}
minimumOn1 :: Ord b => (a -> b) -> Identity a -> a
minimumOn1 :: (a -> b) -> Identity a -> a
minimumOn1 = (Identity a -> a) -> (a -> b) -> Identity a -> a
forall a b. a -> b -> a
const Identity a -> a
coerce
{-# INLINE minimumOn1 #-}
instance Foldable1 ((,) c) where
foldMap1 :: Semigroup m => (a -> m) -> (c, a) -> m
foldMap1 :: (a -> m) -> (c, a) -> m
foldMap1 a -> m
f = a -> m
f (a -> m) -> ((c, a) -> a) -> (c, a) -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c, a) -> a
forall c a. (c, a) -> a
snd
{-# INLINE foldMap1 #-}
fold1 :: Semigroup m => (c, m) -> m
fold1 :: (c, m) -> m
fold1 = (c, m) -> m
forall c a. (c, a) -> a
snd
{-# INLINE fold1 #-}
toNonEmpty :: (c, a) -> NonEmpty a
toNonEmpty :: (c, a) -> NonEmpty a
toNonEmpty (c
_, a
y) = (a
y a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [])
{-# INLINE toNonEmpty #-}
head1, last1 :: (c, a) -> a
head1 :: (c, a) -> a
head1 = (c, a) -> a
forall c a. (c, a) -> a
snd
last1 :: (c, a) -> a
last1 = (c, a) -> a
forall c a. (c, a) -> a
snd
{-# INLINE head1 #-}
{-# INLINE last1 #-}
maximum1, minimum1 :: Ord a => (c, a) -> a
maximum1 :: (c, a) -> a
maximum1 = (c, a) -> a
forall c a. (c, a) -> a
snd
minimum1 :: (c, a) -> a
minimum1 = (c, a) -> a
forall c a. (c, a) -> a
snd
{-# INLINE maximum1 #-}
{-# INLINE minimum1 #-}
maximumOn1, minimumOn1 :: Ord b => (a -> b) -> (c, a) -> a
maximumOn1 :: (a -> b) -> (c, a) -> a
maximumOn1 = ((c, a) -> a) -> (a -> b) -> (c, a) -> a
forall a b. a -> b -> a
const (c, a) -> a
forall c a. (c, a) -> a
snd
minimumOn1 :: (a -> b) -> (c, a) -> a
minimumOn1 = ((c, a) -> a) -> (a -> b) -> (c, a) -> a
forall a b. a -> b -> a
const (c, a) -> a
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 :: (a -> m) -> Compose f g a -> m
foldMap1 a -> m
f = (g a -> m) -> f (g a) -> m
forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 ((a -> m) -> g a -> m
forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 a -> m
f) (f (g a) -> m) -> (Compose f g a -> f (g a)) -> Compose f g a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f g a -> f (g a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
{-# INLINE foldMap1 #-}
head1 :: Compose f g a -> a
head1 :: Compose f g a -> a
head1 = g a -> a
forall (f :: * -> *) a. Foldable1 f => f a -> a
head1 (g a -> a) -> (Compose f g a -> g a) -> Compose f g a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (g a) -> g a
forall (f :: * -> *) a. Foldable1 f => f a -> a
head1 (f (g a) -> g a)
-> (Compose f g a -> f (g a)) -> Compose f g a -> g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f g a -> f (g a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
{-# INLINE head1 #-}
last1 :: Compose f g a -> a
last1 :: Compose f g a -> a
last1 = g a -> a
forall (f :: * -> *) a. Foldable1 f => f a -> a
last1 (g a -> a) -> (Compose f g a -> g a) -> Compose f g a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (g a) -> g a
forall (f :: * -> *) a. Foldable1 f => f a -> a
last1 (f (g a) -> g a)
-> (Compose f g a -> f (g a)) -> Compose f g a -> g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f g a -> f (g a)
forall k1 (f :: k1 -> *) k2 (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 :: (a -> m) -> Product f g a -> m
foldMap1 a -> m
f (Pair f a
a g a
b) = (a -> m) -> f a -> m
forall (f :: * -> *) m a.
(Foldable1 f, Semigroup m) =>
(a -> m) -> f a -> m
foldMap1 a -> m
f f a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> g a -> m
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 :: (a -> m) -> Sum f g a -> m
foldMap1 a -> m
f (InL f a
x) = (a -> m) -> f a -> m
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) = (a -> m) -> g a -> m
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 :: (a -> m) -> [a] -> m
foldMap1 a -> m
_ [a]
_ = Text -> m
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 :: (a -> b -> b) -> b -> f a -> b
foldr1 a -> b -> b
_ b
_ = Text -> f a -> b
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Unreachable list instance of Foldable1"
fold1 :: Semigroup m => [m] -> m
fold1 :: [m] -> m
fold1 [m]
_ = Text -> m
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Unreachable list instance of Foldable1"
toNonEmpty :: [a] -> NonEmpty a
toNonEmpty :: [a] -> NonEmpty a
toNonEmpty [a]
_ = Text -> NonEmpty a
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Unreachable list instance of Foldable1"
head1 :: [a] -> a
head1 :: [a] -> a
head1 [a]
_ = Text -> a
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Unreachable list instance of Foldable1"
last1 :: [a] -> a
last1 :: [a] -> a
last1 [a]
_ = Text -> a
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Unreachable list instance of Foldable1"
maximum1 :: Ord a => [a] -> a
maximum1 :: [a] -> a
maximum1 [a]
_ = Text -> a
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Unreachable list instance of Foldable1"
minimum1 :: Ord a => [a] -> a
minimum1 :: [a] -> a
minimum1 [a]
_ = Text -> 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 :: (a -> b) -> f a -> a
maximumOn1 a -> b
_ f a
_ = Text -> 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 :: (a -> b) -> f a -> a
minimumOn1 a -> b
_ f a
_ = Text -> a
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Unreachable list instance of Foldable1"
foldl1' :: (a -> a -> a) -> NonEmpty a -> a
foldl1' :: (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)) = (a -> a -> a) -> a -> [a] -> a
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 :: f a -> a
average1 = (a -> a -> a) -> (a, a) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> a
forall a. Fractional a => a -> a -> a
(/) ((a, a) -> a) -> (f a -> (a, a)) -> f a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, a) -> a -> (a, a)) -> (a, a) -> f a -> (a, a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(!a
total, !a
count) a
x -> (a
total a -> a -> a
forall a. Num a => a -> a -> a
+ a
x, a
count a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)) (a
0,a
0)
{-# INLINE average1 #-}