{-# LANGUAGE RankNTypes #-}
module Fresnel.Traversal1
( -- * Relevant traversals
  Traversal1
, Traversal1'
, IsTraversal1
  -- * Construction
, traversal1
, traversed1
, backwards
, both
, beside
  -- * Elimination
, traverse1Of
, for1Of
, sequence1Of
, transposeOf
) where

import Control.Applicative.Backwards
import Data.Functor.Apply
import Data.List.NonEmpty (NonEmpty(..), zipWith)
import Data.Profunctor.Unsafe ((#.), (.#))
import Data.Semigroup.Bitraversable
import Data.Semigroup.Traversable
import Fresnel.Optic
import Fresnel.Profunctor.Star1 (Star1(..))
import Fresnel.Profunctor.Traversing1
import Fresnel.Traversal1.Internal
import Prelude hiding (zipWith)

-- Relevant traversals

type Traversal1 s t a b = forall p . IsTraversal1 p => Optic p s t a b

type Traversal1' s a = Traversal1 s s a a


-- Construction

traversal1 :: (forall f . Apply f => (a -> f b) -> (s -> f t)) -> Traversal1 s t a b
traversal1 :: forall a b s t.
(forall (f :: * -> *). Apply f => (a -> f b) -> s -> f t)
-> Traversal1 s t a b
traversal1 forall (f :: * -> *). Apply f => (a -> f b) -> s -> f t
f = (forall (f :: * -> *). Apply f => (a -> f b) -> s -> f t)
-> p a b -> p s t
forall a b s t.
(forall (f :: * -> *). Apply f => (a -> f b) -> s -> f t)
-> p a b -> p s t
forall (p :: * -> * -> *) a b s t.
Traversing1 p =>
(forall (f :: * -> *). Apply f => (a -> f b) -> s -> f t)
-> p a b -> p s t
wander1 (a -> f b) -> s -> f t
forall (f :: * -> *). Apply f => (a -> f b) -> s -> f t
f

traversed1 :: Traversable1 t => Traversal1 (t a) (t b) a b
traversed1 :: forall (t :: * -> *) a b.
Traversable1 t =>
Traversal1 (t a) (t b) a b
traversed1 = (forall (f :: * -> *). Apply f => (a -> f b) -> t a -> f (t b))
-> Traversal1 (t a) (t b) a b
forall a b s t.
(forall (f :: * -> *). Apply f => (a -> f b) -> s -> f t)
-> Traversal1 s t a b
traversal1 (a -> f b) -> t a -> f (t b)
forall (f :: * -> *). Apply f => (a -> f b) -> t a -> f (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b. Apply f => (a -> f b) -> t a -> f (t b)
traverse1

-- | Reverse the order in which a (finite) 'Traversal1' is traversed.
--
-- @
-- 'backwards' . 'backwards' = 'id'
-- @
backwards :: Traversal1 s t a b -> Traversal1 s t a b
backwards :: forall s t a b. Traversal1 s t a b -> Traversal1 s t a b
backwards Traversal1 s t a b
o = (forall (f :: * -> *). Apply f => (a -> f b) -> s -> f t)
-> Traversal1 s t a b
forall a b s t.
(forall (f :: * -> *). Apply f => (a -> f b) -> s -> f t)
-> Traversal1 s t a b
traversal1 (\ 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
#. Traversal1 s t a b -> (a -> Backwards f b) -> s -> Backwards f t
forall (f :: * -> *) s t a b.
Apply f =>
Traversal1 s t a b -> (a -> f b) -> s -> f t
traverse1Of Optic p s t a b
Traversal1 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 :: Bitraversable1 r => Traversal1 (r a a) (r b b) a b
both :: forall (r :: * -> * -> *) a b.
Bitraversable1 r =>
Traversal1 (r a a) (r b b) a b
both = (forall (f :: * -> *). Apply f => (a -> f b) -> r a a -> f (r b b))
-> Traversal1 (r a a) (r b b) a b
forall a b s t.
(forall (f :: * -> *). Apply f => (a -> f b) -> s -> f t)
-> Traversal1 s t a b
traversal1 (\ a -> f b
f -> (a -> f b) -> (a -> f b) -> r a a -> f (r b b)
forall (f :: * -> *) a b c d.
Apply f =>
(a -> f b) -> (c -> f d) -> r a c -> f (r b d)
forall (t :: * -> * -> *) (f :: * -> *) a b c d.
(Bitraversable1 t, Apply f) =>
(a -> f b) -> (c -> f d) -> t a c -> f (t b d)
bitraverse1 a -> f b
f a -> f b
f)

beside :: Bitraversable1 r => Traversal1 s1 t1 a b -> Traversal1 s2 t2 a b -> Traversal1 (r s1 s2) (r t1 t2) a b
beside :: forall (r :: * -> * -> *) s1 t1 a b s2 t2.
Bitraversable1 r =>
Traversal1 s1 t1 a b
-> Traversal1 s2 t2 a b -> Traversal1 (r s1 s2) (r t1 t2) a b
beside Traversal1 s1 t1 a b
l Traversal1 s2 t2 a b
r = (forall (f :: * -> *).
 Apply f =>
 (a -> f b) -> r s1 s2 -> f (r t1 t2))
-> Traversal1 (r s1 s2) (r t1 t2) a b
forall a b s t.
(forall (f :: * -> *). Apply f => (a -> f b) -> s -> f t)
-> Traversal1 s t a b
traversal1 (\ a -> f b
f -> (s1 -> f t1) -> (s2 -> f t2) -> r s1 s2 -> f (r t1 t2)
forall (f :: * -> *) a b c d.
Apply f =>
(a -> f b) -> (c -> f d) -> r a c -> f (r b d)
forall (t :: * -> * -> *) (f :: * -> *) a b c d.
(Bitraversable1 t, Apply f) =>
(a -> f b) -> (c -> f d) -> t a c -> f (t b d)
bitraverse1 (Traversal1 s1 t1 a b -> (a -> f b) -> s1 -> f t1
forall (f :: * -> *) s t a b.
Apply f =>
Traversal1 s t a b -> (a -> f b) -> s -> f t
traverse1Of Optic p s1 t1 a b
Traversal1 s1 t1 a b
l a -> f b
f) (Traversal1 s2 t2 a b -> (a -> f b) -> s2 -> f t2
forall (f :: * -> *) s t a b.
Apply f =>
Traversal1 s t a b -> (a -> f b) -> s -> f t
traverse1Of Optic p s2 t2 a b
Traversal1 s2 t2 a b
r a -> f b
f))


-- Elimination

-- | Map over the targets of an 'Fresnel.Iso.Iso', 'Fresnel.Lens.Lens', 'Fresnel.Optional.Optional', or 'Traversal', collecting the results.
--
-- @
-- 'traverse1Of' . 'traversal1' = 'id'
-- 'traverse1Of' 'traversed1' = 'traverse1'
-- @
traverse1Of :: Apply f => Traversal1 s t a b -> ((a -> f b) -> (s -> f t))
traverse1Of :: forall (f :: * -> *) s t a b.
Apply f =>
Traversal1 s t a b -> (a -> f b) -> s -> f t
traverse1Of Traversal1 s t a b
o = Star1 f s t -> s -> f t
forall (f :: * -> *) a b. Star1 f a b -> a -> f b
runStar1 (Star1 f s t -> s -> f t)
-> (Star1 f a b -> Star1 f s t) -> Star1 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
#. Star1 f a b -> Star1 f s t
Traversal1 s t a b
o (Star1 f a b -> s -> f t)
-> ((a -> f b) -> Star1 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) -> Star1 f a b
forall (f :: * -> *) a b. (a -> f b) -> Star1 f a b
Star1

for1Of :: Apply f => Traversal1 s t a b -> (s -> (a -> f b) -> f t)
for1Of :: forall (f :: * -> *) s t a b.
Apply f =>
Traversal1 s t a b -> s -> (a -> f b) -> f t
for1Of Traversal1 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 (Traversal1 s t a b -> (a -> f b) -> s -> f t
forall (f :: * -> *) s t a b.
Apply f =>
Traversal1 s t a b -> (a -> f b) -> s -> f t
traverse1Of Optic p s t a b
Traversal1 s t a b
o)

sequence1Of :: Apply f => Traversal1 s t (f b) b -> (s -> f t)
sequence1Of :: forall (f :: * -> *) s t b.
Apply f =>
Traversal1 s t (f b) b -> s -> f t
sequence1Of Traversal1 s t (f b) b
o = Traversal1 s t (f b) b -> (f b -> f b) -> s -> f t
forall (f :: * -> *) s t a b.
Apply f =>
Traversal1 s t a b -> (a -> f b) -> s -> f t
traverse1Of Optic p s t (f b) b
Traversal1 s t (f b) b
o f b -> f b
forall a. a -> a
id

transposeOf :: Traversal1 s t (NonEmpty a) a -> s -> NonEmpty t
transposeOf :: forall s t a. Traversal1 s t (NonEmpty a) a -> s -> NonEmpty t
transposeOf Traversal1 s t (NonEmpty a) a
o = ZipList t -> NonEmpty t
forall a. ZipList a -> NonEmpty a
getZipList (ZipList t -> NonEmpty t) -> (s -> ZipList t) -> s -> NonEmpty 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
#. Traversal1 s t (NonEmpty a) a
-> (NonEmpty a -> ZipList a) -> s -> ZipList t
forall (f :: * -> *) s t a b.
Apply f =>
Traversal1 s t a b -> (a -> f b) -> s -> f t
traverse1Of Optic p s t (NonEmpty a) a
Traversal1 s t (NonEmpty a) a
o NonEmpty a -> ZipList a
forall a. NonEmpty a -> ZipList a
ZipList

newtype ZipList a = ZipList { forall a. ZipList a -> NonEmpty a
getZipList :: NonEmpty a }

instance Functor ZipList where
  fmap :: forall a b. (a -> b) -> ZipList a -> ZipList b
fmap a -> b
f (ZipList NonEmpty a
as) = NonEmpty b -> ZipList b
forall a. NonEmpty a -> ZipList a
ZipList ((a -> b) -> NonEmpty a -> NonEmpty b
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f NonEmpty a
as)

instance Apply ZipList where
  liftF2 :: forall a b c. (a -> b -> c) -> ZipList a -> ZipList b -> ZipList c
liftF2 a -> b -> c
f (ZipList NonEmpty a
as) (ZipList NonEmpty b
bs) = NonEmpty c -> ZipList c
forall a. NonEmpty a -> ZipList a
ZipList ((a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
zipWith a -> b -> c
f NonEmpty a
as NonEmpty b
bs)