Skip to content

Commit

Permalink
Merge pull request #23 from AttilaMihaly/master
Browse files Browse the repository at this point in the history 
Full type name resolution support
  • Loading branch information
@AttilaMihaly
AttilaMihaly committed Mar 18, 2020
2 parents 1726587 + 2f9550d commit f0a80dc
Show file tree
Hide file tree
Showing 11 changed files with 513 additions and 276 deletions.
148 changes: 81 additions & 67 deletions src/Morphir/Elm/Backend/Codec/Gen.elm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,8 +6,8 @@ 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.AccessControlled exposing (Access(..), AccessControlled)
import Morphir.IR.Advanced.Type exposing (Constructor, Definition(..), Field, Type(..), record)
import Morphir.IR.FQName exposing (FQName(..))
import Morphir.IR.Name as Name exposing (Name, fromString, toCamelCase, toTitleCase)
import Morphir.IR.Path as Path exposing (toString)
Expand Down Expand Up @@ -36,77 +36,91 @@ typeDefToEncoder e typeName typeDef =

args : List (Node Pattern)
args =
case typeDef of
Public (CustomTypeDefinition _ (Public constructors)) ->
case constructors of
[] ->
[]

( ctorName, fields ) :: [] ->
[ deconsPattern ctorName fields
|> emptyRangeNode
|> ParenthesizedPattern
|> emptyRangeNode
]

_ ->
case typeDef.access of
Public ->
case typeDef.value of
CustomTypeDefinition _ constructors ->
case constructors.access of
Public ->
case constructors.value of
[] ->
[]

( ctorName, fields ) :: [] ->
[ deconsPattern ctorName fields
|> emptyRangeNode
|> ParenthesizedPattern
|> emptyRangeNode
]

_ ->
[ typeName |> Name.toCamelCase |> VarPattern |> emptyRangeNode ]

Private ->
[]

TypeAliasDefinition _ _ ->
[ typeName |> Name.toCamelCase |> VarPattern |> emptyRangeNode ]

Public (TypeAliasDefinition _ _) ->
[ typeName |> Name.toCamelCase |> VarPattern |> emptyRangeNode ]

_ ->
Private ->
[]

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 False [ Tuple.first ctor ]

ctors ->
let
caseValExpr : Node Expression
caseValExpr =
typeName
|> Name.toCamelCase
|> FunctionOrValue []
|> emptyRangeNode

cases : List ( Node Pattern, Node Expression )
cases =
let
ctorToPatternExpr : Constructor extra -> ( Node Pattern, Node Expression )
ctorToPatternExpr ctor =
case typeDef.access of
Public ->
case typeDef.value of
CustomTypeDefinition _ constructors ->
case constructors.access of
Public ->
case constructors.value of
[] ->
Literal "Types without constructors are not supported"

ctor :: [] ->
ctor
|> constructorToRecord e
|> typeToEncoder False [ Tuple.first ctor ]

ctors ->
let
pattern : Pattern
pattern =
deconsPattern (Tuple.first ctor) (Tuple.second ctor)

expr : Expression
expr =
ctor
|> constructorToRecord e
|> typeToEncoder True [ Tuple.first ctor ]
|> customTypeTopExpr
caseValExpr : Node Expression
caseValExpr =
typeName
|> Name.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 True [ Tuple.first ctor ]
|> customTypeTopExpr
in
( emptyRangeNode pattern, emptyRangeNode expr )
in
ctors |> List.map ctorToPatternExpr
in
( emptyRangeNode pattern, emptyRangeNode expr )
in
ctors |> List.map ctorToPatternExpr
in
CaseExpression { expression = caseValExpr, cases = cases }
CaseExpression { expression = caseValExpr, cases = cases }

Private ->
Literal "Private constructors are not supported"

Public (TypeAliasDefinition _ tpe) ->
typeToEncoder True [ typeName ] tpe
TypeAliasDefinition _ tpe ->
typeToEncoder True [ typeName ] tpe

_ ->
Private ->
Literal "Private types are not supported"
in
FunctionDeclaration function
Expand Down Expand Up @@ -193,10 +207,10 @@ typeToEncoder fwdNames varName tpe =
[ name ]

fieldEncoder : Field extra -> Expression
fieldEncoder (Field name fieldType) =
fieldEncoder field =
TupledExpression
[ name |> Name.toCamelCase |> Literal |> emptyRangeNode
, typeToEncoder fwdNames (namesToFwd name) fieldType |> emptyRangeNode
[ field.name |> Name.toCamelCase |> Literal |> emptyRangeNode
, typeToEncoder fwdNames (namesToFwd field.name) field.tpe |> emptyRangeNode
]
in
elmJsonEncoderApplication
Expand Down Expand Up @@ -268,7 +282,7 @@ constructorToRecord e ( _, types ) =
fields : List (Morphir.IR.Advanced.Type.Field extra)
fields =
types
|> List.map (\t -> field (Tuple.first t) (Tuple.second t))
|> List.map (\t -> Field (Tuple.first t) (Tuple.second t))
in
record fields e

Expand Down
53 changes: 36 additions & 17 deletions src/Morphir/Elm/Frontend.elm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@ import Morphir.IR.Advanced.Module as Module
import Morphir.IR.Advanced.Package as Package
import Morphir.IR.Advanced.Type as Type exposing (Type)
import Morphir.IR.Advanced.Value as Value exposing (Value)
import Morphir.IR.FQName as FQName exposing (fQName)
import Morphir.IR.FQName as FQName exposing (FQName, fQName)
import Morphir.IR.Name as Name exposing (Name)
import Morphir.IR.Path as Path exposing (Path)
import Morphir.ResultList as ResultList
Expand Down Expand Up @@ -255,7 +255,7 @@ mapProcessedFile currentPackagePath processedFile modulesSoFar =
valuesResult
in
moduleResult
|> Result.andThen (resolveLocalTypes currentPackagePath modulePath)
|> Result.andThen (resolveLocalTypes currentPackagePath modulePath moduleResolver)
|> Result.map
(\m ->
modulesSoFar
Expand Down Expand Up @@ -444,7 +444,7 @@ mapTypeAnnotation sourceFile (Node range typeAnnotation) =
|> List.map
(\( Node _ fieldName, fieldTypeNode ) ->
mapTypeAnnotation sourceFile fieldTypeNode
|> Result.map (Type.field (fieldName |> Name.fromString))
|> Result.map (Type.Field (fieldName |> Name.fromString))
)
|> ResultList.toResult
|> Result.map
Expand All @@ -459,7 +459,7 @@ mapTypeAnnotation sourceFile (Node range typeAnnotation) =
|> List.map
(\( Node _ fieldName, fieldTypeNode ) ->
mapTypeAnnotation sourceFile fieldTypeNode
|> Result.map (Type.field (fieldName |> Name.fromString))
|> Result.map (Type.Field (fieldName |> Name.fromString))
)
|> ResultList.toResult
|> Result.map
Expand All @@ -477,25 +477,46 @@ mapTypeAnnotation sourceFile (Node range typeAnnotation) =
(mapTypeAnnotation sourceFile returnTypeNode)


resolveLocalTypes : Path -> Path -> Module.Definition SourceLocation -> Result Errors (Module.Definition SourceLocation)
resolveLocalTypes packagePath modulePath moduleDef =
resolveLocalTypes : Path -> Path -> ModuleResolver -> Module.Definition SourceLocation -> Result Errors (Module.Definition SourceLocation)
resolveLocalTypes packagePath modulePath moduleResolver moduleDef =
let
rewriteTypes : Type SourceLocation -> Result Error (Type SourceLocation)
rewriteTypes =
Rewrite.bottomUp Type.rewriteType
(\tpe ->
case tpe of
Type.Reference fullName args sourceLocation ->
Type.Reference refFullName args sourceLocation ->
let
localName =
fullName
refModulePath : Path
refModulePath =
refFullName
|> FQName.getModulePath

refLocalName : Name
refLocalName =
refFullName
|> FQName.getLocalName

resolvedFullNameResult : Result Resolve.Error FQName
resolvedFullNameResult =
case moduleDef.types |> Dict.get refLocalName of
Just _ ->
if Path.isPrefixOf modulePath packagePath then
Ok (fQName packagePath (modulePath |> List.drop (List.length packagePath)) refLocalName)

else
Err (Resolve.PackageNotPrefixOfModule packagePath modulePath)

Nothing ->
moduleResolver.resolveType (refModulePath |> List.map Name.toTitleCase) (refLocalName |> Name.toTitleCase)
in
moduleDef.types
|> Dict.get localName
|> Maybe.map
(\_ ->
Type.Reference (fQName packagePath modulePath localName) args sourceLocation
resolvedFullNameResult
|> Result.map
(\resolvedFullName ->
Type.Reference resolvedFullName args sourceLocation
)
|> Result.mapError ResolveError
|> Just

_ ->
Nothing
Expand All @@ -504,9 +525,7 @@ resolveLocalTypes packagePath modulePath moduleDef =
rewriteValues =
identity
in
moduleDef
|> Module.mapDefinition rewriteTypes rewriteValues
|> Ok
Module.mapDefinition rewriteTypes rewriteValues moduleDef


withAccessControl : Bool -> a -> AccessControlled a
Expand Down
3 changes: 2 additions & 1 deletion src/Morphir/Elm/Frontend/Resolve.elm
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
module Morphir.Elm.Frontend.Resolve exposing (Error, ModuleResolver, PackageResolver, createModuleResolver, createPackageResolver)
module Morphir.Elm.Frontend.Resolve exposing (Error(..), ModuleResolver, PackageResolver, createModuleResolver, createPackageResolver)

import Dict exposing (Dict)
import Elm.Syntax.Exposing exposing (Exposing(..), TopLevelExpose(..))
Expand Down Expand Up @@ -31,6 +31,7 @@ type Error
| CouldNotFindPackage Path
| ModuleNotImported ModuleName
| AliasNotFound String
| PackageNotPrefixOfModule Path Path


type alias ModuleResolver =
Expand Down
Loading

0 comments on commit f0a80dc

Please sign in to comment.