diff --git a/morphir.json b/morphir.json index ba294d695..a1524892c 100644 --- a/morphir.json +++ b/morphir.json @@ -1,8 +1,8 @@ { - "name": "morphir", + "name": "Morphir", "sourceDirectory": "src", "exposedModules": [ - "Morphir.IR.Name", - "Morphir.IR.Path" + "IR.Advanced.Type", + "IR.Advanced.Value" ] } \ No newline at end of file diff --git a/src/Morphir/Elm/Frontend.elm b/src/Morphir/Elm/Frontend.elm index 64d617120..f677dfc46 100644 --- a/src/Morphir/Elm/Frontend.elm +++ b/src/Morphir/Elm/Frontend.elm @@ -13,9 +13,9 @@ import Elm.Syntax.Node as Node exposing (Node(..)) import Elm.Syntax.TypeAnnotation exposing (TypeAnnotation(..)) import Json.Decode as Decode import Json.Encode as Encode -import Morphir.DAG as DAG exposing (DAG) import Morphir.Elm.Frontend.Resolve as Resolve exposing (ModuleResolver, PackageResolver) -import Morphir.IR.AccessControlled as AccessControlled exposing (AccessControlled, private, public) +import Morphir.Graph as Graph exposing (Graph) +import Morphir.IR.AccessControlled exposing (AccessControlled, private, public) import Morphir.IR.Advanced.Module as Module import Morphir.IR.Advanced.Package as Package import Morphir.IR.Advanced.Type as Type exposing (Type) @@ -124,7 +124,7 @@ type alias Errors = type Error = ParseError String (List Parser.DeadEnd) - | CyclicModules (DAG (List String)) + | CyclicModules (Graph (List String)) | ResolveError SourceLocation Resolve.Error @@ -180,6 +180,41 @@ packageDefinitionFromSource packageInfo sourceFiles = ) |> ResultList.toResult + exposedModuleNames : Set ModuleName + exposedModuleNames = + packageInfo.exposedModules + |> Set.map + (\modulePath -> + (packageInfo.name |> Path.toList) + ++ (modulePath |> Path.toList) + |> List.map Name.toTitleCase + ) + + treeShakeModules : List ( ModuleName, ParsedFile ) -> List ( ModuleName, ParsedFile ) + treeShakeModules allModules = + let + allUsedModules : Set ModuleName + allUsedModules = + allModules + |> List.map + (\( moduleName, parsedFile ) -> + ( moduleName + , parsedFile.rawFile + |> RawFile.imports + |> List.map (.moduleName >> Node.value) + |> Set.fromList + ) + ) + |> Dict.fromList + |> Graph.fromDict + |> Graph.reachableNodes exposedModuleNames + in + allModules + |> List.filter + (\( moduleName, _ ) -> + allUsedModules |> Set.member moduleName + ) + sortModules : List ( ModuleName, ParsedFile ) -> Result Errors (List ModuleName) sortModules modules = let @@ -195,10 +230,10 @@ packageDefinitionFromSource packageInfo sourceFiles = ) ) |> Dict.fromList - |> DAG.fromDict - |> DAG.topologicalSort + |> Graph.fromDict + |> Graph.topologicalSort in - if DAG.isEmpty cycles then + if Graph.isEmpty cycles then Ok sortedModules else @@ -212,7 +247,9 @@ packageDefinitionFromSource packageInfo sourceFiles = parsedFiles |> Dict.fromList in - sortModules parsedFiles + parsedFiles + |> treeShakeModules + |> sortModules |> Result.andThen (mapParsedFiles packageInfo.name parsedFilesByModuleName) ) |> Result.map @@ -220,14 +257,23 @@ packageDefinitionFromSource packageInfo sourceFiles = { dependencies = Dict.empty , modules = moduleDefs - |> Dict.map - (\modulePath m -> - if packageInfo.exposedModules |> Set.member modulePath then - public m + |> Dict.toList + |> List.map + (\( modulePath, m ) -> + let + packageLessModulePath = + modulePath + |> Path.toList + |> List.drop (packageInfo.name |> Path.toList |> List.length) + |> Path.fromList + in + if packageInfo.exposedModules |> Set.member packageLessModulePath then + ( packageLessModulePath, public m ) else - private m + ( packageLessModulePath, private m ) ) + |> Dict.fromList } ) diff --git a/src/Morphir/Elm/Frontend/Resolve.elm b/src/Morphir/Elm/Frontend/Resolve.elm index efce611ad..d39d22612 100644 --- a/src/Morphir/Elm/Frontend/Resolve.elm +++ b/src/Morphir/Elm/Frontend/Resolve.elm @@ -111,10 +111,12 @@ defaultImports = ) in [ importExplicit [ "Morphir", "SDK", "Bool" ] Nothing [ TypeOrAliasExpose "Bool" ] + , importExplicit [ "Morphir", "SDK", "Char" ] Nothing [ TypeOrAliasExpose "Char" ] , importExplicit [ "Morphir", "SDK", "Int" ] Nothing [ TypeOrAliasExpose "Int" ] , importExplicit [ "Morphir", "SDK", "Float" ] Nothing [ TypeOrAliasExpose "Float" ] , importExplicit [ "Morphir", "SDK", "String" ] Nothing [ TypeOrAliasExpose "String" ] , importExplicit [ "Morphir", "SDK", "Maybe" ] Nothing [ TypeOrAliasExpose "Maybe" ] + , importExplicit [ "Morphir", "SDK", "Result" ] Nothing [ TypeOrAliasExpose "Result" ] , importExplicit [ "Morphir", "SDK", "List" ] Nothing [ TypeOrAliasExpose "List" ] ] diff --git a/src/Morphir/DAG.elm b/src/Morphir/Graph.elm similarity index 50% rename from src/Morphir/DAG.elm rename to src/Morphir/Graph.elm index 92647a1b2..bc93f4f16 100644 --- a/src/Morphir/DAG.elm +++ b/src/Morphir/Graph.elm @@ -1,25 +1,38 @@ -module Morphir.DAG exposing (DAG, fromDict, isEmpty, topologicalSort) +module Morphir.Graph exposing (Graph, empty, fromDict, fromList, isEmpty, reachableNodes, topologicalSort) import Dict exposing (Dict) import Set exposing (Set) -type DAG comparable - = DAG (Dict comparable (Set comparable)) +type Graph comparable + = Graph (Dict comparable (Set comparable)) -fromDict : Dict comparable (Set comparable) -> DAG comparable +fromDict : Dict comparable (Set comparable) -> Graph comparable fromDict = - DAG + Graph -isEmpty : DAG comparable -> Bool -isEmpty (DAG edges) = +fromList : List ( comparable, List comparable ) -> Graph comparable +fromList list = + list + |> List.map (\( from, tos ) -> ( from, Set.fromList tos )) + |> Dict.fromList + |> Graph + + +empty : Graph comparable +empty = + Graph Dict.empty + + +isEmpty : Graph comparable -> Bool +isEmpty (Graph edges) = Dict.isEmpty edges -topologicalSort : DAG comparable -> ( List comparable, DAG comparable ) -topologicalSort (DAG edges) = +topologicalSort : Graph comparable -> ( List comparable, Graph comparable ) +topologicalSort (Graph edges) = let normalize graphEdges = let @@ -74,6 +87,42 @@ topologicalSort (DAG edges) = step newGraphEdges (startNode :: sorting) Nothing -> - ( List.reverse sorting, DAG graphEdges ) + ( List.reverse sorting, Graph graphEdges ) in step (normalize edges) [] + + +reachableNodes : Set comparable -> Graph comparable -> Set comparable +reachableNodes startNodes (Graph edges) = + let + directlyReachable : Set comparable -> Set comparable + directlyReachable fromNodes = + edges + |> Dict.toList + |> List.filterMap + (\( fromNode, toNodes ) -> + if fromNodes |> Set.member fromNode then + Just toNodes + + else + Nothing + ) + |> List.foldl Set.union Set.empty + + transitivelyReachable : Set comparable -> Set comparable + transitivelyReachable fromNodes = + if Set.isEmpty fromNodes then + Set.empty + + else + let + reachables = + Set.union (directlyReachable fromNodes) fromNodes + in + if reachables == fromNodes then + fromNodes + + else + Set.union fromNodes (transitivelyReachable reachables) + in + transitivelyReachable startNodes diff --git a/src/Morphir/IR/SDK.elm b/src/Morphir/IR/SDK.elm index 23821f7c7..b8e45fe5a 100644 --- a/src/Morphir/IR/SDK.elm +++ b/src/Morphir/IR/SDK.elm @@ -3,10 +3,12 @@ module Morphir.IR.SDK exposing (..) import Dict import Morphir.IR.Advanced.Package as Package import Morphir.IR.SDK.Bool as Bool +import Morphir.IR.SDK.Char as Char import Morphir.IR.SDK.Float as Float import Morphir.IR.SDK.Int as Int import Morphir.IR.SDK.List as List import Morphir.IR.SDK.Maybe as Maybe +import Morphir.IR.SDK.Result as Result import Morphir.IR.SDK.String as String @@ -15,10 +17,12 @@ packageDeclaration = { modules = Dict.fromList [ ( [ [ "bool" ] ], Bool.moduleDeclaration ) + , ( [ [ "char" ] ], Char.moduleDeclaration ) , ( [ [ "int" ] ], Int.moduleDeclaration ) , ( [ [ "float" ] ], Float.moduleDeclaration ) , ( [ [ "string" ] ], String.moduleDeclaration ) , ( [ [ "maybe" ] ], Maybe.moduleDeclaration ) + , ( [ [ "result" ] ], Result.moduleDeclaration ) , ( [ [ "list" ] ], List.moduleDeclaration ) ] } diff --git a/src/Morphir/IR/SDK/Char.elm b/src/Morphir/IR/SDK/Char.elm new file mode 100644 index 000000000..29d2383a7 --- /dev/null +++ b/src/Morphir/IR/SDK/Char.elm @@ -0,0 +1,39 @@ +module Morphir.IR.SDK.Char exposing (..) + +import Dict +import Morphir.IR.Advanced.Module as Module +import Morphir.IR.Advanced.Type exposing (Declaration(..), Type(..)) +import Morphir.IR.FQName as FQName exposing (FQName) +import Morphir.IR.Name as Name +import Morphir.IR.Path exposing (Path) +import Morphir.IR.QName as QName +import Morphir.IR.SDK.Common exposing (packageName) + + +moduleName : Path +moduleName = + [ [ "char" ] ] + + +moduleDeclaration : Module.Declaration () +moduleDeclaration = + { types = + Dict.fromList + [ ( [ "char" ], OpaqueTypeDeclaration [] ) + ] + , values = + Dict.empty + } + + +fromLocalName : String -> FQName +fromLocalName name = + name + |> Name.fromString + |> QName.fromName moduleName + |> FQName.fromQName packageName + + +charType : extra -> Type extra +charType extra = + Reference (fromLocalName "char") [] extra diff --git a/src/Morphir/IR/SDK/Result.elm b/src/Morphir/IR/SDK/Result.elm new file mode 100644 index 000000000..d15d93f20 --- /dev/null +++ b/src/Morphir/IR/SDK/Result.elm @@ -0,0 +1,44 @@ +module Morphir.IR.SDK.Result exposing (..) + +import Dict +import Morphir.IR.Advanced.Module as Module +import Morphir.IR.Advanced.Type as Type exposing (Declaration(..), Type(..)) +import Morphir.IR.FQName as FQName exposing (FQName) +import Morphir.IR.Name as Name +import Morphir.IR.Path exposing (Path) +import Morphir.IR.QName as QName +import Morphir.IR.SDK.Common exposing (packageName) + + +moduleName : Path +moduleName = + [ [ "result" ] ] + + +moduleDeclaration : Module.Declaration () +moduleDeclaration = + { types = + Dict.fromList + [ ( [ "result" ] + , CustomTypeDeclaration [ [ "e" ], [ "a" ] ] + [ ( [ "ok" ], [ ( [ "value" ], Type.Variable [ "a" ] () ) ] ) + , ( [ "err" ], [ ( [ "error" ], Type.Variable [ "e" ] () ) ] ) + ] + ) + ] + , values = + Dict.empty + } + + +fromLocalName : String -> FQName +fromLocalName name = + name + |> Name.fromString + |> QName.fromName moduleName + |> FQName.fromQName packageName + + +resultType : Type extra -> extra -> Type extra +resultType itemType extra = + Reference (fromLocalName "result") [ itemType ] extra diff --git a/tests/Morphir/Elm/FrontendTests.elm b/tests/Morphir/Elm/FrontendTests.elm index 18c4c6936..2e067ba88 100644 --- a/tests/Morphir/Elm/FrontendTests.elm +++ b/tests/Morphir/Elm/FrontendTests.elm @@ -57,14 +57,24 @@ type Bee = Bee """ } + sourceC = + { path = "My/Package/C.elm" + , content = + unindent """ +module My.Package.C exposing (..) + +type Cee = Cee + """ + } + packageName = - Path.fromString "my/package" + Path.fromString "My.Package" moduleA = - Path.fromString "My.Package.A" + Path.fromString "A" moduleB = - Path.fromString "My.Package.B" + Path.fromString "B" packageInfo = { name = @@ -152,7 +162,7 @@ type Bee = Bee in test "first" <| \_ -> - Frontend.packageDefinitionFromSource packageInfo [ sourceA, sourceB ] + Frontend.packageDefinitionFromSource packageInfo [ sourceA, sourceB, sourceC ] |> Result.map Package.eraseDefinitionExtra |> Expect.equal (Ok expected) diff --git a/tests/Morphir/GraphTests.elm b/tests/Morphir/GraphTests.elm new file mode 100644 index 000000000..4862e9c65 --- /dev/null +++ b/tests/Morphir/GraphTests.elm @@ -0,0 +1,36 @@ +module Morphir.GraphTests exposing (..) + +import Expect +import Morphir.Graph as Graph +import Set +import Test exposing (..) + + +topologicalSortTests : Test +topologicalSortTests = + describe "topologicalSort" + [ test "empty graph is sorted" <| + \_ -> + Graph.topologicalSort Graph.empty + |> Expect.equal ( [], Graph.empty ) + ] + + +reachableNodesTests : Test +reachableNodesTests = + describe "reachableNodes" + [ test "empty graph returns empty" <| + \_ -> + Graph.reachableNodes Set.empty Graph.empty + |> Expect.equal Set.empty + , test "unreachable node removed" <| + \_ -> + Graph.fromList [ ( 1, [ 2 ] ), ( 2, [ 3 ] ), ( 4, [ 5 ] ) ] + |> Graph.reachableNodes (Set.fromList [ 1 ]) + |> Expect.equal (Set.fromList [ 1, 2, 3 ]) + , test "cycles handled gracefully" <| + \_ -> + Graph.fromList [ ( 1, [ 2 ] ), ( 2, [ 1 ] ), ( 4, [ 5 ] ) ] + |> Graph.reachableNodes (Set.fromList [ 1 ]) + |> Expect.equal (Set.fromList [ 1, 2 ]) + ]