{-# 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".
-}