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
42
|
{-|
A pseudo derivation. For each field in the data type, deriving
@Ref@ generates @ref@/FieldName/@ = Ref { select = @/fieldName/@ , update =
\ f v -> v { @/fieldName/@ = f (@/fieldName/@ v) } }@.
This is intended for use with the compositional functional references
described in
<http://www.haskell.org/pipermail/haskell-cafe/2007-June/026477.html>.
-}
module Data.Derive.Ref(makeRef) where
{-
test :: Sample
test :: Computer
refSpeed :: Ref Computer
refSpeed = Ref {select = speed, update = \f v -> v{speed = f (speed v)}}
refWeight :: Ref Computer
refWeight = Ref {select = weight, update = \f v -> v{weight = f (weight v)}}
-}
import Language.Haskell
import Data.Derive.Internal.Derivation
makeRef :: Derivation
makeRef = derivationCustom "Ref" $ \(_,d) -> Right $ concatMap (makeRefField d) $ dataDeclFields d
makeRefField :: DataDecl -> String -> [Decl]
makeRefField d field = [TypeSig sl [name ref] typ, bind ref [] bod]
where
ref = "ref" ++ title field
typ = TyApp (tyCon "Ref") (dataDeclType d)
bod = RecConstr (qname "Ref")
[FieldUpdate (qname "select") (var field)
,FieldUpdate (qname "update") $ Lambda sl [pVar "f",pVar "v"] $
RecUpdate (var "v") [FieldUpdate (qname field) $ App (var "f") $ Paren $ App (var field) (var "v")]
]
|
