1 package org.simantics.scl.compiler.internal.deriving;
3 import java.util.ArrayList;
5 import org.simantics.scl.compiler.common.datatypes.Constructor;
6 import org.simantics.scl.compiler.common.names.Names;
7 import org.simantics.scl.compiler.constants.StringConstant;
8 import org.simantics.scl.compiler.elaboration.errors.NotPatternException;
9 import org.simantics.scl.compiler.elaboration.expressions.EApply;
10 import org.simantics.scl.compiler.elaboration.expressions.EConstant;
11 import org.simantics.scl.compiler.elaboration.expressions.EListLiteral;
12 import org.simantics.scl.compiler.elaboration.expressions.ELiteral;
13 import org.simantics.scl.compiler.elaboration.expressions.ERecord;
14 import org.simantics.scl.compiler.elaboration.expressions.EVar;
15 import org.simantics.scl.compiler.elaboration.expressions.Expression;
16 import org.simantics.scl.compiler.elaboration.expressions.records.FieldAssignment;
17 import org.simantics.scl.compiler.elaboration.modules.SCLValue;
18 import org.simantics.scl.compiler.elaboration.modules.TypeAlias;
19 import org.simantics.scl.compiler.elaboration.modules.TypeConstructor;
20 import org.simantics.scl.compiler.elaboration.modules.TypeDescriptor;
21 import org.simantics.scl.compiler.environment.AmbiguousNameException;
22 import org.simantics.scl.compiler.environment.Environment;
23 import org.simantics.scl.compiler.environment.Environments;
24 import org.simantics.scl.compiler.errors.ErrorLog;
25 import org.simantics.scl.compiler.internal.parsing.declarations.DDerivingInstanceAst;
26 import org.simantics.scl.compiler.internal.parsing.declarations.DInstanceAst;
27 import org.simantics.scl.compiler.internal.parsing.declarations.DValueAst;
28 import org.simantics.scl.compiler.internal.parsing.translation.ProcessedDInstanceAst;
29 import org.simantics.scl.compiler.internal.parsing.translation.ValueRepository;
30 import org.simantics.scl.compiler.internal.parsing.types.TVarAst;
31 import org.simantics.scl.compiler.types.TApply;
32 import org.simantics.scl.compiler.types.TCon;
33 import org.simantics.scl.compiler.types.Type;
34 import org.simantics.scl.compiler.types.Types;
36 class JsonDeriver implements InstanceDeriver {
41 Environment environment,
42 ArrayList<ProcessedDInstanceAst> instancesAst,
43 DDerivingInstanceAst der) {
45 if(der.types.length != 1) {
46 errorLog.log(der.location, "Invalid number of parameters to " + der.name);
49 TVarAst headType = DerivingUtils.getHeadType(der.types[0]);
50 if(headType == null) {
51 errorLog.log(der.types[0].location, "Cannot derive Json instance for the type " + headType + ".");
56 con = Environments.getTypeDescriptorName(environment, headType.name);
57 } catch (AmbiguousNameException e1) {
58 errorLog.log(headType.location, e1.getMessage());
62 errorLog.log(headType.location, "Couldn't resolve " + headType.name);
65 TypeDescriptor tdesc = environment.getTypeDescriptor(con);
67 errorLog.log(headType.location, "Didn't find type constructor for " + headType.name);
70 if(tdesc instanceof TypeAlias) {
71 errorLog.log(headType.location, "Cannot derive instance for a type alias.");
74 TypeConstructor tcon = (TypeConstructor)tdesc;
76 errorLog.log(headType.location, "Cannot derive instance for open data types.");
80 if(tcon.constructors.length != 1) {
81 errorLog.log(headType.location, "Data must have exactly one constructor for deriving to work.");
84 Constructor constructor = tcon.constructors[0];
85 if(constructor.recordFieldNames == null) {
86 errorLog.log(headType.location, "Data must have a record constructor for deriving to work.");
90 DInstanceAst instanceAst = new DInstanceAst(der.location, der.context, der.name, der.types);
91 ValueRepository valueDefs = new ValueRepository();
93 SCLValue fromJson = environment.getValue(Names.Json_fromJson);
94 SCLValue toJson = environment.getValue(Names.Json_toJson);
95 SCLValue lookupJsonField = environment.getValue(Names.Json_lookupJsonField);
96 SCLValue JsonObject = environment.getValue(Names.Json_JsonObject);
97 SCLValue JsonField = environment.getValue(Names.Json_JsonField);
99 SCLValue Just = environment.getValue(Names.Builtin_Just);
100 SCLValue fromJust = environment.getValue(Names.Prelude_fromJust);
101 SCLValue map = environment.getValue(Names.Prelude_map);
102 SCLValue filterJust = environment.getValue(Names.Prelude_filterJust);
103 SCLValue dot = environment.getValue(Names.Prelude_dot);
105 // Collect all relevant information about the constructor
106 String constructorName = constructor.name.name;
107 int fieldCount = constructor.parameterTypes.length;
108 String[] fieldNames = constructor.recordFieldNames;
109 boolean[] isOptional = new boolean[fieldCount];
110 boolean hasAtLeastOneOptional = false;
111 for(int i=0;i<fieldCount;++i) {
112 Type type = constructor.parameterTypes[i];
113 hasAtLeastOneOptional |= isOptional[i] = type instanceof TApply
114 && ((TApply)type).function == Types.MAYBE;
119 /* toJson GeographicalLocation { latitude, longitude } = JsonObject [
120 * JsonField "latitude" (toJson latitude),
121 * JsonField "longitude" (toJson longitude)
123 * toJson GeographicalLocation { latitude, longitude } = JsonObject $ filterJust [
124 * Just (JsonField "latitude" (toJson latitude)),
125 * map (JsonField "longitude" . toJson) longitude
128 FieldAssignment[] fieldAssignments = new FieldAssignment[fieldCount];
129 for(int i=0;i<fieldCount;++i)
130 fieldAssignments[i] = new FieldAssignment(fieldNames[i], null);
131 Expression lhs = new EApply(
133 new ERecord(new EVar(constructorName), fieldAssignments)
135 Expression componentsExpression;
136 if(hasAtLeastOneOptional) {
137 Expression[] components = new Expression[fieldCount];
138 for(int i=0;i<fieldCount;++i) {
140 components[i] = new EApply(new EConstant(map),
141 new EApply(new EConstant(dot),
142 new EApply(new EConstant(JsonField), new ELiteral(new StringConstant(fieldNames[i]))),
143 new EConstant(toJson)
145 new EVar(fieldNames[i])
148 components[i] = new EApply(new EConstant(Just),
149 new EApply(new EConstant(JsonField),
150 new ELiteral(new StringConstant(fieldNames[i])),
151 new EApply(new EConstant(toJson), new EVar(fieldNames[i]))
154 componentsExpression = new EApply(new EConstant(filterJust),
155 new EListLiteral(components));
158 Expression[] components = new Expression[fieldCount];
159 for(int i=0;i<fieldCount;++i) {
160 components[i] = new EApply(new EConstant(JsonField),
161 new ELiteral(new StringConstant(fieldNames[i])),
162 new EApply(new EConstant(toJson), new EVar(fieldNames[i]))
165 componentsExpression = new EListLiteral(components);
167 Expression rhs = new EApply(new EConstant(JsonObject), componentsExpression);
169 DValueAst valueAst = new DValueAst(lhs, rhs);
170 valueAst.setLocationDeep(der.location);
171 valueDefs.add(valueAst);
172 } catch (NotPatternException e) {
173 errorLog.log(e.getExpression().location, "Not a pattern (a).");
179 /* fromJson object = GeographicalLocation {
180 * latitude = fromJson $ fromJust $ lookupJsonField "latitude" object,
181 * longitude = map fromJson $ lookupJsonField "longitude" object
184 Expression lhs = new EApply(
185 new EVar("fromJson"),
186 new EVar("jsonObject")
188 FieldAssignment[] fieldAssignments = new FieldAssignment[fieldCount];
189 for(int i=0;i<fieldCount;++i) {
190 Expression fieldValue = new EApply(new EConstant(lookupJsonField),
191 new ELiteral(new StringConstant(fieldNames[i])),
192 new EVar("jsonObject")
195 fieldValue = new EApply(new EConstant(map), new EConstant(fromJson), fieldValue);
198 fieldValue = new EApply(new EConstant(fromJust), fieldValue);
199 fieldValue = new EApply(new EConstant(fromJson), fieldValue);
201 fieldAssignments[i] = new FieldAssignment(fieldNames[i], fieldValue);
203 Expression rhs = new ERecord(new EVar(constructorName),
207 DValueAst valueAst = new DValueAst(lhs, rhs);
208 valueAst.setLocationDeep(der.location);
209 valueDefs.add(valueAst);
210 } catch (NotPatternException e) {
211 errorLog.log(e.getExpression().location, "Not a pattern (b).");
215 instancesAst.add(new ProcessedDInstanceAst(instanceAst, valueDefs));