Copyright | (C) 2012-16 Edward Kmett 2012-13 Michael Sloan |
---|---|
License | BSD-style (see the file LICENSE) |
Maintainer | Edward Kmett <ekmett@gmail.com> |
Stability | experimental |
Portability | non-portable |
Safe Haskell | Safe |
Language | Haskell2010 |
Synopsis
- makeLenses :: Name -> DecsQ
- makeLensesFor :: [(String, String)] -> Name -> DecsQ
- makeClassy :: Name -> DecsQ
- makeClassyFor :: String -> String -> [(String, String)] -> Name -> DecsQ
- makeClassy_ :: Name -> DecsQ
- makeFields :: Name -> DecsQ
- makeFieldsNoPrefix :: Name -> DecsQ
- makePrisms :: Name -> DecsQ
- makeClassyPrisms :: Name -> DecsQ
- makeWrapped :: Name -> DecsQ
- declareLenses :: DecsQ -> DecsQ
- declareLensesFor :: [(String, String)] -> DecsQ -> DecsQ
- declareClassy :: DecsQ -> DecsQ
- declareClassyFor :: [(String, (String, String))] -> [(String, String)] -> DecsQ -> DecsQ
- declareFields :: DecsQ -> DecsQ
- declarePrisms :: DecsQ -> DecsQ
- declareWrapped :: DecsQ -> DecsQ
- makeLensesWith :: LensRules -> Name -> DecsQ
- declareLensesWith :: LensRules -> DecsQ -> DecsQ
- data LensRules
- lensRules :: LensRules
- lensRulesFor :: [(String, String)] -> LensRules
- classyRules :: LensRules
- classyRules_ :: LensRules
- defaultFieldRules :: LensRules
- camelCaseFields :: LensRules
- classUnderscoreNoPrefixFields :: LensRules
- underscoreFields :: LensRules
- abbreviatedFields :: LensRules
- lensField :: Lens' LensRules FieldNamer
- type FieldNamer = Name -> [Name] -> Name -> [DefName]
- data DefName
- lensClass :: Lens' LensRules ClassyNamer
- type ClassyNamer = Name -> Maybe (Name, Name)
- simpleLenses :: Lens' LensRules Bool
- createClass :: Lens' LensRules Bool
- generateSignatures :: Lens' LensRules Bool
- generateUpdateableOptics :: Lens' LensRules Bool
- generateLazyPatterns :: Lens' LensRules Bool
- underscoreNoPrefixNamer :: FieldNamer
- lookingupNamer :: [(String, String)] -> FieldNamer
- mappingNamer :: (String -> [String]) -> FieldNamer
- camelCaseNamer :: FieldNamer
- classUnderscoreNoPrefixNamer :: FieldNamer
- underscoreNamer :: FieldNamer
- abbreviatedNamer :: FieldNamer
Constructing Lenses Automatically
Lenses for data fields
makeLenses :: Name -> DecsQ Source #
Build lenses (and traversals) with a sensible default configuration.
e.g.
data FooBar = Foo { _x, _y ::Int
} | Bar { _x ::Int
}makeLenses
''FooBar
will create
x ::Lens'
FooBarInt
x f (Foo a b) = (\a' -> Foo a' b) <$> f a x f (Bar a) = Bar <$> f a y ::Traversal'
FooBarInt
y f (Foo a b) = (\b' -> Foo a b') <$> f b y _ c@(Bar _) = pure c
makeLenses
=makeLensesWith
lensRules
makeLensesFor :: [(String, String)] -> Name -> DecsQ Source #
Derive lenses and traversals, specifying explicit pairings
of (fieldName, lensName)
.
If you map multiple names to the same label, and it is present in the same
constructor then this will generate a Traversal
.
e.g.
makeLensesFor
[("_foo", "fooLens"), ("baz", "lbaz")] ''FoomakeLensesFor
[("_barX", "bar"), ("_barY", "bar")] ''Bar
makeClassy :: Name -> DecsQ Source #
Make lenses and traversals for a type, and create a class when the type has no arguments.
e.g.
data Foo = Foo { _fooX, _fooY ::Int
}makeClassy
''Foo
will create
class HasFoo t where foo ::Lens'
t Foo fooX ::Lens'
tInt
fooX = foo . go where go f (Foo x y) = (\x' -> Foo x' y) <$> f x fooY ::Lens'
tInt
fooY = foo . go where go f (Foo x y) = (\y' -> Foo x y') <$> f y instance HasFoo Foo where foo = id
makeClassy
=makeLensesWith
classyRules
makeClassyFor :: String -> String -> [(String, String)] -> Name -> DecsQ Source #
Derive lenses and traversals, using a named wrapper class, and
specifying explicit pairings of (fieldName, traversalName)
.
Example usage:
makeClassyFor
"HasFoo" "foo" [("_foo", "fooLens"), ("bar", "lbar")] ''Foo
makeClassy_ :: Name -> DecsQ Source #
Make lenses and traversals for a type, and create a class when the type
has no arguments. Works the same as makeClassy
except that (a) it
expects that record field names do not begin with an underscore, (b) all
record fields are made into lenses, and (c) the resulting lens is prefixed
with an underscore.
makeFields :: Name -> DecsQ Source #
Generate overloaded field accessors.
e.g
data Foo a = Foo { _fooX ::Int
, _fooY :: a } newtype Bar = Bar { _barX ::Char
} makeFields ''Foo makeFields ''Bar
will create
_fooXLens :: Lens' (Foo a) Int _fooYLens :: Lens (Foo a) (Foo b) a b class HasX s a | s -> a where x :: Lens' s a instance HasX (Foo a) Int where x = _fooXLens class HasY s a | s -> a where y :: Lens' s a instance HasY (Foo a) a where y = _fooYLens _barXLens :: Iso' Bar Char instance HasX Bar Char where x = _barXLens
For details, see camelCaseFields
.
makeFields =makeLensesWith
defaultFieldRules
makeFieldsNoPrefix :: Name -> DecsQ Source #
Generate overloaded field accessors based on field names which
are only prefixed with an underscore (e.g. _name
), not
additionally with the type name (e.g. _fooName
).
This might be the desired behaviour in case the
DuplicateRecordFields
language extension is used in order to get
rid of the necessity to prefix each field name with the type name.
As an example:
data Foo a = Foo { _x ::Int
, _y :: a } newtype Bar = Bar { _x ::Char
} makeFieldsNoPrefix ''Foo makeFieldsNoPrefix ''Bar
will create classes
class HasX s a | s -> a where x :: Lens' s a class HasY s a | s -> a where y :: Lens' s a
together with instances
instance HasX (Foo a) Int instance HasY (Foo a) a where instance HasX Bar Char where
For details, see classUnderscoreNoPrefixFields
.
makeFieldsNoPrefix =makeLensesWith
classUnderscoreNoPrefixFields
Prisms
Generate a Prism
for each constructor of a data type.
Isos generated when possible.
Reviews are created for constructors with existentially
quantified constructors and GADTs.
e.g.
data FooBarBaz a = Foo Int | Bar a | Baz Int Char makePrisms ''FooBarBaz
will create
_Foo :: Prism' (FooBarBaz a) Int _Bar :: Prism (FooBarBaz a) (FooBarBaz b) a b _Baz :: Prism' (FooBarBaz a) (Int, Char)
Generate a Prism
for each constructor of a data type
and combine them into a single class. No Isos are created.
Reviews are created for constructors with existentially
quantified constructors and GADTs.
e.g.
data FooBarBaz a = Foo Int | Bar a | Baz Int Char makeClassyPrisms ''FooBarBaz
will create
class AsFooBarBaz s a | s -> a where _FooBarBaz :: Prism' s (FooBarBaz a) _Foo :: Prism' s Int _Bar :: Prism' s a _Baz :: Prism' s (Int,Char) _Foo = _FooBarBaz . _Foo _Bar = _FooBarBaz . _Bar _Baz = _FooBarBaz . _Baz instance AsFooBarBaz (FooBarBaz a) a
Generate an As class of prisms. Names are selected by prefixing the constructor name with an underscore. Constructors with multiple fields will construct Prisms to tuples of those fields.
In the event that the name of a data type is also the name of one of its
constructors, the name of the Prism
generated for the data type will be
prefixed with an extra _
(if the data type name is prefix) or .
(if the
name is infix) to disambiguate it from the Prism
for the corresponding
constructor. For example, this code:
data Quux = Quux Int | Fred Bool makeClassyPrisms ''Quux
will create:
class AsQuux s where __Quux :: Prism' s Quux -- Data type prism _Quux :: Prism' s Int -- Constructor prism _Fred :: Prism' s Bool _Quux = __Quux . _Quux _Fred = __Quux . _Fred instance AsQuux Quux
Wrapped
makeWrapped :: Name -> DecsQ Source #
Build Wrapped
instance for a given newtype
Constructing Lenses Given a Declaration Quote
Lenses for data fields
declareLenses :: DecsQ -> DecsQ Source #
declareLensesFor :: [(String, String)] -> DecsQ -> DecsQ Source #
Similar to makeLensesFor
, but takes a declaration quote.
declareClassy :: DecsQ -> DecsQ Source #
For each record in the declaration quote, make lenses and traversals for it, and create a class when the type has no arguments. All record syntax in the input will be stripped off.
e.g.
declareClassy [d| data Foo = Foo { fooX, fooY ::Int
} derivingShow
|]
will create
data Foo = FooInt
Int
derivingShow
class HasFoo t where foo ::Lens'
t Foo instance HasFoo Foo where foo =id
fooX, fooY :: HasFoo t =>Lens'
tInt
declareClassyFor :: [(String, (String, String))] -> [(String, String)] -> DecsQ -> DecsQ Source #
Similar to makeClassyFor
, but takes a declaration quote.
declareFields :: DecsQ -> DecsQ Source #
declareFields =declareLensesWith
defaultFieldRules
Prisms
declarePrisms :: DecsQ -> DecsQ Source #
Generate a Prism
for each constructor of each data type.
e.g.
declarePrisms [d| data Exp = Lit Int | Var String | Lambda{ bound::String, body::Exp } |]
will create
data Exp = Lit Int | Var String | Lambda { bound::String, body::Exp } _Lit ::Prism'
Exp Int _Var ::Prism'
Exp String _Lambda ::Prism'
Exp (String, Exp)
Wrapped
Configuring Lenses
Running LensRules
declareLensesWith :: LensRules -> DecsQ -> DecsQ Source #
Declare lenses for each records in the given declarations, using the
specified LensRules
. Any record syntax in the input will be stripped
off.
LensRules type
Predefined LensRules
lensRules :: LensRules Source #
Rules for making fairly simple partial lenses, ignoring the special cases
for isomorphisms and traversals, and not making any classes.
It uses underscoreNoPrefixNamer
.
Construct a LensRules
value for generating top-level definitions
using the given map from field names to definition names.
classyRules :: LensRules Source #
Rules for making lenses and traversals that precompose another Lens
.
classyRules_ :: LensRules Source #
A LensRules
used by makeClassy_
.
camelCaseFields :: LensRules Source #
Field rules for fields in the form prefixFieldname or _prefixFieldname
If you want all fields to be lensed, then there is no reason to use an _
before the prefix.
If any of the record fields leads with an _
then it is assume a field without an _
should not have a lens created.
Note: The prefix
must be the same as the typename (with the first
letter lowercased). This is a change from lens versions before lens 4.5.
If you want the old behaviour, use makeLensesWith
abbreviatedFields
classUnderscoreNoPrefixFields :: LensRules Source #
Field rules for fields in the form _fieldname
(the leading
underscore is mandatory).
Note: The primary difference to camelCaseFields
is that for
classUnderscoreNoPrefixFields
the field names are not expected to
be prefixed with the type name. This might be the desired behaviour
when the DuplicateRecordFields
extension is enabled.
underscoreFields :: LensRules Source #
Field rules for fields in the form _prefix_fieldname
abbreviatedFields :: LensRules Source #
Field rules fields in the form prefixFieldname or _prefixFieldname
If you want all fields to be lensed, then there is no reason to use an _
before the prefix.
If any of the record fields leads with an _
then it is assume a field without an _
should not have a lens created.
Note that prefix
may be any string of characters that are not uppercase
letters. (In particular, it may be arbitrary string of lowercase letters
and numbers) This is the behavior that defaultFieldRules
had in lens
4.4 and earlier.
LensRules configuration accessors
type FieldNamer Source #
= Name | Name of the data type that lenses are being generated for. |
-> [Name] | Names of all fields (including the field being named) in the data type. |
-> Name | Name of the field being named. |
-> [DefName] | Name(s) of the lens functions. If empty, no lens is created for that field. |
The rule to create function names of lenses for data fields.
Although it's sometimes useful, you won't need the first two arguments most of the time.
Name to give to generated field optics.
TopName Name | Simple top-level definition name |
MethodName Name Name | makeFields-style class name and method name |
lensClass :: Lens' LensRules ClassyNamer Source #
Lens'
to access the option for naming "classy" lenses.
type ClassyNamer Source #
= Name | Name of the data type that lenses are being generated for. |
-> Maybe (Name, Name) | Names of the class and the main method it generates, respectively. |
The optional rule to create a class and method around a monomorphic data type. If this naming convention is provided, it generates a "classy" lens.
generateSignatures :: Lens' LensRules Bool Source #
Indicate whether or not to supply the signatures for the generated lenses.
Disabling this can be useful if you want to provide a more restricted type signature or if you want to supply hand-written haddocks.
generateLazyPatterns :: Lens' LensRules Bool Source #
Generate optics using lazy pattern matches. This can allow fields of an undefined value to be initialized with lenses:
data Foo = Foo {_x :: Int, _y :: Bool} deriving ShowmakeLensesWith
(lensRules
&generateLazyPatterns
.~ True) ''Foo
> undefined & x .~ 8 & y .~ True Foo {_x = 8, _y = True}
The downside of this flag is that it can lead to space-leaks and code-size/compile-time increases when generated for large records. By default this flag is turned off, and strict optics are generated.
When using lazy optics the strict optic can be recovered by composing
with $!
:
strictOptic = ($!) . lazyOptic
FieldNamers
underscoreNoPrefixNamer :: FieldNamer Source #
A FieldNamer
that strips the _ off of the field name,
lowercases the name, and skips the field if it doesn't start with
an '_'.
lookingupNamer :: [(String, String)] -> FieldNamer Source #
Create a FieldNamer
from explicit pairings of (fieldName, lensName)
.
:: (String -> [String]) | A function that maps a |
-> FieldNamer |
Create a FieldNamer
from a mapping function. If the function
returns []
, it creates no lens for the field.
camelCaseNamer :: FieldNamer Source #
A FieldNamer
for camelCaseFields
.