ref: f962f4a8fa5d9de0354263ee3fabfafdd9759291
parent: 0dae71b0c16a33956c4faee318dac7abef303de0
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Wed Jan 10 07:58:50 EST 2024
Initial versions of Foldable and Traversable
--- a/lib/AllOfLib.hs
+++ b/lib/AllOfLib.hs
@@ -23,9 +23,11 @@
import Data.Enum
import Data.Eq
import Data.Floating
+import Data.Foldable
import Data.Fractional
import Data.Function
import Data.Functor
+import Data.Functor.Const
import Data.Functor.Identity
import Data.IOArray
import Data.IORef
@@ -52,6 +54,7 @@
import Data.Records
import Data.Semigroup
import Data.STRef
+import Data.Traversable
import Data.Tuple
import Data.Typeable
import Data.TypeLits
--- /dev/null
+++ b/lib/Data/Foldable.hs
@@ -1,0 +1,482 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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 Primitives
+import Control.Alternative
+import Control.Applicative
+import Control.Error
+import Control.Monad
+import Data.Bool
+import Data.Either
+import Data.Eq
+import Data.Function
+import Data.Functor.Const
+import Data.Functor.Identity
+import Data.List_Type
+import qualified Data.List as List
+import Data.Maybe
+import Data.Monoid
+import Data.Num
+import Data.Ord
+import Data.Proxy
+import Data.Semigroup
+import System.IO(seq)
+
+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))
--- /dev/null
+++ b/lib/Data/Traversable.hs
@@ -1,0 +1,242 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.Traversable
+-- Copyright : Conor McBride and 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 traversed from left to right,
+-- performing an action on each element. Instances are expected to satisfy
+-- the listed [laws](#laws).
+-----------------------------------------------------------------------------
+
+module Data.Traversable (
+ -- * The 'Traversable' class
+ Traversable(..),
+ -- * Utility functions
+ for,
+ forM,
+{-+ forAccumM,
+ mapAccumL,
+ mapAccumR,
+ mapAccumM,
+ -- * General definitions for superclass methods
+ fmapDefault,
+ foldMapDefault,
+-}
+ ) where
+import Primitives
+import Control.Applicative
+import Control.Monad
+--import Data.Coerce
+import Data.Either
+import Data.Foldable
+import Data.Function
+import Data.Functor
+import Data.Functor.Const
+import Data.Functor.Identity
+--import Data.Functor.Utils ( StateL(..), StateR(..), StateT(..), (#.) )
+import Data.List_Type
+import qualified Data.List as List
+import Data.Maybe
+import Data.Monoid
+import Data.Proxy
+--import Data.Ord ( Down(..) )
+--import Data.Proxy ( Proxy(..) )
+
+class (Functor t, Foldable t) => Traversable (t :: Type -> Type) where
+
+ traverse :: forall (f :: Type -> Type) a b . Applicative f => (a -> f b) -> t a -> f (t b)
+ traverse f = sequenceA . fmap f
+
+ sequenceA :: forall (f :: Type -> Type) a . Applicative f => t (f a) -> f (t a)
+ sequenceA = traverse id
+
+ mapM :: forall (m :: Type -> Type) a b . Monad m => (a -> m b) -> t a -> m (t b)
+ mapM = traverse
+
+ sequence :: forall (m :: Type -> Type) a . Monad m => t (m a) -> m (t a)
+ sequence = sequenceA
+
+instance Traversable Maybe where
+ traverse _ Nothing = pure Nothing
+ traverse f (Just x) = Just <$> f x
+
+instance Traversable [] where
+ traverse f = List.foldr cons_f (pure [])
+ where cons_f x ys = liftA2 (:) (f x) ys
+
+instance forall a . Traversable (Either a) where
+ traverse _ (Left x) = pure (Left x)
+ traverse f (Right y) = Right <$> f y
+
+instance Traversable Identity where
+ traverse f (Identity a) = Identity <$> f a
+
+instance Traversable Proxy where
+ traverse _ _ = pure Proxy
+
+instance forall m . Traversable (Const m) where
+ traverse _ (Const m) = pure $ Const m
+
+{-+-- | @since 4.15
+deriving instance Traversable Solo
+
+-- | @since 4.7.0.0
+instance Traversable ((,) a) where
+ traverse f (x, y) = (,) x <$> f y
+
+-- | @since 2.01
+instance Ix i => Traversable (Array i) where
+ traverse f arr = listArray (bounds arr) `fmap` traverse f (elems arr)
+
+-- | @since 4.7.0.0
+instance Traversable Proxy where
+ traverse _ _ = pure Proxy
+ {-# INLINE traverse #-}+ sequenceA _ = pure Proxy
+ {-# INLINE sequenceA #-}+ mapM _ _ = pure Proxy
+ {-# INLINE mapM #-}+ sequence _ = pure Proxy
+ {-# INLINE sequence #-}+
+-- | @since 4.7.0.0
+instance Traversable (Const m) where
+ traverse _ (Const m) = pure $ Const m
+
+-- | @since 4.8.0.0
+instance Traversable Dual where
+ traverse f (Dual x) = Dual <$> f x
+
+-- | @since 4.8.0.0
+instance Traversable Sum where
+ traverse f (Sum x) = Sum <$> f x
+
+-- | @since 4.8.0.0
+instance Traversable Product where
+ traverse f (Product x) = Product <$> f x
+
+-- | @since 4.8.0.0
+instance Traversable First where
+ traverse f (First x) = First <$> traverse f x
+
+-- | @since 4.8.0.0
+instance Traversable Last where
+ traverse f (Last x) = Last <$> traverse f x
+
+-- | @since 4.12.0.0
+instance (Traversable f) => Traversable (Alt f) where
+ traverse f (Alt x) = Alt <$> traverse f x
+
+-- | @since 4.12.0.0
+instance (Traversable f) => Traversable (Ap f) where
+ traverse f (Ap x) = Ap <$> traverse f x
+
+-- | @since 4.9.0.0
+instance Traversable ZipList where
+ traverse f (ZipList x) = ZipList <$> traverse f x
+
+
+-- Instances for GHC.Generics
+-- | @since 4.9.0.0
+instance Traversable U1 where
+ traverse _ _ = pure U1
+ {-# INLINE traverse #-}+ sequenceA _ = pure U1
+ {-# INLINE sequenceA #-}+ mapM _ _ = pure U1
+ {-# INLINE mapM #-}+ sequence _ = pure U1
+ {-# INLINE sequence #-}+
+-- | @since 4.9.0.0
+deriving instance Traversable V1
+
+-- | @since 4.9.0.0
+deriving instance Traversable Par1
+
+-- | @since 4.9.0.0
+deriving instance Traversable f => Traversable (Rec1 f)
+
+-- | @since 4.9.0.0
+deriving instance Traversable (K1 i c)
+
+-- | @since 4.9.0.0
+deriving instance Traversable f => Traversable (M1 i c f)
+
+-- | @since 4.9.0.0
+deriving instance (Traversable f, Traversable g) => Traversable (f :+: g)
+
+-- | @since 4.9.0.0
+deriving instance (Traversable f, Traversable g) => Traversable (f :*: g)
+
+-- | @since 4.9.0.0
+deriving instance (Traversable f, Traversable g) => Traversable (f :.: g)
+
+-- | @since 4.9.0.0
+deriving instance Traversable UAddr
+
+-- | @since 4.9.0.0
+deriving instance Traversable UChar
+
+-- | @since 4.9.0.0
+deriving instance Traversable UDouble
+
+-- | @since 4.9.0.0
+deriving instance Traversable UFloat
+
+-- | @since 4.9.0.0
+deriving instance Traversable UInt
+
+-- | @since 4.9.0.0
+deriving instance Traversable UWord
+
+-- Instance for Data.Ord
+-- | @since 4.12.0.0
+deriving instance Traversable Down
+-}
+-- general functions
+
+-- | 'for' is 'traverse' with its arguments flipped. For a version
+-- that ignores the results see 'Data.Foldable.for_'.
+for :: forall (t :: Type -> Type) (f :: Type -> Type) a b . (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b)
+for = flip traverse
+
+forM :: forall (t :: Type -> Type) (m :: Type -> Type) a b . (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)
+forM = flip mapM
+
+{-+mapAccumL :: forall t s a b. Traversable t
+ => (s -> a -> (s, b)) -> s -> t a -> (s, t b)
+mapAccumL f s t = coerce (traverse @t @(StateL s) @a @b) (flip f) t s
+
+mapAccumR :: forall t s a b. Traversable t
+ => (s -> a -> (s, b)) -> s -> t a -> (s, t b)
+mapAccumR f s t = coerce (traverse @t @(StateR s) @a @b) (flip f) t s
+
+mapAccumM
+ :: forall m t s a b. (Monad m, Traversable t)
+ => (s -> a -> m (s, b))
+ -> s -> t a -> m (s, t b)
+mapAccumM f s t = coerce (mapM @t @(StateT s m) @a @b) (StateT #. flip f) t s
+
+forAccumM
+ :: (Monad m, Traversable t)
+ => s -> t a -> (s -> a -> m (s, b)) -> m (s, t b)
+forAccumM s t f = mapAccumM f s t
+
+-}
+
+fmapDefault :: forall t a b . Traversable t
+ => (a -> b) -> t a -> t b
+fmapDefault f = runIdentity . traverse (Identity . f)
+
+foldMapDefault :: forall t m a . (Traversable t, Monoid m)
+ => (a -> m) -> t a -> m
+foldMapDefault f = getConst . traverse (Const . f)
--
⑨