summaryrefslogtreecommitdiff
path: root/src/Data/Profunctor/Optic/Traversal.hs
blob: 86a1f69b867084189adf0b21d28301b4fa935073 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
module Data.Profunctor.Optic.Traversal where

import Data.Bitraversable
import Data.Profunctor.Optic.Prelude
import Data.Profunctor.Optic.Type

---------------------------------------------------------------------
-- 'Traversal'
---------------------------------------------------------------------

-- | TODO: Document
--
traversal :: Traversable f => (s -> f a) -> (s -> f b -> t) -> Traversal s t a b
traversal sa sbt = dimap dup (uncurry sbt) . psecond . lmap sa . lift traverse

-- | Transform a Van Laarhoven 'Traversal' into a profunctor 'Traversal'.
--
traversalVL :: (forall f. Applicative f => (a -> f b) -> s -> f t) -> Traversal s t a b
traversalVL = lift

-- | TODO: Document
--
traversed :: Traversable f => Traversal (f a) (f b) a b
traversed = lift traverse

---------------------------------------------------------------------
-- Primitive Operators
---------------------------------------------------------------------

-- ^ @
-- traverseOf :: Functor f => Lens s t a b -> (a -> f b) -> s -> f t
-- traverseOf :: Applicative f => Traversal s t a b -> (a -> f b) -> s -> f t
-- @
--
traverseOf :: Applicative f => ATraversal f s t a b -> (a -> f b) -> s -> f t
traverseOf = between runStar Star

-- | TODO: Document
--
sequenceOf :: Applicative f => ATraversal f s t (f a) a -> s -> f t
sequenceOf t = traverseOf t id

---------------------------------------------------------------------
-- Common 'Traversal's
---------------------------------------------------------------------

-- | Traverse bitraversed parts of a 'Bitraversable' container with matching types.
--
-- >>> traverseOf bitraversed (pure . length) (Right "hello")
-- Right 5
--
-- >>> traverseOf bitraversed (pure . length) ("hello","world")
-- (5,5)
--
-- >>> ("hello","world") ^. bitraversed
-- "helloworld"
--
-- @
-- 'bitraversed' :: 'Traversal' (a , a) (b , b) a b
-- 'bitraversed' :: 'Traversal' (a + a) (b + b) a b
-- @
--
bitraversed :: Bitraversable f => Traversal (f a a) (f b b) a b
bitraversed = lift $ \f -> bitraverse f f
{-# INLINE bitraversed #-}