{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
#if __GLASGOW_HASKELL__ >=706
{-# LANGUAGE PolyKinds #-}
#endif
#if __GLASGOW_HASKELL__ >=702
{-# LANGUAGE Trustworthy #-}
#endif
module Data.Foldable1 (
Foldable1(..),
foldr1, foldr1',
foldl1, foldl1',
intercalate1,
foldrM1,
foldlM1,
foldrMapM1,
foldlMapM1,
maximumBy,
minimumBy,
) where
import Data.Foldable (Foldable, foldlM, foldr)
import Data.List (foldl, foldl')
import Data.List.NonEmpty (NonEmpty (..))
import Data.Semigroup
(Dual (..), First (..), Last (..), Max (..), Min (..), Product (..),
Semigroup (..), Sum (..))
import Prelude
(Maybe (..), Monad (..), Ord, Ordering (..), id, seq, ($!), ($), (.),
(=<<), flip, const, error)
import qualified Data.List.NonEmpty as NE
#if MIN_VERSION_base(4,4,0)
import Data.Complex (Complex (..))
import GHC.Generics
(M1 (..), Par1 (..), Rec1 (..), V1, (:*:) (..), (:+:) (..), (:.:) (..))
#else
import Generics.Deriving
(M1 (..), Par1 (..), Rec1 (..), V1, (:*:) (..), (:+:) (..), (:.:) (..))
#endif
#if MIN_VERSION_base(4,6,0)
import Data.Ord (Down (..))
#endif
#if MIN_VERSION_base(4,8,0)
import qualified Data.Monoid as Mon
#endif
#if !MIN_VERSION_base(4,12,0)
import Data.Orphans ()
#endif
#ifdef MIN_VERSION_tagged
import Data.Tagged (Tagged (..))
#endif
#ifdef MIN_VERSION_ghc_prim
#if MIN_VERSION_ghc_prim(0,7,0)
import GHC.Tuple (Solo (..))
#endif
#endif
import Control.Applicative.Backwards (Backwards (..))
import Control.Applicative.Lift (Lift (..))
import Control.Monad.Trans.Identity (IdentityT (..))
import Data.Functor.Compose (Compose (..))
import Data.Functor.Identity (Identity (..))
import Data.Functor.Reverse (Reverse (..))
import Data.Tree (Tree (..))
import qualified Data.Functor.Product as Functor
import qualified Data.Functor.Sum as Functor
#if __GLASGOW_HASKELL__ <708
import Unsafe.Coerce (unsafeCoerce)
#else
import Data.Coerce (Coercible, coerce)
#endif
class Foldable t => Foldable1 t where
#if __GLASGOW_HASKELL__ >= 708
{-# MINIMAL foldMap1 | foldrMap1 #-}
#endif
fold1 :: Semigroup m => t m -> m
fold1 = forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 forall a. a -> a
id
foldMap1 :: Semigroup m => (a -> m) -> t a -> m
foldMap1 a -> m
f = forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (a -> b -> b) -> t a -> b
foldrMap1 a -> m
f (\a
a m
m -> a -> m
f a
a forall a. Semigroup a => a -> a -> a
<> m
m)
foldMap1' :: Semigroup m => (a -> m) -> t a -> m
foldMap1' a -> m
f = forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (b -> a -> b) -> t a -> b
foldlMap1' a -> m
f (\m
m a
a -> m
m forall a. Semigroup a => a -> a -> a
<> a -> m
f a
a)
toNonEmpty :: t a -> NonEmpty a
toNonEmpty = forall a. NonEmptyDList a -> NonEmpty a
runNonEmptyDList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 forall a. a -> NonEmptyDList a
singleton
maximum :: Ord a => t a -> a
maximum = forall a. Max a -> a
getMax forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1' forall a. a -> Max a
Max
minimum :: Ord a => t a -> a
minimum = forall a. Min a -> a
getMin forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1' forall a. a -> Min a
Min
head :: t a -> a
head = forall a. First a -> a
getFirst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 forall a. a -> First a
First
last :: t a -> a
last = forall a. Last a -> a
getLast forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 forall a. a -> Last a
Last
foldrMap1 :: (a -> b) -> (a -> b -> b) -> t a -> b
foldrMap1 a -> b
f a -> b -> b
g t a
xs =
forall b. FromMaybe b -> Maybe b -> b
appFromMaybe (forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 (forall b. (Maybe b -> b) -> FromMaybe b
FromMaybe forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> Maybe b -> b
h) t a
xs) forall a. Maybe a
Nothing
where
h :: a -> Maybe b -> b
h a
a Maybe b
Nothing = a -> b
f a
a
h a
a (Just b
b) = a -> b -> b
g a
a b
b
foldlMap1' :: (a -> b) -> (b -> a -> b) -> t a -> b
foldlMap1' a -> b
f b -> a -> b
g t a
xs =
forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (a -> b -> b) -> t a -> b
foldrMap1 a -> SMaybe b -> b
f' forall {b}. a -> (SMaybe b -> b) -> SMaybe b -> b
g' t a
xs forall a. SMaybe a
SNothing
where
f' :: a -> SMaybe b -> b
f' a
a SMaybe b
SNothing = a -> b
f a
a
f' a
a (SJust b
b) = b -> a -> b
g b
b a
a
g' :: a -> (SMaybe b -> b) -> SMaybe b -> b
g' a
a SMaybe b -> b
x SMaybe b
SNothing = SMaybe b -> b
x forall a b. (a -> b) -> a -> b
$! forall a. a -> SMaybe a
SJust (a -> b
f a
a)
g' a
a SMaybe b -> b
x (SJust b
b) = SMaybe b -> b
x forall a b. (a -> b) -> a -> b
$! forall a. a -> SMaybe a
SJust (b -> a -> b
g b
b a
a)
foldlMap1 :: (a -> b) -> (b -> a -> b) -> t a -> b
foldlMap1 a -> b
f b -> a -> b
g t a
xs =
forall b. FromMaybe b -> Maybe b -> b
appFromMaybe (forall a. Dual a -> a
getDual (forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 ((forall a. a -> Dual a
Dual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. (Maybe b -> b) -> FromMaybe b
FromMaybe) forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> Maybe b -> b
h) t a
xs)) forall a. Maybe a
Nothing
where
h :: a -> Maybe b -> b
h a
a Maybe b
Nothing = a -> b
f a
a
h a
a (Just b
b) = b -> a -> b
g b
b a
a
foldrMap1' :: (a -> b) -> (a -> b -> b) -> t a -> b
foldrMap1' a -> b
f a -> b -> b
g t a
xs =
forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (b -> a -> b) -> t a -> b
foldlMap1 a -> SMaybe b -> b
f' forall {b}. (SMaybe b -> b) -> a -> SMaybe b -> b
g' t a
xs forall a. SMaybe a
SNothing
where
f' :: a -> SMaybe b -> b
f' a
a SMaybe b
SNothing = a -> b
f a
a
f' a
a (SJust b
b) = a -> b -> b
g a
a b
b
g' :: (SMaybe b -> b) -> a -> SMaybe b -> b
g' SMaybe b -> b
bb a
a SMaybe b
SNothing = SMaybe b -> b
bb forall a b. (a -> b) -> a -> b
$! forall a. a -> SMaybe a
SJust (a -> b
f a
a)
g' SMaybe b -> b
bb a
a (SJust b
b) = SMaybe b -> b
bb forall a b. (a -> b) -> a -> b
$! forall a. a -> SMaybe a
SJust (a -> b -> b
g a
a b
b)
foldr1 :: Foldable1 t => (a -> a -> a) -> t a -> a
foldr1 :: forall (t :: * -> *) a. Foldable1 t => (a -> a -> a) -> t a -> a
foldr1 = forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (a -> b -> b) -> t a -> b
foldrMap1 forall a. a -> a
id
{-# INLINE foldr1 #-}
foldr1' :: Foldable1 t => (a -> a -> a) -> t a -> a
foldr1' :: forall (t :: * -> *) a. Foldable1 t => (a -> a -> a) -> t a -> a
foldr1' = forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (a -> b -> b) -> t a -> b
foldrMap1' forall a. a -> a
id
{-# INLINE foldr1' #-}
foldl1 :: Foldable1 t => (a -> a -> a) -> t a -> a
foldl1 :: forall (t :: * -> *) a. Foldable1 t => (a -> a -> a) -> t a -> a
foldl1 = forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (b -> a -> b) -> t a -> b
foldlMap1 forall a. a -> a
id
{-# INLINE foldl1 #-}
foldl1' :: Foldable1 t => (a -> a -> a) -> t a -> a
foldl1' :: forall (t :: * -> *) a. Foldable1 t => (a -> a -> a) -> t a -> a
foldl1' = forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (b -> a -> b) -> t a -> b
foldlMap1' forall a. a -> a
id
{-# INLINE foldl1' #-}
intercalate1 :: (Foldable1 t, Semigroup m) => m -> t m -> m
intercalate1 :: forall (t :: * -> *) m. (Foldable1 t, Semigroup m) => m -> t m -> m
intercalate1 = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
m -> (a -> m) -> t a -> m
intercalateMap1 forall a. a -> a
id
intercalateMap1 :: (Foldable1 t, Semigroup m) => m -> (a -> m) -> t a -> m
intercalateMap1 :: forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
m -> (a -> m) -> t a -> m
intercalateMap1 m
j a -> m
f = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. JoinWith a -> a -> a
joinee m
j forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 (forall a. (a -> a) -> JoinWith a
JoinWith forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m
f)
foldrM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a
foldrM1 :: forall (t :: * -> *) (m :: * -> *) a.
(Foldable1 t, Monad m) =>
(a -> a -> m a) -> t a -> m a
foldrM1 = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable1 t, Monad m) =>
(a -> m b) -> (a -> b -> m b) -> t a -> m b
foldrMapM1 forall (m :: * -> *) a. Monad m => a -> m a
return
foldrMapM1 :: (Foldable1 t, Monad m) => (a -> m b) -> (a -> b -> m b) -> t a -> m b
foldrMapM1 :: forall (t :: * -> *) (m :: * -> *) a b.
(Foldable1 t, Monad m) =>
(a -> m b) -> (a -> b -> m b) -> t a -> m b
foldrMapM1 a -> m b
g a -> b -> m b
f = NonEmpty a -> m b
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty
where
go :: NonEmpty a -> m b
go (a
e:|[a]
es) =
case [a]
es of
[] -> a -> m b
g a
e
a
x:[a]
xs -> a -> b -> m b
f a
e forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NonEmpty a -> m b
go (a
xforall a. a -> [a] -> NonEmpty a
:|[a]
xs)
foldlM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a
foldlM1 :: forall (t :: * -> *) (m :: * -> *) a.
(Foldable1 t, Monad m) =>
(a -> a -> m a) -> t a -> m a
foldlM1 = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable1 t, Monad m) =>
(a -> m b) -> (b -> a -> m b) -> t a -> m b
foldlMapM1 forall (m :: * -> *) a. Monad m => a -> m a
return
foldlMapM1 :: (Foldable1 t, Monad m) => (a -> m b) -> (b -> a -> m b) -> t a -> m b
foldlMapM1 :: forall (t :: * -> *) (m :: * -> *) a b.
(Foldable1 t, Monad m) =>
(a -> m b) -> (b -> a -> m b) -> t a -> m b
foldlMapM1 a -> m b
g b -> a -> m b
f t a
t = a -> m b
g a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
y -> forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM b -> a -> m b
f b
y [a]
xs
where a
x:|[a]
xs = forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty t a
t
maximumBy :: Foldable1 t => (a -> a -> Ordering) -> t a -> a
maximumBy :: forall (t :: * -> *) a.
Foldable1 t =>
(a -> a -> Ordering) -> t a -> a
maximumBy a -> a -> Ordering
cmp = forall (t :: * -> *) a. Foldable1 t => (a -> a -> a) -> t a -> a
foldl1' a -> a -> a
max'
where max' :: a -> a -> a
max' a
x a
y = case a -> a -> Ordering
cmp a
x a
y of
Ordering
GT -> a
x
Ordering
_ -> a
y
minimumBy :: Foldable1 t => (a -> a -> Ordering) -> t a -> a
minimumBy :: forall (t :: * -> *) a.
Foldable1 t =>
(a -> a -> Ordering) -> t a -> a
minimumBy a -> a -> Ordering
cmp = forall (t :: * -> *) a. Foldable1 t => (a -> a -> a) -> t a -> a
foldl1' a -> a -> a
min'
where min' :: a -> a -> a
min' a
x a
y = case a -> a -> Ordering
cmp a
x a
y of
Ordering
GT -> a
y
Ordering
_ -> a
x
newtype NonEmptyDList a = NEDL { forall a. NonEmptyDList a -> [a] -> NonEmpty a
unNEDL :: [a] -> NonEmpty a }
instance Semigroup (NonEmptyDList a) where
NonEmptyDList a
xs <> :: NonEmptyDList a -> NonEmptyDList a -> NonEmptyDList a
<> NonEmptyDList a
ys = forall a. ([a] -> NonEmpty a) -> NonEmptyDList a
NEDL (forall a. NonEmptyDList a -> [a] -> NonEmpty a
unNEDL NonEmptyDList a
xs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmptyDList a -> [a] -> NonEmpty a
unNEDL NonEmptyDList a
ys)
{-# INLINE (<>) #-}
singleton :: a -> NonEmptyDList a
singleton :: forall a. a -> NonEmptyDList a
singleton = forall a. ([a] -> NonEmpty a) -> NonEmptyDList a
NEDL forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall a. a -> [a] -> NonEmpty a
(:|)
runNonEmptyDList :: NonEmptyDList a -> NonEmpty a
runNonEmptyDList :: forall a. NonEmptyDList a -> NonEmpty a
runNonEmptyDList = (forall a b. (a -> b) -> a -> b
$ []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmptyDList a -> [a] -> NonEmpty a
unNEDL
{-# INLINE runNonEmptyDList #-}
newtype FromMaybe b = FromMaybe { forall b. FromMaybe b -> Maybe b -> b
appFromMaybe :: Maybe b -> b }
instance Semigroup (FromMaybe b) where
FromMaybe Maybe b -> b
f <> :: FromMaybe b -> FromMaybe b -> FromMaybe b
<> FromMaybe Maybe b -> b
g = forall b. (Maybe b -> b) -> FromMaybe b
FromMaybe (Maybe b -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe b -> b
g)
data SMaybe a = SNothing | SJust !a
newtype JoinWith a = JoinWith {forall a. JoinWith a -> a -> a
joinee :: (a -> a)}
instance Semigroup a => Semigroup (JoinWith a) where
JoinWith a -> a
a <> :: JoinWith a -> JoinWith a -> JoinWith a
<> JoinWith a -> a
b = forall a. (a -> a) -> JoinWith a
JoinWith forall a b. (a -> b) -> a -> b
$ \a
j -> a -> a
a a
j forall a. Semigroup a => a -> a -> a
<> a
j forall a. Semigroup a => a -> a -> a
<> a -> a
b a
j
instance Foldable1 NonEmpty where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> NonEmpty a -> m
foldMap1 a -> m
f (a
x :| [a]
xs) = m -> [a] -> m
go (a -> m
f a
x) [a]
xs where
go :: m -> [a] -> m
go m
y [] = m
y
go m
y (a
z : [a]
zs) = m
y forall a. Semigroup a => a -> a -> a
<> m -> [a] -> m
go (a -> m
f a
z) [a]
zs
foldMap1' :: forall m a. Semigroup m => (a -> m) -> NonEmpty a -> m
foldMap1' a -> m
f (a
x :| [a]
xs) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\m
m a
y -> m
m forall a. Semigroup a => a -> a -> a
<> a -> m
f a
y) (a -> m
f a
x) [a]
xs
toNonEmpty :: forall a. NonEmpty a -> NonEmpty a
toNonEmpty = forall a. a -> a
id
foldrMap1 :: forall a b. (a -> b) -> (a -> b -> b) -> NonEmpty a -> b
foldrMap1 a -> b
g a -> b -> b
f (a
x :| [a]
xs) = a -> [a] -> b
go a
x [a]
xs where
go :: a -> [a] -> b
go a
y [] = a -> b
g a
y
go a
y (a
z : [a]
zs) = a -> b -> b
f a
y (a -> [a] -> b
go a
z [a]
zs)
foldlMap1 :: forall a b. (a -> b) -> (b -> a -> b) -> NonEmpty a -> b
foldlMap1 a -> b
g b -> a -> b
f (a
x :| [a]
xs) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f (a -> b
g a
x) [a]
xs
foldlMap1' :: forall a b. (a -> b) -> (b -> a -> b) -> NonEmpty a -> b
foldlMap1' a -> b
g b -> a -> b
f (a
x :| [a]
xs) = let gx :: b
gx = a -> b
g a
x in b
gx seq :: forall a b. a -> b -> b
`seq` forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> a -> b
f b
gx [a]
xs
head :: forall a. NonEmpty a -> a
head = forall a. NonEmpty a -> a
NE.head
last :: forall a. NonEmpty a -> a
last = forall a. NonEmpty a -> a
NE.last
#if MIN_VERSION_base(4,6,0)
instance Foldable1 Down where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Down a -> m
foldMap1 = coerce :: forall a b. Coercible a b => a -> b
coerce
#endif
#if MIN_VERSION_base(4,4,0)
instance Foldable1 Complex where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Complex a -> m
foldMap1 a -> m
f (a
x :+ a
y) = a -> m
f a
x forall a. Semigroup a => a -> a -> a
<> a -> m
f a
y
toNonEmpty :: forall a. Complex a -> NonEmpty a
toNonEmpty (a
x :+ a
y) = a
x forall a. a -> [a] -> NonEmpty a
:| a
y forall a. a -> [a] -> [a]
: []
#endif
instance Foldable1 ((,) a) where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> (a, a) -> m
foldMap1 a -> m
f (a
_, a
y) = a -> m
f a
y
toNonEmpty :: forall a. (a, a) -> NonEmpty a
toNonEmpty (a
_, a
x) = a
x forall a. a -> [a] -> NonEmpty a
:| []
minimum :: forall a. Ord a => (a, a) -> a
minimum (a
_, a
x) = a
x
maximum :: forall a. Ord a => (a, a) -> a
maximum (a
_, a
x) = a
x
head :: forall a. (a, a) -> a
head (a
_, a
x) = a
x
last :: forall a. (a, a) -> a
last (a
_, a
x) = a
x
instance Foldable1 Dual where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Dual a -> m
foldMap1 = coerce :: forall a b. Coercible a b => a -> b
coerce
instance Foldable1 Sum where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Sum a -> m
foldMap1 = coerce :: forall a b. Coercible a b => a -> b
coerce
instance Foldable1 Product where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Product a -> m
foldMap1 = coerce :: forall a b. Coercible a b => a -> b
coerce
instance Foldable1 Min where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Min a -> m
foldMap1 = coerce :: forall a b. Coercible a b => a -> b
coerce
instance Foldable1 Max where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Max a -> m
foldMap1 = coerce :: forall a b. Coercible a b => a -> b
coerce
instance Foldable1 First where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> First a -> m
foldMap1 = coerce :: forall a b. Coercible a b => a -> b
coerce
instance Foldable1 Last where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Last a -> m
foldMap1 = coerce :: forall a b. Coercible a b => a -> b
coerce
#if MIN_VERSION_base(4,8,0)
deriving instance (Foldable1 f) => Foldable1 (Mon.Alt f)
#endif
#if MIN_VERSION_base(4,12,0)
deriving instance (Foldable1 f) => Foldable1 (Mon.Ap f)
#endif
instance Foldable1 V1 where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> V1 a -> m
foldMap1 a -> m
_ V1 a
x = V1 a
x seq :: forall a b. a -> b -> b
`seq` forall a. HasCallStack => [Char] -> a
error [Char]
"foldMap1 @V1"
instance Foldable1 Par1 where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Par1 a -> m
foldMap1 = coerce :: forall a b. Coercible a b => a -> b
coerce
deriving instance Foldable1 f => Foldable1 (Rec1 f)
deriving instance Foldable1 f => Foldable1 (M1 i c f)
instance (Foldable1 f, Foldable1 g) => Foldable1 (f :+: g) where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> (:+:) f g a -> m
foldMap1 a -> m
f (L1 f a
x) = forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f f a
x
foldMap1 a -> m
f (R1 g a
y) = forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f g a
y
instance (Foldable1 f, Foldable1 g) => Foldable1 (f :*: g) where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> (:*:) f g a -> m
foldMap1 a -> m
f (f a
x :*: g a
y) = forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f f a
x forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f g a
y
instance (Foldable1 f, Foldable1 g) => Foldable1 (f :.: g) where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> (:.:) f g a -> m
foldMap1 a -> m
f = forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 (forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1
instance Foldable1 Identity where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Identity a -> m
foldMap1 = coerce :: forall a b. Coercible a b => a -> b
coerce
foldrMap1 :: forall a b. (a -> b) -> (a -> b -> b) -> Identity a -> b
foldrMap1 a -> b
g a -> b -> b
_ = coerce :: forall a b. Coercible a b => a -> b
coerce a -> b
g
foldrMap1' :: forall a b. (a -> b) -> (a -> b -> b) -> Identity a -> b
foldrMap1' a -> b
g a -> b -> b
_ = coerce :: forall a b. Coercible a b => a -> b
coerce a -> b
g
foldlMap1 :: forall a b. (a -> b) -> (b -> a -> b) -> Identity a -> b
foldlMap1 a -> b
g b -> a -> b
_ = coerce :: forall a b. Coercible a b => a -> b
coerce a -> b
g
foldlMap1' :: forall a b. (a -> b) -> (b -> a -> b) -> Identity a -> b
foldlMap1' a -> b
g b -> a -> b
_ = coerce :: forall a b. Coercible a b => a -> b
coerce a -> b
g
toNonEmpty :: forall a. Identity a -> NonEmpty a
toNonEmpty (Identity a
x) = a
x forall a. a -> [a] -> NonEmpty a
:| []
last :: forall a. Identity a -> a
last = coerce :: forall a b. Coercible a b => a -> b
coerce
head :: forall a. Identity a -> a
head = coerce :: forall a b. Coercible a b => a -> b
coerce
minimum :: forall a. Ord a => Identity a -> a
minimum = coerce :: forall a b. Coercible a b => a -> b
coerce
maximum :: forall a. Ord a => Identity a -> a
maximum = coerce :: forall a b. Coercible a b => a -> b
coerce
instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Product f g) where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Product f g a -> m
foldMap1 a -> m
f (Functor.Pair f a
x g a
y) = forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f f a
x forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f g a
y
foldrMap1 :: forall a b. (a -> b) -> (a -> b -> b) -> Product f g a -> b
foldrMap1 a -> b
g a -> b -> b
f (Functor.Pair f a
x g a
y) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f (forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (a -> b -> b) -> t a -> b
foldrMap1 a -> b
g a -> b -> b
f g a
y) f a
x
head :: forall a. Product f g a -> a
head (Functor.Pair f a
x g a
_) = forall (t :: * -> *) a. Foldable1 t => t a -> a
head f a
x
last :: forall a. Product f g a -> a
last (Functor.Pair f a
_ g a
y) = forall (t :: * -> *) a. Foldable1 t => t a -> a
last g a
y
instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Sum f g) where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Sum f g a -> m
foldMap1 a -> m
f (Functor.InL f a
x) = forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f f a
x
foldMap1 a -> m
f (Functor.InR g a
y) = forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f g a
y
foldrMap1 :: forall a b. (a -> b) -> (a -> b -> b) -> Sum f g a -> b
foldrMap1 a -> b
g a -> b -> b
f (Functor.InL f a
x) = forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (a -> b -> b) -> t a -> b
foldrMap1 a -> b
g a -> b -> b
f f a
x
foldrMap1 a -> b
g a -> b -> b
f (Functor.InR g a
y) = forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (a -> b -> b) -> t a -> b
foldrMap1 a -> b
g a -> b -> b
f g a
y
toNonEmpty :: forall a. Sum f g a -> NonEmpty a
toNonEmpty (Functor.InL f a
x) = forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty f a
x
toNonEmpty (Functor.InR g a
y) = forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty g a
y
head :: forall a. Sum f g a -> a
head (Functor.InL f a
x) = forall (t :: * -> *) a. Foldable1 t => t a -> a
head f a
x
head (Functor.InR g a
y) = forall (t :: * -> *) a. Foldable1 t => t a -> a
head g a
y
last :: forall a. Sum f g a -> a
last (Functor.InL f a
x) = forall (t :: * -> *) a. Foldable1 t => t a -> a
last f a
x
last (Functor.InR g a
y) = forall (t :: * -> *) a. Foldable1 t => t a -> a
last g a
y
minimum :: forall a. Ord a => Sum f g a -> a
minimum (Functor.InL f a
x) = forall (t :: * -> *) a. (Foldable1 t, Ord a) => t a -> a
minimum f a
x
minimum (Functor.InR g a
y) = forall (t :: * -> *) a. (Foldable1 t, Ord a) => t a -> a
minimum g a
y
maximum :: forall a. Ord a => Sum f g a -> a
maximum (Functor.InL f a
x) = forall (t :: * -> *) a. (Foldable1 t, Ord a) => t a -> a
maximum f a
x
maximum (Functor.InR g a
y) = forall (t :: * -> *) a. (Foldable1 t, Ord a) => t a -> a
maximum g a
y
instance (Foldable1 f, Foldable1 g) => Foldable1 (Compose f g) where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Compose f g a -> m
foldMap1 a -> m
f = forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 (forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t 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
foldrMap1 :: forall a b. (a -> b) -> (a -> b -> b) -> Compose f g a -> b
foldrMap1 a -> b
f a -> b -> b
g = forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (a -> b -> b) -> t a -> b
foldrMap1 (forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (a -> b -> b) -> t a -> b
foldrMap1 a -> b
f a -> b -> b
g) (\g a
xs b
x -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
g b
x g a
xs) 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
head :: forall a. Compose f g a -> a
head = forall (t :: * -> *) a. Foldable1 t => t a -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable1 t => t a -> a
head 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
last :: forall a. Compose f g a -> a
last = forall (t :: * -> *) a. Foldable1 t => t a -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable1 t => t a -> a
last 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
instance Foldable1 Tree where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Tree a -> m
foldMap1 a -> m
f (Node a
x []) = a -> m
f a
x
foldMap1 a -> m
f (Node a
x (Tree a
y : [Tree a]
ys)) = a -> m
f a
x forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 (forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f) (Tree a
y forall a. a -> [a] -> NonEmpty a
:| [Tree a]
ys)
foldMap1' :: forall m a. Semigroup m => (a -> m) -> Tree a -> m
foldMap1' a -> m
f = Tree a -> m
go where
go :: Tree a -> m
go (Node a
x [Tree a]
ys) =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\m
m Tree a
zs -> let gozs :: m
gozs = Tree a -> m
go Tree a
zs in m
gozs seq :: forall a b. a -> b -> b
`seq` m
m forall a. Semigroup a => a -> a -> a
<> m
gozs) (a -> m
f a
x) [Tree a]
ys
foldlMap1 :: forall a b. (a -> b) -> (b -> a -> b) -> Tree a -> b
foldlMap1 a -> b
f b -> a -> b
g (Node a
x [Tree a]
xs) = b -> [Tree a] -> b
goForest (a -> b
f a
x) [Tree a]
xs where
goForest :: b -> [Tree a] -> b
goForest = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> Tree a -> b
go
go :: b -> Tree a -> b
go b
y (Node a
z [Tree a]
zs) = b -> [Tree a] -> b
goForest (b -> a -> b
g b
y a
z) [Tree a]
zs
foldlMap1' :: forall a b. (a -> b) -> (b -> a -> b) -> Tree a -> b
foldlMap1' a -> b
f b -> a -> b
g (Node a
x [Tree a]
xs) = b -> [Tree a] -> b
goForest (a -> b
f a
x) [Tree a]
xs where
goForest :: b -> [Tree a] -> b
goForest !b
y = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> Tree a -> b
go b
y
go :: b -> Tree a -> b
go !b
y (Node a
z [Tree a]
zs) = b -> [Tree a] -> b
goForest (b -> a -> b
g b
y a
z) [Tree a]
zs
head :: forall a. Tree a -> a
head (Node a
x [Tree a]
_) = a
x
instance Foldable1 f => Foldable1 (Reverse f) where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Reverse f a -> m
foldMap1 a -> m
f = forall a. Dual a -> a
getDual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 (forall a. a -> Dual a
Dual forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). Reverse f a -> f a
getReverse
foldrMap1 :: forall a b. (a -> b) -> (a -> b -> b) -> Reverse f a -> b
foldrMap1 a -> b
f a -> b -> b
g (Reverse f a
xs) = forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (b -> a -> b) -> t a -> b
foldlMap1 a -> b
f (forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> b
g) f a
xs
foldlMap1 :: forall a b. (a -> b) -> (b -> a -> b) -> Reverse f a -> b
foldlMap1 a -> b
f b -> a -> b
g (Reverse f a
xs) = forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (a -> b -> b) -> t a -> b
foldrMap1 a -> b
f (forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> a -> b
g) f a
xs
foldrMap1' :: forall a b. (a -> b) -> (a -> b -> b) -> Reverse f a -> b
foldrMap1' a -> b
f a -> b -> b
g (Reverse f a
xs) = forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (b -> a -> b) -> t a -> b
foldlMap1' a -> b
f (forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> b
g) f a
xs
foldlMap1' :: forall a b. (a -> b) -> (b -> a -> b) -> Reverse f a -> b
foldlMap1' a -> b
f b -> a -> b
g (Reverse f a
xs) = forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (a -> b -> b) -> t a -> b
foldrMap1' a -> b
f (forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> a -> b
g) f a
xs
head :: forall a. Reverse f a -> a
head = forall (t :: * -> *) a. Foldable1 t => t a -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). Reverse f a -> f a
getReverse
last :: forall a. Reverse f a -> a
last = forall (t :: * -> *) a. Foldable1 t => t a -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). Reverse f a -> f a
getReverse
deriving instance Foldable1 f => Foldable1 (IdentityT f)
instance Foldable1 f => Foldable1 (Backwards f) where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Backwards f a -> m
foldMap1 a -> m
f = forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
forwards
instance Foldable1 f => Foldable1 (Lift f) where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Lift f a -> m
foldMap1 a -> m
f (Pure a
x) = a -> m
f a
x
foldMap1 a -> m
f (Other f a
y) = forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f f a
y
#ifdef MIN_VERSION_tagged
instance Foldable1 (Tagged b) where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Tagged b a -> m
foldMap1 = coerce :: forall a b. Coercible a b => a -> b
coerce
foldrMap1 :: forall a b. (a -> b) -> (a -> b -> b) -> Tagged b a -> b
foldrMap1 a -> b
g a -> b -> b
_ = coerce :: forall a b. Coercible a b => a -> b
coerce a -> b
g
foldrMap1' :: forall a b. (a -> b) -> (a -> b -> b) -> Tagged b a -> b
foldrMap1' a -> b
g a -> b -> b
_ = coerce :: forall a b. Coercible a b => a -> b
coerce a -> b
g
foldlMap1 :: forall a b. (a -> b) -> (b -> a -> b) -> Tagged b a -> b
foldlMap1 a -> b
g b -> a -> b
_ = coerce :: forall a b. Coercible a b => a -> b
coerce a -> b
g
foldlMap1' :: forall a b. (a -> b) -> (b -> a -> b) -> Tagged b a -> b
foldlMap1' a -> b
g b -> a -> b
_ = coerce :: forall a b. Coercible a b => a -> b
coerce a -> b
g
toNonEmpty :: forall a. Tagged b a -> NonEmpty a
toNonEmpty Tagged b a
x = coerce :: forall a b. Coercible a b => a -> b
coerce Tagged b a
x forall a. a -> [a] -> NonEmpty a
:| []
last :: forall a. Tagged b a -> a
last = coerce :: forall a b. Coercible a b => a -> b
coerce
head :: forall a. Tagged b a -> a
head = coerce :: forall a b. Coercible a b => a -> b
coerce
minimum :: forall a. Ord a => Tagged b a -> a
minimum = coerce :: forall a b. Coercible a b => a -> b
coerce
maximum :: forall a. Ord a => Tagged b a -> a
maximum = coerce :: forall a b. Coercible a b => a -> b
coerce
#endif
#ifdef MIN_VERSION_ghc_prim
#if MIN_VERSION_ghc_prim(0,7,0)
instance Foldable1 Solo where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> Solo a -> m
foldMap1 a -> m
f (Solo a
y) = a -> m
f a
y
toNonEmpty :: forall a. Solo a -> NonEmpty a
toNonEmpty (Solo a
x) = a
x forall a. a -> [a] -> NonEmpty a
:| []
minimum :: forall a. Ord a => Solo a -> a
minimum (Solo a
x) = a
x
maximum :: forall a. Ord a => Solo a -> a
maximum (Solo a
x) = a
x
head :: forall a. Solo a -> a
head (Solo a
x) = a
x
last :: forall a. Solo a -> a
last (Solo a
x) = a
x
#endif
#endif
#if __GLASGOW_HASKELL__ <708
coerce :: a -> b
coerce = unsafeCoerce
(#.) :: (b -> c) -> (a -> b) -> a -> c
(#.) _f = coerce
#else
(#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. :: forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
(#.) b -> c
_f = coerce :: forall a b. Coercible a b => a -> b
coerce
#endif