----------------------------------------------------------------------------- -- | -- 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))