Copyright | (C) 2012-16 Edward Kmett |
---|---|
License | BSD-style (see the file LICENSE) |
Maintainer | Edward Kmett <ekmett@gmail.com> |
Stability | provisional |
Portability | non-portable |
Safe Haskell | Trustworthy |
Language | Haskell2010 |
Synopsis
- type Prism s t a b = forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t)
- type Prism' s a = Prism s s a a
- type APrism s t a b = Market a b a (Identity b) -> Market a b s (Identity t)
- type APrism' s a = APrism s s a a
- prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
- prism' :: (b -> s) -> (s -> Maybe a) -> Prism s s a b
- withPrism :: APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
- clonePrism :: APrism s t a b -> Prism s t a b
- outside :: Representable p => APrism s t a b -> Lens (p t r) (p s r) (p b r) (p a r)
- aside :: APrism s t a b -> Prism (e, s) (e, t) (e, a) (e, b)
- without :: APrism s t a b -> APrism u v c d -> Prism (Either s u) (Either t v) (Either a c) (Either b d)
- below :: Traversable f => APrism' s a -> Prism' (f s) (f a)
- isn't :: APrism s t a b -> s -> Bool
- matching :: APrism s t a b -> s -> Either t a
- matching' :: LensLike (Either a) s t a b -> s -> Either t a
- _Left :: Prism (Either a c) (Either b c) a b
- _Right :: Prism (Either c a) (Either c b) a b
- _Just :: Prism (Maybe a) (Maybe b) a b
- _Nothing :: Prism' (Maybe a) ()
- _Void :: Prism s s a Void
- _Show :: (Read a, Show a) => Prism' String a
- only :: Eq a => a -> Prism' a ()
- nearly :: a -> (a -> Bool) -> Prism' a ()
- class Prefixed t where
- class Suffixed t where
- class Profunctor p => Choice (p :: Type -> Type -> Type) where
Prisms
type Prism s t a b = forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t) Source #
A Prism
l
is a Traversal
that can also be turned
around with re
to obtain a Getter
in the
opposite direction.
There are three laws that a Prism
should satisfy:
First, if I re
or review
a value with a Prism
and then preview
or use (^?
), I will get it back:
preview
l (review
l b) ≡Just
b
Second, if you can extract a value a
using a Prism
l
from a value s
, then the value s
is completely described by l
and a
:
preview
l s ≡Just
a ⟹review
l a ≡ s
Third, if you get non-match t
, you can convert it result back to s
:
matching
l s ≡Left
t ⟹matching
l t ≡Left
s
The first two laws imply that the Traversal
laws hold for every Prism
and that we traverse
at most 1 element:
lengthOf
l x<=
1
It may help to think of this as an Iso
that can be partial in one direction.
Every Prism
is a valid Traversal
.
For example, you might have a
allows you to always
go from a Prism'
Integer
Natural
Natural
to an Integer
, and provide you with tools to check if an Integer
is
a Natural
and/or to edit one if it is.
nat
::Prism'
Integer
Natural
nat
=prism
toInteger
$
\ i -> if i<
0 thenLeft
i elseRight
(fromInteger
i)
Now we can ask if an Integer
is a Natural
.
>>>
5^?nat
Just 5
>>>
(-5)^?nat
Nothing
We can update the ones that are:
>>>
(-3,4) & both.nat *~ 2
(-3,8)
And we can then convert from a Natural
to an Integer
.
>>>
5 ^. re nat -- :: Natural
5
Similarly we can use a Prism
to traverse
the Left
half of an Either
:
>>>
Left "hello" & _Left %~ length
Left 5
or to construct an Either
:
>>>
5^.re _Left
Left 5
such that if you query it with the Prism
, you will get your original input back.
>>>
5^.re _Left ^? _Left
Just 5
Another interesting way to think of a Prism
is as the categorical dual of a Lens
-- a co-Lens
, so to speak. This is what permits the construction of outside
.
Note: Composition with a Prism
is index-preserving.
type APrism s t a b = Market a b a (Identity b) -> Market a b s (Identity t) Source #
If you see this in a signature for a function, the function is expecting a Prism
.
Constructing Prisms
Consuming Prisms
withPrism :: APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r Source #
Convert APrism
to the pair of functions that characterize it.
clonePrism :: APrism s t a b -> Prism s t a b Source #
Clone a Prism
so that you can reuse the same monomorphically typed Prism
for different purposes.
See cloneLens
and cloneTraversal
for examples of why you might want to do this.
aside :: APrism s t a b -> Prism (e, s) (e, t) (e, a) (e, b) Source #
Use a Prism
to work over part of a structure.
without :: APrism s t a b -> APrism u v c d -> Prism (Either s u) (Either t v) (Either a c) (Either b d) Source #
below :: Traversable f => APrism' s a -> Prism' (f s) (f a) Source #
lift
a Prism
through a Traversable
functor, giving a Prism that matches only if all the elements of the container match the Prism
.
>>>
[Left 1, Right "foo", Left 4, Right "woot"]^..below _Right
[]
>>>
[Right "hail hydra!", Right "foo", Right "blah", Right "woot"]^..below _Right
[["hail hydra!","foo","blah","woot"]]
matching :: APrism s t a b -> s -> Either t a Source #
Retrieve the value targeted by a Prism
or return the
original value while allowing the type to change if it does
not match.
>>>
matching _Just (Just 12)
Right 12
>>>
matching _Just (Nothing :: Maybe Int) :: Either (Maybe Bool) Int
Left Nothing
matching' :: LensLike (Either a) s t a b -> s -> Either t a Source #
Like matching
, but also works for combinations of Lens
and Prism
s,
and also Traversal
s.
>>>
matching' (_2 . _Just) ('x', Just True)
Right True
>>>
matching' (_2 . _Just) ('x', Nothing :: Maybe Int) :: Either (Char, Maybe Bool) Int
Left ('x',Nothing)
>>>
matching' traverse "" :: Either [Int] Char
Left []
>>>
matching' traverse "xyz" :: Either [Int] Char
Right 'x'
Common Prisms
_Left :: Prism (Either a c) (Either b c) a b Source #
This Prism
provides a Traversal
for tweaking the Left
half of an Either
:
>>>
over _Left (+1) (Left 2)
Left 3
>>>
over _Left (+1) (Right 2)
Right 2
>>>
Right 42 ^._Left :: String
""
>>>
Left "hello" ^._Left
"hello"
It also can be turned around to obtain the embedding into the Left
half of an Either
:
>>>
_Left # 5
Left 5
>>>
5^.re _Left
Left 5
_Right :: Prism (Either c a) (Either c b) a b Source #
This Prism
provides a Traversal
for tweaking the Right
half of an Either
:
>>>
over _Right (+1) (Left 2)
Left 2
>>>
over _Right (+1) (Right 2)
Right 3
>>>
Right "hello" ^._Right
"hello"
>>>
Left "hello" ^._Right :: [Double]
[]
It also can be turned around to obtain the embedding into the Right
half of an Either
:
>>>
_Right # 5
Right 5
>>>
5^.re _Right
Right 5
_Just :: Prism (Maybe a) (Maybe b) a b Source #
This Prism
provides a Traversal
for tweaking the target of the value of Just
in a Maybe
.
>>>
over _Just (+1) (Just 2)
Just 3
Unlike traverse
this is a Prism
, and so you can use it to inject as well:
>>>
_Just # 5
Just 5
>>>
5^.re _Just
Just 5
Interestingly,
m^?
_Just
≡ m
>>>
Just x ^? _Just
Just x
>>>
Nothing ^? _Just
Nothing
_Show :: (Read a, Show a) => Prism' String a Source #
This is an improper prism for text formatting based on Read
and Show
.
This Prism
is "improper" in the sense that it normalizes the text formatting, but round tripping
is idempotent given sane Read
/Show
instances.
>>>
_Show # 2
"2"
>>>
"EQ" ^? _Show :: Maybe Ordering
Just EQ
_Show
≡prism'
show
readMaybe
nearly :: a -> (a -> Bool) -> Prism' a () Source #
This Prism
compares for approximate equality with a given value and a predicate for testing,
an example where the value is the empty list and the predicate checks that a list is empty (same
as _Empty
with the AsEmpty
list instance):
>>>
nearly [] null # ()
[]>>>
[1,2,3,4] ^? nearly [] null
Nothing
nearly
[]null
::Prism'
[a] ()
To comply with the Prism
laws the arguments you supply to nearly a p
are somewhat constrained.
We assume p x
holds iff x ≡ a
. Under that assumption then this is a valid Prism
.
This is useful when working with a type where you can test equality for only a subset of its values, and the prism selects such a value.
class Prefixed t where Source #
Instances
Prefixed ByteString Source # | |
Defined in Control.Lens.Prism | |
Prefixed ByteString Source # | |
Defined in Control.Lens.Prism | |
Prefixed Text Source # | |
Prefixed Text Source # | |
Eq a => Prefixed [a] Source # | |
Defined in Control.Lens.Prism |
class Suffixed t where Source #
Instances
Suffixed ByteString Source # | |
Defined in Control.Lens.Prism | |
Suffixed ByteString Source # | |
Defined in Control.Lens.Prism | |
Suffixed Text Source # | |
Suffixed Text Source # | |
Eq a => Suffixed [a] Source # | |
Defined in Control.Lens.Prism |
Prismatic profunctors
class Profunctor p => Choice (p :: Type -> Type -> Type) where #
The generalization of Costar
of Functor
that is strong with respect
to Either
.
Note: This is also a notion of strength, except with regards to another monoidal structure that we can choose to equip Hask with: the cocartesian coproduct.
left' :: p a b -> p (Either a c) (Either b c) #
Laws:
left'
≡dimap
swapE swapE.
right'
where swapE ::Either
a b ->Either
b a swapE =either
Right
Left
rmap
Left
≡lmap
Left
.
left'
lmap
(right
f).
left'
≡rmap
(right
f).
left'
left'
.
left'
≡dimap
assocE unassocE.
left'
where assocE ::Either
(Either
a b) c ->Either
a (Either
b c) assocE (Left
(Left
a)) =Left
a assocE (Left
(Right
b)) =Right
(Left
b) assocE (Right
c) =Right
(Right
c) unassocE ::Either
a (Either
b c) ->Either
(Either
a b) c unassocE (Left
a) =Left
(Left
a) unassocE (Right
(Left
b)) =Left
(Right
b) unassocE (Right
(Right
c)) =Right
c
right' :: p a b -> p (Either c a) (Either c b) #
Laws:
right'
≡dimap
swapE swapE.
left'
where swapE ::Either
a b ->Either
b a swapE =either
Right
Left
rmap
Right
≡lmap
Right
.
right'
lmap
(left
f).
right'
≡rmap
(left
f).
right'
right'
.
right'
≡dimap
unassocE assocE.
right'
where assocE ::Either
(Either
a b) c ->Either
a (Either
b c) assocE (Left
(Left
a)) =Left
a assocE (Left
(Right
b)) =Right
(Left
b) assocE (Right
c) =Right
(Right
c) unassocE ::Either
a (Either
b c) ->Either
(Either
a b) c unassocE (Left
a) =Left
(Left
a) unassocE (Right
(Left
b)) =Left
(Right
b) unassocE (Right
(Right
c)) =Right
c