Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell98 |
This module defines the Accessor
type.
It should be imported with qualification.
Synopsis
- data T r a
- fromSetGet :: (a -> r -> r) -> (r -> a) -> T r a
- fromLens :: (r -> (a, a -> r)) -> T r a
- fromWrapper :: (b -> a) -> (a -> b) -> T a b
- self :: T r r
- null :: T r ()
- result :: Eq a => a -> T (a -> b) b
- set :: T r a -> a -> r -> r
- (^=) :: T r a -> a -> r -> r
- compose :: [r -> r] -> r -> r
- get :: T r a -> r -> a
- (^.) :: r -> T r a -> a
- modify :: T r a -> (a -> a) -> r -> r
- (^:) :: T r a -> (a -> a) -> r -> r
- (.>) :: T a b -> T b c -> T a c
- (<.) :: T b c -> T a b -> T a c
- ($%) :: a -> (a -> b) -> b
- merge :: T a b -> T a c -> T a (b, c)
Documentation
The accessor function we use, has a record value as first argument and returns the content of a specific record field and a function that allows to overwrite that field with a new value.
In former version of a package
we used a function that resembled the state monad.
However this required to use an undefined
in the implementation of the get
function.
fromSetGet :: (a -> r -> r) -> (r -> a) -> T r a Source #
fromWrapper :: (b -> a) -> (a -> b) -> T a b Source #
If an object is wrapped in a newtype
,
you can generate an Accessor
to the unwrapped data
by providing a wrapper and an unwrapper function.
The set function is simpler in this case,
since no existing data must be kept.
Since the information content of the wrapped and unwrapped data is equivalent,
you can swap wrapper and unwrapper.
This way you can construct an Accessor
that treats a record field containing an unwrapped object
like a field containing a wrapped object.
newtype A = A {unA :: Int} access :: Accessor.T A Int access = fromWrapper A unA
We could also have called this function fromBijection
,
since it must hold wrap . unwrap = id
and unwrap . wrap = id
.
result :: Eq a => a -> T (a -> b) b Source #
result a
accesses the value of a function for argument a
.
It is not very efficient to build a function
from setting all of its values using this accessor,
since every access to a function adds another if-then-else
.
Also see semantic editor combinators, that allow to modify all function values of a function at once. Cf. http://conal.net/blog/posts/semantic-editor-combinators/
(^=) :: T r a -> a -> r -> r infixr 5 Source #
set
as infix operator.
This lets us write first ^= 2+3 $ second ^= 5+7 $ record
.
compose :: [r -> r] -> r -> r Source #
This is a general function, but it is especially useful for setting many values of different type at once.
(^.) :: r -> T r a -> a infixl 8 Source #
get
as infix operator.
This lets us write record^.field^.subfield
.
This imitates Modula II syntax.
(^:) :: T r a -> (a -> a) -> r -> r infixr 5 Source #
modify
as infix operator.
This lets us write
field^:subfield^:(2*) $ record
,
record$%field^:subfield^:(2*)
or record$%field^:subfield^:(const 1)
.
(.>) :: T a b -> T b c -> T a c infixl 9 Source #
Accessor composition: Combine an accessor with an accessor to a sub-field. Speak "stack".
(<.) :: T b c -> T a b -> T a c infixr 9 Source #
Accessor composition the other direction.
(<.) = flip (.>)
You may also use the (.)
operator from Category class.
merge :: T a b -> T a c -> T a (b, c) Source #
Merge the accessors to two independent fields.
Independency means, it must hold:
set (merge accA accB) (a,b) = set (merge accB accA) (b,a)
You may construct smart accessors
by composing a merged accessor with a fromWrapper
accessor.
This is a special case of the more general Point
concept
in the package fclabels
.