lens-4.2: Lenses, Folds and Traversals

Copyright(C) 2012-14 Edward Kmett, Michael Sloan
LicenseBSD-style (see the file LICENSE)
MaintainerEdward Kmett <ekmett@gmail.com>
Stabilityexperimental
Portabilitynon-portable
Safe HaskellTrustworthy
LanguageHaskell98

Control.Lens.TH

Contents

Description

 

Synopsis

Constructing Lenses Automatically

makeLenses :: Name -> Q [Dec] 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' FooBar Int
x f (Foo a b) = (\a' -> Foo a' b) <$> f a
x f (Bar a)   = Bar <$> f a
y :: Traversal' FooBar Int
y f (Foo a b) = (\b' -> Foo a  b') <$> f b
y _ c@(Bar _) = pure c
makeLenses = makeLensesWith lensRules

makeLensesFor :: [(String, String)] -> Name -> Q [Dec] 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")] ''Foo
makeLensesFor [("_barX", "bar"), ("_barY", "bar")] ''Bar

makeClassy :: Name -> Q [Dec] 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' t Int
  fooX = foo . go where go f (Foo x y) = (\x' -> Foo x' y) <$> f x
  fooY :: Lens' t Int
  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 -> Q [Dec] 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 -> Q [Dec] 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.

makeIso :: Name -> Q [Dec] Source

Make a top level isomorphism injecting into the type.

The supplied name is required to be for a type with a single constructor that has a single argument.

e.g.

newtype List a = List [a]
makeIso ''List

will create

list :: Iso [a] [b] (List a) (List b)
makeIso = makeLensesWith isoRules

makePrisms :: Name -> Q [Dec] Source

Generate a Prism for each constructor of a data type.

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)

makeWrapped :: Name -> DecsQ Source

Build Wrapped instance for a given newtype

makeFields :: Name -> Q [Dec] 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
makeFields = makeFieldsWith defaultFieldRules

Constructing Lenses Given a Declaration Quote

declareLenses :: Q [Dec] -> Q [Dec] Source

Make lenses for all records in the given declaration quote. All record syntax in the input will be stripped off.

e.g.

declareLenses [d|
  data Foo = Foo { fooX, fooY :: Int }
    deriving Show
  |]

will create

data Foo = Foo Int Int deriving Show
fooX, fooY :: Lens' Foo Int
 declareLenses = declareLensesWith (lensRules & lensField .~ Just)

declareLensesFor :: [(String, String)] -> Q [Dec] -> Q [Dec] Source

Similar to makeLensesFor, but takes a declaration quote.

declareClassy :: Q [Dec] -> Q [Dec] 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 }
    deriving Show
  |]

will create

data Foo = Foo Int Int deriving Show
class HasFoo t where
  foo :: Lens' t Foo
instance HasFoo Foo where foo = id
fooX, fooY :: HasFoo t => Lens' t Int
 declareClassy = declareLensesWith (classyRules & lensField .~ Just)

declareClassyFor :: [(String, (String, String))] -> [(String, String)] -> Q [Dec] -> Q [Dec] Source

Similar to makeClassyFor, but takes a declaration quote.

declareIso :: Q [Dec] -> Q [Dec] Source

For each datatype declaration, make a top level isomorphism injecting into the type. The types are required to be for a type with a single constructor that has a single argument.

All record syntax in the input will be stripped off.

e.g.

declareIso [d|
  newtype WrappedInt = Wrap { unwrap :: Int }
  newtype List a = List [a]
  |]

will create

newtype WrappedList = Wrap Int
newtype List a = List [a]
wrap :: Iso' Int WrappedInt
unwrap :: Iso' WrappedInt Int
list :: Iso [a] [b] (List a) (List b)
 declareIso = declareLensesWith (isoRules & lensField .~ Just)

declarePrisms :: Q [Dec] -> Q [Dec] 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)

declareWrapped :: Q [Dec] -> Q [Dec] Source

Build Wrapped instance for each newtype.

Configuring Lenses

makeLensesWith :: LensRules -> Name -> Q [Dec] Source

Build lenses with a custom configuration.

makeFieldsWith :: FieldRules -> Name -> Q [Dec] Source

Make fields with the specified FieldRules.

declareLensesWith :: LensRules -> Q [Dec] -> Q [Dec] Source

Declare lenses for each records in the given declarations, using the specified LensRules. Any record syntax in the input will be stripped off.

declareFieldsWith :: FieldRules -> Q [Dec] -> Q [Dec] Source

Declare fields for each records in the given declarations, using the specified FieldRules. Any record syntax in the input will be stripped off.

camelCaseFields :: FieldRules 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.

underscoreFields :: FieldRules Source

Field rules for fields in the form _prefix_fieldname

data LensRules Source

This configuration describes the options we'll be using to make isomorphisms or lenses.

lensRules :: LensRules Source

Rules for making fairly simple partial lenses, ignoring the special cases for isomorphisms and traversals, and not making any classes.

classyRules :: LensRules Source

Rules for making lenses and traversals that precompose another Lens.

isoRules :: LensRules Source

Rules for making an isomorphism from a data type.

lensIso :: Lens' LensRules (String -> Maybe String) Source

Lens' to access the convention for naming top level isomorphisms in our LensRules.

Defaults to lowercasing the first letter of the constructor.

lensField :: Lens' LensRules (String -> Maybe String) Source

Lens' to access the convention for naming fields in our LensRules.

Defaults to stripping the _ off of the field name, lowercasing the name, and rejecting the field if it doesn't start with an '_'.

lensClass :: Lens' LensRules (String -> Maybe (String, String)) Source

Retrieve options such as the name of the class and method to put in it to build a class around monomorphic data types.

lensFlags :: Lens' LensRules (Set LensFlag) Source

Retrieve options such as the name of the class and method to put in it to build a class around monomorphic data types.

simpleLenses :: Lens' LensRules Bool Source

Only Generate valid Simple lenses.

partialLenses :: Lens' LensRules Bool Source

Enables the generation of partial lenses, generating runtime errors for every constructor that does not have a valid definition for the Lens. This occurs when the constructor lacks the field, or has multiple fields mapped to the same Lens.

buildTraversals :: Lens' LensRules Bool Source

In the situations that a Lens would be partial, when partialLenses is used, this flag instead causes traversals to be generated. Only one can be used, and if neither are, then compile-time errors are generated.

handleSingletons :: Lens' LensRules Bool Source

Handle singleton constructors specially.

singletonIso :: Lens' LensRules Bool Source

Use Iso for singleton constructors.

backwardIso :: Lens' LensRules Bool Source

When generating an Iso put the field type as the "outer" type.

singletonRequired :: Lens' LensRules Bool Source

Expect a single constructor, single field newtype or data type.

createClass :: Lens' LensRules Bool Source

Create the class if the constructor is Simple and the lensClass rule matches.

createInstance :: Lens' LensRules Bool Source

Create the instance if the constructor is Simple and the lensClass rule matches.

classRequired :: Lens' LensRules Bool Source

Die if the lensClass fails to match.

singletonAndField :: Lens' LensRules Bool Source

When building a singleton Iso (or Lens) for a record constructor, build both the Iso (or Lens) for the record and the one for the field.

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.