Skip to content

Commit 9ef85c8

Browse files
committed
Restrict over', iover', and set' to traversals
* `over'`, `iover'`, `set'`, and associated operators previously accepted setters. However, it's impossible to actually modify strictly through a setter; a traversal is needed for that. Restrict the types to require `A_Traversal`, and remove the associated (technically correct but deceptive) `Mapping` instances. * Document the strictness behavior of `set'`. Fixes well-typed#473
1 parent cf35bef commit 9ef85c8

File tree

4 files changed

+13
-21
lines changed

4 files changed

+13
-21
lines changed

Diff for: optics-core/src/Optics/Internal/Utils.hs

-10
Original file line numberDiff line numberDiff line change
@@ -28,16 +28,6 @@ import Data.Tuple.Solo (Solo (..), getSolo)
2828
-- Credit for this goes to Eric Mertens, see
2929
-- <https://github.com/glguy/irc-core/commit/2d5fc45b05f1>.
3030

31-
instance Mapping (Star Solo) where
32-
roam f (Star k) = Star $ wrapSolo' . f (getSolo . k)
33-
iroam f (Star k) = Star $ wrapSolo' . f (\_ -> getSolo . k)
34-
35-
instance Mapping (IxStar Solo) where
36-
roam f (IxStar k) =
37-
IxStar $ \i -> wrapSolo' . f (getSolo . k i)
38-
iroam f (IxStar k) =
39-
IxStar $ \ij -> wrapSolo' . f (\i -> getSolo . k (ij i))
40-
4131
-- | Mark a value for evaluation to whnf.
4232
--
4333
-- This allows us to, when applying a setter to a structure, evaluate only the

Diff for: optics-core/src/Optics/IxSetter.hs

+3-3
Original file line numberDiff line numberDiff line change
@@ -81,11 +81,11 @@ iover o = \f -> runIxFunArrow (getOptic (castOptic @A_Setter o) (IxFunArrow f))
8181

8282
-- | Apply an indexed setter as a modifier, strictly.
8383
iover'
84-
:: (Is k A_Setter, is `HasSingleIndex` i)
84+
:: (Is k A_Traversal, is `HasSingleIndex` i)
8585
=> Optic k is s t a b
8686
-> (i -> a -> b) -> s -> t
8787
iover' o = \f ->
88-
let star = getOptic (castOptic @A_Setter o) $ IxStar (\i -> wrapSolo' . f i)
88+
let star = getOptic (castOptic @A_Traversal o) $ IxStar (\i -> wrapSolo' . f i)
8989
in getSolo . runIxStar star id
9090

9191
{-# INLINE iover' #-}
@@ -105,7 +105,7 @@ iset o = \f -> iover o (\i _ -> f i)
105105

106106
-- | Apply an indexed setter, strictly.
107107
iset'
108-
:: (Is k A_Setter, is `HasSingleIndex` i)
108+
:: (Is k A_Traversal, is `HasSingleIndex` i)
109109
=> Optic k is s t a b
110110
-> (i -> b) -> s -> t
111111
iset' o = \f -> iover' o (\i _ -> f i)

Diff for: optics-core/src/Optics/Operators.hs

+4-3
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@ import Optics.Getter
2828
import Optics.Optic
2929
import Optics.Review
3030
import Optics.Setter
31+
import Optics.Traversal
3132

3233
-- | Flipped infix version of 'view'.
3334
(^.) :: Is k A_Getter => s -> Optic' k is s a -> a
@@ -65,7 +66,7 @@ infixr 8 #
6566
infixr 4 %~
6667

6768
-- | Infix version of 'over''.
68-
(%!~) :: Is k A_Setter => Optic k is s t a b -> (a -> b) -> s -> t
69+
(%!~) :: Is k A_Traversal => Optic k is s t a b -> (a -> b) -> s -> t
6970
(%!~) = over'
7071
{-# INLINE (%!~) #-}
7172

@@ -79,7 +80,7 @@ infixr 4 %!~
7980
infixr 4 .~
8081

8182
-- | Infix version of 'set''.
82-
(!~) :: Is k A_Setter => Optic k is s t a b -> b -> s -> t
83+
(!~) :: Is k A_Traversal => Optic k is s t a b -> b -> s -> t
8384
(!~) = set'
8485
{-# INLINE (!~) #-}
8586

@@ -103,7 +104,7 @@ infixr 4 !~
103104
infixr 4 ?~
104105

105106
-- | Strict version of ('?~').
106-
(?!~) :: Is k A_Setter => Optic k is s t a (Maybe b) -> b -> s -> t
107+
(?!~) :: Is k A_Traversal => Optic k is s t a (Maybe b) -> b -> s -> t
107108
(?!~) = \o !b -> set' o (Just b)
108109
{-# INLINE (?!~) #-}
109110

Diff for: optics-core/src/Optics/Setter.hs

+6-5
Original file line numberDiff line numberDiff line change
@@ -102,11 +102,11 @@ over o = \f -> runFunArrow $ getOptic (castOptic @A_Setter o) (FunArrow f)
102102
-- 'over' is used, because the first coordinate of a pair is never forced.
103103
--
104104
over'
105-
:: Is k A_Setter
105+
:: Is k A_Traversal
106106
=> Optic k is s t a b
107107
-> (a -> b) -> s -> t
108108
over' o = \f ->
109-
let star = getOptic (castOptic @A_Setter o) $ Star (wrapSolo' . f)
109+
let star = getOptic (castOptic @A_Traversal o) $ Star (wrapSolo' . f)
110110
in getSolo . runStar star
111111
{-# INLINE over' #-}
112112

@@ -128,10 +128,11 @@ set o = over o . const
128128

129129
-- | Apply a setter, strictly.
130130
--
131-
-- TODO DOC: what exactly is the strictness property?
132-
--
131+
-- The new value will be forced if and only if the optic traverses at
132+
-- least one target. If forcing the new value is inexpensive, then it
133+
-- is cheaper to do so manually and use 'set'.
133134
set'
134-
:: Is k A_Setter
135+
:: Is k A_Traversal
135136
=> Optic k is s t a b
136137
-> b -> s -> t
137138
set' o = over' o . const

0 commit comments

Comments
 (0)