content: {-# LANGUAGE RankNTypes #-}
  module Fresnel.Traversal
  ( -- * Traversals
    Traversal
  , Traversal'
  , IsTraversal
    -- * Construction
  , traversal
  , traversed
  , backwards
  , both
  , beside
  , ignored
    -- * Elimination
  , traverseOf
  , forOf
  , sequenceOf
  , transposeOf
  , mapAccumLOf
  , mapAccumROf
  , scanl1Of
  , scanr1Of
  ) where
  
  import Control.Applicative (ZipList(..))
  import Control.Applicative.Backwards
  import Control.Monad.Trans.State
  import Data.Bitraversable (Bitraversable(..))
  import Data.Profunctor
  import Data.Profunctor.Traversing (Traversing(..))
  import Data.Profunctor.Unsafe ((#.), (.#))
  import Fresnel.Optic
  import Fresnel.Traversal.Internal (IsTraversal)
  
  -- Traversals
  
  type Traversal s t a b = forall p . IsTraversal p => Optic p s t a b
  
  type Traversal' s a = Traversal s s a a
  
  
  -- Construction
  
  traversal :: (forall f . Applicative f => (a -> f b) -> (s -> f t)) -> Traversal s t a b
  traversal f = wander f
  
  traversed :: Traversable t => Traversal (t a) (t b) a b
  traversed = traversal traverse
  
  -- | Reverse the order in which a (finite) 'Traversal' is traversed.
  --
  -- @
  -- 'backwards' . 'backwards' = 'id'
  -- @
  backwards :: Traversal s t a b -> Traversal s t a b
  backwards o = traversal (\ f -> forwards #. traverseOf o (Backwards #. f))
  
  both :: Bitraversable r => Traversal (r a a) (r b b) a b
  both = traversal (\ f -> bitraverse f f)
  
  beside :: Bitraversable r => Traversal s1 t1 a b -> Traversal s2 t2 a b -> Traversal (r s1 s2) (r t1 t2) a b
  beside l r = traversal (\ f -> bitraverse (traverseOf l f) (traverseOf r f))
  
  -- | The trivially empty @'Traversal'@.
  --
  -- @
  -- 'traverseOf' 'ignored' f = pure
  -- @
  ignored :: Traversal s s a b
  ignored = traversal (const pure)
  
  
  -- Elimination
  
  -- | Map over the targets of an 'Fresnel.Iso.Iso', 'Fresnel.Lens.Lens', 'Fresnel.Optional.Optional', or 'Traversal', collecting the results.
  --
  -- @
  -- 'traverseOf' . 'traversal' = 'id'
  -- 'traverseOf' 'traversed' = 'traverse'
  -- @
  traverseOf :: Applicative f => Traversal s t a b -> ((a -> f b) -> (s -> f t))
  traverseOf o = runStar #. o .# Star
  
  forOf :: Applicative f => Traversal s t a b -> (s -> (a -> f b) -> f t)
  forOf o = flip (traverseOf o)
  
  sequenceOf :: Applicative f => Traversal s t (f b) b -> (s -> f t)
  sequenceOf o = traverseOf o id
  
  transposeOf :: Traversal s t [a] a -> s -> [t]
  transposeOf o = getZipList #. traverseOf o ZipList
  
  mapAccumLOf :: Traversal s t a b -> (accum -> a -> (b, accum)) -> accum -> s -> (t, accum)
  mapAccumLOf o f z s =
    let g a = state $ \ accum -> f accum a
    in runState (traverseOf o g s) z
  
  mapAccumROf :: Traversal s t a b -> (accum -> a -> (b, accum)) -> accum -> s -> (t, accum)
  mapAccumROf o = mapAccumLOf (backwards o)
  
  scanl1Of :: Traversal s t a a -> (a -> a -> a) -> s -> t
  scanl1Of o f =
    let step Nothing  a = (a, Just a)
        step (Just s) a = let r = f s a in (r, Just r)
    in fst . mapAccumLOf o step Nothing
  
  scanr1Of :: Traversal s t a a -> (a -> a -> a) -> s -> t
  scanr1Of o f =
    let step Nothing  a = (a, Just a)
        step (Just s) a = let r = f s a in (r, Just r)
    in fst . mapAccumROf o step Nothing
  