{-# OPTIONS_GHC -Wall #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE BangPatterns #-} -- | -- Module : MapWith -- Description : Provides the fmap-like functions -- Copyright : (c) David James, 2020 -- License : BSD3 -- Stability : Experimental -- -- Provides 'fmap'-like functionality, but can also "inject" additional parameters to the mapping function, such as: -- -- * whether the first / last item -- * the previous / next item -- * the index from the start / end -- -- It offers excellent [performance](#Performance). module MapWith ( -- * Type Names -- $TypeNames -- * Pre-Packaged Maps -- $PrePackagedMaps withFirst , withLast , withFirstLast , andFirstLast , withPrevNext , andPrevNext -- * Custom Maps -- $CustomMaps , mapWith , mapWithM , mapWithM_ , foldMapWith , InjectedFn , Injectable(..) -- * Predefined Injectors -- $PredefinedInjectors , isLim , adjElt , adj2Elts , eltIx , evenElt , foldlElts , foldl1Elts , eltFrom , eltFromMay , eltFromDef -- ** Pre-Combined Injectors -- $PrecombinedInjectors , isFirst , isLast , prevElt , nextElt -- * Custom Injectors , Injector(..) -- ** Stacked-Tuple Helpers -- $StackedTupleHelpers , module CurryTFExps --these are very helpful for building Injectors. Someone can import CurryTF if they want more. -- * Performance -- $Performance -- ** Benchmarks -- $Benchmarks -- ** Fusion -- $Fusion ) where import CurryTF import qualified CurryTF as CurryTFExps (App1, App2, App3, App4, app1, app2, app3, app4) import Data.Foldable (fold) import Data.Traversable (mapAccumL, mapAccumR) import Data.Function ((&)) import Control.Exception (assert) import GHC.Base (build) -- $TypeNames -- These names are used for types and variables throughout: -- -- [@t@]: the 'Traversable' we're mapping over -- [@a@]: a value in the input 'Traversable' -- [@b@]: a result in the output 'Traversable' -- [@i@]: an output from an 'Injector', injected into a map function. (i may represent one than one injected value). -- [@s@]: the internal state in an 'Injector' --XXXX I'd like to add separate comments for each parameter, but that's not supported to GHC 8.6 https://github.com/haskell/haddock/issues/836#issuecomment-391402361 data Injector a i = forall s. Injector (a -> s -> (s, i)) s -- ^the first parameter is a generate function, the second parameter is the initial/prior state. -- ^ An @Injector a i@ can be used with 'mapWith' to map over a 'Traversable' containing elements of type @a@, injecting values according to the type @i@ as it goes. -- -- Injectors have an initial state and a generate function. -- -- For each item in the 'Traversable', the generate function can use both: -- -- - the item from the 'Traversable', and -- - the current state -- -- to determine both: -- -- - the new state, and -- - the injection value(s) -- -- The injection value(s) must be an @args@ (per 'CurryTF'), in order for the injector to work with the '^->' and '<-^' operators. -- These can be created by: -- -- - (recommended) using 'app1', 'app2', etc; -- - by nesting the values appropriately e.g @(i1, ())@ or @(i1, (i2, (i3, (i4, (i5, .. () ..)))))@; or -- - defining a new instance of 'CurryTF' -- -- The first value(s) to inject is/are determined by a first call to the generate function. -- The first call to the generate function is with the first (if combined with '^->') or last (if combined with '<-^') item from the 'Traversable' and the initial state. -- -- For example: -- -- >>> funnyNext a s = (a + 1, app1 $ a + s) -- >>> funnyInjector = Injector funnyNext 17 -- >>> mapWith ((\_ i -> i) ^-> funnyInjector) [4,8,3] -- [21,13,12] -- -- +-------+---------------+------+-----------------+---------------+ -- + Call + Initial State + Item + New State + Injection + -- +=======+===============+======+=================+===============+ -- + 1 + 17 + 4 + 4+1=5 + 17+4=__21__ + -- +-------+---------------+------+-----------------+---------------+ -- + 2 + 5 + 8 + 8+1=9 + 5+8=__13__ + -- +-------+---------------+------+-----------------+---------------+ -- + 3 + 9 + 3 + 3+1=4 (ignored) | 9+3=__12__ + -- +-------+---------------+------+-----------------+---------------+ -- -- >>> mapWith ((\_ i -> i) <-^ funnyInjector) [4,8,3] -- [13,12,20] -- -- +-------+---------------+------+-----------------+---------------+ -- + Call + Initial State + Item + New State + Injection + -- +=======+===============+======+=================+===============+ -- + 1 + 17 + 3 + 3+1=4 + 17+3=__20__ + -- +-------+---------------+------+-----------------+---------------+ -- + 2 + 4 + 8 + 8+1=9 + 4+8=__12__ + -- +-------+---------------+------+-----------------+---------------+ -- + 3 + 9 + 4 + 4+1=5 (ignored) | 9+4=__13__ + -- +-------+---------------+------+-----------------+---------------+ -- -- More usefully, this might allow for e.g. injection of random values, etc. -- $StackedTupleHelpers -- These make it easier to define 'Injector' types and injection values. For example: -- -- >>> myInj = Injector (\_ _ -> ((), app3 7 False 'z')) () :: Injector a (App3 Int Bool Char) -- -- defines an 'Injector', that can map over a 'Traversable' containing any type, and inject three additional constant parameters: @7::Int@, @False::Bool@ and @\'z\'::Char@. Then: -- -- >>> mapWith ((,,,) ^-> myInj) ["foo", "bar", "baz"] -- [("foo",7,False,'z'),("bar",7,False,'z'),("baz",7,False,'z')] -- -- You are advised to use these since I'm considering re-working CurryTF so that it's not based on tuples. -- If I do, I intend to maintain compatibility of app1/App1, etc. {-# INLINE injPair #-} injPair :: Injector a i1 -> Injector a i2 -> Injector a (i1, i2) injPair (Injector n1 z1) (Injector n2 z2) = Injector nxt (z1, z2) where nxt a ~(s1, s2) = let (s1', i1) = n1 a s1 -- !! NOTE THE ~ !! It allows "constant" injectors (e.g. isLim), and hence e.g. andFirstLast to work on infinite lists. (s2', i2) = n2 a s2 in ((s1', s2'), (i1, i2)) -- $PredefinedInjectors -- -- #PredefinedInjectors#Use these (or custom 'Injector's) to create 'InjectedFn's that can be used with 'mapWith' {-# INLINABLE isLim #-} isLim :: Injector a (App1 Bool) isLim = Injector (\_ i -> (False, app1 i)) True -- ^ inject 'True' if the item is at the limit: -- -- - from the left: if it's the first item -- - from the right: if it's the last item -- -- else inject False. -- -- >>> let f a l = [a, if l then '*' else ' '] in mapWith (f ^-> isLim) "12345" -- ["1*","2 ","3 ","4 ","5 "] -- >>> let f a l = [a, if l then '*' else ' '] in mapWith (f <-^ isLim) "12345" -- ["1 ","2 ","3 ","4 ","5*"] {-# INLINABLE eltIx #-} eltIx :: Integral i => Injector a (App1 i) eltIx = Injector (\_ i -> (i+1, app1 i)) 0 -- ^ inject the item index: -- -- - from the left: the first item is 0, the second 1, etc. -- - from the right: the last item is 0, the penultimate 1, etc. -- -- >>> let f a b = a : show b in mapWith (f ^-> eltIx) "freddy" -- ["f0","r1","e2","d3","d4","y5"] -- >>> let f a b = a : show b in mapWith (f <-^ eltIx) "freddy" -- ["f5","r4","e3","d2","d1","y0"] evenElt :: Injector a (App1 Bool) evenElt = Injector (\_ s -> (not s, app1 s)) True -- ^ True if an even-numbered (0th, 2nd, 4th, etc) item, counting from the left or from the right. -- -- >>> let f a e = [a, if e then '*' else ' '] in mapWith (f ^-> evenElt) "012345" -- ["0*","1 ","2*","3 ","4*","5 "] -- >>> let f a e = [a, if e then '*' else ' '] in mapWith (f <-^ evenElt) "543210" -- ["5 ","4*","3 ","2*","1 ","0*"] {-# INLINABLE eltFrom #-} eltFrom :: [i] -- ^ The elements to inject. There must be enough elements. -> Injector a (App1 i) eltFrom l = Injector (\_ s -> assert (not $ null s) (tail s, app1 $ head s)) l -- ^ Inject each given element in turn: -- -- - from the left: the first element will be injected for the first item in the 'Traversable'. -- - from the right: the first element will be injected for the last item in the 'Traversable'. -- -- >>> let f a b = [a,b] in mapWith (f ^-> eltFrom "bill") "sue" -- ["sb","ui","el"] -- >>> let f a b = [a,b] in mapWith (f <-^ eltFrom "bill") "sue" -- ["sl","ui","eb"] -- -- As a result of laziness, it is not always an error if there are not enough elements, for example: -- -- >>> drop 1 $ mapWith ((\_ i -> i) <-^ eltFrom [8,2]) "abc" -- [2,8] {-# INLINABLE eltFromMay #-} eltFromMay :: [i] -> Injector a (App1 (Maybe i)) eltFromMay l = Injector (\_ s -> case s of [] -> ([], app1 Nothing) i:ix -> (ix, app1 $ Just i)) l -- ^ a safe version of `eltFrom`. Injects 'Just' each given element in turn, or 'Nothing' after they've been exhausted. -- -- >>> let f a b = [a,ch b]; ch = maybe '-' id in mapWith (f ^-> eltFromMay "ben") "sally" -- ["sb","ae","ln","l-","y-"] -- >>> let f a b = [a,ch b]; ch = maybe '-' id in mapWith (f <-^ eltFromMay "ben") "sally" -- ["s-","a-","ln","le","yb"] {-# INLINABLE eltFromDef #-} eltFromDef :: i -> [i] -> Injector a (App1 i) eltFromDef def l = Injector (\_ s -> case s of [] -> ([], app1 def) i:ix -> (ix, app1 i)) l -- ^ a safe version of `eltFrom`. Injects each given element in turn, or the default after they've been exhausted. -- -- >>> let f a b = [a,b] in mapWith (f ^-> eltFromDef 'X' "ben") "sally" -- ["sb","ae","ln","lX","yX"] -- >>> let f a b = [a,b] in mapWith (f <-^ eltFromDef 'X' "ben") "sally" -- ["sX","aX","ln","le","yb"] {-# INLINABLE adjElt #-} adjElt :: Injector a (App1 (Maybe a)) adjElt = Injector (\a prevMay -> (Just a, app1 prevMay)) Nothing -- ^ inject 'Just' the adjacent item: -- -- - from the left: the previous item, except for the first item -- - from the right: the next item, except for the last item. (The "previous from the right" is the "next".) -- -- inject 'Nothing' if there is no adjacent item (i.e. for the first / last). -- -- >>> let f a b = [a,maybe '-' id b] in mapWith (f ^-> adjElt) "12345" -- ["1-","21","32","43","54"] -- >>> let f a b = [a,maybe '-' id b] in mapWith (f <-^ adjElt) "12345" -- ["12","23","34","45","5-"] {-# INLINABLE adj2Elts #-} adj2Elts :: Injector a (App2 (Maybe a) (Maybe a)) adj2Elts = Injector (\a (prev1May, prev2May) -> ((Just a, prev1May), app2 prev1May prev2May)) (Nothing, Nothing) -- ^ like 'adjElt', but injects the two adjacent items into separate parameters. -- -- >>> let f a b c = [a,ch b,ch c]; ch = maybe '-' id in mapWith (f ^-> adj2Elts) "12345" -- ["1--","21-","321","432","543"] -- >>> let f a b c = [a,ch b,ch c]; ch = maybe '-' id in mapWith (f <-^ adj2Elts) "12345" -- ["123","234","345","45-","5--"] {-# INLINABLE foldlElts #-} foldlElts :: (i -> a -> i) -> i -> Injector a (App1 i) foldlElts f z = Injector (\a s -> let s' = f s a in (s', app1 s')) z -- ^ Inject a (left-associative) fold of the items: -- -- +------+---------------------------------------------------------------------------------------------+ -- | | Injected Value | -- | +---------------------------------------------+-----------------------------------------------+ -- | Item | from the left | from the right | -- +======+=============================================+===============================================+ -- | a0 | @z \`acc\` a0@ | @((z \`acc\` an) \`acc\` .. a1) \`acc\` a0@ | -- +------+---------------------------------------------+-----------------------------------------------+ -- | a1 | @(z \`acc\` a0) \`acc\` a1@ | @(z \`acc\` an) \`acc\` .. a1@ | -- +------+---------------------------------------------+-----------------------------------------------+ -- | .. | | | -- +------+---------------------------------------------+-----------------------------------------------+ -- | an | @((z \`acc\` a0) \`acc\` a1) \`acc\` .. an@ | @z \`acc\` an@ | -- +------+---------------------------------------------+-----------------------------------------------+ -- -- >>> let f a b = a ++ show b in mapWith (f ^-> foldlElts (\l s -> l + length s) 0) ["every", "good", "boy"] -- ["every5","good9","boy12"] -- >>> let f a b = a ++ show b in mapWith (f <-^ foldlElts (\l s -> l + length s) 0) ["every", "good", "boy"] -- ["every12","good7","boy3"] {-# INLINABLE foldl1Elts #-} foldl1Elts :: (a -> a -> a) -> Injector a (App1 a) foldl1Elts f = Injector (\a s -> let s' = maybe a (flip f a) s in (Just s', app1 s')) Nothing -- ^ A variant of 'foldlElts' that has no starting value: -- -- +------+----------------------------------------------------------------------+ -- | | Injected Value | -- | +----------------------------------+-----------------------------------+ -- | Item | from the left | from the right | -- +======+==================================+===================================+ -- | a0 | @a0@ | @(an \`acc\` .. a1) \`acc\` a0@ | -- +------+----------------------------------+-----------------------------------+ -- | a1 | @a0 \`acc\` a1@ | @an \`acc\` .. a1@ | -- +------+----------------------------------+-----------------------------------+ -- | .. | | | -- +------+----------------------------------+-----------------------------------+ -- | an | @(a0 \`acc\` a1) \`acc\` .. an@ | @an@ | -- +------+----------------------------------+-----------------------------------+ -- -- >>> mapWith ((,) ^-> foldl1Elts (-)) [10,1,3] -- [(10,10),(1,9),(3,6)] -- >>> mapWith ((,) <-^ foldl1Elts (-)) [10,1,3] -- [(10,-8),(1,2),(3,3)] -- $CustomMaps -- -- In general, a map function will take one parameter from the 'Traversable', then one (or more) from each of any number of 'Injector's. For example: -- -- >>> mapFn w x y z = (w, x, y, z) -- >>> injectedFn = mapFn <-^ isLim ^-> eltIx <-^ eltFrom [8,2,7,1] -- >>> mapWith injectedFn "abc" -- [('a',False,0,7),('b',False,1,2),('c',True,2,8)] -- -- Where: -- -- - @mapFn@: a function that maps over a 'Traversable', but requires additional parameters -- - @injectedFn@: represents the combination of @mapFn@ with three injectors that provide the required parameters: -- -- - @'<-^' 'isLim'@: injects True if this is the limit, from the right (i.e. the last item). -- - @'^->' 'eltIx'@: inject the index, from the left -- - @'<-^' 'eltFrom' [8,2,7,1]@: inject elements from this list, from the right. -- -- 'mapWith' then maps the @mapFn@ over the 'Traversable', with the following parameters: -- -- +------+--------+---------+---------+---------+ -- | Call | w | x | y | z | -- +======+========+=========+=========+=========+ -- | 1 | \'a\' | 'False' | 0 | 7 | -- +------+--------+---------+---------+---------+ -- | 2 | \'b\' | 'False' | 1 | 2 | -- +------+--------+---------+---------+---------+ -- | 3 | \'c\' | 'True' | 2 | 8 | -- +------+--------+---------+---------+---------+ {-# INLINABLE mapWith #-} mapWith :: Traversable t => InjectedFn a b -> t a -> t b mapWith (InjectedFnL f (Injector gen z)) = mySnd . myMapAccumL acc z where acc s a = let (s', i) = gen a s in (s', f a i) mapWith (InjectedFnR f (Injector gen z)) = snd . mapAccumR acc z where acc s a = let (s', i) = gen a s in (s', f a i) mapWith (InjectedFnLR f (Injector genL zL) (Injector genR zR)) = snd . mapAccumR accR zR . mySnd . myMapAccumL accL zL --have mapAccumL create values (not parial function applications). It can fuse with data providers --the myMapAccumR can then PIN the mapAccumL results (not on stack) plus its own R-based injections. --(good) consumets can tail recurse/loop over the data applying the injections as they go. --(Don't store data or partial functions during recusion unwind: it can cause very slow behaviour on huge lists). where accL s a = let (s', il) = genL a s in (s', (a, il)) accR s (a, il) = let (s', ir) = genR a s in (s', f a il ir) -- ^ maps an 'InjectedFn' over a 'Traversable' type @t@, turning a @t a@ into a @t b@ and preserving the structure of @t@. -- -- Parameters (as defined in the 'InjectedFn') are passed to a map function (embedded in the 'InjectedFn'), in addition to the elements of the 'Traversable'. mapWithM :: (Traversable t, Monad m) => InjectedFn a (m b) -> t a -> m (t b) mapWithM f = sequence . mapWith f -- ^ like 'mapM', but with an 'InjectedFn'. mapWithM_ :: (Traversable t, Monad m) => InjectedFn a (m b) -> t a -> m () mapWithM_ f = sequence_ . mapWith f -- ^ like 'mapM_' (which is like 'mapM' but ignores the results), but with an 'InjectedFn'. foldMapWith :: (Traversable t, Monoid b) => InjectedFn a b -> t a -> b foldMapWith f = fold . mapWith f -- ^ like 'foldMap', but with an 'InjectedFn' data InjectedFn a b = forall l r. InjectedFnLR (a -> l -> r -> b) (Injector a l) (Injector a r) | forall l . InjectedFnL (a -> l -> b) (Injector a l) | forall r. InjectedFnR (a -> r -> b) (Injector a r) -- ^ Represents a function from @a@, plus a number of injected values, to @b@. -- -- Used by 'mapWith' (& related), which maps over a 'Traversable', injecting the additional values as it goes. -- -- Constructed by combining a map function with 'Injector's using the '^->' and '<-^' operators. -- -- The sequence: -- -- @(a -> i1 -> i2 -> ... -> in -> b) /op1/ /inj1/ /op2/ /inj2/ ... /opn/ /injn/@ -- -- where: -- -- - each @/op/@ is '^->' or '<-^'; and -- - each @/inj/@ is an 'Injector' -- -- produces an @'InjectedFn' a b@, with n injected values (or more if any of the injectors inject multiple values). class Injectable m where -- | Inject "from the left" (^->) :: CurryTF i b => m a (FnType i b) -> Injector a i -> InjectedFn a b -- | Inject "from the right" (<-^) :: CurryTF i b => m a (FnType i b) -> Injector a i -> InjectedFn a b -- ^ An 'Injectable' is (recursively) either: -- -- - a function @(a -> i1 [.. -> in] -> b)@; or -- - an @InjectedFn a (i1 [.. -> in] -> b)@, created by @'Injectable' /op/ 'Injector'@ -- -- When @n@ is the number of parameters injected by an injector (most commonly 1). infixl 1 ^-> infixl 1 <-^ --In the below, iL = existing left Injector; nL = new left Injector. l = existing left-injected value; nl = new left-injected value. instance Injectable (->) where f ^-> nL = InjectedFnL (\a nl -> f a $# nl) nL f <-^ nR = InjectedFnR (\a nr -> f a $# nr) nR instance Injectable InjectedFn where InjectedFnL f iL ^-> nL = InjectedFnL (\a (l, nl) -> f a l $# nl) (injPair iL nL) InjectedFnR f iR ^-> nL = InjectedFnLR (\a nl r -> f a r $# nl) nL iR InjectedFnLR f iL iR ^-> nL = InjectedFnLR (\a (l, nl) r -> f a l r $# nl) (injPair iL nL) iR InjectedFnL f iL <-^ nR = InjectedFnLR (\a l nr -> f a l $# nr) iL nR InjectedFnR f iR <-^ nR = InjectedFnR (\a (r, nr) -> f a r $# nr) (injPair iR nR) InjectedFnLR f iL iR <-^ nR = InjectedFnLR (\a l (r, nr) -> f a l r $# nr) iL (injPair iR nR) -- $PrecombinedInjectors -- These are combinations of '^->' or '<-^' with [pre-defined injectors](#PredefinedInjectors). -- -- They work well with the '&' operator, and can be combined with the '^->' and '<-^' operators e.g.: -- -- prop> mapWith (f & isFirst <-^ eltFrom [9,2]) == mapWith (f ^-> isLim <-^ eltFrom [9,2]) -- -- You may find them more memorable or easier to type. isFirst :: Injectable f => f a (Bool -> b) -> InjectedFn a b isFirst f = f ^-> isLim -- ^ 'isLim', from the left. isLast :: Injectable f => f a (Bool -> b) -> InjectedFn a b isLast f = f <-^ isLim -- ^ 'isLim', from the right. prevElt :: Injectable f => f a (Maybe a -> b) -> InjectedFn a b prevElt f = f ^-> adjElt -- ^ 'adjElt', from the left. nextElt :: Injectable f => f a (Maybe a -> b) -> InjectedFn a b nextElt f = f <-^ adjElt -- ^ 'adjElt', from the right. -- $PrePackagedMaps -- Some pre-defined maps with commonly used injectors. {-# INLINABLE withFirst #-} withFirst :: Traversable t => (a -> Bool -> b) -> t a -> t b withFirst f = mapWith $ f & isFirst -- ^ Maps over a 'Traversable', with an additional parameter indicating whether an item is the first. -- -- >>> let g x f = [if f then '*' else ' ', x] in withFirst g "fred" -- ["*f", " r", " e", " d"] {-# INLINABLE withLast #-} withLast :: Traversable t => (a -> Bool -> b) -> t a -> t b withLast f = mapWith $ f & isLast -- ^ Maps over a 'Traversable', with an additional parameter indicating whether an item is the last. -- -- >>> let g x l = [x, if l then '*' else ' '] in withLast g "fred" -- ["f ","r ","e ","d*"] {-# INLINABLE withFirstLast #-} withFirstLast :: Traversable t => (a -> Bool -> Bool -> b) -> t a -> t b withFirstLast f = mapWith $ f & isFirst & isLast -- ^ Maps over a 'Traversable', with additional parameters indicating whether an item is the first or last (or both). -- -- >>> let g x f l = [star f, x, star l]; star b = if b then '*' else ' ' in withFirstLast g "fred" -- ["*f ", " r ", " e ", " d*"] {-# INLINABLE andFirstLast #-} andFirstLast :: Traversable t => t a -> t (a, Bool, Bool) andFirstLast = withFirstLast (,,) -- ^ > andFirstLast = withFirstLast (,,) {-# INLINABLE withPrevNext #-} withPrevNext :: Traversable t => (a -> Maybe a -> Maybe a -> b) -> t a -> t b withPrevNext f = mapWith $ f & prevElt & nextElt -- ^ Maps over a 'Traversable', with additional parameters indicating the previous and next elements. -- -- The second (or third) parameter to the map function is 'Nothing' when called for the first (or last) item, otherwise it's 'Just' the previous (or next) item. -- -- >>> let f x prvMay nxtMay = maybe "*" (cmp x) prvMay ++ x ++ maybe "*" (cmp x) nxtMay; cmp x y = show $ compare x y in withPrevNext f ["foo", "bar", "baz"] -- ["*fooGT","LTbarLT","GTbaz*"] {-# INLINABLE andPrevNext #-} andPrevNext :: Traversable t => t a -> t (a, Maybe a, Maybe a) andPrevNext = withPrevNext (,,) -- ^ > andPrevNext = withPrevNext (,,) -- myMapAccumL/R which can fuse. {-# NOINLINE [1] myMapAccumL #-} --cf {-# NOINLINE [1] unsafeTake #-} myMapAccumL :: Traversable t => (s -> a -> (s, b)) -> s -> t a -> (s, t b) myMapAccumL = mapAccumL {-# NOINLINE [1] mySnd #-} mySnd :: (a, b) -> b mySnd = snd {-# RULES --modelled on "take". "sndMapAccumL" [~1] forall f z xs. mySnd (myMapAccumL f z xs) = build (\c nil -> foldr (mapAccumLFB c f) (flipSeqMapAccumL nil) xs z) #-} {- I can't make this fire, but it doesn't seem to be a great loss. "sndMapAccumLList" [1] forall f z xs. foldr (mapAccumLFB (:) f) (flipSeqMapAccumL []) xs z = sndMapAccumLList f z xs {-# NOINLINE [1] sndMapAccumLList #-} sndMapAccumLList :: (s -> a -> (s, b)) -> s -> [a] -> [b] sndMapAccumLList f z = snd . mapAccumL f z -} {-# INLINE [0] mapAccumLFB #-} mapAccumLFB :: (b -> r -> r) -> (s -> a -> (s, b)) -> a -> (s -> r) -> s -> r mapAccumLFB c f x xs = \s -> let (s', b) = f s x in b `c` xs s' {-# INLINE [0] flipSeqMapAccumL #-} flipSeqMapAccumL :: a -> s -> a flipSeqMapAccumL x !_s = x {- $Performance I think the performance is now (since 0.2.0.0) excellent. In particular: - `mapWith` "traverses" in each direction at most once, and only goes in both directions if it needs to; - many functions are inlinable and "compile away"; and - mapWith is capable of fusion (see details below). If you have any examples where you think performance is poor, or suggestions for improvements, please let me know. -} {- $Benchmarks I've compared the performance of `mapWith` vs [markbounds](https://stackoverflow.com/questions/14114011/haskell-map-operation-with-different-first-and-last-functions#answer-53282575) and a number of other attempts to "hand craft" equivalent functionality. The results are in [Benchmarks.ods](https://github.com/davjam/MapWith/blob/master/doc/Benchmarks.ods). The [Benchmarks.hs](https://github.com/davjam/MapWith/blob/master/perf/Benchmarks.hs) file contains the details of these tests. -} {- $Fusion `mapWith` & friends are capable of [list fusion](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#list-fusion). When the `Traversable` is a List, `mapWith` is always a "good consumer". When the only injections are "from the left", it is also a "good producer". As a result, code like: >>> let f n b = if b then n*2 else n*3 in sum $ mapWith (f ^-> evenElt) [1..1000000] will compile to a loop with no generation of list elements and no call stack usage. When a "from the right" injection occurs, `mapWith` is not a "good producer", and an intermediate list will be created. However, with a "state free" `Injector` (such as `isLim` or `adjElt`), the list elements will only exist temporarily, the call stack will not grow (see [here](https://stackoverflow.com/questions/63504127/haskell-pinned-or-stack-memory-for-performance)), and there is no limit to the number of elements in the processed list. With other "from the right" Injectors, the call stack will grow as elements are processed, giving a limit to the size of the list. Despite this, I think the performance remains very good, and better than many alternative approaches. In summary, when `mapWith` sits between a "good producer" and a "good consumer", there are three broad categories of behaviour: +-----------------------------------------+--------------+------------+ | Injections | Speed | Size limit | +=========================================+==============+============+ | only "from the left" | exceptional | No | +-----------------------------------------+--------------+------------+ | "from the right", but only "state free" | very good | No | +-----------------------------------------+--------------+------------+ | any | good | Yes | +-----------------------------------------+--------------+------------+ Note that `eltFrom` (and similar) are not a "good consumers". -}