From 492e68f3b28f5d56fdc9786196d092274d2760eb Mon Sep 17 00:00:00 2001 From: Attila Mihaly Date: Wed, 11 Mar 2020 14:42:36 -0400 Subject: [PATCH 01/13] Fix compilation errors. --- tests/Morphir/{ => Elm/Backend}/Codec/Examples.elm | 0 tests/Morphir/{ => Elm/Backend}/Codec/Tests/A.elm | 2 +- 2 files changed, 1 insertion(+), 1 deletion(-) rename tests/Morphir/{ => Elm/Backend}/Codec/Examples.elm (100%) rename tests/Morphir/{ => Elm/Backend}/Codec/Tests/A.elm (87%) diff --git a/tests/Morphir/Codec/Examples.elm b/tests/Morphir/Elm/Backend/Codec/Examples.elm similarity index 100% rename from tests/Morphir/Codec/Examples.elm rename to tests/Morphir/Elm/Backend/Codec/Examples.elm diff --git a/tests/Morphir/Codec/Tests/A.elm b/tests/Morphir/Elm/Backend/Codec/Tests/A.elm similarity index 87% rename from tests/Morphir/Codec/Tests/A.elm rename to tests/Morphir/Elm/Backend/Codec/Tests/A.elm index 633b87101..ac3512ebb 100644 --- a/tests/Morphir/Codec/Tests/A.elm +++ b/tests/Morphir/Elm/Backend/Codec/Tests/A.elm @@ -1,4 +1,4 @@ -module A exposing (..) +module Morphir.Elm.Backend.Codec.Tests.A exposing (..) type alias Name = From 79dc50d5226677032ff1523304ca9a35b9b9659b Mon Sep 17 00:00:00 2001 From: Attila Mihaly Date: Wed, 11 Mar 2020 14:43:23 -0400 Subject: [PATCH 02/13] Fix isPrefixOf. #4 --- src/Morphir/IR/Path.elm | 12 ++++++------ tests/Morphir/IR/PathTests.elm | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 38 insertions(+), 6 deletions(-) create mode 100644 tests/Morphir/IR/PathTests.elm diff --git a/src/Morphir/IR/Path.elm b/src/Morphir/IR/Path.elm index d87d460db..fcc2b903c 100644 --- a/src/Morphir/IR/Path.elm +++ b/src/Morphir/IR/Path.elm @@ -114,16 +114,16 @@ toList names = {-| Checks if a path is a prefix of another. - isPrefixOf [ ["foo"], ["bar"] ] [ ["foo"] ] == True + isPrefixOf [ [ "foo" ], [ "bar" ] ] [ [ "foo" ] ] == True - isPrefixOf [ ["foo"] ] [ ["foo"], ["bar"] ] == False + isPrefixOf [ [ "foo" ] ] [ [ "foo" ], [ "bar" ] ] == False - isPrefixOf [ ["foo"], ["bar"] ] [ ["foo"], ["bar"] ] == True + isPrefixOf [ [ "foo" ], [ "bar" ] ] [ [ "foo" ], [ "bar" ] ] == True -} isPrefixOf : Path -> Path -> Bool -isPrefixOf path prefix = - case ( prefix, path ) of +isPrefixOf prefix path = + case ( path, prefix ) of -- empty path is a prefix of any other path ( [], _ ) -> True @@ -133,7 +133,7 @@ isPrefixOf path prefix = False -- for any other case compare the head and recurse - ( prefixHead :: prefixTail, pathHead :: pathTail ) -> + ( pathHead :: pathTail, prefixHead :: prefixTail ) -> if prefixHead == pathHead then isPrefixOf prefixTail pathTail diff --git a/tests/Morphir/IR/PathTests.elm b/tests/Morphir/IR/PathTests.elm new file mode 100644 index 000000000..aef7a3646 --- /dev/null +++ b/tests/Morphir/IR/PathTests.elm @@ -0,0 +1,32 @@ +module Morphir.IR.PathTests exposing (..) + +import Expect +import Morphir.IR.Name as Name +import Morphir.IR.Path as Path +import Test exposing (..) + + +isPrefixOfTests : Test +isPrefixOfTests = + let + toModuleName = + Path.toString Name.toTitleCase "." + + boolToString bool = + if bool then + "True" + + else + "False" + + isPrefixOf prefix path expectedResult = + test ("isPrefixOf " ++ toModuleName prefix ++ " " ++ toModuleName path ++ " == " ++ boolToString expectedResult) <| + \_ -> + Path.isPrefixOf prefix path + |> Expect.equal expectedResult + in + describe "fromString" + [ isPrefixOf [ [ "foo" ], [ "bar" ] ] [ [ "foo" ] ] True + , isPrefixOf [ [ "foo" ] ] [ [ "foo" ], [ "bar" ] ] False + , isPrefixOf [ [ "foo" ], [ "bar" ] ] [ [ "foo" ], [ "bar" ] ] True + ] From fd717d042b4b46b38707b5cb9d9b468c91081004 Mon Sep 17 00:00:00 2001 From: Attila Mihaly Date: Wed, 11 Mar 2020 16:45:04 -0400 Subject: [PATCH 03/13] Setup for NPM publishing. #1 --- .gitignore | 3 ++ cli/.gitignore | 3 +- cli/{morphir.js => morphir-elm.js} | 59 ++++++++++++++++++------------ package-lock.json | 13 +++++-- package.json | 12 +++++- 5 files changed, 60 insertions(+), 30 deletions(-) rename cli/{morphir.js => morphir-elm.js} (58%) diff --git a/.gitignore b/.gitignore index 2f2a48b1d..f9566b818 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,5 @@ +node_modules elm-stuff .vscode +.idea +Morphir.Elm.EncodersCLI.js diff --git a/cli/.gitignore b/cli/.gitignore index 38fafd1d7..cf3d32d2d 100644 --- a/cli/.gitignore +++ b/cli/.gitignore @@ -1 +1,2 @@ -Morphir.Elm.CLI.js \ No newline at end of file +Morphir.Elm.CLI.js +Morphir.Elm.EncodersCLI.js \ No newline at end of file diff --git a/cli/morphir.js b/cli/morphir-elm.js similarity index 58% rename from cli/morphir.js rename to cli/morphir-elm.js index a4d791c63..c9082221a 100644 --- a/cli/morphir.js +++ b/cli/morphir-elm.js @@ -1,12 +1,25 @@ 'use strict' +// NPM imports const path = require('path') const util = require('util') const fs = require('fs') const readdir = util.promisify(fs.readdir) const readFile = util.promisify(fs.readFile) +const commander = require('commander') + +// Elm imports const packageDefWorker = require('./Morphir.Elm.CLI').Elm.Morphir.Elm.CLI.init() const elmEncoderWorker = require('./Morphir.Elm.EncodersCLI').Elm.Morphir.Elm.EncodersCLI.init() +// Read the package.json of this package +const packageJson = require(path.join(__dirname, '../package.json')) + +// Set up Commander +const program = new commander.Command() +program + .version(packageJson.version, '-v, --version') + .parse(process.argv) + packageDefWorker.ports.decodeError.subscribe(res => { console.error(res) @@ -31,39 +44,39 @@ const sourceDir = "../src" const testDir = "../tests/Morphir/Codec/Tests" readElmSources(sourceDir) -.then((sourceFiles) => { - packageDefWorker.ports.packageDefinitionFromSource.send([packageInfo, sourceFiles]) - sourceFiles.forEach(element => { - console.log(element.path) - }); -}) -.catch((err) => { - console.error(err) -}) + .then((sourceFiles) => { + packageDefWorker.ports.packageDefinitionFromSource.send([packageInfo, sourceFiles]) + sourceFiles.forEach(element => { + console.log(element.path) + }); + }) + .catch((err) => { + 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 ("") -}) + .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) { - const readElmSource = async function(filePath) { - const content = await readFile(filePath) + const readElmSource = async function (filePath) { + const content = await readFile(filePath) return { path: filePath, content: content.toString() } } - const readDir = async function(currentDir) { - const entries = await readdir(currentDir, {withFileTypes: true}) + const readDir = async function (currentDir) { + const entries = await readdir(currentDir, { withFileTypes: true }) const elmSources = entries .filter(entry => entry.isFile() && entry.name.endsWith('.elm')) @@ -77,7 +90,7 @@ async function readElmSources(dir) { const next = await nextPromise return soFar.concat(next) }, Promise.resolve([])) - return elmSources.concat(await subDirSources) + return elmSources.concat(await subDirSources) } return Promise.all(await readDir(dir)) diff --git a/package-lock.json b/package-lock.json index d683021b2..aecc4306e 100644 --- a/package-lock.json +++ b/package-lock.json @@ -489,10 +489,9 @@ } }, "commander": { - "version": "3.0.2", - "resolved": "https://registry.npmjs.org/commander/-/commander-3.0.2.tgz", - "integrity": "sha512-Gar0ASD4BDyKC4hl4DwHqDrmvjoxWKZigVnAbn5H1owvm4CxCPdb0HQDehwNYMJpla5+M2tPmPARzhtYuwpHow==", - "dev": true + "version": "4.1.1", + "resolved": "https://registry.npmjs.org/commander/-/commander-4.1.1.tgz", + "integrity": "sha512-NOKm8xhkzAjzFx8B2v5OAHT+u5pRQc2UCa2Vq9jYL/31o2wi9mxBA7LIFs3sV5VSC49z6pEhfbMULvShKj26WA==" }, "component-emitter": { "version": "1.3.0", @@ -766,6 +765,12 @@ "integrity": "sha1-p9BVi9icQveV3UIyj3QIMcpTvCU=", "dev": true }, + "commander": { + "version": "3.0.2", + "resolved": "https://registry.npmjs.org/commander/-/commander-3.0.2.tgz", + "integrity": "sha512-Gar0ASD4BDyKC4hl4DwHqDrmvjoxWKZigVnAbn5H1owvm4CxCPdb0HQDehwNYMJpla5+M2tPmPARzhtYuwpHow==", + "dev": true + }, "cross-spawn": { "version": "6.0.5", "resolved": "https://registry.npmjs.org/cross-spawn/-/cross-spawn-6.0.5.tgz", diff --git a/package.json b/package.json index da0a01153..cc4a4fcc3 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "morphir-elm", - "version": "1.0.0", + "version": "0.1.0", "description": "Elm bindings for Morphir", "scripts": { "test": "elm-test", @@ -10,6 +10,11 @@ "type": "git", "url": "git+https://github.com/Morgan-Stanley/morphir-elm.git" }, + "files": [ + "./cli/morphir-elm.js", + "./cli/Morphir.Elm.CLI.js", + "./cli/Morphir.Elm.EncodersCLI.js" + ], "keywords": [ "morphir", "elm" @@ -24,5 +29,8 @@ "elm": "^0.19.1-3", "elm-doc-preview": "^3.0.4", "elm-test": "^0.19.1-revision2" + }, + "dependencies": { + "commander": "^4.1.1" } -} +} \ No newline at end of file From 603091621c8b587b7f12b1555c135844a9afb2ff Mon Sep 17 00:00:00 2001 From: Attila Mihaly Date: Wed, 11 Mar 2020 16:56:44 -0400 Subject: [PATCH 04/13] Set package version --- package-lock.json | 2 +- package.json | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/package-lock.json b/package-lock.json index aecc4306e..85877c9d2 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "morphir-elm", - "version": "1.0.0", + "version": "0.1.0", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index cc4a4fcc3..24e64d36a 100644 --- a/package.json +++ b/package.json @@ -33,4 +33,4 @@ "dependencies": { "commander": "^4.1.1" } -} \ No newline at end of file +} From 3f846753ff2b92eeceaad2f0f14c5ad88d37b196 Mon Sep 17 00:00:00 2001 From: Attila Mihaly Date: Wed, 11 Mar 2020 20:54:13 -0400 Subject: [PATCH 05/13] Improved CLI. #3, #1 --- cli/morphir-elm-gen.js | 76 +++++++++++++++++++++++++++++++++ cli/morphir-elm-make.js | 93 +++++++++++++++++++++++++++++++++++++++++ cli/morphir-elm.js | 90 +++------------------------------------ morphir.json | 8 ++++ package.json | 5 ++- 5 files changed, 186 insertions(+), 86 deletions(-) create mode 100644 cli/morphir-elm-gen.js create mode 100644 cli/morphir-elm-make.js create mode 100644 morphir.json diff --git a/cli/morphir-elm-gen.js b/cli/morphir-elm-gen.js new file mode 100644 index 000000000..234426a63 --- /dev/null +++ b/cli/morphir-elm-gen.js @@ -0,0 +1,76 @@ +#!/usr/bin/env node +'use strict' + +// NPM imports +const path = require('path') +const util = require('util') +const fs = require('fs') +const readdir = util.promisify(fs.readdir) +const readFile = util.promisify(fs.readFile) +const commander = require('commander') + +// Elm imports +const worker = require('./Morphir.Elm.EncodersCLI').Elm.Morphir.Elm.EncodersCLI.init() + +// Set up Commander +const program = new commander.Command() +program + .name('morphir-elm gen') + .description('Generate code from Morphir IR') + .parse(process.argv) + + +worker.ports.elmEncoderBackend.subscribe(res => { + console.log(res) +}) + + +const packageInfo = { + name: "morphir", + exposedModules: ["A"] +} + + +const testDir = "tests/Morphir/Elm/Backend/Codec/Tests" + +readElmSources(testDir) + .then((sourceFiles) => { + console.log("Generating elm encoders for following:") + sourceFiles.forEach(element => { + console.log(element.path) + }); + console.log("") + worker.ports.elmFrontEnd.send([packageInfo, sourceFiles]) + console.log("") + }) + + + +async function readElmSources(dir) { + const readElmSource = async function (filePath) { + const content = await readFile(filePath) + return { + path: filePath, + content: content.toString() + } + } + const readDir = async function (currentDir) { + const entries = await readdir(currentDir, { withFileTypes: true }) + const elmSources = + entries + .filter(entry => entry.isFile() && entry.name.endsWith('.elm')) + .map(entry => readElmSource(path.join(currentDir, entry.name))) + const subDirSources = + entries + .filter(entry => entry.isDirectory()) + .map(entry => readDir(path.join(currentDir, entry.name))) + .reduce(async (soFarPromise, nextPromise) => { + const soFar = await soFarPromise + const next = await nextPromise + return soFar.concat(next) + }, Promise.resolve([])) + return elmSources.concat(await subDirSources) + } + + return Promise.all(await readDir(dir)) +} \ No newline at end of file diff --git a/cli/morphir-elm-make.js b/cli/morphir-elm-make.js new file mode 100644 index 000000000..abe21e931 --- /dev/null +++ b/cli/morphir-elm-make.js @@ -0,0 +1,93 @@ +#!/usr/bin/env node +'use strict' + +// NPM imports +const path = require('path') +const util = require('util') +const fs = require('fs') +const readdir = util.promisify(fs.readdir) +const readFile = util.promisify(fs.readFile) +const writeFile = util.promisify(fs.writeFile) +const commander = require('commander') + +// Elm imports +const worker = require('./Morphir.Elm.CLI').Elm.Morphir.Elm.CLI.init() + +// Set up Commander +const program = new commander.Command() +program + .name('morphir-elm make') + .description('Translate Elm sources to Morphir IR') + .option('-p, --project-dir ', 'Root directory of the project where morphir.json is located.', '.') + .option('-o, --output ', 'Target location where the Morphir IR will be sent. Defaults to STDOUT.') + .parse(process.argv) + + +make(program.projectDir, program.output) + .then((packageDef) => { + console.log('Done.') + }) + .catch((err) => { + console.error(err) + }) + +async function make(projectDir, output) { + const morphirJsonContent = await readFile(path.join(projectDir, 'morphir.json')) + const morphirJson = JSON.parse(morphirJsonContent.toString()) + const sourceFiles = await readElmSources(morphirJson.sourceDirectory) + const packageDef = await packageDefinitionFromSource(morphirJson, sourceFiles) + if (output) { + console.log(`Writing file ${output}.`) + await writeFile(output, JSON.stringify(packageDef, null, 4)) + } else { + console.log(JSON.stringify(packageDef, null, 4)) + } + return packageDef +} + +async function packageDefinitionFromSource(morphirJson, sourceFiles) { + return new Promise((resolve, reject) => { + worker.ports.decodeError.subscribe(err => { + reject(err) + }) + + worker.ports.packageDefinitionFromSourceResult.subscribe(([err, ok]) => { + if (err) { + reject(err) + } else { + resolve(ok) + } + }) + + worker.ports.packageDefinitionFromSource.send([morphirJson, sourceFiles]) + }) +} + +async function readElmSources(dir) { + const readElmSource = async function (filePath) { + const content = await readFile(filePath) + return { + path: filePath, + content: content.toString() + } + } + const readDir = async function (currentDir) { + const entries = await readdir(currentDir, { withFileTypes: true }) + const elmSources = + entries + .filter(entry => entry.isFile() && entry.name.endsWith('.elm')) + .map(entry => readElmSource(path.join(currentDir, entry.name))) + const subDirSources = + entries + .filter(entry => entry.isDirectory()) + .map(entry => readDir(path.join(currentDir, entry.name))) + .reduce(async (soFarPromise, nextPromise) => { + const soFar = await soFarPromise + const next = await nextPromise + return soFar.concat(next) + }, Promise.resolve([])) + return elmSources.concat(await subDirSources) + } + + return Promise.all(await readDir(dir)) +} \ No newline at end of file diff --git a/cli/morphir-elm.js b/cli/morphir-elm.js index c9082221a..1d0712774 100644 --- a/cli/morphir-elm.js +++ b/cli/morphir-elm.js @@ -1,16 +1,10 @@ +#!/usr/bin/env node 'use strict' + // NPM imports const path = require('path') -const util = require('util') -const fs = require('fs') -const readdir = util.promisify(fs.readdir) -const readFile = util.promisify(fs.readFile) const commander = require('commander') -// Elm imports -const packageDefWorker = require('./Morphir.Elm.CLI').Elm.Morphir.Elm.CLI.init() -const elmEncoderWorker = require('./Morphir.Elm.EncodersCLI').Elm.Morphir.Elm.EncodersCLI.init() - // Read the package.json of this package const packageJson = require(path.join(__dirname, '../package.json')) @@ -18,80 +12,6 @@ const packageJson = require(path.join(__dirname, '../package.json')) const program = new commander.Command() program .version(packageJson.version, '-v, --version') - .parse(process.argv) - - -packageDefWorker.ports.decodeError.subscribe(res => { - console.error(res) -}) - -packageDefWorker.ports.packageDefinitionFromSourceResult.subscribe(res => { - console.log(JSON.stringify(res)) -}) - -elmEncoderWorker.ports.elmEncoderBackend.subscribe(res => { - console.log(res) -}) - - -const packageInfo = { - name: "morphir", - exposedModules: ["A"] -} - - -const sourceDir = "../src" -const testDir = "../tests/Morphir/Codec/Tests" - -readElmSources(sourceDir) - .then((sourceFiles) => { - packageDefWorker.ports.packageDefinitionFromSource.send([packageInfo, sourceFiles]) - sourceFiles.forEach(element => { - console.log(element.path) - }); - }) - .catch((err) => { - 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) { - const readElmSource = async function (filePath) { - const content = await readFile(filePath) - return { - path: filePath, - content: content.toString() - } - } - const readDir = async function (currentDir) { - const entries = await readdir(currentDir, { withFileTypes: true }) - const elmSources = - entries - .filter(entry => entry.isFile() && entry.name.endsWith('.elm')) - .map(entry => readElmSource(path.join(currentDir, entry.name))) - const subDirSources = - entries - .filter(entry => entry.isDirectory()) - .map(entry => readDir(path.join(currentDir, entry.name))) - .reduce(async (soFarPromise, nextPromise) => { - const soFar = await soFarPromise - const next = await nextPromise - return soFar.concat(next) - }, Promise.resolve([])) - return elmSources.concat(await subDirSources) - } - - return Promise.all(await readDir(dir)) -} \ No newline at end of file + .command('make', 'Translate Elm sources to Morphir IR') + .command('gen', 'Generate code from Morphir IR') + .parse(process.argv) \ No newline at end of file diff --git a/morphir.json b/morphir.json new file mode 100644 index 000000000..ba294d695 --- /dev/null +++ b/morphir.json @@ -0,0 +1,8 @@ +{ + "name": "morphir", + "sourceDirectory": "src", + "exposedModules": [ + "Morphir.IR.Name", + "Morphir.IR.Path" + ] +} \ No newline at end of file diff --git a/package.json b/package.json index 24e64d36a..e1c238fe9 100644 --- a/package.json +++ b/package.json @@ -10,6 +10,9 @@ "type": "git", "url": "git+https://github.com/Morgan-Stanley/morphir-elm.git" }, + "bin": { + "morphir-elm": "./cli/morphir-elm.js" + }, "files": [ "./cli/morphir-elm.js", "./cli/Morphir.Elm.CLI.js", @@ -33,4 +36,4 @@ "dependencies": { "commander": "^4.1.1" } -} +} \ No newline at end of file From 27d76f5556fab95c13631060ac18b17797b0ea5b Mon Sep 17 00:00:00 2001 From: Attila Mihaly Date: Thu, 12 Mar 2020 14:27:25 -0400 Subject: [PATCH 06/13] Added more documentation. #1, #3 --- README.md | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 59 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index d872358f6..cd0e69f3a 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,61 @@ -# Morphir Elm binding +# morphir-elm -This repo contains tools to work with the Morphir IR in Elm. It includes the data models for -the IR, JSON serialization and a frontend to parse Elm source code into Morphir IR. +[![npm version](https://badge.fury.io/js/morphir-elm.svg)](https://badge.fury.io/js/morphir-elm) +morphir-elm is a set of tools to work with Morphir in Elm. It currently provides these features: + +* Translate Elm sources to Morphir IR +* Generate code from the Morphir IR + +# Installation + +``` +npm install -g morphir-elm +``` + +# Usage + +All the features can be accessed through sub-commands within the `morphir-elm` command: + +``` +morphir-elm [command] +``` + +Each command has different options which are detailed below: + +## Translate Elm sources to Morphir IR + +This command reads Elm sources, translates to Morphir IR and outputs the IR into JSON. + +``` +morphir-elm make [options] +``` + +**Important**: The command requires a configuration file called `morphir.json` located in the project +root directory with the following structure: + +``` +{ + "name": "package-name", + "sourceDirectory": "src", + "exposedModules": [ + "Foo", + "Bar" + ] +} +``` + +### Options + +|Option|Shorthand|Description| +|---|---|---| +|`--project-dir `|`-p`|Root directory of the project where morphir.json is located. (default: ".")| +|`--output `|`-o`|Target location where the Morphir IR will be sent. Defaults to STDOUT.| + +## Generate code from the Morphir IR + +Generate code from the Morphir IR + +``` +morphir-elm gen +``` \ No newline at end of file From 9788a37405eedc313d2565e79231fcd6631147a6 Mon Sep 17 00:00:00 2001 From: Attila Mihaly Date: Thu, 12 Mar 2020 15:43:08 -0400 Subject: [PATCH 07/13] Fix package publish errors. #1 --- .gitignore | 1 - cli/.npmignore | 0 package.json | 8 +++++--- 3 files changed, 5 insertions(+), 4 deletions(-) create mode 100644 cli/.npmignore diff --git a/.gitignore b/.gitignore index f9566b818..561c47651 100644 --- a/.gitignore +++ b/.gitignore @@ -2,4 +2,3 @@ node_modules elm-stuff .vscode .idea -Morphir.Elm.EncodersCLI.js diff --git a/cli/.npmignore b/cli/.npmignore new file mode 100644 index 000000000..e69de29bb diff --git a/package.json b/package.json index e1c238fe9..edee38157 100644 --- a/package.json +++ b/package.json @@ -14,9 +14,11 @@ "morphir-elm": "./cli/morphir-elm.js" }, "files": [ - "./cli/morphir-elm.js", - "./cli/Morphir.Elm.CLI.js", - "./cli/Morphir.Elm.EncodersCLI.js" + "cli/morphir-elm.js", + "cli/morphir-elm-make.js", + "cli/morphir-elm-gen.js", + "cli/Morphir.Elm.CLI.js", + "cli/Morphir.Elm.EncodersCLI.js" ], "keywords": [ "morphir", From 29002a54a4b0b0b5c6dff2291eaec2a1d785e27e Mon Sep 17 00:00:00 2001 From: Attila Mihaly Date: Thu, 12 Mar 2020 17:39:52 -0400 Subject: [PATCH 08/13] Do not print done if STDOUT is used. --- cli/morphir-elm-make.js | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/cli/morphir-elm-make.js b/cli/morphir-elm-make.js index abe21e931..d7d02ef39 100644 --- a/cli/morphir-elm-make.js +++ b/cli/morphir-elm-make.js @@ -25,7 +25,9 @@ program make(program.projectDir, program.output) .then((packageDef) => { - console.log('Done.') + if (program.output) { + console.log('Done.') + } }) .catch((err) => { console.error(err) From 6c12c360df5e8722c32387fd1f4a486419b5d768 Mon Sep 17 00:00:00 2001 From: Attila Mihaly Date: Thu, 12 Mar 2020 17:46:08 -0400 Subject: [PATCH 09/13] Print JSON in compact form. --- cli/morphir-elm-make.js | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cli/morphir-elm-make.js b/cli/morphir-elm-make.js index d7d02ef39..a58d3e04d 100644 --- a/cli/morphir-elm-make.js +++ b/cli/morphir-elm-make.js @@ -42,7 +42,7 @@ async function make(projectDir, output) { console.log(`Writing file ${output}.`) await writeFile(output, JSON.stringify(packageDef, null, 4)) } else { - console.log(JSON.stringify(packageDef, null, 4)) + console.log(JSON.stringify(packageDef)) } return packageDef } From 455baeb76b81d2bebc3353e2da0e727396d4242b Mon Sep 17 00:00:00 2001 From: Attila Mihaly Date: Thu, 12 Mar 2020 23:20:12 -0400 Subject: [PATCH 10/13] Better error handling. --- cli/morphir-elm-make.js | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/cli/morphir-elm-make.js b/cli/morphir-elm-make.js index a58d3e04d..363e5f5d3 100644 --- a/cli/morphir-elm-make.js +++ b/cli/morphir-elm-make.js @@ -6,6 +6,7 @@ const path = require('path') const util = require('util') const fs = require('fs') const readdir = util.promisify(fs.readdir) +const lstat = util.promisify(fs.lstat) const readFile = util.promisify(fs.readFile) const writeFile = util.promisify(fs.writeFile) const commander = require('commander') @@ -30,11 +31,17 @@ make(program.projectDir, program.output) } }) .catch((err) => { - console.error(err) + if (err.code == 'ENOENT') { + console.error(`Could not find file at '${err.path}'`) + } else { + console.error(err) + } + process.exit(1) }) async function make(projectDir, output) { - const morphirJsonContent = await readFile(path.join(projectDir, 'morphir.json')) + const morphirJsonPath = path.join(projectDir, 'morphir.json') + const morphirJsonContent = await readFile(morphirJsonPath) const morphirJson = JSON.parse(morphirJsonContent.toString()) const sourceFiles = await readElmSources(morphirJson.sourceDirectory) const packageDef = await packageDefinitionFromSource(morphirJson, sourceFiles) From 1509d3f172c4cfc24f54e54c82444c6946a44974 Mon Sep 17 00:00:00 2001 From: Attila Mihaly Date: Tue, 17 Mar 2020 00:09:21 -0400 Subject: [PATCH 11/13] Added resolution for local names. --- src/Morphir/Elm/Frontend.elm | 70 ++++++++++++++++++++--------- src/Morphir/IR/Advanced/Type.elm | 2 +- src/Morphir/Rewrite.elm | 14 ++++-- tests/Morphir/Elm/FrontendTests.elm | 30 ++++++++----- 4 files changed, 77 insertions(+), 39 deletions(-) diff --git a/src/Morphir/Elm/Frontend.elm b/src/Morphir/Elm/Frontend.elm index a3b14ff92..d7d049861 100644 --- a/src/Morphir/Elm/Frontend.elm +++ b/src/Morphir/Elm/Frontend.elm @@ -15,15 +15,16 @@ 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 exposing (AccessControlled, private, public) +import Morphir.IR.AccessControlled as 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) import Morphir.IR.Advanced.Value as Value exposing (Value) -import Morphir.IR.FQName exposing (fQName) +import Morphir.IR.FQName as FQName exposing (fQName) import Morphir.IR.Name as Name exposing (Name) import Morphir.IR.Path as Path exposing (Path) import Morphir.ResultList as ResultList +import Morphir.Rewrite as Rewrite import Parser import Set exposing (Set) @@ -238,19 +239,6 @@ mapProcessedFile currentPackagePath processedFile modulesSoFar = |> Node.value |> ElmModule.exposingList - moduleDeclsSoFar = - modulesSoFar - |> Dict.map - (\path def -> - Module.definitionToDeclaration def - ) - - moduleResolver : ModuleResolver - moduleResolver = - Resolve.createModuleResolver - (Resolve.createPackageResolver Dict.empty currentPackagePath moduleDeclsSoFar) - (processedFile.file.imports |> List.map Node.value) - typesResult : Result Errors (Dict Name (AccessControlled (Type.Definition SourceLocation))) typesResult = mapDeclarationsToType processedFile.parsedFile.sourceFile moduleExpose (processedFile.file.declarations |> List.map Node.value) @@ -259,14 +247,20 @@ mapProcessedFile currentPackagePath processedFile modulesSoFar = valuesResult : Result Errors (Dict Name (AccessControlled (Value.Definition SourceLocation))) valuesResult = Ok Dict.empty + + moduleResult : Result Errors (Module.Definition SourceLocation) + moduleResult = + Result.map2 Module.Definition + typesResult + valuesResult in - Result.map2 - (\types values -> - modulesSoFar - |> Dict.insert modulePath (Module.Definition types values) - ) - typesResult - valuesResult + moduleResult + |> Result.andThen (resolveLocalTypes currentPackagePath modulePath) + |> Result.map + (\m -> + modulesSoFar + |> Dict.insert modulePath m + ) mapDeclarationsToType : SourceFile -> Exposing -> List Declaration -> Result Errors (List ( Name, AccessControlled (Type.Definition SourceLocation) )) @@ -483,6 +477,38 @@ mapTypeAnnotation sourceFile (Node range typeAnnotation) = (mapTypeAnnotation sourceFile returnTypeNode) +resolveLocalTypes : Path -> Path -> Module.Definition SourceLocation -> Result Errors (Module.Definition SourceLocation) +resolveLocalTypes packagePath modulePath moduleDef = + let + rewriteTypes = + Rewrite.bottomUp Type.rewriteType + (\tpe -> + case tpe of + Type.Reference fullName args sourceLocation -> + let + localName = + fullName + |> FQName.getLocalName + in + moduleDef.types + |> Dict.get localName + |> Maybe.map + (\_ -> + Type.Reference (fQName packagePath modulePath localName) args sourceLocation + ) + + _ -> + Nothing + ) + + rewriteValues = + identity + in + moduleDef + |> Module.mapDefinition rewriteTypes rewriteValues + |> Ok + + withAccessControl : Bool -> a -> AccessControlled a withAccessControl isExposed a = if isExposed then diff --git a/src/Morphir/IR/Advanced/Type.elm b/src/Morphir/IR/Advanced/Type.elm index 00ddd18c6..adcf627eb 100644 --- a/src/Morphir/IR/Advanced/Type.elm +++ b/src/Morphir/IR/Advanced/Type.elm @@ -8,7 +8,7 @@ module Morphir.IR.Advanced.Type exposing , Constructors , fuzzType , encodeType, decodeType, encodeDeclaration, encodeDefinition - , Constructor, definitionToDeclaration, mapDeclaration, mapDefinition, mapTypeExtra + , Constructor, definitionToDeclaration, mapDeclaration, mapDefinition, mapTypeExtra, rewriteType ) {-| This module contains the building blocks of types in the Morphir IR. diff --git a/src/Morphir/Rewrite.elm b/src/Morphir/Rewrite.elm index 7d9ca6ed2..a4b85d98c 100644 --- a/src/Morphir/Rewrite.elm +++ b/src/Morphir/Rewrite.elm @@ -40,7 +40,13 @@ the entire tree regardless of rule matches but only changes the tree if a rule matches. -} bottomUp : Rewrite a -> Rule a -> a -> a -bottomUp rewrite rewriteRule = - rewrite - (bottomUp rewrite rewriteRule) - (Rule.defaultToOriginal rewriteRule) +bottomUp rewrite rewriteRule typeToRewrite = + let + top = + rewrite + (\a -> bottomUp rewrite rewriteRule a) + (Rule.defaultToOriginal rewriteRule) + typeToRewrite + in + rewriteRule top + |> Maybe.withDefault top diff --git a/tests/Morphir/Elm/FrontendTests.elm b/tests/Morphir/Elm/FrontendTests.elm index 882b5a878..734ca7bf0 100644 --- a/tests/Morphir/Elm/FrontendTests.elm +++ b/tests/Morphir/Elm/FrontendTests.elm @@ -40,6 +40,21 @@ module B exposing (..) """ } + packageName = + Path.fromString "my/package" + + moduleA = + Path.fromString "A" + + packageInfo = + { name = + packageName + , exposedModules = + Set.fromList + [ moduleA + ] + } + expected : Package.Definition () expected = { dependencies = Dict.empty @@ -52,7 +67,7 @@ module B exposing (..) [ ( [ "bar" ] , public (Type.typeAliasDefinition [] - (Type.reference (fQName [] [] [ "foo" ]) [] ()) + (Type.reference (fQName packageName moduleA [ "foo" ]) [] ()) ) ) , ( [ "foo" ] @@ -72,9 +87,9 @@ module B exposing (..) (Type.typeAliasDefinition [] (Type.record [ Type.field [ "field", "1" ] - (Type.reference (fQName [] [] [ "foo" ]) [] ()) + (Type.reference (fQName packageName moduleA [ "foo" ]) [] ()) , Type.field [ "field", "2" ] - (Type.reference (fQName [] [] [ "bar" ]) [] ()) + (Type.reference (fQName packageName moduleA [ "bar" ]) [] ()) ] () ) @@ -95,15 +110,6 @@ module B exposing (..) ) ] } - - packageInfo = - { name = - Path.fromString "my/package" - , exposedModules = - Set.fromList - [ Path.fromString "A" - ] - } in test "first" <| \_ -> From 023cae94a8ecb719fe01f260699d201c79138cb1 Mon Sep 17 00:00:00 2001 From: Attila Mihaly Date: Tue, 17 Mar 2020 16:19:36 -0400 Subject: [PATCH 12/13] Better naming. --- src/Morphir/Rewrite.elm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Morphir/Rewrite.elm b/src/Morphir/Rewrite.elm index a4b85d98c..296ba5907 100644 --- a/src/Morphir/Rewrite.elm +++ b/src/Morphir/Rewrite.elm @@ -24,13 +24,13 @@ not match the rewrite continues downward. When a rule matches it's applied and the rewrite process stops traversing downward in the subtree. -} topDown : Rewrite a -> Rule a -> a -> a -topDown rewrite rewriteRule typeToRewrite = - rewriteRule typeToRewrite +topDown rewrite rewriteRule nodeToRewrite = + rewriteRule nodeToRewrite |> Maybe.withDefault (rewrite (topDown rewrite rewriteRule) identity - typeToRewrite + nodeToRewrite ) @@ -40,13 +40,13 @@ the entire tree regardless of rule matches but only changes the tree if a rule matches. -} bottomUp : Rewrite a -> Rule a -> a -> a -bottomUp rewrite rewriteRule typeToRewrite = +bottomUp rewrite rewriteRule nodeToRewrite = let top = rewrite (\a -> bottomUp rewrite rewriteRule a) (Rule.defaultToOriginal rewriteRule) - typeToRewrite + nodeToRewrite in rewriteRule top |> Maybe.withDefault top From c22e947c35286e2d14db793abba2a05f59c59eac Mon Sep 17 00:00:00 2001 From: Attila Mihaly Date: Tue, 17 Mar 2020 22:12:10 -0400 Subject: [PATCH 13/13] Full type name resolution support. #21 --- package.json | 2 +- src/Morphir/Elm/Backend/Codec/Gen.elm | 148 ++++++++++--------- src/Morphir/Elm/Frontend.elm | 66 ++++++--- src/Morphir/Elm/Frontend/Resolve.elm | 3 +- src/Morphir/IR/AccessControlled.elm | 59 ++++---- src/Morphir/IR/Advanced/Module.elm | 90 +++++++++--- src/Morphir/IR/Advanced/Package.elm | 91 +++++++++--- src/Morphir/IR/Advanced/Type.elm | 198 +++++++++++++++++--------- src/Morphir/IR/Advanced/Value.elm | 39 +++-- src/Morphir/Rewrite.elm | 32 +++-- src/Morphir/Rule.elm | 24 ++-- tests/Morphir/Elm/FrontendTests.elm | 44 ++++-- 12 files changed, 523 insertions(+), 273 deletions(-) diff --git a/package.json b/package.json index c46101652..3687382f5 100644 --- a/package.json +++ b/package.json @@ -38,4 +38,4 @@ "dependencies": { "commander": "^4.1.1" } -} \ No newline at end of file +} diff --git a/src/Morphir/Elm/Backend/Codec/Gen.elm b/src/Morphir/Elm/Backend/Codec/Gen.elm index c9b0a3dcc..c0910df03 100644 --- a/src/Morphir/Elm/Backend/Codec/Gen.elm +++ b/src/Morphir/Elm/Backend/Codec/Gen.elm @@ -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) @@ -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 @@ -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 @@ -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 diff --git a/src/Morphir/Elm/Frontend.elm b/src/Morphir/Elm/Frontend.elm index d7d049861..3070fcf17 100644 --- a/src/Morphir/Elm/Frontend.elm +++ b/src/Morphir/Elm/Frontend.elm @@ -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 @@ -239,6 +239,19 @@ mapProcessedFile currentPackagePath processedFile modulesSoFar = |> Node.value |> ElmModule.exposingList + moduleDeclsSoFar = + modulesSoFar + |> Dict.map + (\path def -> + Module.definitionToDeclaration def + ) + + moduleResolver : ModuleResolver + moduleResolver = + Resolve.createModuleResolver + (Resolve.createPackageResolver Dict.empty currentPackagePath moduleDeclsSoFar) + (processedFile.file.imports |> List.map Node.value) + typesResult : Result Errors (Dict Name (AccessControlled (Type.Definition SourceLocation))) typesResult = mapDeclarationsToType processedFile.parsedFile.sourceFile moduleExpose (processedFile.file.declarations |> List.map Node.value) @@ -255,7 +268,7 @@ mapProcessedFile currentPackagePath processedFile modulesSoFar = valuesResult in moduleResult - |> Result.andThen (resolveLocalTypes currentPackagePath modulePath) + |> Result.andThen (resolveLocalTypes currentPackagePath modulePath moduleResolver) |> Result.map (\m -> modulesSoFar @@ -444,7 +457,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 @@ -459,7 +472,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 @@ -477,25 +490,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 @@ -504,9 +538,7 @@ resolveLocalTypes packagePath modulePath moduleDef = rewriteValues = identity in - moduleDef - |> Module.mapDefinition rewriteTypes rewriteValues - |> Ok + Module.mapDefinition rewriteTypes rewriteValues moduleDef withAccessControl : Bool -> a -> AccessControlled a diff --git a/src/Morphir/Elm/Frontend/Resolve.elm b/src/Morphir/Elm/Frontend/Resolve.elm index 0dc570558..cb4fe38a6 100644 --- a/src/Morphir/Elm/Frontend/Resolve.elm +++ b/src/Morphir/Elm/Frontend/Resolve.elm @@ -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(..)) @@ -31,6 +31,7 @@ type Error | CouldNotFindPackage Path | ModuleNotImported ModuleName | AliasNotFound String + | PackageNotPrefixOfModule Path Path type alias ModuleResolver = diff --git a/src/Morphir/IR/AccessControlled.elm b/src/Morphir/IR/AccessControlled.elm index bbbcb6003..d46b1efc8 100644 --- a/src/Morphir/IR/AccessControlled.elm +++ b/src/Morphir/IR/AccessControlled.elm @@ -1,9 +1,9 @@ module Morphir.IR.AccessControlled exposing - ( AccessControlled(..) + ( AccessControlled , public, private , withPublicAccess, withPrivateAccess , decodeAccessControlled, encodeAccessControlled - , map + , Access(..), map ) {-| Module to manage access to a node in the IR. This is only used to declare access levels @@ -36,23 +36,29 @@ import Json.Encode as Encode {-| Type that represents different access levels. -} -type AccessControlled a - = Public a - | Private a +type alias AccessControlled a = + { access : Access + , value : a + } + + +type Access + = Public + | Private {-| Mark a node as public access. Actors with both public and private access are allowed to see. -} public : a -> AccessControlled a public value = - Public value + AccessControlled Public value {-| Mark a node as private access. Only actors with private access level can see. -} private : a -> AccessControlled a private value = - Private value + AccessControlled Private value {-| Get the value with public access level. Will return `Nothing` if the value is private. @@ -64,11 +70,11 @@ private value = -} withPublicAccess : AccessControlled a -> Maybe a withPublicAccess ac = - case ac of - Public a -> - Just a + case ac.access of + Public -> + Just ac.value - Private a -> + Private -> Nothing @@ -81,39 +87,34 @@ withPublicAccess ac = -} withPrivateAccess : AccessControlled a -> a withPrivateAccess ac = - case ac of - Public a -> - a + case ac.access of + Public -> + ac.value - Private a -> - a + Private -> + ac.value map : (a -> b) -> AccessControlled a -> AccessControlled b map f ac = - case ac of - Public a -> - Public (f a) - - Private a -> - Private (f a) + AccessControlled ac.access (f ac.value) {-| Encode AccessControlled to JSON. -} encodeAccessControlled : (a -> Encode.Value) -> AccessControlled a -> Encode.Value encodeAccessControlled encodeValue ac = - case ac of - Public value -> + case ac.access of + Public -> Encode.object [ ( "$type", Encode.string "public" ) - , ( "value", encodeValue value ) + , ( "value", encodeValue ac.value ) ] - Private value -> + Private -> Encode.object [ ( "$type", Encode.string "private" ) - , ( "value", encodeValue value ) + , ( "value", encodeValue ac.value ) ] @@ -126,11 +127,11 @@ decodeAccessControlled decodeValue = (\tag -> case tag of "public" -> - Decode.map Public + Decode.map (AccessControlled Public) (Decode.field "value" decodeValue) "private" -> - Decode.map Private + Decode.map (AccessControlled Private) (Decode.field "value" decodeValue) other -> diff --git a/src/Morphir/IR/Advanced/Module.elm b/src/Morphir/IR/Advanced/Module.elm index 0d060b1ce..b37ddcf69 100644 --- a/src/Morphir/IR/Advanced/Module.elm +++ b/src/Morphir/IR/Advanced/Module.elm @@ -19,6 +19,7 @@ import Morphir.IR.AccessControlled as AccessControlled exposing (AccessControlle import Morphir.IR.Advanced.Type as Type exposing (Type) import Morphir.IR.Advanced.Value as Value exposing (Value) import Morphir.IR.Name exposing (Name, encodeName) +import Morphir.ResultList as ResultList {-| Type that represents a module declaration. @@ -99,31 +100,78 @@ encodeDeclaration encodeExtra decl = ] -mapDeclaration : (Type a -> Type b) -> (Value a -> Value b) -> Declaration a -> Declaration b +mapDeclaration : (Type a -> Result e (Type b)) -> (Value a -> Value b) -> Declaration a -> Result (List e) (Declaration b) mapDeclaration mapType mapValue decl = - { types = - decl.types - |> Dict.map (\_ typeDecl -> Type.mapDeclaration mapType typeDecl) - , values = - decl.values - |> Dict.map (\_ valueDecl -> Value.mapDeclaration mapType mapValue valueDecl) - } + let + typesResult : Result (List e) (Dict Name (Type.Declaration b)) + typesResult = + decl.types + |> Dict.toList + |> List.map + (\( typeName, typeDecl ) -> + typeDecl + |> Type.mapDeclaration mapType + |> Result.map (Tuple.pair typeName) + ) + |> ResultList.toResult + |> Result.map Dict.fromList + |> Result.mapError List.concat + valuesResult : Result (List e) (Dict Name (Value.Declaration b)) + valuesResult = + decl.values + |> Dict.toList + |> List.map + (\( valueName, valueDecl ) -> + valueDecl + |> Value.mapDeclaration mapType mapValue + |> Result.map (Tuple.pair valueName) + ) + |> ResultList.toResult + |> Result.map Dict.fromList + |> Result.mapError List.concat + in + Result.map2 Declaration + typesResult + valuesResult -mapDefinition : (Type a -> Type b) -> (Value a -> Value b) -> Definition a -> Definition b + +mapDefinition : (Type a -> Result e (Type b)) -> (Value a -> Value b) -> Definition a -> Result (List e) (Definition b) mapDefinition mapType mapValue def = - { types = - def.types - |> Dict.map - (\_ ac -> - ac - |> AccessControlled.map - (Type.mapDefinition mapType) - ) - , values = - def.values - |> Dict.map (\_ ac -> ac |> AccessControlled.map (Value.mapDefinition mapType mapValue)) - } + let + typesResult : Result (List e) (Dict Name (AccessControlled (Type.Definition b))) + typesResult = + def.types + |> Dict.toList + |> List.map + (\( typeName, typeDef ) -> + typeDef.value + |> Type.mapDefinition mapType + |> Result.map (AccessControlled typeDef.access) + |> Result.map (Tuple.pair typeName) + ) + |> ResultList.toResult + |> Result.map Dict.fromList + |> Result.mapError List.concat + + valuesResult : Result (List e) (Dict Name (AccessControlled (Value.Definition b))) + valuesResult = + def.values + |> Dict.toList + |> List.map + (\( valueName, valueDef ) -> + valueDef.value + |> Value.mapDefinition mapType mapValue + |> Result.map (AccessControlled valueDef.access) + |> Result.map (Tuple.pair valueName) + ) + |> ResultList.toResult + |> Result.map Dict.fromList + |> Result.mapError List.concat + in + Result.map2 Definition + typesResult + valuesResult {-| -} diff --git a/src/Morphir/IR/Advanced/Package.elm b/src/Morphir/IR/Advanced/Package.elm index 2b155592e..958cfd473 100644 --- a/src/Morphir/IR/Advanced/Package.elm +++ b/src/Morphir/IR/Advanced/Package.elm @@ -21,6 +21,7 @@ import Morphir.IR.Advanced.Type as Type exposing (Type) import Morphir.IR.Advanced.Value as Value exposing (Value) import Morphir.IR.Path exposing (Path, encodePath) import Morphir.IR.QName exposing (QName, encodeQName) +import Morphir.ResultList as ResultList {-| Type that represents a package declaration. @@ -30,6 +31,12 @@ type alias Declaration extra = } +emptyDeclaration : Declaration extra +emptyDeclaration = + { modules = Dict.empty + } + + {-| Type that represents a package definition. -} type alias Definition extra = @@ -65,37 +72,79 @@ definitionToDeclaration def = } -mapDeclaration : (Type a -> Type b) -> (Value a -> Value b) -> Declaration a -> Declaration b +mapDeclaration : (Type a -> Result e (Type b)) -> (Value a -> Value b) -> Declaration a -> Result (List e) (Declaration b) mapDeclaration mapType mapValue decl = - { modules = - decl.modules - |> Dict.map (\_ moduleDecl -> Module.mapDeclaration mapType mapValue moduleDecl) - } + let + modulesResult : Result (List e) (Dict Path (Module.Declaration b)) + modulesResult = + decl.modules + |> Dict.toList + |> List.map + (\( modulePath, moduleDecl ) -> + moduleDecl + |> Module.mapDeclaration mapType mapValue + |> Result.map (Tuple.pair modulePath) + ) + |> ResultList.toResult + |> Result.map Dict.fromList + |> Result.mapError List.concat + in + Result.map Declaration modulesResult eraseDeclarationExtra : Declaration a -> Declaration () -eraseDeclarationExtra = - mapDeclaration - (Type.mapTypeExtra (\_ -> ())) - (Value.mapValueExtra (\_ -> ())) +eraseDeclarationExtra decl = + decl + |> mapDeclaration + (Type.mapTypeExtra (\_ -> ()) >> Ok) + (Value.mapValueExtra (\_ -> ())) + |> Result.withDefault emptyDeclaration -mapDefinition : (Type a -> Type b) -> (Value a -> Value b) -> Definition a -> Definition b +mapDefinition : (Type a -> Result e (Type b)) -> (Value a -> Value b) -> Definition a -> Result (List e) (Definition b) mapDefinition mapType mapValue def = - { dependencies = - def.dependencies - |> Dict.map (\_ packageDecl -> mapDeclaration mapType mapValue packageDecl) - , modules = - def.modules - |> Dict.map (\_ ac -> ac |> AccessControlled.map (Module.mapDefinition mapType mapValue)) - } + let + dependenciesResult : Result (List e) (Dict Path (Declaration b)) + dependenciesResult = + def.dependencies + |> Dict.toList + |> List.map + (\( packagePath, packageDecl ) -> + packageDecl + |> mapDeclaration mapType mapValue + |> Result.map (Tuple.pair packagePath) + ) + |> ResultList.toResult + |> Result.map Dict.fromList + |> Result.mapError List.concat + + modulesResult : Result (List e) (Dict Path (AccessControlled (Module.Definition b))) + modulesResult = + def.modules + |> Dict.toList + |> List.map + (\( modulePath, moduleDef ) -> + moduleDef.value + |> Module.mapDefinition mapType mapValue + |> Result.map (AccessControlled moduleDef.access) + |> Result.map (Tuple.pair modulePath) + ) + |> ResultList.toResult + |> Result.map Dict.fromList + |> Result.mapError List.concat + in + Result.map2 Definition + dependenciesResult + modulesResult eraseDefinitionExtra : Definition a -> Definition () -eraseDefinitionExtra = - mapDefinition - (Type.mapTypeExtra (\_ -> ())) - (Value.mapValueExtra (\_ -> ())) +eraseDefinitionExtra def = + def + |> mapDefinition + (Type.mapTypeExtra (\_ -> ()) >> Ok) + (Value.mapValueExtra (\_ -> ())) + |> Result.withDefault emptyDefinition encodeDeclaration : (extra -> Encode.Value) -> Declaration extra -> Encode.Value diff --git a/src/Morphir/IR/Advanced/Type.elm b/src/Morphir/IR/Advanced/Type.elm index adcf627eb..83211aca6 100644 --- a/src/Morphir/IR/Advanced/Type.elm +++ b/src/Morphir/IR/Advanced/Type.elm @@ -2,7 +2,7 @@ module Morphir.IR.Advanced.Type exposing ( Type(..) , variable, reference, tuple, record, extensibleRecord, function, unit , matchVariable, matchReference, matchTuple, matchRecord, matchExtensibleRecord, matchFunction, matchUnit - , Field(..), field, matchField, mapFieldName, mapFieldType + , Field, matchField, mapFieldName, mapFieldType , Declaration, typeAliasDeclaration, opaqueTypeDeclaration, customTypeDeclaration, matchCustomTypeDeclaration , Definition(..), typeAliasDefinition, customTypeDefinition , Constructors @@ -31,7 +31,7 @@ module Morphir.IR.Advanced.Type exposing # Record Field -@docs Field, field, matchField, mapFieldName, mapFieldType +@docs Field, matchField, mapFieldName, mapFieldType # Declaration @@ -67,6 +67,7 @@ import Morphir.IR.AccessControlled as AccessControlled exposing (AccessControlle import Morphir.IR.FQName exposing (FQName, decodeFQName, encodeFQName, fuzzFQName) import Morphir.IR.Name exposing (Name, decodeName, encodeName, fuzzName) import Morphir.Pattern exposing (Pattern) +import Morphir.ResultList as ResultList import Morphir.Rewrite exposing (Rewrite) @@ -94,8 +95,10 @@ type Type extra {-| An opaque representation of a field. It's made up of a name and a type. -} -type Field extra - = Field Name (Type extra) +type alias Field extra = + { name : Name + , tpe : Type extra + } {-| -} @@ -144,55 +147,71 @@ definitionToDeclaration def = OpaqueTypeDeclaration params -mapDeclaration : (Type a -> Type b) -> Declaration a -> Declaration b +mapDeclaration : (Type a -> Result e (Type b)) -> Declaration a -> Result (List e) (Declaration b) mapDeclaration f decl = case decl of TypeAliasDeclaration params tpe -> - TypeAliasDeclaration params (f tpe) + f tpe + |> Result.map (TypeAliasDeclaration params) + |> Result.mapError List.singleton OpaqueTypeDeclaration params -> OpaqueTypeDeclaration params - - CustomTypeDeclaration params ctors -> - CustomTypeDeclaration params - (ctors - |> List.map - (\( name, args ) -> - ( name - , args - |> List.map - (\( argName, argType ) -> - ( argName, f argType ) - ) + |> Ok + + CustomTypeDeclaration params constructors -> + let + ctorsResult : Result (List e) (Constructors b) + ctorsResult = + constructors + |> List.map + (\( ctorName, ctorArgs ) -> + ctorArgs + |> List.map + (\( argName, argType ) -> + f argType + |> Result.map (Tuple.pair argName) + ) + |> ResultList.toResult + |> Result.map (Tuple.pair ctorName) ) - ) - ) + |> ResultList.toResult + |> Result.mapError List.concat + in + ctorsResult + |> Result.map (CustomTypeDeclaration params) -mapDefinition : (Type a -> Type b) -> Definition a -> Definition b +mapDefinition : (Type a -> Result e (Type b)) -> Definition a -> Result (List e) (Definition b) mapDefinition f def = case def of TypeAliasDefinition params tpe -> - TypeAliasDefinition params (f tpe) - - CustomTypeDefinition params ac -> - CustomTypeDefinition params - (ac - |> AccessControlled.map - (\ctors -> - ctors - |> List.map - (\( name, args ) -> - ( name - , args - |> List.map - (\( argName, argType ) -> - ( argName, f argType ) - ) + f tpe + |> Result.map (TypeAliasDefinition params) + |> Result.mapError List.singleton + + CustomTypeDefinition params constructors -> + let + ctorsResult : Result (List e) (AccessControlled (Constructors b)) + ctorsResult = + constructors.value + |> List.map + (\( ctorName, ctorArgs ) -> + ctorArgs + |> List.map + (\( argName, argType ) -> + f argType + |> Result.map (Tuple.pair argName) ) - ) - ) - ) + |> ResultList.toResult + |> Result.map (Tuple.pair ctorName) + ) + |> ResultList.toResult + |> Result.map (AccessControlled constructors.access) + |> Result.mapError List.concat + in + ctorsResult + |> Result.map (CustomTypeDefinition params) mapTypeExtra : (a -> b) -> Type a -> Type b @@ -533,39 +552,78 @@ matchCustomTypeDeclaration matchTypeParams matchCtors declToMatch = Nothing -rewriteType : Rewrite (Type extra) +rewriteType : Rewrite e (Type extra) rewriteType rewriteBranch rewriteLeaf typeToRewrite = case typeToRewrite of Reference fQName argTypes extra -> - Reference fQName (argTypes |> List.map rewriteBranch) extra + argTypes + |> List.foldr + (\nextArg resultSoFar -> + Result.map2 (::) + (rewriteBranch nextArg) + resultSoFar + ) + (Ok []) + |> Result.map + (\args -> + Reference fQName args extra + ) Tuple elemTypes extra -> - Tuple (elemTypes |> List.map rewriteBranch) extra - - Record fields extra -> - Record (fields |> List.map (mapFieldType rewriteBranch)) extra + elemTypes + |> List.foldr + (\nextArg resultSoFar -> + Result.map2 (::) + (rewriteBranch nextArg) + resultSoFar + ) + (Ok []) + |> Result.map + (\elems -> + Tuple elems extra + ) - ExtensibleRecord varName fields extra -> - ExtensibleRecord varName (fields |> List.map (mapFieldType rewriteBranch)) extra + Record fieldTypes extra -> + fieldTypes + |> List.foldr + (\field resultSoFar -> + Result.map2 (::) + (rewriteBranch field.tpe + |> Result.map (Field field.name) + ) + resultSoFar + ) + (Ok []) + |> Result.map + (\fields -> + Record fields extra + ) + + ExtensibleRecord varName fieldTypes extra -> + fieldTypes + |> List.foldr + (\field resultSoFar -> + Result.map2 (::) + (rewriteBranch field.tpe + |> Result.map (Field field.name) + ) + resultSoFar + ) + (Ok []) + |> Result.map + (\fields -> + ExtensibleRecord varName fields extra + ) Function argType returnType extra -> - Function (argType |> rewriteBranch) (returnType |> rewriteBranch) extra + Result.map2 (\arg return -> Function arg return extra) + (rewriteBranch argType) + (rewriteBranch returnType) _ -> rewriteLeaf typeToRewrite -{-| Creates a field. - - toIR { foo = Int } - == record [ field [ "foo" ] SDK.Basics.intType ] - --} -field : Name -> Type extra -> Field extra -field fieldName fieldType = - Field fieldName fieldType - - {-| Matches a field. let @@ -580,24 +638,24 @@ field fieldName fieldType = -} matchField : Pattern Name a -> Pattern (Type extra) b -> Pattern (Field extra) ( a, b ) -matchField matchFieldName matchFieldType (Field fieldName fieldType) = +matchField matchFieldName matchFieldType field = Maybe.map2 Tuple.pair - (matchFieldName fieldName) - (matchFieldType fieldType) + (matchFieldName field.name) + (matchFieldType field.tpe) {-| Map the name of the field to get a new field. -} mapFieldName : (Name -> Name) -> Field extra -> Field extra -mapFieldName f (Field name tpe) = - Field (f name) tpe +mapFieldName f field = + Field (f field.name) field.tpe {-| Map the type of the field to get a new field. -} mapFieldType : (Type a -> Type b) -> Field a -> Field b -mapFieldType f (Field name tpe) = - Field name (f tpe) +mapFieldType f field = + Field field.name (f field.tpe) {-| Generate random types. @@ -797,10 +855,10 @@ decodeType decodeExtra = encodeField : (extra -> Encode.Value) -> Field extra -> Encode.Value -encodeField encodeExtra (Field fieldName fieldType) = +encodeField encodeExtra field = Encode.list identity - [ encodeName fieldName - , encodeType encodeExtra fieldType + [ encodeName field.name + , encodeType encodeExtra field.tpe ] diff --git a/src/Morphir/IR/Advanced/Value.elm b/src/Morphir/IR/Advanced/Value.elm index f4b48cea8..80b9207c6 100644 --- a/src/Morphir/IR/Advanced/Value.elm +++ b/src/Morphir/IR/Advanced/Value.elm @@ -70,6 +70,7 @@ import Json.Encode as Encode import Morphir.IR.Advanced.Type as Type exposing (Type, decodeType, encodeType) import Morphir.IR.FQName exposing (FQName, decodeFQName, encodeFQName) import Morphir.IR.Name exposing (Name, decodeName, encodeName) +import Morphir.ResultList as ResultList import String @@ -150,27 +151,41 @@ type Definition extra -- in -mapDeclaration : (Type a -> Type b) -> (Value a -> Value b) -> Declaration a -> Declaration b +mapDeclaration : (Type a -> Result e (Type b)) -> (Value a -> Value b) -> Declaration a -> Result (List e) (Declaration b) mapDeclaration mapType mapValue decl = - { inputs = - decl.inputs - |> List.map - (\( name, tpe ) -> - ( name, mapType tpe ) - ) - , output = - mapType decl.output - } + let + inputsResult = + decl.inputs + |> List.map + (\( name, tpe ) -> + mapType tpe + |> Result.map (Tuple.pair name) + ) + |> ResultList.toResult + + outputResult = + mapType decl.output + |> Result.mapError List.singleton + in + Result.map2 Declaration + inputsResult + outputResult -mapDefinition : (Type a -> Type b) -> (Value a -> Value b) -> Definition a -> Definition b +mapDefinition : (Type a -> Result e (Type b)) -> (Value a -> Value b) -> Definition a -> Result (List e) (Definition b) mapDefinition mapType mapValue def = case def of TypedDefinition tpe args body -> - TypedDefinition (mapType tpe) args (mapValue body) + mapType tpe + |> Result.map + (\t -> + TypedDefinition t args (mapValue body) + ) + |> Result.mapError List.singleton UntypedDefinition args body -> UntypedDefinition args (mapValue body) + |> Ok mapValueExtra : (a -> b) -> Value a -> Value b diff --git a/src/Morphir/Rewrite.elm b/src/Morphir/Rewrite.elm index 296ba5907..6c79cbb0c 100644 --- a/src/Morphir/Rewrite.elm +++ b/src/Morphir/Rewrite.elm @@ -14,8 +14,8 @@ import Morphir.Rule as Rule exposing (Rule) tree node. It takes two functions as input: a mapping that's applied to the children of branch nodes and one that is applied to leaf nodes. -} -type alias Rewrite a = - (a -> a) -> (a -> a) -> a -> a +type alias Rewrite e a = + (a -> Result e a) -> (a -> Result e a) -> a -> Result e a {-| Executes a rewrite using a top-down approach where the rules are @@ -23,15 +23,17 @@ applied to nodes from the root towards the leaf nodes. When a rule does not match the rewrite continues downward. When a rule matches it's applied and the rewrite process stops traversing downward in the subtree. -} -topDown : Rewrite a -> Rule a -> a -> a +topDown : Rewrite e a -> Rule e a -> a -> Result e a topDown rewrite rewriteRule nodeToRewrite = - rewriteRule nodeToRewrite - |> Maybe.withDefault - (rewrite + case rewriteRule nodeToRewrite of + Nothing -> + rewrite (topDown rewrite rewriteRule) - identity + (\a -> Ok a) nodeToRewrite - ) + + Just result -> + result {-| Executes a rewrite using a bottom-up approach where the rules are @@ -39,14 +41,22 @@ applied to nodes from the leaf nodes towards the root. Always traverses the entire tree regardless of rule matches but only changes the tree if a rule matches. -} -bottomUp : Rewrite a -> Rule a -> a -> a +bottomUp : Rewrite e a -> Rule e a -> a -> Result e a bottomUp rewrite rewriteRule nodeToRewrite = let + top : Result e a top = rewrite (\a -> bottomUp rewrite rewriteRule a) (Rule.defaultToOriginal rewriteRule) nodeToRewrite in - rewriteRule top - |> Maybe.withDefault top + case top |> Result.map rewriteRule of + Ok Nothing -> + top + + Ok (Just result) -> + result + + Err error -> + Err error diff --git a/src/Morphir/Rule.elm b/src/Morphir/Rule.elm index 08c0f1fc0..01cec0f53 100644 --- a/src/Morphir/Rule.elm +++ b/src/Morphir/Rule.elm @@ -24,8 +24,8 @@ import Morphir.Pattern exposing (Pattern) {-| Type that represents a rewrite rule which is a pattern that maps back to the same type. -} -type alias Rule a = - Pattern a a +type alias Rule e a = + Pattern a (Result e a) {-| Chains two rules together. @@ -46,10 +46,14 @@ type alias Rule a = rule 2 == Nothing -- rule1 does not match -} -andThen : (a -> Rule a) -> Rule a -> Rule a +andThen : (a -> Rule e a) -> Rule e a -> Rule e a andThen f rule a = - rule a - |> Maybe.andThen (f a) + case rule a of + Just (Ok firstRuleOut) -> + f firstRuleOut a + + other -> + other {-| Turns a rule into a function that will return the original value when the rule doesn't match. @@ -67,7 +71,11 @@ andThen f rule a = fun 13 == 13 -- rule doesn't match, original value returned -} -defaultToOriginal : Rule a -> a -> a +defaultToOriginal : Rule e a -> a -> Result e a defaultToOriginal rule a = - rule a - |> Maybe.withDefault a + case rule a of + Nothing -> + Ok a + + Just result -> + result diff --git a/tests/Morphir/Elm/FrontendTests.elm b/tests/Morphir/Elm/FrontendTests.elm index 734ca7bf0..7e51793f6 100644 --- a/tests/Morphir/Elm/FrontendTests.elm +++ b/tests/Morphir/Elm/FrontendTests.elm @@ -16,12 +16,14 @@ frontendTest : Test frontendTest = let sourceA = - { path = "A.elm" + { path = "My/Package/A.elm" , content = unindent """ -module A exposing (..) +module My.Package.A exposing (..) -type Foo = Foo Int +import My.Package.B exposing (Bee) + +type Foo = Foo Bee type alias Bar = Foo @@ -33,10 +35,12 @@ type alias Rec = } sourceB = - { path = "B.elm" + { path = "My/Package/B.elm" , content = unindent """ -module B exposing (..) +module My.Package.B exposing (..) + +type Bee = Bee """ } @@ -44,7 +48,10 @@ module B exposing (..) Path.fromString "my/package" moduleA = - Path.fromString "A" + Path.fromString "My.Package.A" + + moduleB = + Path.fromString "My.Package.B" packageInfo = { name = @@ -60,14 +67,14 @@ module B exposing (..) { dependencies = Dict.empty , modules = Dict.fromList - [ ( [ [ "a" ] ] + [ ( moduleA , public { types = Dict.fromList [ ( [ "bar" ] , public (Type.typeAliasDefinition [] - (Type.reference (fQName packageName moduleA [ "foo" ]) [] ()) + (Type.reference (fQName packageName [ [ "a" ] ] [ "foo" ]) [] ()) ) ) , ( [ "foo" ] @@ -75,7 +82,7 @@ module B exposing (..) (Type.customTypeDefinition [] (public [ ( [ "foo" ] - , [ ( [ "arg", "1" ], Type.reference (fQName [] [] [ "int" ]) [] () ) + , [ ( [ "arg", "1" ], Type.reference (fQName packageName [ [ "b" ] ] [ "bee" ]) [] () ) ] ) ] @@ -86,10 +93,10 @@ module B exposing (..) , public (Type.typeAliasDefinition [] (Type.record - [ Type.field [ "field", "1" ] - (Type.reference (fQName packageName moduleA [ "foo" ]) [] ()) - , Type.field [ "field", "2" ] - (Type.reference (fQName packageName moduleA [ "bar" ]) [] ()) + [ Type.Field [ "field", "1" ] + (Type.reference (fQName packageName [ [ "a" ] ] [ "foo" ]) [] ()) + , Type.Field [ "field", "2" ] + (Type.reference (fQName packageName [ [ "a" ] ] [ "bar" ]) [] ()) ] () ) @@ -100,10 +107,17 @@ module B exposing (..) Dict.empty } ) - , ( [ [ "b" ] ] + , ( moduleB , private { types = - Dict.empty + Dict.fromList + [ ( [ "bee" ] + , public + (Type.customTypeDefinition [] + (public [ ( [ "bee" ], [] ) ]) + ) + ) + ] , values = Dict.empty }