From 46c8fc519bee6aaef7ad8606adb8bfbb8fa3655d Mon Sep 17 00:00:00 2001 From: Reeshabh Date: Tue, 10 Mar 2020 17:48:10 -0400 Subject: [PATCH 1/5] First draft of elm encoder backend --- cli/morphir.js | 25 +- cli/src/Morphir/Elm/EncodersCLI.elm | 131 ++++++++++ package.json | 2 +- src/Morphir/Elm/Backend/Codec/Gen.elm | 271 +++++++++++++++++++ src/Morphir/Elm/Frontend.elm | 2 +- src/Morphir/IR/AccessControlled.elm | 2 +- src/Morphir/IR/Advanced/Type.elm | 18 +- src/Morphir/IR/FQName.elm | 2 +- tests/Morphir/Codec/Examples.elm | 359 ++++++++++++++++++++++++++ tests/Morphir/Codec/Tests/A.elm | 31 +++ 10 files changed, 830 insertions(+), 13 deletions(-) create mode 100644 cli/src/Morphir/Elm/EncodersCLI.elm create mode 100644 src/Morphir/Elm/Backend/Codec/Gen.elm create mode 100644 tests/Morphir/Codec/Examples.elm create mode 100644 tests/Morphir/Codec/Tests/A.elm diff --git a/cli/morphir.js b/cli/morphir.js index e42af48a2..a4d791c63 100644 --- a/cli/morphir.js +++ b/cli/morphir.js @@ -4,17 +4,22 @@ const util = require('util') const fs = require('fs') const readdir = util.promisify(fs.readdir) const readFile = util.promisify(fs.readFile) -const worker = require('./Morphir.Elm.CLI').Elm.Morphir.Elm.CLI.init() +const packageDefWorker = require('./Morphir.Elm.CLI').Elm.Morphir.Elm.CLI.init() +const elmEncoderWorker = require('./Morphir.Elm.EncodersCLI').Elm.Morphir.Elm.EncodersCLI.init() -worker.ports.decodeError.subscribe(res => { +packageDefWorker.ports.decodeError.subscribe(res => { console.error(res) }) -worker.ports.packageDefinitionFromSourceResult.subscribe(res => { +packageDefWorker.ports.packageDefinitionFromSourceResult.subscribe(res => { console.log(JSON.stringify(res)) }) +elmEncoderWorker.ports.elmEncoderBackend.subscribe(res => { + console.log(res) +}) + const packageInfo = { name: "morphir", @@ -23,10 +28,11 @@ const packageInfo = { const sourceDir = "../src" +const testDir = "../tests/Morphir/Codec/Tests" readElmSources(sourceDir) .then((sourceFiles) => { - worker.ports.packageDefinitionFromSource.send([packageInfo, sourceFiles]) + packageDefWorker.ports.packageDefinitionFromSource.send([packageInfo, sourceFiles]) sourceFiles.forEach(element => { console.log(element.path) }); @@ -35,6 +41,17 @@ readElmSources(sourceDir) console.error(err) }) +readElmSources(testDir) +.then((sourceFiles) => { + console.log ("Generating elm encoders for following:") + sourceFiles.forEach(element => { + console.log(element.path) + }); + console.log ("") + elmEncoderWorker.ports.elmFrontEnd.send([packageInfo, sourceFiles]) + console.log ("") +}) + async function readElmSources(dir) { diff --git a/cli/src/Morphir/Elm/EncodersCLI.elm b/cli/src/Morphir/Elm/EncodersCLI.elm new file mode 100644 index 000000000..bc8ce45ba --- /dev/null +++ b/cli/src/Morphir/Elm/EncodersCLI.elm @@ -0,0 +1,131 @@ +port module Morphir.Elm.EncodersCLI exposing (..) + +import Dict as Dict exposing (..) +import Elm.Syntax.Declaration as S exposing (..) +import Elm.Syntax.Exposing exposing (..) +import Elm.Syntax.File exposing (..) +import Elm.Syntax.Module exposing (..) +import Elm.Syntax.Node exposing (..) +import Elm.Syntax.Range exposing (..) +import Elm.Writer exposing (..) +import Json.Decode as Decode exposing (..) +import Morphir.Elm.Backend.Codec.Gen exposing (..) +import Morphir.Elm.Frontend exposing (..) +import Morphir.IR.AccessControlled exposing (..) +import Morphir.IR.Advanced.Module as Advanced exposing (..) +import Morphir.IR.Name exposing (..) +import Set exposing (..) + + +main = + Platform.worker + { init = init, update = update, subscriptions = subscriptions } + + +type Msg + = PackageDefinitionFromSource ( Decode.Value, List SourceFile ) + + +type alias Model = + () + + +init : () -> ( Model, Cmd Msg ) +init _ = + ( (), Cmd.none ) + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update (PackageDefinitionFromSource ( _, sourceFiles )) model = + ( model, genEncodersFile sourceFiles |> elmEncoderBackend ) + + +subscriptions : Model -> Sub Msg +subscriptions _ = + elmFrontEnd PackageDefinitionFromSource + + +port elmEncoderBackend : String -> Cmd msg + + +port elmFrontEnd : (( Decode.Value, List SourceFile ) -> msg) -> Sub msg + + +genEncodersFile : List SourceFile -> String +genEncodersFile sources = + let + file = + { moduleDefinition = + emptyRangeNode <| + NormalModule + { moduleName = emptyRangeNode [ "AEncoders" ] + , exposingList = emptyRangeNode (All emptyRange) + } + , imports = [] + , declarations = + case encoderDeclarations sources of + Ok maybList -> + case maybList of + Just list -> + list + + Nothing -> + [] + + Err _ -> + [] + , comments = [] + } + in + writeFile file |> write + + +encoderDeclarations : List SourceFile -> Result Errors (Maybe (List (Node S.Declaration))) +encoderDeclarations sourceFiles = + packageDefinitionFromSource emptyPackageInfo sourceFiles + |> Result.map .modules + |> Result.map (Dict.get [ [ "a" ] ]) + |> Result.map (Maybe.map getEncodersFromModuleDef) + + +getEncodersFromModuleDef : AccessControlled (Advanced.Definition SourceLocation) -> List (Node S.Declaration) +getEncodersFromModuleDef accessCtrlModuleDef = + case accessCtrlModuleDef of + Public { types, values } -> + Dict.toList types + |> List.map + (\typeNameAndDef -> + typeDefToEncoder emptySourceLocation + (Tuple.first typeNameAndDef) + (Tuple.second typeNameAndDef) + ) + |> List.map (Node emptyRange) + + _ -> + [] + + +emptySourceLocation : SourceLocation +emptySourceLocation = + { source = + { path = "" + , content = "" + } + , range = + { start = + { row = 0 + , column = 0 + } + , end = + { row = 0 + , column = 0 + } + } + } + + +emptyPackageInfo : PackageInfo +emptyPackageInfo = + { name = [] + , exposedModules = Set.fromList [ [ fromString "a" ] ] + } diff --git a/package.json b/package.json index 243c7c5f8..da0a01153 100644 --- a/package.json +++ b/package.json @@ -4,7 +4,7 @@ "description": "Elm bindings for Morphir", "scripts": { "test": "elm-test", - "make-cli": "cd cli && elm make src/Morphir/Elm/CLI.elm --output Morphir.Elm.CLI.js --optimize" + "make-cli": "cd cli && elm make src/Morphir/Elm/CLI.elm --output Morphir.Elm.CLI.js --optimize && elm make src/Morphir/Elm/EncodersCLI.elm --output Morphir.Elm.EncodersCLI.js --optimize" }, "repository": { "type": "git", diff --git a/src/Morphir/Elm/Backend/Codec/Gen.elm b/src/Morphir/Elm/Backend/Codec/Gen.elm new file mode 100644 index 000000000..72f24dd50 --- /dev/null +++ b/src/Morphir/Elm/Backend/Codec/Gen.elm @@ -0,0 +1,271 @@ +module Morphir.Elm.Backend.Codec.Gen exposing (..) + +import Elm.Syntax.Declaration exposing (Declaration(..)) +import Elm.Syntax.Expression exposing (Case, Expression(..), Function, FunctionImplementation) +import Elm.Syntax.ModuleName exposing (ModuleName) +import Elm.Syntax.Node exposing (Node(..)) +import Elm.Syntax.Pattern exposing (Pattern(..), QualifiedNameRef) +import Elm.Syntax.Range exposing (emptyRange) +import Morphir.IR.AccessControlled exposing (AccessControlled(..)) +import Morphir.IR.Advanced.Type exposing (Constructor, Definition(..), Field(..), Type(..), field, record) +import Morphir.IR.FQName exposing (FQName(..)) +import Morphir.IR.Name exposing (Name, fromString, toCamelCase, toTitleCase) +import Morphir.IR.Path as Path exposing (toString) + + +typeDefToEncoder : extra -> Name -> AccessControlled (Definition extra) -> Declaration +typeDefToEncoder e typeName typeDef = + let + function : Function + function = + { documentation = Nothing + , signature = Nothing + , declaration = emptyRangeNode functionImpl + } + + functionImpl : FunctionImplementation + functionImpl = + { name = emptyRangeNode functionName + , arguments = args + , expression = emptyRangeNode funcExpr + } + + functionName : String + functionName = + toCamelCase <| [ "encode" ] ++ typeName + + args : List (Node Pattern) + args = + case typeDef of + Public (CustomTypeDefinition _ (Public constructors)) -> + case constructors of + [] -> + [] + + ( ctorName, fields ) :: [] -> + [ deconsPattern ctorName fields + |> emptyRangeNode + |> ParenthesizedPattern + |> emptyRangeNode + ] + + _ -> + [ typeName |> toCamelCase |> VarPattern |> emptyRangeNode ] + + Public (TypeAliasDefinition _ _) -> + [ typeName |> toCamelCase |> VarPattern |> emptyRangeNode ] + + _ -> + [] + + funcExpr : Expression + funcExpr = + case typeDef of + Public (CustomTypeDefinition _ (Public constructors)) -> + case constructors of + [] -> + Literal "Types without constructors are not supported" + + ctor :: [] -> + ctor + |> constructorToRecord e + |> typeToEncoder [ Tuple.first ctor ] + + ctors -> + let + caseValExpr : Node Expression + caseValExpr = + typeName + |> toCamelCase + |> FunctionOrValue [] + |> emptyRangeNode + + cases : List ( Node Pattern, Node Expression ) + cases = + let + ctorToPatternExpr : Constructor extra -> ( Node Pattern, Node Expression ) + ctorToPatternExpr ctor = + let + pattern : Pattern + pattern = + deconsPattern (Tuple.first ctor) (Tuple.second ctor) + + expr : Expression + expr = + ctor + |> constructorToRecord e + |> typeToEncoder [ Tuple.first ctor ] + |> customTypeTopExpr + in + ( emptyRangeNode pattern, emptyRangeNode expr ) + in + ctors |> List.map ctorToPatternExpr + in + CaseExpression { expression = caseValExpr, cases = cases } + + Public (TypeAliasDefinition _ tpe) -> + typeToEncoder [ typeName ] tpe + + _ -> + Literal "Private types are not supported" + in + FunctionDeclaration function + + +typeToEncoder : List Name -> Type extra -> Expression +typeToEncoder varName tpe = + case tpe of + Reference fqName typeArgs _ -> + case fqName of + FQName _ _ [ "int" ] -> + elmJsonEncoderApplication + (elmJsonEncoderFunction "int") + (varPathToExpr varName) + + FQName _ _ [ "string" ] -> + elmJsonEncoderApplication + (elmJsonEncoderFunction "string") + (varPathToExpr varName) + + FQName _ _ [ "Maybe" ] -> + case typeArgs of + typeArg :: [] -> + let + caseValExpr : Node Expression + caseValExpr = + FunctionOrValue [] "arg" + |> emptyRangeNode + + justPattern : Pattern + justPattern = + NamedPattern + (QualifiedNameRef [] "Just") + [ "a" |> VarPattern |> emptyRangeNode ] + + justExpression : Expression + justExpression = + typeToEncoder [ fromString "a" ] typeArg + + nothingPattern : Pattern + nothingPattern = + NamedPattern + (QualifiedNameRef [] "Nothing") + [] + + nothingExpression : Expression + nothingExpression = + elmJsonEncoderFunction "null" + + cases : List ( Node Pattern, Node Expression ) + cases = + [ ( justPattern |> emptyRangeNode + , justExpression |> emptyRangeNode + ) + , ( nothingPattern |> emptyRangeNode + , nothingExpression |> emptyRangeNode + ) + ] + in + CaseExpression { expression = caseValExpr, cases = cases } + + _ -> + Literal + """Generic types with a single type argument are supported""" + + FQName _ _ names -> + elmJsonEncoderApplication + ([ "encode" ] ++ names |> toCamelCase |> FunctionOrValue []) + (varPathToExpr varName) + + Record fields _ -> + let + fieldEncoder : Field extra -> Expression + fieldEncoder (Field name fieldType) = + TupledExpression + [ name |> toCamelCase |> Literal |> emptyRangeNode + , typeToEncoder (varName ++ [ name ]) fieldType |> emptyRangeNode + ] + in + elmJsonEncoderApplication + (elmJsonEncoderFunction "object") + (TupledExpression + [ emptyRangeNode <| Literal <| Path.toString toCamelCase "." varName + , emptyRangeNode <| + elmJsonEncoderApplication + (elmJsonEncoderFunction "object") + (ListExpr + (fields |> List.map fieldEncoder |> List.map emptyRangeNode) + ) + ] + ) + + _ -> + Literal + """Only reference with single type argument + and record types are supported""" + + +varPathToExpr : List Name -> Expression +varPathToExpr names = + FunctionOrValue [] <| Path.toString toCamelCase "." names + + +elmJsonEncoderApplication : Expression -> Expression -> Expression +elmJsonEncoderApplication func arg = + Application [ emptyRangeNode func, emptyRangeNode arg ] + + +elmJsonEncoderFunction : String -> Expression +elmJsonEncoderFunction funcName = + FunctionOrValue elmJsonEncoderModuleName funcName + + +elmJsonEncoderModuleName : ModuleName +elmJsonEncoderModuleName = + [ "E" ] + + +emptyRangeNode : a -> Node a +emptyRangeNode a = + Node emptyRange a + + +deconsPattern : Name -> List ( Name, Type extra ) -> Pattern +deconsPattern ctorName fields = + let + consVars : List (Node Pattern) + consVars = + fields + |> List.map Tuple.first + |> List.map toCamelCase + |> List.map VarPattern + |> List.map emptyRangeNode + in + NamedPattern + { moduleName = [], name = toTitleCase ctorName } + consVars + + +constructorToRecord : extra -> Constructor extra -> Type extra +constructorToRecord e ( _, types ) = + let + fields : List (Morphir.IR.Advanced.Type.Field extra) + fields = + types + |> List.map (\t -> field (Tuple.first t) (Tuple.second t)) + in + record fields e + + +customTypeTopExpr : Expression -> Expression +customTypeTopExpr expr = + elmJsonEncoderApplication + (elmJsonEncoderFunction "object") + (ListExpr + [ emptyRangeNode <| + TupledExpression + [ Literal "$type" |> emptyRangeNode + , expr |> emptyRangeNode + ] + ] + ) diff --git a/src/Morphir/Elm/Frontend.elm b/src/Morphir/Elm/Frontend.elm index 96031fcb8..a3b14ff92 100644 --- a/src/Morphir/Elm/Frontend.elm +++ b/src/Morphir/Elm/Frontend.elm @@ -1,4 +1,4 @@ -module Morphir.Elm.Frontend exposing (Error(..), PackageInfo, SourceFile, SourceLocation, decodePackageInfo, encodeError, packageDefinitionFromSource) +module Morphir.Elm.Frontend exposing (Error(..), Errors, PackageInfo, SourceFile, SourceLocation, decodePackageInfo, encodeError, packageDefinitionFromSource) import Dict exposing (Dict) import Elm.Parser diff --git a/src/Morphir/IR/AccessControlled.elm b/src/Morphir/IR/AccessControlled.elm index 0ffe1a5c7..bbbcb6003 100644 --- a/src/Morphir/IR/AccessControlled.elm +++ b/src/Morphir/IR/AccessControlled.elm @@ -1,5 +1,5 @@ module Morphir.IR.AccessControlled exposing - ( AccessControlled + ( AccessControlled(..) , public, private , withPublicAccess, withPrivateAccess , decodeAccessControlled, encodeAccessControlled diff --git a/src/Morphir/IR/Advanced/Type.elm b/src/Morphir/IR/Advanced/Type.elm index a46c3a25a..00ddd18c6 100644 --- a/src/Morphir/IR/Advanced/Type.elm +++ b/src/Morphir/IR/Advanced/Type.elm @@ -1,14 +1,14 @@ module Morphir.IR.Advanced.Type exposing - ( Type + ( Type(..) , variable, reference, tuple, record, extensibleRecord, function, unit , matchVariable, matchReference, matchTuple, matchRecord, matchExtensibleRecord, matchFunction, matchUnit - , Field, field, matchField, mapFieldName, mapFieldType + , Field(..), field, matchField, mapFieldName, mapFieldType , Declaration, typeAliasDeclaration, opaqueTypeDeclaration, customTypeDeclaration, matchCustomTypeDeclaration - , Definition, typeAliasDefinition, customTypeDefinition + , Definition(..), typeAliasDefinition, customTypeDefinition , Constructors , fuzzType , encodeType, decodeType, encodeDeclaration, encodeDefinition - , definitionToDeclaration, mapDeclaration, mapDefinition, mapTypeExtra + , Constructor, definitionToDeclaration, mapDeclaration, mapDefinition, mapTypeExtra ) {-| This module contains the building blocks of types in the Morphir IR. @@ -105,7 +105,15 @@ type Declaration extra | CustomTypeDeclaration (List Name) (Constructors extra) -{-| -} +{-| This syntax represents a type definition. For example: + + - `type alias Foo a = {bar : Maybe a, qux : Int}` + - `type MyList a = End | Cons a (MyList a)` + +In the definition, the `List Name` refers to type parameters on the LHS +and `Type extra` refers to the RHS + +-} type Definition extra = TypeAliasDefinition (List Name) (Type extra) | CustomTypeDefinition (List Name) (AccessControlled (Constructors extra)) diff --git a/src/Morphir/IR/FQName.elm b/src/Morphir/IR/FQName.elm index 6f9627ec8..4de925da1 100644 --- a/src/Morphir/IR/FQName.elm +++ b/src/Morphir/IR/FQName.elm @@ -1,5 +1,5 @@ module Morphir.IR.FQName exposing - ( FQName, fQName, getPackagePath, getModulePath, getLocalName + ( FQName(..), fQName, getPackagePath, getModulePath, getLocalName , fuzzFQName , encodeFQName, decodeFQName ) diff --git a/tests/Morphir/Codec/Examples.elm b/tests/Morphir/Codec/Examples.elm new file mode 100644 index 000000000..fa0944d9d --- /dev/null +++ b/tests/Morphir/Codec/Examples.elm @@ -0,0 +1,359 @@ +module Morphir.Elm.Backend.Codec.Examples exposing (..) + +import Json.Decode as D exposing (..) +import Json.Encode as E exposing (..) + + +{-| + + Type aliases + +-} +type alias Name = + String + + +type alias Age = + Int + + +{-| + + Simple type alias json + "\"John\"" + 4 + +-} +encodeName : Name -> E.Value +encodeName name = + E.string name + + +decoderName : Decoder Name +decoderName = + D.string + + +encodeAge : Age -> E.Value +encodeAge age = + E.int age + + +decoderAge : Decoder Age +decoderAge = + D.int + + +{-| + + Records with primitive fields + +-} +type alias Animal = + { name : String } + + +type alias Person = + { name : String, age : Int } + + +{-| + + Record with primitive fields json + + Animal: + + { + "animal" : + { + "name" : "\"Cat\"" + } + } + + Person: + + { + "person" : + { + "name" : "\"John\"", + "age" : 34 + } + } + +-} +encodeAnimal : Animal -> E.Value +encodeAnimal animal = + object + [ ( "animal" + , object + [ ( "name", E.string animal.name ) ] + ) + ] + + +decoderAnimal : Decoder Animal +decoderAnimal = + map Animal (at [ "animal", "name" ] D.string) + + +encodePerson : Person -> E.Value +encodePerson person = + object + [ ( "person" + , object + [ ( "name", E.string person.name ) + , ( "age", E.int person.age ) + ] + ) + ] + + +decoderPerson : Decoder Person +decoderPerson = + map2 + Person + (at [ "person", "name" ] D.string) + (at [ "pseron", "age" ] D.int) + + +{-| + + Simple custom types + +-} +type Color + = Red + | Green + | Blue + + +type Point + = Point Int Int + + +{-| + + Simple custom types json + + { + "$type" : "red" + } + + { + "red" : {} + } + + { + "green" : {} + } + + { + "point" : + { + "$pos1" : 3, + "$pos2" : 4 + } + } + +-} +encodeColor : Color -> E.Value +encodeColor color = + case color of + Red -> + object [ ( "red", object [] ) ] + + Green -> + object [ ( "green", object [] ) ] + + Blue -> + object [ ( "blue", object [] ) ] + + +decoderColor : Decoder Color +decoderColor = + D.oneOf + [ field "red" (succeed Red) + , field "green" (succeed Green) + , field "blue" (succeed Blue) + ] + + +encodePoint : Point -> E.Value +encodePoint (Point pos0 pos1) = + object + [ ( "point" + , object + [ ( "$pos0", E.int pos0 ) + , ( "$pos1", E.int pos1 ) + ] + ) + ] + + +decoderPoint : Decoder Point +decoderPoint = + map2 + Point + (at [ "point", "$pos1" ] D.int) + (at [ "point", "$pos2" ] D.int) + + +{-| + + Complex custom types + +-} +type User + = Regular String + | Visitor + + +{-| + + Complex custom type json + + Regular json: + + { + "regular" : + { + "$pos1" : "\"John\"" + } + } + + Visitor json: + + { + "visitor" : {} + } + +-} +encodeUser : User -> E.Value +encodeUser user = + case user of + Regular pos1 -> + object [ ( "regular", object [ ( "$pos1", E.string pos1 ) ] ) ] + + Visitor -> + object [ ( "visit", object [] ) ] + + +decoderUser : Decoder User +decoderUser = + oneOf + [ field "visitor" (succeed Visitor) + , map Regular (at [ "regular", "$pos1" ] D.string) + ] + + +{-| + + Custom types with generics a.k.a. higher kinded type (* -> *) + +-} +type Option a + = None + | Some a + + +type Li a + = Empty + | Cons a (Li a) + + +{-| + + Higher kinded types cannot be encoded to json hence they should be completely evaluated before + they can be encoded to json. + + Maybe String + Nothing : + "null" + Just "helloworld" : + "\"helloworld\"" + + List Int + Empty : + [] + Non-empty : + [1, 2, 3] + +-} +encodeMaybeString : Maybe String -> E.Value +encodeMaybeString arg = + case arg of + Just a -> + E.string a + + Nothing -> + E.null + + +decoderMaybeString : Decoder (Maybe String) +decoderMaybeString = + nullable D.string + + +intListEncode : List Int -> E.Value +intListEncode li = + E.list E.int li + + +intListDecoder : Decoder (List Int) +intListDecoder = + D.list D.int + + +{-| + + Rcord type with primitive, alias, simple cutom type and complex cutom type + + player json: + + { + "player" : + { + "name" : "\"John\"", + "age" : 23 + "team" : + { + "red" : {} + }, + "position" : + { + "point" : + { + "$pos1" : 3, + "$pos2" : 4 + } + } + } + } + +-} +type alias Player = + { name : String, age : Age, team : Color, position : Point } + + +encodePlayer : Player -> E.Value +encodePlayer player = + E.object + [ ( "player" + , E.object + [ ( "name", E.string player.name ) + , ( "age", encodeAge player.age ) + , ( "team", encodeColor player.team ) + , ( "position", encodePoint player.position ) + ] + ) + ] + + +decoderPlayer : Decoder Player +decoderPlayer = + map4 + Player + (at [ "player", "name" ] decoderName) + (at [ "player", "age" ] decoderAge) + (at [ "player", "team" ] decoderColor) + (at [ "player", "position" ] decoderPoint) diff --git a/tests/Morphir/Codec/Tests/A.elm b/tests/Morphir/Codec/Tests/A.elm new file mode 100644 index 000000000..1e4fd9201 --- /dev/null +++ b/tests/Morphir/Codec/Tests/A.elm @@ -0,0 +1,31 @@ +module A exposing (..) + + +type alias Name = + String + + +type alias Age = + Int + + +type alias Animal = + { name : String } + + +type alias Person = + { name : String, age : Int } + + +type Point + = Point Int Int + + +type Color + = Red + | Green + | Blue + + +type alias Player = + { name : String, age : Age, team : Color, position : Point } From fe75fc173e280f29b6e9d3b4d4cc38a42fde2a32 Mon Sep 17 00:00:00 2001 From: Reeshabh Date: Wed, 11 Mar 2020 10:23:06 -0400 Subject: [PATCH 2/5] Minor change --- src/Morphir/Elm/Backend/Codec/Gen.elm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Morphir/Elm/Backend/Codec/Gen.elm b/src/Morphir/Elm/Backend/Codec/Gen.elm index 72f24dd50..2fb13e4cf 100644 --- a/src/Morphir/Elm/Backend/Codec/Gen.elm +++ b/src/Morphir/Elm/Backend/Codec/Gen.elm @@ -32,7 +32,7 @@ typeDefToEncoder e typeName typeDef = functionName : String functionName = - toCamelCase <| [ "encode" ] ++ typeName + [ "encode" ] ++ typeName |> toCamelCase args : List (Node Pattern) args = From a134670d4ffb1a37e5c1ae3ba26ac18e176cff53 Mon Sep 17 00:00:00 2001 From: Reeshabh Date: Wed, 11 Mar 2020 11:37:21 -0400 Subject: [PATCH 3/5] Added a flag so that a record type generator for a custom type does not chain the names in the object --- src/Morphir/Elm/Backend/Codec/Gen.elm | 21 ++++++++++++++------- tests/Morphir/Codec/Tests/A.elm | 4 ++++ 2 files changed, 18 insertions(+), 7 deletions(-) diff --git a/src/Morphir/Elm/Backend/Codec/Gen.elm b/src/Morphir/Elm/Backend/Codec/Gen.elm index 2fb13e4cf..8ffd7bc21 100644 --- a/src/Morphir/Elm/Backend/Codec/Gen.elm +++ b/src/Morphir/Elm/Backend/Codec/Gen.elm @@ -69,7 +69,7 @@ typeDefToEncoder e typeName typeDef = ctor :: [] -> ctor |> constructorToRecord e - |> typeToEncoder [ Tuple.first ctor ] + |> typeToEncoder False [ Tuple.first ctor ] ctors -> let @@ -94,7 +94,7 @@ typeDefToEncoder e typeName typeDef = expr = ctor |> constructorToRecord e - |> typeToEncoder [ Tuple.first ctor ] + |> typeToEncoder True [ Tuple.first ctor ] |> customTypeTopExpr in ( emptyRangeNode pattern, emptyRangeNode expr ) @@ -104,7 +104,7 @@ typeDefToEncoder e typeName typeDef = CaseExpression { expression = caseValExpr, cases = cases } Public (TypeAliasDefinition _ tpe) -> - typeToEncoder [ typeName ] tpe + typeToEncoder True [ typeName ] tpe _ -> Literal "Private types are not supported" @@ -112,8 +112,8 @@ typeDefToEncoder e typeName typeDef = FunctionDeclaration function -typeToEncoder : List Name -> Type extra -> Expression -typeToEncoder varName tpe = +typeToEncoder : Bool -> List Name -> Type extra -> Expression +typeToEncoder fwdNames varName tpe = case tpe of Reference fqName typeArgs _ -> case fqName of @@ -144,7 +144,7 @@ typeToEncoder varName tpe = justExpression : Expression justExpression = - typeToEncoder [ fromString "a" ] typeArg + typeToEncoder True [ fromString "a" ] typeArg nothingPattern : Pattern nothingPattern = @@ -179,11 +179,18 @@ typeToEncoder varName tpe = Record fields _ -> let + namesToFwd name = + if fwdNames then + varName ++ [ name ] + + else + [ name ] + fieldEncoder : Field extra -> Expression fieldEncoder (Field name fieldType) = TupledExpression [ name |> toCamelCase |> Literal |> emptyRangeNode - , typeToEncoder (varName ++ [ name ]) fieldType |> emptyRangeNode + , typeToEncoder fwdNames (namesToFwd name) fieldType |> emptyRangeNode ] in elmJsonEncoderApplication diff --git a/tests/Morphir/Codec/Tests/A.elm b/tests/Morphir/Codec/Tests/A.elm index 1e4fd9201..633b87101 100644 --- a/tests/Morphir/Codec/Tests/A.elm +++ b/tests/Morphir/Codec/Tests/A.elm @@ -29,3 +29,7 @@ type Color type alias Player = { name : String, age : Age, team : Color, position : Point } + + +type alias User = + { name : String, id : Maybe Int } From 6f65be955a1230ef65f39adda77b19b6ab018fbf Mon Sep 17 00:00:00 2001 From: Reeshabh Date: Wed, 11 Mar 2020 11:48:39 -0400 Subject: [PATCH 4/5] Making maybes work as expected --- src/Morphir/Elm/Backend/Codec/Gen.elm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Morphir/Elm/Backend/Codec/Gen.elm b/src/Morphir/Elm/Backend/Codec/Gen.elm index 8ffd7bc21..fd3c28863 100644 --- a/src/Morphir/Elm/Backend/Codec/Gen.elm +++ b/src/Morphir/Elm/Backend/Codec/Gen.elm @@ -127,7 +127,7 @@ typeToEncoder fwdNames varName tpe = (elmJsonEncoderFunction "string") (varPathToExpr varName) - FQName _ _ [ "Maybe" ] -> + FQName _ _ [ "maybe" ] -> case typeArgs of typeArg :: [] -> let From 4f2de2b03cc7388afd610616acda7140c944af80 Mon Sep 17 00:00:00 2001 From: Reeshabh Date: Wed, 11 Mar 2020 11:55:47 -0400 Subject: [PATCH 5/5] Minor changes --- src/Morphir/Elm/Backend/Codec/Gen.elm | 29 ++++++++++++++++----------- 1 file changed, 17 insertions(+), 12 deletions(-) diff --git a/src/Morphir/Elm/Backend/Codec/Gen.elm b/src/Morphir/Elm/Backend/Codec/Gen.elm index fd3c28863..ccc3e49c6 100644 --- a/src/Morphir/Elm/Backend/Codec/Gen.elm +++ b/src/Morphir/Elm/Backend/Codec/Gen.elm @@ -9,7 +9,7 @@ import Elm.Syntax.Range exposing (emptyRange) import Morphir.IR.AccessControlled exposing (AccessControlled(..)) import Morphir.IR.Advanced.Type exposing (Constructor, Definition(..), Field(..), Type(..), field, record) import Morphir.IR.FQName exposing (FQName(..)) -import Morphir.IR.Name exposing (Name, fromString, toCamelCase, toTitleCase) +import Morphir.IR.Name as Name exposing (Name, fromString, toCamelCase, toTitleCase) import Morphir.IR.Path as Path exposing (toString) @@ -32,7 +32,7 @@ typeDefToEncoder e typeName typeDef = functionName : String functionName = - [ "encode" ] ++ typeName |> toCamelCase + [ "encode" ] ++ typeName |> Name.toCamelCase args : List (Node Pattern) args = @@ -50,10 +50,10 @@ typeDefToEncoder e typeName typeDef = ] _ -> - [ typeName |> toCamelCase |> VarPattern |> emptyRangeNode ] + [ typeName |> Name.toCamelCase |> VarPattern |> emptyRangeNode ] Public (TypeAliasDefinition _ _) -> - [ typeName |> toCamelCase |> VarPattern |> emptyRangeNode ] + [ typeName |> Name.toCamelCase |> VarPattern |> emptyRangeNode ] _ -> [] @@ -76,7 +76,7 @@ typeDefToEncoder e typeName typeDef = caseValExpr : Node Expression caseValExpr = typeName - |> toCamelCase + |> Name.toCamelCase |> FunctionOrValue [] |> emptyRangeNode @@ -112,6 +112,11 @@ typeDefToEncoder e typeName typeDef = FunctionDeclaration function +{-| + + TODO: Capture Elm's primitive types in the SDK + +-} typeToEncoder : Bool -> List Name -> Type extra -> Expression typeToEncoder fwdNames varName tpe = case tpe of @@ -144,7 +149,7 @@ typeToEncoder fwdNames varName tpe = justExpression : Expression justExpression = - typeToEncoder True [ fromString "a" ] typeArg + typeToEncoder True [ Name.fromString "a" ] typeArg nothingPattern : Pattern nothingPattern = @@ -174,7 +179,7 @@ typeToEncoder fwdNames varName tpe = FQName _ _ names -> elmJsonEncoderApplication - ([ "encode" ] ++ names |> toCamelCase |> FunctionOrValue []) + ([ "encode" ] ++ names |> Name.toCamelCase |> FunctionOrValue []) (varPathToExpr varName) Record fields _ -> @@ -189,14 +194,14 @@ typeToEncoder fwdNames varName tpe = fieldEncoder : Field extra -> Expression fieldEncoder (Field name fieldType) = TupledExpression - [ name |> toCamelCase |> Literal |> emptyRangeNode + [ name |> Name.toCamelCase |> Literal |> emptyRangeNode , typeToEncoder fwdNames (namesToFwd name) fieldType |> emptyRangeNode ] in elmJsonEncoderApplication (elmJsonEncoderFunction "object") (TupledExpression - [ emptyRangeNode <| Literal <| Path.toString toCamelCase "." varName + [ emptyRangeNode <| Literal <| Path.toString Name.toCamelCase "." varName , emptyRangeNode <| elmJsonEncoderApplication (elmJsonEncoderFunction "object") @@ -214,7 +219,7 @@ typeToEncoder fwdNames varName tpe = varPathToExpr : List Name -> Expression varPathToExpr names = - FunctionOrValue [] <| Path.toString toCamelCase "." names + FunctionOrValue [] <| Path.toString Name.toCamelCase "." names elmJsonEncoderApplication : Expression -> Expression -> Expression @@ -244,12 +249,12 @@ deconsPattern ctorName fields = consVars = fields |> List.map Tuple.first - |> List.map toCamelCase + |> List.map Name.toCamelCase |> List.map VarPattern |> List.map emptyRangeNode in NamedPattern - { moduleName = [], name = toTitleCase ctorName } + { moduleName = [], name = Name.toTitleCase ctorName } consVars