{-# LANGUAGE RankNTypes #-}
module Fresnel.Traversal
( -- * Traversals
  Traversal
, Traversal'
, IsTraversal
  -- * Construction
, traversed
, backwards
  -- * Elimination
, traverseOf
, forOf
, sequenceOf
, transposeOf
, mapAccumLOf
, mapAccumROf
, scanl1Of
, scanr1Of
) where

import Control.Applicative (ZipList(..))
import Control.Monad.Trans.State
import Data.Profunctor
import Data.Profunctor.Traversing (Traversing(..))
import Data.Profunctor.Unsafe ((#.))
import Fresnel.Functor.Backwards
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

traversed :: Traversable t => Traversal (t a) (t b) a b
traversed :: Traversal (t a) (t b) a b
traversed = (forall (f :: * -> *).
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> p a b -> p (t a) (t b)
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 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)
traverse

backwards :: Traversal s t a b -> Traversal s t a b
backwards :: 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)
-> 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
f -> Backwards f t -> f t
forall (f :: * -> *) a. Backwards f a -> f a
forwards (Backwards f t -> f t) -> (s -> Backwards f t) -> s -> f t
forall b c a. (b -> c) -> (a -> b) -> 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 Traversal s t a b
o (f b -> Backwards f b
forall (f :: * -> *) a. f a -> Backwards f a
Backwards (f b -> Backwards f b) -> (a -> f b) -> a -> Backwards f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f))


-- Elimination

traverseOf :: Applicative f => Traversal s t a b -> ((a -> f b) -> (s -> f t))
traverseOf :: 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)
-> ((a -> f b) -> Star f s t) -> (a -> f b) -> s -> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic (Star f) s t a b
Traversal s t a b
o Optic (Star f) s t a b
-> ((a -> f b) -> Star f a b) -> (a -> f b) -> Star f s t
forall b c a. (b -> c) -> (a -> b) -> 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 :: 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 Traversal s t a b
o)

sequenceOf :: Applicative f => Traversal s t (f b) b -> (s -> f t)
sequenceOf :: 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 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 :: 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 (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 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 :: 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 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 :: 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 Traversal s t a b
o)

scanl1Of :: Traversal s t a a -> (a -> a -> a) -> s -> t
scanl1Of :: 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 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 :: 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 Traversal s t a a
o Maybe a -> a -> (a, Maybe a)
step Maybe a
forall a. Maybe a
Nothing