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
|
{-|
A pseudo derivation. For each field in the data type, deriving
@Set@ generates @set@/FieldName/@ v x = x{@/fieldName/@ = v}@.
This derivation is intended to work around the fact that in Haskell
assigning to a field is not a first class object (although
extracting from a field is).
-}
module Data.Derive.Set(makeSet) where
{-
test :: Computer
setSpeed :: Int -> Computer -> Computer
setSpeed v x = x{speed=v}
setWeight :: Double -> Computer -> Computer
setWeight v x = x{weight=v}
test :: Sample
-}
import Language.Haskell
import Data.Derive.Internal.Derivation
import Data.Maybe
makeSet :: Derivation
makeSet = derivationCustom "Set" $ \(_,d) -> Right $ concatMap (makeSetField d) $ dataDeclFields d
makeSetField :: DataDecl -> String -> [Decl]
makeSetField d field = [TypeSig sl [name set] typ, bind set [pVar "v",pVar "x"] bod]
where
set = "set" ++ title field
typ = typField `TyFun` (dataDeclType d `TyFun` dataDeclType d)
typField = fromBangType $ fromJust $ lookup field $ concatMap ctorDeclFields $ dataDeclCtors d
bod = RecUpdate (var "x") [FieldUpdate (qname field) (var "v")]
|
