Safe Haskell | None |
---|
A simple problem is being solved here, but unfortunately it is a bit involved. The idea is to use the same haskell identifier for a lens and for other purposes. In other words, get the same behavior as:
x = hLens (Label :: Label "x") r ^. x
While still being able to extract the symbol "x" from x, so that things
like x .=. 123
could be acceptable. In this case we don't overload .=.
,
so instead you have to write x .==. 123
.
Elaboration of some ideas from edwardk.
Documentation
makeLabelable :: String -> Q [Dec]Source
makeLabelable "x y z"
will generate haskell identifiers that work with .==.
and
are also lenses.
x = hLens' (Label :: Label "x") y = hLens' (Label :: Label "y") z = hLens' (Label :: Label "z")
class Labelable l p f s t a b | l s -> a, l t -> b, l s b -> t, l t a -> s whereSource
f s t a b
type parameters are the same as those that make
Control.Lens work.
(Functor f, HasField k x (Record s) a, HasField k x (Record t) b, HFind k x (RecordLabels k t) n, HFind k x (RecordLabels k s) n, HUpdateAtHNat n (Tagged k x b) s, ~ [*] t (HUpdateAtHNatR n (Tagged k x b) s)) => Labelable k x (->) f s t a b | make a lens |
(~ (* -> *) f Identity, ~ [*] s ([] *), ~ [*] t ([] *), ~ * a (), ~ * b (), ~ k x' x) => Labelable k x' (Labeled k x) f s t a b | make a data type that allows recovering the field name |
(.==.) :: ToSym * Symbol t l => t -> v -> Tagged Symbol l vSource
modification of .=.
which works with the labels from this module,
and those from Data.HList.Label6. Note that this is not strictly a
generalization of .=.
, since it does not work with labels like
Data.HList.Label3 which have the wrong kind.
comparison with hLens
Note that passing around variables defined with hLens'
doesn't get
you exactly the same thing as calling hLens
at the call-site:
The following code needs to apply the x
for different Functor
f =>
, so you would have to write a type signature (rank-2) to allow this
definition:
-- with the x defined using hLens' let f x r = let a = r ^. x b = r & x .~ "6" in (a,b)
This alternative won't need a type signature
-- with the x defined as x = Label :: Label "x" let f x r = let a = r ^. hLens x b = r & hLens x .~ "6" in (a,b)
It may work to use hLens'
instead of hLens
in the second code,
but that is a bit beside the point being made here.
likely unneeded (re)exports
data Identity a
Identity functor and monad.