{-# 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 :: forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> Traversal s t a b
traversal forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f = (forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> p a b -> p s t
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> p a b -> p s t
forall (p :: * -> * -> *) a b s t.
Traversing p =>
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> p a b -> p s t
wander (a -> f b) -> s -> f t
forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f

traversed :: Traversable t => Traversal (t a) (t b) a b
traversed :: forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed = (forall (f :: * -> *).
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> Traversal (t a) (t b) a b
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> Traversal s t a b
traversal (a -> f b) -> t a -> f (t b)
forall (f :: * -> *). Applicative f => (a -> f b) -> t a -> f (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
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 :: forall s t a b. Traversal s t a b -> Traversal s t a b
backwards Traversal s t a b
o = (forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> Traversal s t a b
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> Traversal s t a b
traversal (\ a -> f b
f -> Backwards f t -> f t
forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
forwards (Backwards f t -> f t) -> (s -> Backwards f t) -> s -> f t
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Traversal s t a b -> (a -> Backwards f b) -> s -> Backwards f t
forall (f :: * -> *) s t a b.
Applicative f =>
Traversal s t a b -> (a -> f b) -> s -> f t
traverseOf Optic p s t a b
Traversal s t a b
o (f b -> Backwards f b
forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (f b -> Backwards f b) -> (a -> f b) -> a -> Backwards f b
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. a -> f b
f))

both :: Bitraversable r => Traversal (r a a) (r b b) a b
both :: forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both = (forall (f :: * -> *).
 Applicative f =>
 (a -> f b) -> r a a -> f (r b b))
-> Traversal (r a a) (r b b) a b
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> Traversal s t a b
traversal (\ a -> f b
f -> (a -> f b) -> (a -> f b) -> r a a -> f (r b b)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> r a b -> f (r c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f b
f a -> f b
f)

beside :: Bitraversable r => Traversal s1 t1 a b -> Traversal s2 t2 a b -> Traversal (r s1 s2) (r t1 t2) a b
beside :: forall (r :: * -> * -> *) s1 t1 a b s2 t2.
Bitraversable r =>
Traversal s1 t1 a b
-> Traversal s2 t2 a b -> Traversal (r s1 s2) (r t1 t2) a b
beside Traversal s1 t1 a b
l Traversal s2 t2 a b
r = (forall (f :: * -> *).
 Applicative f =>
 (a -> f b) -> r s1 s2 -> f (r t1 t2))
-> Traversal (r s1 s2) (r t1 t2) a b
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> Traversal s t a b
traversal (\ a -> f b
f -> (s1 -> f t1) -> (s2 -> f t2) -> r s1 s2 -> f (r t1 t2)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> r a b -> f (r c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (Traversal s1 t1 a b -> (a -> f b) -> s1 -> f t1
forall (f :: * -> *) s t a b.
Applicative f =>
Traversal s t a b -> (a -> f b) -> s -> f t
traverseOf Optic p s1 t1 a b
Traversal s1 t1 a b
l a -> f b
f) (Traversal s2 t2 a b -> (a -> f b) -> s2 -> f t2
forall (f :: * -> *) s t a b.
Applicative f =>
Traversal s t a b -> (a -> f b) -> s -> f t
traverseOf Optic p s2 t2 a b
Traversal s2 t2 a b
r a -> f b
f))

-- | The trivially empty @'Traversal'@.
--
-- @
-- 'traverseOf' 'ignored' f = pure
-- @
ignored :: Traversal s s a b
ignored :: forall s a b (p :: * -> * -> *). IsTraversal p => Optic p s s a b
ignored = (forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f s)
-> Traversal s s a b
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> Traversal s t a b
traversal ((s -> f s) -> (a -> f b) -> s -> f s
forall a b. a -> b -> a
const s -> f s
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
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 :: forall (f :: * -> *) s t a b.
Applicative f =>
Traversal s t a b -> (a -> f b) -> s -> f t
traverseOf Traversal s t a b
o = Star f s t -> s -> f t
forall {k} (f :: k -> *) d (c :: k). Star f d c -> d -> f c
runStar (Star f s t -> s -> f t)
-> (Star f a b -> Star f s t) -> Star f a b -> s -> f t
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Star f a b -> Star f s t
Traversal s t a b
o (Star f a b -> s -> f t)
-> ((a -> f b) -> Star f a b) -> (a -> f b) -> s -> f t
forall a b c (q :: * -> * -> *).
Coercible b a =>
(b -> c) -> q a b -> a -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# (a -> f b) -> Star f a b
forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star

forOf :: Applicative f => Traversal s t a b -> (s -> (a -> f b) -> f t)
forOf :: forall (f :: * -> *) s t a b.
Applicative f =>
Traversal s t a b -> s -> (a -> f b) -> f t
forOf Traversal s t a b
o = ((a -> f b) -> s -> f t) -> s -> (a -> f b) -> f t
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Traversal s t a b -> (a -> f b) -> s -> f t
forall (f :: * -> *) s t a b.
Applicative f =>
Traversal s t a b -> (a -> f b) -> s -> f t
traverseOf Optic p s t a b
Traversal s t a b
o)

sequenceOf :: Applicative f => Traversal s t (f b) b -> (s -> f t)
sequenceOf :: forall (f :: * -> *) s t b.
Applicative f =>
Traversal s t (f b) b -> s -> f t
sequenceOf Traversal s t (f b) b
o = Traversal s t (f b) b -> (f b -> f b) -> s -> f t
forall (f :: * -> *) s t a b.
Applicative f =>
Traversal s t a b -> (a -> f b) -> s -> f t
traverseOf Optic p s t (f b) b
Traversal s t (f b) b
o f b -> f b
forall a. a -> a
id

transposeOf :: Traversal s t [a] a -> s -> [t]
transposeOf :: forall s t a. Traversal s t [a] a -> s -> [t]
transposeOf Traversal s t [a] a
o = ZipList t -> [t]
forall a. ZipList a -> [a]
getZipList (ZipList t -> [t]) -> (s -> ZipList t) -> s -> [t]
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Traversal s t [a] a -> ([a] -> ZipList a) -> s -> ZipList t
forall (f :: * -> *) s t a b.
Applicative f =>
Traversal s t a b -> (a -> f b) -> s -> f t
traverseOf Optic p s t [a] a
Traversal s t [a] a
o [a] -> ZipList a
forall a. [a] -> ZipList a
ZipList

mapAccumLOf :: Traversal s t a b -> (accum -> a -> (b, accum)) -> accum -> s -> (t, accum)
mapAccumLOf :: forall s t a b accum.
Traversal s t a b
-> (accum -> a -> (b, accum)) -> accum -> s -> (t, accum)
mapAccumLOf Traversal s t a b
o accum -> a -> (b, accum)
f accum
z s
s =
  let g :: a -> StateT accum m b
g a
a = (accum -> (b, accum)) -> StateT accum m b
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((accum -> (b, accum)) -> StateT accum m b)
-> (accum -> (b, accum)) -> StateT accum m b
forall a b. (a -> b) -> a -> b
$ \ accum
accum -> accum -> a -> (b, accum)
f accum
accum a
a
  in State accum t -> accum -> (t, accum)
forall s a. State s a -> s -> (a, s)
runState (Traversal s t a b
-> (a -> StateT accum Identity b) -> s -> State accum t
forall (f :: * -> *) s t a b.
Applicative f =>
Traversal s t a b -> (a -> f b) -> s -> f t
traverseOf Optic p s t a b
Traversal s t a b
o a -> StateT accum Identity b
forall {m :: * -> *}. Monad m => a -> StateT accum m b
g s
s) accum
z

mapAccumROf :: Traversal s t a b -> (accum -> a -> (b, accum)) -> accum -> s -> (t, accum)
mapAccumROf :: forall s t a b accum.
Traversal s t a b
-> (accum -> a -> (b, accum)) -> accum -> s -> (t, accum)
mapAccumROf Traversal s t a b
o = Traversal s t a b
-> (accum -> a -> (b, accum)) -> accum -> s -> (t, accum)
forall s t a b accum.
Traversal s t a b
-> (accum -> a -> (b, accum)) -> accum -> s -> (t, accum)
mapAccumLOf (Traversal s t a b -> Traversal s t a b
forall s t a b. Traversal s t a b -> Traversal s t a b
backwards Optic p s t a b
Traversal s t a b
o)

scanl1Of :: Traversal s t a a -> (a -> a -> a) -> s -> t
scanl1Of :: forall s t a. Traversal s t a a -> (a -> a -> a) -> s -> t
scanl1Of Traversal s t a a
o a -> a -> a
f =
  let step :: Maybe a -> a -> (a, Maybe a)
step Maybe a
Nothing  a
a = (a
a, a -> Maybe a
forall a. a -> Maybe a
Just a
a)
      step (Just a
s) a
a = let r :: a
r = a -> a -> a
f a
s a
a in (a
r, a -> Maybe a
forall a. a -> Maybe a
Just a
r)
  in (t, Maybe a) -> t
forall a b. (a, b) -> a
fst ((t, Maybe a) -> t) -> (s -> (t, Maybe a)) -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal s t a a
-> (Maybe a -> a -> (a, Maybe a)) -> Maybe a -> s -> (t, Maybe a)
forall s t a b accum.
Traversal s t a b
-> (accum -> a -> (b, accum)) -> accum -> s -> (t, accum)
mapAccumLOf Optic p s t a a
Traversal s t a a
o Maybe a -> a -> (a, Maybe a)
step Maybe a
forall a. Maybe a
Nothing

scanr1Of :: Traversal s t a a -> (a -> a -> a) -> s -> t
scanr1Of :: forall s t a. Traversal s t a a -> (a -> a -> a) -> s -> t
scanr1Of Traversal s t a a
o a -> a -> a
f =
  let step :: Maybe a -> a -> (a, Maybe a)
step Maybe a
Nothing  a
a = (a
a, a -> Maybe a
forall a. a -> Maybe a
Just a
a)
      step (Just a
s) a
a = let r :: a
r = a -> a -> a
f a
s a
a in (a
r, a -> Maybe a
forall a. a -> Maybe a
Just a
r)
  in (t, Maybe a) -> t
forall a b. (a, b) -> a
fst ((t, Maybe a) -> t) -> (s -> (t, Maybe a)) -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal s t a a
-> (Maybe a -> a -> (a, Maybe a)) -> Maybe a -> s -> (t, Maybe a)
forall s t a b accum.
Traversal s t a b
-> (accum -> a -> (b, accum)) -> accum -> s -> (t, accum)
mapAccumROf Optic p s t a a
Traversal s t a a
o Maybe a -> a -> (a, Maybe a)
step Maybe a
forall a. Maybe a
Nothing