1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
|
{-|
A pseudo derivation. For each field in the data type, deriving
@Lens@ generates @lens@/FieldName/@ = lens @/fieldName/@
(\ x v -> v { @/fieldName/@ = x })@.
This works with the @data-lens@ package.
-}
module Data.Derive.Lens(makeLens) where
{-
import "data-lens" Data.Lens.Common
test :: Sample
test :: Computer
lensSpeed :: Lens Computer Int
lensSpeed = lens speed (\x v -> v{speed = x})
lensWeight :: Lens Computer Double
lensWeight = lens weight (\x v -> v{weight = x})
-}
import Language.Haskell
import Data.Derive.Internal.Derivation
makeLens :: Derivation
makeLens = derivationCustom "Lens" $ \(_,d) -> Right $ concatMap (makeLensField d) $ dataDeclFields d
makeLensField :: DataDecl -> String -> [Decl]
makeLensField d field = [TypeSig sl [name ref] typ, bind ref [] bod]
where
ref = "lens" ++ title field
typ = tyApps (tyCon "Lens") [dataDeclType d, fromBangType t]
Just t = lookup field $ concatMap ctorDeclFields $ dataDeclCtors d
bod = apps (var "lens")
[var field
,Paren $ Lambda sl [pVar "x",pVar "v"] $ RecUpdate (var "v") [FieldUpdate (qname field) (var "x")]]
|
