mini-1.0.1.0: Minimal essentials
Safe HaskellSafe-Inferred
LanguageHaskell2010

Mini.Lens

Description

Minimal library of van Laarhoven lenses: composable polymorphic record updates

Synopsis
  • type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
  • lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
  • view :: Lens s t a b -> s -> a
  • over :: Lens s t a b -> (a -> b) -> s -> t
  • set :: Lens s t a b -> b -> s -> t

Types

type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t Source #

A purely functional reference for updating structures of type s with fields of type a to structures of type t with fields of type b

Construction

lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b Source #

From a getter and a setter to a lens

data Foo = Foo { _bar :: Bar } deriving Show
data Bar = Bar { _baz :: Int } deriving Show

bar :: Lens Foo Foo Bar Bar
bar = lens _bar $ \s b -> s { _bar = b }

baz :: Lens Bar Bar Int Int
baz = lens _baz $ \s b -> s { _baz = b }

Reading

view :: Lens s t a b -> s -> a Source #

From a lens and a structure to the value of the field of the structure referenced by the lens

ghci> view (bar . baz) $ Foo (Bar 73)
73

Modifying

over :: Lens s t a b -> (a -> b) -> s -> t Source #

From a lens, an operation and a structure to the structure updated by applying the operation to the value of the field referenced by the lens

ghci> over (bar . baz) (+ 1) $ Foo (Bar 73)
Foo {_bar = Bar {_baz = 74}}

Writing

set :: Lens s t a b -> b -> s -> t Source #

From a lens, a value and a structure to the structure updated by setting the field referenced by the lens to the value

ghci> set (bar . baz) 21 $ Foo (Bar 73)
Foo {_bar = Bar {_baz = 21}}