| Copyright | (C) 2017 Csongor Kiss |
|---|---|
| License | BSD3 |
| Maintainer | Csongor Kiss <kiss.csongor.kiss@gmail.com> |
| Stability | experimental |
| Portability | non-portable |
| Safe Haskell | None |
| Language | Haskell2010 |
Data.Generics.Product.Positions
Contents
Description
Derive positional product type getters and setters generically.
Synopsis
- class HasPosition (i :: Nat) s t a b | s i -> a, t i -> b, s i b -> t, t i a -> s where
- class HasPosition' (i :: Nat) s a | s i -> a where
- getPosition :: forall i s a. HasPosition' i s a => s -> a
- setPosition :: forall i s a. HasPosition' i s a => a -> s -> s
Lenses
Running example:
>>>:set -XTypeApplications>>>:set -XDataKinds>>>:set -XDeriveGeneric>>>:set -XGADTs>>>:set -XFlexibleContexts>>>import GHC.Generics>>>:m +Data.Generics.Internal.VL.Lens>>>:m +Data.Function>>>:{data Human = Human { name :: String , age :: Int , address :: String } deriving (Generic, Show) human :: Human human = Human "Tunyasz" 50 "London" :}
class HasPosition (i :: Nat) s t a b | s i -> a, t i -> b, s i b -> t, t i a -> s where Source #
Records that have a field at a given position.
Minimal complete definition
Methods
position :: Lens s t a b Source #
A lens that focuses on a field at a given position. Compatible with the
lens package's Lens type.
>>>human ^. position @1"Tunyasz">>>human & position @3 .~ "Berlin"Human {name = "Tunyasz", age = 50, address = "Berlin"}
Type errors
>>>human & position @4 .~ "Berlin"... ... The type Human does not contain a field at position 4 ...
Instances
| (Generic s, ErrorUnless i s ((0 <? i) && (i <=? Size (Rep s))), Generic t, s' ~ Proxied s, t' ~ Proxied t, Generic s', Generic t', GLens (HasTotalPositionPSym i) cs ct a b, cs ~ (CRep s :: G Type), ct ~ (CRep t :: G Type), GLens' (HasTotalPositionPSym i) (CRep s' :: G Type) a', GLens' (HasTotalPositionPSym i) (CRep t' :: G Type) b', t ~ Infer s a' b, s ~ Infer t b' a, Coercible cs (Rep s), Coercible ct (Rep t)) => HasPosition i s t a b Source # | |
Defined in Data.Generics.Product.Positions | |
class HasPosition' (i :: Nat) s a | s i -> a where Source #
Minimal complete definition
getPosition :: forall i s a. HasPosition' i s a => s -> a Source #
setPosition :: forall i s a. HasPosition' i s a => a -> s -> s Source #