ref: 60e96185f08ab8f36698c16c41633bc3a4295b77
dir: /lib/Data/Foldable.hs/
-----------------------------------------------------------------------------
-- |
-- Module : Data.Foldable
-- Copyright : Ross Paterson 2005
-- License : BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer : libraries@haskell.org
-- Stability : stable
-- Portability : portable
--
-- Class of data structures that can be folded to a summary value.
--
-----------------------------------------------------------------------------
module Data.Foldable (
Foldable(..),
-- * Special biased folds
foldrM,
foldlM,
-- * Folding actions
-- ** Applicative actions
traverse_,
for_,
sequenceA_,
asum,
-- ** Monadic actions
mapM_,
forM_,
sequence_,
msum,
-- * Specialized folds
concat,
concatMap,
and,
or,
any,
all,
maximumBy,
minimumBy,
-- * Searches
notElem,
find
) where
import Prelude() -- do not import Prelude
import Primitives
import Control.Applicative(Applicative(..), Alternative(..))
import Control.Error
import Control.Monad(Monad(..), MonadPlus(..))
import Data.Bool
import Data.Either
import Data.Eq
import Data.Function
import Data.Functor.Const
import Data.Functor.Identity
import Data.List_Type hiding (concatMap)
import qualified Data.List as List
import Data.Maybe
import Data.Monoid
import Data.Num
import Data.Ord
import Data.Proxy
import Data.Semigroup
newtype MMax a = MMax (Maybe a)
getMMax :: forall a . MMax a -> Maybe a
getMMax (MMax ma) = ma
newtype MMin a = MMin (Maybe a)
getMMin :: forall a . MMin a -> Maybe a
getMMin (MMin ma) = ma
instance forall a . Ord a => Semigroup (MMax a) where
m <> MMax Nothing = m
MMax Nothing <> n = n
(MMax m@(Just x)) <> (MMax n@(Just y))
| x >= y = MMax m
| otherwise = MMax n
instance forall a . Ord a => Monoid (MMax a) where
mempty = MMax Nothing
mconcat = List.foldl' (<>) mempty
instance forall a . Ord a => Semigroup (MMin a) where
m <> MMin Nothing = m
MMin Nothing <> n = n
(MMin m@(Just x)) <> (MMin n@(Just y))
| x <= y = MMin m
| otherwise = MMin n
instance forall a . Ord a => Monoid (MMin a) where
mempty = MMin Nothing
mconcat = List.foldl' (<>) mempty
-------------------------------
infix 4 `elem`, `notElem`
class Foldable (t :: Type -> Type) where
{-# MINIMAL foldMap | foldr #-}
fold :: forall m . Monoid m => t m -> m
fold = foldMap id
foldMap :: forall m a . Monoid m => (a -> m) -> t a -> m
foldMap f = foldr (mappend . f) mempty
foldMap' :: forall m a . Monoid m => (a -> m) -> t a -> m
foldMap' f = foldl' (\ acc a -> acc <> f a) mempty
foldr :: forall a b . (a -> b -> b) -> b -> t a -> b
foldr f z t = appEndo (foldMap (Endo . f) t) z
foldr' :: forall a b . (a -> b -> b) -> b -> t a -> b
foldr' f z0 = \ xs ->
foldl (\ k x -> {-oneShot-} (\ z -> z `seq` k (f x z)))
id xs z0
foldl :: forall a b . (b -> a -> b) -> b -> t a -> b
foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z
foldl' :: forall a b . (b -> a -> b) -> b -> t a -> b
foldl' f z0 = \ xs ->
foldr (\ x k -> {-oneShot-} (\ z -> z `seq` k (f z x)))
id xs z0
foldr1 :: forall a . (a -> a -> a) -> t a -> a
foldr1 f xs = fromMaybe (error "foldr1: empty structure")
(foldr mf Nothing xs)
where
mf x m = Just (case m of
Nothing -> x
Just y -> f x y
)
foldl1 :: forall a . (a -> a -> a) -> t a -> a
foldl1 f xs = fromMaybe (error "foldl1: empty structure")
(foldl mf Nothing xs)
where
mf m y = Just (case m of
Nothing -> y
Just x -> f x y
)
toList :: forall a . t a -> [a]
toList t = foldr (:) [] t
null :: forall a . t a -> Bool
null = foldr (\_ _ -> False) True
length :: forall a . t a -> Int
length = foldl' (\c _ -> c+1) 0
elem :: forall a . Eq a => a -> t a -> Bool
elem = any . (==)
maximum :: forall a . Ord a => t a -> a
maximum = fromMaybe (error "maximum: empty structure") .
getMMax . foldMap' (MMax . Just)
minimum :: forall a . Ord a => t a -> a
minimum = fromMaybe (error "minimum: empty structure") .
getMMin . foldMap' (MMin . Just)
sum :: forall a . Num a => t a -> a
sum = getSum . foldMap' Sum
product :: forall a . Num a => t a -> a
product = getProduct . foldMap' Product
instance Foldable Maybe where
foldMap = maybe mempty
foldr _ z Nothing = z
foldr f z (Just x) = f x z
foldl _ z Nothing = z
foldl f z (Just x) = f z x
instance Foldable [] where
elem = List.elem
foldl = List.foldl
foldl' = List.foldl'
foldl1 = List.foldl1
foldr = List.foldr
--foldr' = List.foldr'
foldr1 = List.foldr1
foldMap = (mconcat .) . List.map
fold = mconcat
length = List.length
maximum = List.maximum
minimum = List.minimum
null = List.null
product = List.product
sum = List.sum
toList = id
instance forall a . Foldable (Either a) where
foldMap _ (Left _) = mempty
foldMap f (Right y) = f y
foldr _ z (Left _) = z
foldr f z (Right y) = f y z
length (Left _) = 0
length (Right _) = 1
null = isLeft
instance Foldable Proxy where
foldMap _ _ = mempty
instance Foldable Identity where
foldMap f (Identity a) = f a
instance forall m . Foldable (Const m) where
foldMap _ _ = mempty
{-
-- | @since 4.15
deriving instance Foldable Solo
-- | @since 4.7.0.0
instance Foldable ((,) a) where
foldMap f (_, y) = f y
foldr f z (_, y) = f y z
length _ = 1
null _ = False
-- | @since 4.8.0.0
instance Foldable (Array i) where
foldr = foldrElems
foldl = foldlElems
foldl' = foldlElems'
foldr' = foldrElems'
foldl1 = foldl1Elems
foldr1 = foldr1Elems
toList = elems
length = numElements
null a = numElements a == 0
-- | @since 4.7.0.0
instance Foldable Proxy where
foldMap _ _ = mempty
{-# INLINE foldMap #-}
fold _ = mempty
{-# INLINE fold #-}
foldr _ z _ = z
{-# INLINE foldr #-}
foldl _ z _ = z
{-# INLINE foldl #-}
foldl1 _ _ = error "foldl1: Proxy"
foldr1 _ _ = error "foldr1: Proxy"
length _ = 0
null _ = True
elem _ _ = False
sum _ = 0
product _ = 1
-- | @since 4.8.0.0
instance Foldable Dual where
foldMap = coerce
elem = (. getDual) . (==)
foldl = coerce
foldl' = coerce
foldl1 _ = getDual
foldr f z (Dual x) = f x z
foldr' = foldr
foldr1 _ = getDual
length _ = 1
maximum = getDual
minimum = getDual
null _ = False
product = getDual
sum = getDual
toList (Dual x) = [x]
-- | @since 4.8.0.0
instance Foldable Sum where
foldMap = coerce
elem = (. getSum) . (==)
foldl = coerce
foldl' = coerce
foldl1 _ = getSum
foldr f z (Sum x) = f x z
foldr' = foldr
foldr1 _ = getSum
length _ = 1
maximum = getSum
minimum = getSum
null _ = False
product = getSum
sum = getSum
toList (Sum x) = [x]
-- | @since 4.8.0.0
instance Foldable Product where
foldMap = coerce
elem = (. getProduct) . (==)
foldl = coerce
foldl' = coerce
foldl1 _ = getProduct
foldr f z (Product x) = f x z
foldr' = foldr
foldr1 _ = getProduct
length _ = 1
maximum = getProduct
minimum = getProduct
null _ = False
product = getProduct
sum = getProduct
toList (Product x) = [x]
-- | @since 4.8.0.0
instance Foldable First where
foldMap f = foldMap f . getFirst
-- | @since 4.8.0.0
instance Foldable Last where
foldMap f = foldMap f . getLast
-- | @since 4.12.0.0
instance (Foldable f) => Foldable (Alt f) where
foldMap f = foldMap f . getAlt
-- | @since 4.12.0.0
instance (Foldable f) => Foldable (Ap f) where
foldMap f = foldMap f . getAp
-- Instances for GHC.Generics
-- | @since 4.9.0.0
instance Foldable U1 where
foldMap _ _ = mempty
{-# INLINE foldMap #-}
fold _ = mempty
{-# INLINE fold #-}
foldr _ z _ = z
{-# INLINE foldr #-}
foldl _ z _ = z
{-# INLINE foldl #-}
foldl1 _ _ = error "foldl1: U1"
foldr1 _ _ = error "foldr1: U1"
length _ = 0
null _ = True
elem _ _ = False
sum _ = 0
product _ = 1
-- | @since 4.9.0.0
deriving instance Foldable V1
-- | @since 4.9.0.0
deriving instance Foldable Par1
-- | @since 4.9.0.0
deriving instance Foldable f => Foldable (Rec1 f)
-- | @since 4.9.0.0
deriving instance Foldable (K1 i c)
-- | @since 4.9.0.0
deriving instance Foldable f => Foldable (M1 i c f)
-- | @since 4.9.0.0
deriving instance (Foldable f, Foldable g) => Foldable (f :+: g)
-- | @since 4.9.0.0
deriving instance (Foldable f, Foldable g) => Foldable (f :*: g)
-- | @since 4.9.0.0
deriving instance (Foldable f, Foldable g) => Foldable (f :.: g)
-- | @since 4.9.0.0
deriving instance Foldable UAddr
-- | @since 4.9.0.0
deriving instance Foldable UChar
-- | @since 4.9.0.0
deriving instance Foldable UDouble
-- | @since 4.9.0.0
deriving instance Foldable UFloat
-- | @since 4.9.0.0
deriving instance Foldable UInt
-- | @since 4.9.0.0
deriving instance Foldable UWord
-- Instances for Data.Ord
-- | @since 4.12.0.0
deriving instance Foldable Down
-}
foldrM :: forall (t :: Type -> Type) (m :: Type -> Type) a b . (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b
foldrM f z0 xs = foldl c return xs z0
where c k x z = f x z >>= k
foldlM :: forall (t :: Type -> Type) (m :: Type -> Type) a b . (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b
foldlM f z0 xs = foldr c return xs z0
where c x k z = f z x >>= k
traverse_ :: forall (t :: Type -> Type) (f :: Type -> Type) a b . (Foldable t, Applicative f) => (a -> f b) -> t a -> f ()
traverse_ f = foldr c (pure ())
where c x k = f x *> k
{-# INLINE c #-}
for_ :: forall (t :: Type -> Type) (f :: Type -> Type) a b . (Foldable t, Applicative f) => t a -> (a -> f b) -> f ()
for_ = flip traverse_
mapM_ :: forall (t :: Type -> Type) (m :: Type -> Type) a b . (Foldable t, Monad m) => (a -> m b) -> t a -> m ()
mapM_ f = foldr c (return ())
where c x k = f x >> k
{-# INLINE c #-}
forM_ :: forall (t :: Type -> Type) (m :: Type -> Type) a b . (Foldable t, Monad m) => t a -> (a -> m b) -> m ()
forM_ = flip mapM_
sequenceA_ :: forall (t :: Type -> Type) (f :: Type -> Type) a . (Foldable t, Applicative f) => t (f a) -> f ()
sequenceA_ = foldr c (pure ())
where c m k = m *> k
{-# INLINE c #-}
sequence_ :: forall (t :: Type -> Type) (m :: Type -> Type) a . (Foldable t, Monad m) => t (m a) -> m ()
sequence_ = foldr c (return ())
where c m k = m >> k
{-# INLINE c #-}
asum :: forall (t :: Type -> Type) (f :: Type -> Type) a . (Foldable t, Alternative f) => t (f a) -> f a
asum = foldr (<|>) empty
msum :: forall (t :: Type -> Type) (m :: Type -> Type) a . (Foldable t, Alternative m, MonadPlus m) => t (m a) -> m a
msum = asum
concat :: forall (t :: Type -> Type) a . Foldable t => t [a] -> [a]
concat xs = foldr (\x y -> foldr (:) y x) [] xs
concatMap :: forall (t :: Type -> Type) a b . Foldable t => (a -> [b]) -> t a -> [b]
concatMap f xs = foldr (\x b -> foldr (:) b (f x)) [] xs
and :: forall (t :: Type -> Type) . Foldable t => t Bool -> Bool
and = getAll . foldMap All
or :: forall (t :: Type -> Type) . Foldable t => t Bool -> Bool
or = getAny . foldMap Any
any :: forall (t :: Type -> Type) a . Foldable t => (a -> Bool) -> t a -> Bool
any p = getAny . foldMap (Any . p)
all :: forall (t :: Type -> Type) a . Foldable t => (a -> Bool) -> t a -> Bool
all p = getAll . foldMap (All . p)
maximumBy :: forall (t :: Type -> Type) a . Foldable t => (a -> a -> Ordering) -> t a -> a
maximumBy cmp = fromMaybe (error "maximumBy: empty structure")
. foldl' max' Nothing
where
max' mx y = Just $! case mx of
Nothing -> y
Just x -> case cmp x y of
GT -> x
_ -> y
minimumBy :: forall (t :: Type -> Type) a . Foldable t => (a -> a -> Ordering) -> t a -> a
minimumBy cmp = fromMaybe (error "minimumBy: empty structure")
. foldl' min' Nothing
where
min' mx y = Just $! case mx of
Nothing -> y
Just x -> case cmp x y of
GT -> y
_ -> x
notElem :: forall (t :: Type -> Type) a . (Foldable t, Eq a) => a -> t a -> Bool
notElem x = not . elem x
find :: forall (t :: Type -> Type) a . Foldable t => (a -> Bool) -> t a -> Maybe a
find p = getFirst . foldMap (\ x -> First (if p x then Just x else Nothing))