--- /dev/null
+package org.simantics.scl.compiler.internal.deriving;
+
+import java.util.ArrayList;
+
+import org.simantics.scl.compiler.common.datatypes.Constructor;
+import org.simantics.scl.compiler.common.names.Names;
+import org.simantics.scl.compiler.constants.StringConstant;
+import org.simantics.scl.compiler.elaboration.errors.NotPatternException;
+import org.simantics.scl.compiler.elaboration.expressions.EApply;
+import org.simantics.scl.compiler.elaboration.expressions.EConstant;
+import org.simantics.scl.compiler.elaboration.expressions.EListLiteral;
+import org.simantics.scl.compiler.elaboration.expressions.ELiteral;
+import org.simantics.scl.compiler.elaboration.expressions.ERecord;
+import org.simantics.scl.compiler.elaboration.expressions.EVar;
+import org.simantics.scl.compiler.elaboration.expressions.Expression;
+import org.simantics.scl.compiler.elaboration.expressions.records.FieldAssignment;
+import org.simantics.scl.compiler.elaboration.modules.SCLValue;
+import org.simantics.scl.compiler.elaboration.modules.TypeAlias;
+import org.simantics.scl.compiler.elaboration.modules.TypeConstructor;
+import org.simantics.scl.compiler.elaboration.modules.TypeDescriptor;
+import org.simantics.scl.compiler.environment.AmbiguousNameException;
+import org.simantics.scl.compiler.environment.Environment;
+import org.simantics.scl.compiler.environment.Environments;
+import org.simantics.scl.compiler.errors.ErrorLog;
+import org.simantics.scl.compiler.internal.parsing.declarations.DDerivingInstanceAst;
+import org.simantics.scl.compiler.internal.parsing.declarations.DInstanceAst;
+import org.simantics.scl.compiler.internal.parsing.declarations.DValueAst;
+import org.simantics.scl.compiler.internal.parsing.translation.ProcessedDInstanceAst;
+import org.simantics.scl.compiler.internal.parsing.translation.ValueRepository;
+import org.simantics.scl.compiler.internal.parsing.types.TVarAst;
+import org.simantics.scl.compiler.types.TApply;
+import org.simantics.scl.compiler.types.TCon;
+import org.simantics.scl.compiler.types.Type;
+import org.simantics.scl.compiler.types.Types;
+
+class JsonDeriver implements InstanceDeriver {
+
+ @Override
+ public void derive(
+ ErrorLog errorLog,
+ Environment environment,
+ ArrayList<ProcessedDInstanceAst> instancesAst,
+ DDerivingInstanceAst der) {
+ // Analyze
+ if(der.types.length != 1) {
+ errorLog.log(der.location, "Invalid number of parameters to " + der.name);
+ return;
+ }
+ TVarAst headType = DerivingUtils.getHeadType(der.types[0]);
+ if(headType == null) {
+ errorLog.log(der.types[0].location, "Cannot derive Json instance for the type " + headType + ".");
+ return;
+ }
+ TCon con;
+ try {
+ con = Environments.getTypeDescriptorName(environment, headType.name);
+ } catch (AmbiguousNameException e1) {
+ errorLog.log(headType.location, e1.getMessage());
+ return;
+ }
+ if(con == null) {
+ errorLog.log(headType.location, "Couldn't resolve " + headType.name);
+ return;
+ }
+ TypeDescriptor tdesc = environment.getTypeDescriptor(con);
+ if(tdesc == null) {
+ errorLog.log(headType.location, "Didn't find type constructor for " + headType.name);
+ return;
+ }
+ if(tdesc instanceof TypeAlias) {
+ errorLog.log(headType.location, "Cannot derive instance for a type alias.");
+ return;
+ }
+ TypeConstructor tcon = (TypeConstructor)tdesc;
+ if(tcon.isOpen) {
+ errorLog.log(headType.location, "Cannot derive instance for open data types.");
+ return;
+ }
+
+ if(tcon.constructors.length != 1) {
+ errorLog.log(headType.location, "Data must have exactly one constructor for deriving to work.");
+ return;
+ }
+ Constructor constructor = tcon.constructors[0];
+ if(constructor.recordFieldNames == null) {
+ errorLog.log(headType.location, "Data must have a record constructor for deriving to work.");
+ return;
+ }
+
+ DInstanceAst instanceAst = new DInstanceAst(der.location, der.context, der.name, der.types);
+ ValueRepository valueDefs = new ValueRepository();
+
+ SCLValue fromJson = environment.getValue(Names.Json_fromJson);
+ SCLValue toJson = environment.getValue(Names.Json_toJson);
+ SCLValue lookupJsonField = environment.getValue(Names.Json_lookupJsonField);
+ SCLValue JsonObject = environment.getValue(Names.Json_JsonObject);
+ SCLValue JsonField = environment.getValue(Names.Json_JsonField);
+
+ SCLValue Just = environment.getValue(Names.Builtin_Just);
+ SCLValue fromJust = environment.getValue(Names.Prelude_fromJust);
+ SCLValue map = environment.getValue(Names.Prelude_map);
+ SCLValue filterJust = environment.getValue(Names.Prelude_filterJust);
+ SCLValue dot = environment.getValue(Names.Prelude_dot);
+
+ // Collect all relevant information about the constructor
+ String constructorName = constructor.name.name;
+ int fieldCount = constructor.parameterTypes.length;
+ String[] fieldNames = constructor.recordFieldNames;
+ boolean[] isOptional = new boolean[fieldCount];
+ boolean hasAtLeastOneOptional = false;
+ for(int i=0;i<fieldCount;++i) {
+ Type type = constructor.parameterTypes[i];
+ hasAtLeastOneOptional |= isOptional[i] = type instanceof TApply
+ && ((TApply)type).function == Types.MAYBE;
+ }
+
+ // Generate toJson
+ {
+ /* toJson GeographicalLocation { latitude, longitude } = JsonObject [
+ * JsonField "latitude" (toJson latitude),
+ * JsonField "longitude" (toJson longitude)
+ * ]
+ * toJson GeographicalLocation { latitude, longitude } = JsonObject $ filterJust [
+ * Just (JsonField "latitude" (toJson latitude)),
+ * map (JsonField "longitude" . toJson) longitude
+ * ]
+ */
+ FieldAssignment[] fieldAssignments = new FieldAssignment[fieldCount];
+ for(int i=0;i<fieldCount;++i)
+ fieldAssignments[i] = new FieldAssignment(fieldNames[i], null);
+ Expression lhs = new EApply(
+ new EVar("toJson"),
+ new ERecord(new EVar(constructorName), fieldAssignments)
+ );
+ Expression componentsExpression;
+ if(hasAtLeastOneOptional) {
+ Expression[] components = new Expression[fieldCount];
+ for(int i=0;i<fieldCount;++i) {
+ if(isOptional[i])
+ components[i] = new EApply(new EConstant(map),
+ new EApply(new EConstant(dot),
+ new EApply(new EConstant(JsonField), new ELiteral(new StringConstant(fieldNames[i]))),
+ new EConstant(toJson)
+ ),
+ new EVar(fieldNames[i])
+ );
+ else
+ components[i] = new EApply(new EConstant(Just),
+ new EApply(new EConstant(JsonField),
+ new ELiteral(new StringConstant(fieldNames[i])),
+ new EApply(new EConstant(toJson), new EVar(fieldNames[i]))
+ ));
+ }
+ componentsExpression = new EApply(new EConstant(filterJust),
+ new EListLiteral(components));
+ }
+ else {
+ Expression[] components = new Expression[fieldCount];
+ for(int i=0;i<fieldCount;++i) {
+ components[i] = new EApply(new EConstant(JsonField),
+ new ELiteral(new StringConstant(fieldNames[i])),
+ new EApply(new EConstant(toJson), new EVar(fieldNames[i]))
+ );
+ }
+ componentsExpression = new EListLiteral(components);
+ }
+ Expression rhs = new EApply(new EConstant(JsonObject), componentsExpression);
+ try {
+ DValueAst valueAst = new DValueAst(lhs, rhs);
+ valueAst.setLocationDeep(der.location);
+ valueDefs.add(valueAst);
+ } catch (NotPatternException e) {
+ errorLog.log(e.getExpression().location, "Not a pattern (a).");
+ }
+ }
+
+ // Generate fromJson
+ {
+ /* fromJson object = GeographicalLocation {
+ * latitude = fromJson $ fromJust $ lookupJsonField "latitude" object,
+ * longitude = map fromJson $ lookupJsonField "longitude" object
+ * }
+ */
+ Expression lhs = new EApply(
+ new EVar("fromJson"),
+ new EVar("jsonObject")
+ );
+ FieldAssignment[] fieldAssignments = new FieldAssignment[fieldCount];
+ for(int i=0;i<fieldCount;++i) {
+ Expression fieldValue = new EApply(new EConstant(lookupJsonField),
+ new ELiteral(new StringConstant(fieldNames[i])),
+ new EVar("jsonObject")
+ );
+ if(isOptional[i]) {
+ fieldValue = new EApply(new EConstant(map), new EConstant(fromJson), fieldValue);
+ }
+ else {
+ fieldValue = new EApply(new EConstant(fromJust), fieldValue);
+ fieldValue = new EApply(new EConstant(fromJson), fieldValue);
+ }
+ fieldAssignments[i] = new FieldAssignment(fieldNames[i], fieldValue);
+ }
+ Expression rhs = new ERecord(new EVar(constructorName),
+ fieldAssignments
+ );
+ try {
+ DValueAst valueAst = new DValueAst(lhs, rhs);
+ valueAst.setLocationDeep(der.location);
+ valueDefs.add(valueAst);
+ } catch (NotPatternException e) {
+ errorLog.log(e.getExpression().location, "Not a pattern (b).");
+ }
+ }
+
+ instancesAst.add(new ProcessedDInstanceAst(instanceAst, valueDefs));
+ }
+
+}
Code Review / simantics / platform.git / blobdiff