diff --git a/ir-migration/src/main.ts b/ir-migration/src/main.ts new file mode 100644 index 000000000..4bfee3494 --- /dev/null +++ b/ir-migration/src/main.ts @@ -0,0 +1,48 @@ +import * as fs from "fs"; +import * as util from "util"; +import * as path from "path"; +import * as v1 from "./migrations/v1Migration"; +import * as v2 from "./migrations/v2Migration"; +import * as v3 from "./migrations/v3Migration"; + +const fsReadFile = util.promisify(fs.readFile); + +type Json = object; + +type Migration = (previousVersion: Json) => Json; + +const MigrationList: Migration[] = [ + v1.Migration, + v2.Migration, + v3.Migration +]; + +/** + * This function loads the Morphir-ir-json from path supplied, checks if the version is update to date, and if not upgrades the IR automically. + * + * @param projectDir + * @param migrationList + * @returns Promise + */ +async function migrate(projectDir: string, migrationList: any): Promise { + const morphirIrPath: string = path.join(projectDir, "morphir-ir.json"); + const morphirIRJSON = JSON.parse( + (await fsReadFile(morphirIrPath)).toString() + ); + const loadedIRVersion = morphirIRJSON["formatVersion"]; + + if (loadedIRVersion != migrationList.length) { + let versionedIRJSON: Json = morphirIRJSON; + for (let i = loadedIRVersion; i < migrationList.length; i++) { + let nextMigrationtoRun = i - 1; // considering the 0 index of a List + let migration = migrationList[nextMigrationtoRun]; + versionedIRJSON = migration(morphirIRJSON); + } + return versionedIRJSON; + } else { + // do nothing. IR is latest + return morphirIRJSON; + } +} + +export { migrate, MigrationList, Json }; diff --git a/ir-migration/src/migrations/v1Migration.ts b/ir-migration/src/migrations/v1Migration.ts new file mode 100644 index 000000000..192c5f8a8 --- /dev/null +++ b/ir-migration/src/migrations/v1Migration.ts @@ -0,0 +1,14 @@ +import { Json } from "../../src/main"; + +export function Migration(iRJSON: Json): Json { + console.log("Migrating From v1 to v2"); + + // migration logic + + let finalIRJSON = { + formatVersion: iRJSON["formatVersion"] + 1, + distribution: [], + }; + + return finalIRJSON; +} diff --git a/ir-migration/src/migrations/v2Migration.ts b/ir-migration/src/migrations/v2Migration.ts new file mode 100644 index 000000000..90e9f56c2 --- /dev/null +++ b/ir-migration/src/migrations/v2Migration.ts @@ -0,0 +1,14 @@ +import { Json } from "../../src/main"; + +export function Migration(iRJSON: Json): Json { + console.log("Migrating From v2 to v3"); + + // migration logic + + let finalIRJSON = { + formatVersion: iRJSON["formatVersion"] + 1, + distribution: [], + }; + + return finalIRJSON; +} \ No newline at end of file diff --git a/ir-migration/src/migrations/v3Migration.ts b/ir-migration/src/migrations/v3Migration.ts new file mode 100644 index 000000000..a593a062a --- /dev/null +++ b/ir-migration/src/migrations/v3Migration.ts @@ -0,0 +1,14 @@ +import { Json } from "../../src/main"; + +export function Migration(iRJSON: Json): Json { + console.log("Migrating From v3 to v4"); + + // migration logic + + let finalIRJSON = { + formatVersion: iRJSON["formatVersion"] + 1, + distribution: [], + }; + + return finalIRJSON; +} \ No newline at end of file diff --git a/src/Morphir/IR/Distribution/Codec.elm b/src/Morphir/IR/Distribution/Codec.elm index cdc2c368b..727fcf79f 100644 --- a/src/Morphir/IR/Distribution/Codec.elm +++ b/src/Morphir/IR/Distribution/Codec.elm @@ -32,25 +32,18 @@ import Json.Encode as Encode import Morphir.Codec exposing (decodeUnit, encodeUnit) import Morphir.IR.Distribution exposing (Distribution(..)) import Morphir.IR.Distribution.CodecV1 as CodecV1 +import Morphir.IR.Distribution.CodecV2 as CodecV2 import Morphir.IR.Package.Codec as PackageCodec import Morphir.IR.Path.Codec exposing (decodePath, encodePath) import Morphir.IR.Type.Codec exposing (decodeType, encodeType) -{-| This is a manually managed version number to be able to handle breaking changes in the IR format more explicitly. --} -currentFormatVersion : Int -currentFormatVersion = - 2 - - {-| Encode distribution including a version number. -} encodeVersionedDistribution : Distribution -> Encode.Value encodeVersionedDistribution distro = Encode.object - [ ( "formatVersion", Encode.int currentFormatVersion ) - , ( "distribution", encodeDistribution distro ) + [ ( "distribution", encodeDistribution distro ) ] @@ -59,27 +52,7 @@ encodeVersionedDistribution distro = decodeVersionedDistribution : Decode.Decoder Distribution decodeVersionedDistribution = Decode.oneOf - [ Decode.field "formatVersion" Decode.int - |> Decode.andThen - (\formatVersion -> - if formatVersion == currentFormatVersion then - Decode.field "distribution" decodeDistribution - - else if formatVersion == 1 then - Decode.field "distribution" CodecV1.decodeDistribution - - else - Decode.fail - (String.concat - [ "The IR is using format version " - , String.fromInt formatVersion - , " but the latest format version is " - , String.fromInt currentFormatVersion - , ". Please regenerate it!" - ] - ) - ) - , Decode.fail "The IR is in an old format that doesn't have a format version on it. Please regenerate it!" + [ Decode.field "distribution" decodeDistribution ] diff --git a/src/Morphir/IR/Distribution/CodecV2.elm b/src/Morphir/IR/Distribution/CodecV2.elm new file mode 100644 index 000000000..e8ffb3e80 --- /dev/null +++ b/src/Morphir/IR/Distribution/CodecV2.elm @@ -0,0 +1,135 @@ +{- + Copyright 2020 Morgan Stanley + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-} + + +module Morphir.IR.Distribution.CodecV2 exposing (encodeVersionedDistribution, decodeVersionedDistribution, encodeDistribution, decodeDistribution) + +{-| Codecs for types in the `Morphir.IR.Distribution` module. + + +# Distribution + +@docs encodeVersionedDistribution, decodeVersionedDistribution, encodeDistribution, decodeDistribution + +-} + +import Dict +import Json.Decode as Decode +import Json.Encode as Encode +import Morphir.Codec exposing (decodeUnit, encodeUnit) +import Morphir.IR.Distribution exposing (Distribution(..)) +import Morphir.IR.Distribution.CodecV1 as CodecV1 +import Morphir.IR.Package.Codec as PackageCodec +import Morphir.IR.Path.Codec exposing (decodePath, encodePath) +import Morphir.IR.Type.Codec exposing (decodeType, encodeType) + + +{-| This is a manually managed version number to be able to handle breaking changes in the IR format more explicitly. +-} +currentFormatVersion : Int +currentFormatVersion = + 2 + + +{-| Encode distribution including a version number. +-} +encodeVersionedDistribution : Distribution -> Encode.Value +encodeVersionedDistribution distro = + Encode.object + [ ( "formatVersion", Encode.int currentFormatVersion ) + , ( "distribution", encodeDistribution distro ) + ] + + +{-| Decode distribution including a version number. +-} +decodeVersionedDistribution : Decode.Decoder Distribution +decodeVersionedDistribution = + Decode.oneOf + [ Decode.field "formatVersion" Decode.int + |> Decode.andThen + (\formatVersion -> + if formatVersion == currentFormatVersion then + Decode.field "distribution" decodeDistribution + + else if formatVersion == 1 then + Decode.field "distribution" CodecV1.decodeDistribution + + else + Decode.fail + (String.concat + [ "The IR is using format version " + , String.fromInt formatVersion + , " but the latest format version is " + , String.fromInt currentFormatVersion + , ". Please regenerate it!" + ] + ) + ) + , Decode.fail "The IR is in an old format that doesn't have a format version on it. Please regenerate it!" + ] + + +{-| Encode Distribution. +-} +encodeDistribution : Distribution -> Encode.Value +encodeDistribution distro = + case distro of + Library packagePath dependencies def -> + Encode.list identity + [ Encode.string "Library" + , encodePath packagePath + , dependencies + |> Dict.toList + |> Encode.list + (\( packageName, packageSpec ) -> + Encode.list identity + [ encodePath packageName + , PackageCodec.encodeSpecification encodeUnit packageSpec + ] + ) + , def + |> PackageCodec.encodeDefinition encodeUnit + (encodeType encodeUnit) + ] + + +{-| Decode Distribution. +-} +decodeDistribution : Decode.Decoder Distribution +decodeDistribution = + Decode.index 0 Decode.string + |> Decode.andThen + (\kind -> + case kind of + "Library" -> + Decode.map3 Library + (Decode.index 1 decodePath) + (Decode.index 2 + (Decode.map Dict.fromList + (Decode.list + (Decode.map2 Tuple.pair + (Decode.index 0 decodePath) + (Decode.index 1 (PackageCodec.decodeSpecification decodeUnit)) + ) + ) + ) + ) + (Decode.index 3 (PackageCodec.decodeDefinition decodeUnit (decodeType decodeUnit))) + + other -> + Decode.fail <| "Unknown value type: " ++ other + ) diff --git a/src/Morphir/IR/Value/Codec.elm b/src/Morphir/IR/Value/Codec.elm index 9783223fb..6cfa9ada1 100644 --- a/src/Morphir/IR/Value/Codec.elm +++ b/src/Morphir/IR/Value/Codec.elm @@ -32,35 +32,35 @@ encodeValue encodeTypeAttributes encodeValueAttributes v = case v of Literal a value -> Encode.list identity - [ Encode.string "literal" + [ Encode.string "Literal" , encodeValueAttributes a , encodeLiteral value ] Constructor a fullyQualifiedName -> Encode.list identity - [ Encode.string "constructor" + [ Encode.string "Constructor" , encodeValueAttributes a , encodeFQName fullyQualifiedName ] Tuple a elements -> Encode.list identity - [ Encode.string "tuple" + [ Encode.string "Tuple" , encodeValueAttributes a , elements |> Encode.list (encodeValue encodeTypeAttributes encodeValueAttributes) ] List a items -> Encode.list identity - [ Encode.string "list" + [ Encode.string "List" , encodeValueAttributes a , items |> Encode.list (encodeValue encodeTypeAttributes encodeValueAttributes) ] Record a fields -> Encode.list identity - [ Encode.string "record" + [ Encode.string "Record" , encodeValueAttributes a , fields |> Dict.toList @@ -75,21 +75,21 @@ encodeValue encodeTypeAttributes encodeValueAttributes v = Variable a name -> Encode.list identity - [ Encode.string "variable" + [ Encode.string "Variable" , encodeValueAttributes a , encodeName name ] Reference a fullyQualifiedName -> Encode.list identity - [ Encode.string "reference" + [ Encode.string "Reference" , encodeValueAttributes a , encodeFQName fullyQualifiedName ] Field a subjectValue fieldName -> Encode.list identity - [ Encode.string "field" + [ Encode.string "Field" , encodeValueAttributes a , encodeValue encodeTypeAttributes encodeValueAttributes subjectValue , encodeName fieldName @@ -97,14 +97,14 @@ encodeValue encodeTypeAttributes encodeValueAttributes v = FieldFunction a fieldName -> Encode.list identity - [ Encode.string "field_function" + [ Encode.string "FieldFunction" , encodeValueAttributes a , encodeName fieldName ] Apply a function argument -> Encode.list identity - [ Encode.string "apply" + [ Encode.string "Apply" , encodeValueAttributes a , encodeValue encodeTypeAttributes encodeValueAttributes function , encodeValue encodeTypeAttributes encodeValueAttributes argument @@ -112,7 +112,7 @@ encodeValue encodeTypeAttributes encodeValueAttributes v = Lambda a argumentPattern body -> Encode.list identity - [ Encode.string "lambda" + [ Encode.string "Lambda" , encodeValueAttributes a , encodePattern encodeValueAttributes argumentPattern , encodeValue encodeTypeAttributes encodeValueAttributes body @@ -120,7 +120,7 @@ encodeValue encodeTypeAttributes encodeValueAttributes v = LetDefinition a valueName valueDefinition inValue -> Encode.list identity - [ Encode.string "let_definition" + [ Encode.string "LetDefinition" , encodeValueAttributes a , encodeName valueName , encodeDefinition encodeTypeAttributes encodeValueAttributes valueDefinition @@ -129,7 +129,7 @@ encodeValue encodeTypeAttributes encodeValueAttributes v = LetRecursion a valueDefinitions inValue -> Encode.list identity - [ Encode.string "let_recursion" + [ Encode.string "LetRecursion" , encodeValueAttributes a , valueDefinitions |> Dict.toList @@ -145,7 +145,7 @@ encodeValue encodeTypeAttributes encodeValueAttributes v = Destructure a pattern valueToDestruct inValue -> Encode.list identity - [ Encode.string "destructure" + [ Encode.string "Destructure" , encodeValueAttributes a , encodePattern encodeValueAttributes pattern , encodeValue encodeTypeAttributes encodeValueAttributes valueToDestruct @@ -154,7 +154,7 @@ encodeValue encodeTypeAttributes encodeValueAttributes v = IfThenElse a condition thenBranch elseBranch -> Encode.list identity - [ Encode.string "if_then_else" + [ Encode.string "IfThenElse" , encodeValueAttributes a , encodeValue encodeTypeAttributes encodeValueAttributes condition , encodeValue encodeTypeAttributes encodeValueAttributes thenBranch @@ -163,7 +163,7 @@ encodeValue encodeTypeAttributes encodeValueAttributes v = PatternMatch a branchOutOn cases -> Encode.list identity - [ Encode.string "pattern_match" + [ Encode.string "PatternMatch" , encodeValueAttributes a , encodeValue encodeTypeAttributes encodeValueAttributes branchOutOn , cases @@ -178,7 +178,7 @@ encodeValue encodeTypeAttributes encodeValueAttributes v = UpdateRecord a valueToUpdate fieldsToUpdate -> Encode.list identity - [ Encode.string "update_record" + [ Encode.string "UpdateRecord" , encodeValueAttributes a , encodeValue encodeTypeAttributes encodeValueAttributes valueToUpdate , fieldsToUpdate @@ -194,7 +194,7 @@ encodeValue encodeTypeAttributes encodeValueAttributes v = Unit a -> Encode.list identity - [ Encode.string "unit" + [ Encode.string "Unit" , encodeValueAttributes a ] @@ -211,27 +211,27 @@ decodeValue decodeTypeAttributes decodeValueAttributes = |> Decode.andThen (\kind -> case kind of - "literal" -> + "Literal" -> Decode.map2 Literal (Decode.index 1 decodeValueAttributes) (Decode.index 2 decodeLiteral) - "constructor" -> + "Constructor" -> Decode.map2 Constructor (Decode.index 1 decodeValueAttributes) (Decode.index 2 decodeFQName) - "tuple" -> + "Tuple" -> Decode.map2 Tuple (Decode.index 1 decodeValueAttributes) (Decode.index 2 <| Decode.list lazyDecodeValue) - "list" -> + "List" -> Decode.map2 List (Decode.index 1 decodeValueAttributes) (Decode.index 2 <| Decode.list lazyDecodeValue) - "record" -> + "Record" -> Decode.map2 Record (Decode.index 1 decodeValueAttributes) (Decode.index 2 @@ -244,47 +244,47 @@ decodeValue decodeTypeAttributes decodeValueAttributes = ) ) - "variable" -> + "Variable" -> Decode.map2 Variable (Decode.index 1 decodeValueAttributes) (Decode.index 2 decodeName) - "reference" -> + "Reference" -> Decode.map2 Reference (Decode.index 1 decodeValueAttributes) (Decode.index 2 decodeFQName) - "field" -> + "Field" -> Decode.map3 Field (Decode.index 1 decodeValueAttributes) (Decode.index 2 <| decodeValue decodeTypeAttributes decodeValueAttributes) (Decode.index 3 decodeName) - "field_function" -> + "FieldFunction" -> Decode.map2 FieldFunction (Decode.index 1 decodeValueAttributes) (Decode.index 2 decodeName) - "apply" -> + "Apply" -> Decode.map3 Apply (Decode.index 1 decodeValueAttributes) (Decode.index 2 <| decodeValue decodeTypeAttributes decodeValueAttributes) (Decode.index 3 <| decodeValue decodeTypeAttributes decodeValueAttributes) - "lambda" -> + "Lambda" -> Decode.map3 Lambda (Decode.index 1 decodeValueAttributes) (Decode.index 2 <| decodePattern decodeValueAttributes) (Decode.index 3 <| decodeValue decodeTypeAttributes decodeValueAttributes) - "let_definition" -> + "LetDefinition" -> Decode.map4 LetDefinition (Decode.index 1 decodeValueAttributes) (Decode.index 2 decodeName) (Decode.index 3 <| decodeDefinition decodeTypeAttributes decodeValueAttributes) (Decode.index 4 <| decodeValue decodeTypeAttributes decodeValueAttributes) - "let_recursion" -> + "LetRecursion" -> Decode.map3 LetRecursion (Decode.index 1 decodeValueAttributes) (Decode.index 2 @@ -298,21 +298,21 @@ decodeValue decodeTypeAttributes decodeValueAttributes = ) (Decode.index 3 <| decodeValue decodeTypeAttributes decodeValueAttributes) - "destructure" -> + "Destructure" -> Decode.map4 Destructure (Decode.index 1 decodeValueAttributes) (Decode.index 2 <| decodePattern decodeValueAttributes) (Decode.index 3 <| decodeValue decodeTypeAttributes decodeValueAttributes) (Decode.index 4 <| decodeValue decodeTypeAttributes decodeValueAttributes) - "if_then_else" -> + "IfThenElse" -> Decode.map4 IfThenElse (Decode.index 1 decodeValueAttributes) (Decode.index 2 <| decodeValue decodeTypeAttributes decodeValueAttributes) (Decode.index 3 <| decodeValue decodeTypeAttributes decodeValueAttributes) (Decode.index 4 <| decodeValue decodeTypeAttributes decodeValueAttributes) - "pattern_match" -> + "PatternMatch" -> Decode.map3 PatternMatch (Decode.index 1 decodeValueAttributes) (Decode.index 2 <| decodeValue decodeTypeAttributes decodeValueAttributes) @@ -324,7 +324,7 @@ decodeValue decodeTypeAttributes decodeValueAttributes = ) ) - "update_record" -> + "UpdateRecord" -> Decode.map3 UpdateRecord (Decode.index 1 decodeValueAttributes) (Decode.index 2 (decodeValue decodeTypeAttributes decodeValueAttributes)) @@ -333,11 +333,12 @@ decodeValue decodeTypeAttributes decodeValueAttributes = (Decode.map2 Tuple.pair (Decode.index 0 decodeName) (Decode.index 1 (decodeValue decodeTypeAttributes decodeValueAttributes)) - ) |> Decode.map Dict.fromList + ) + |> Decode.map Dict.fromList ) ) - "unit" -> + "Unit" -> Decode.map Unit (Decode.index 1 decodeValueAttributes) diff --git a/src/Morphir/IR/Value/CodecV2.elm b/src/Morphir/IR/Value/CodecV2.elm new file mode 100644 index 000000000..9783223fb --- /dev/null +++ b/src/Morphir/IR/Value/CodecV2.elm @@ -0,0 +1,529 @@ +{- + Copyright 2020 Morgan Stanley + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +-} + + +module Morphir.IR.Value.Codec exposing (..) + +import Dict +import Json.Decode as Decode +import Json.Encode as Encode +import Morphir.IR.FQName.Codec exposing (decodeFQName, encodeFQName) +import Morphir.IR.Literal.Codec exposing (decodeLiteral, encodeLiteral) +import Morphir.IR.Name.Codec exposing (decodeName, encodeName) +import Morphir.IR.Type.Codec exposing (decodeType, encodeType) +import Morphir.IR.Value exposing (Definition, Pattern(..), Specification, Value(..)) + + +encodeValue : (ta -> Encode.Value) -> (va -> Encode.Value) -> Value ta va -> Encode.Value +encodeValue encodeTypeAttributes encodeValueAttributes v = + case v of + Literal a value -> + Encode.list identity + [ Encode.string "literal" + , encodeValueAttributes a + , encodeLiteral value + ] + + Constructor a fullyQualifiedName -> + Encode.list identity + [ Encode.string "constructor" + , encodeValueAttributes a + , encodeFQName fullyQualifiedName + ] + + Tuple a elements -> + Encode.list identity + [ Encode.string "tuple" + , encodeValueAttributes a + , elements |> Encode.list (encodeValue encodeTypeAttributes encodeValueAttributes) + ] + + List a items -> + Encode.list identity + [ Encode.string "list" + , encodeValueAttributes a + , items |> Encode.list (encodeValue encodeTypeAttributes encodeValueAttributes) + ] + + Record a fields -> + Encode.list identity + [ Encode.string "record" + , encodeValueAttributes a + , fields + |> Dict.toList + |> Encode.list + (\( fieldName, fieldValue ) -> + Encode.list identity + [ encodeName fieldName + , encodeValue encodeTypeAttributes encodeValueAttributes fieldValue + ] + ) + ] + + Variable a name -> + Encode.list identity + [ Encode.string "variable" + , encodeValueAttributes a + , encodeName name + ] + + Reference a fullyQualifiedName -> + Encode.list identity + [ Encode.string "reference" + , encodeValueAttributes a + , encodeFQName fullyQualifiedName + ] + + Field a subjectValue fieldName -> + Encode.list identity + [ Encode.string "field" + , encodeValueAttributes a + , encodeValue encodeTypeAttributes encodeValueAttributes subjectValue + , encodeName fieldName + ] + + FieldFunction a fieldName -> + Encode.list identity + [ Encode.string "field_function" + , encodeValueAttributes a + , encodeName fieldName + ] + + Apply a function argument -> + Encode.list identity + [ Encode.string "apply" + , encodeValueAttributes a + , encodeValue encodeTypeAttributes encodeValueAttributes function + , encodeValue encodeTypeAttributes encodeValueAttributes argument + ] + + Lambda a argumentPattern body -> + Encode.list identity + [ Encode.string "lambda" + , encodeValueAttributes a + , encodePattern encodeValueAttributes argumentPattern + , encodeValue encodeTypeAttributes encodeValueAttributes body + ] + + LetDefinition a valueName valueDefinition inValue -> + Encode.list identity + [ Encode.string "let_definition" + , encodeValueAttributes a + , encodeName valueName + , encodeDefinition encodeTypeAttributes encodeValueAttributes valueDefinition + , encodeValue encodeTypeAttributes encodeValueAttributes inValue + ] + + LetRecursion a valueDefinitions inValue -> + Encode.list identity + [ Encode.string "let_recursion" + , encodeValueAttributes a + , valueDefinitions + |> Dict.toList + |> Encode.list + (\( name, def ) -> + Encode.list identity + [ encodeName name + , encodeDefinition encodeTypeAttributes encodeValueAttributes def + ] + ) + , encodeValue encodeTypeAttributes encodeValueAttributes inValue + ] + + Destructure a pattern valueToDestruct inValue -> + Encode.list identity + [ Encode.string "destructure" + , encodeValueAttributes a + , encodePattern encodeValueAttributes pattern + , encodeValue encodeTypeAttributes encodeValueAttributes valueToDestruct + , encodeValue encodeTypeAttributes encodeValueAttributes inValue + ] + + IfThenElse a condition thenBranch elseBranch -> + Encode.list identity + [ Encode.string "if_then_else" + , encodeValueAttributes a + , encodeValue encodeTypeAttributes encodeValueAttributes condition + , encodeValue encodeTypeAttributes encodeValueAttributes thenBranch + , encodeValue encodeTypeAttributes encodeValueAttributes elseBranch + ] + + PatternMatch a branchOutOn cases -> + Encode.list identity + [ Encode.string "pattern_match" + , encodeValueAttributes a + , encodeValue encodeTypeAttributes encodeValueAttributes branchOutOn + , cases + |> Encode.list + (\( pattern, body ) -> + Encode.list identity + [ encodePattern encodeValueAttributes pattern + , encodeValue encodeTypeAttributes encodeValueAttributes body + ] + ) + ] + + UpdateRecord a valueToUpdate fieldsToUpdate -> + Encode.list identity + [ Encode.string "update_record" + , encodeValueAttributes a + , encodeValue encodeTypeAttributes encodeValueAttributes valueToUpdate + , fieldsToUpdate + |> Dict.toList + |> Encode.list + (\( fieldName, fieldValue ) -> + Encode.list identity + [ encodeName fieldName + , encodeValue encodeTypeAttributes encodeValueAttributes fieldValue + ] + ) + ] + + Unit a -> + Encode.list identity + [ Encode.string "unit" + , encodeValueAttributes a + ] + + +decodeValue : Decode.Decoder ta -> Decode.Decoder va -> Decode.Decoder (Value ta va) +decodeValue decodeTypeAttributes decodeValueAttributes = + let + lazyDecodeValue = + Decode.lazy <| + \_ -> + decodeValue decodeTypeAttributes decodeValueAttributes + in + Decode.index 0 Decode.string + |> Decode.andThen + (\kind -> + case kind of + "literal" -> + Decode.map2 Literal + (Decode.index 1 decodeValueAttributes) + (Decode.index 2 decodeLiteral) + + "constructor" -> + Decode.map2 Constructor + (Decode.index 1 decodeValueAttributes) + (Decode.index 2 decodeFQName) + + "tuple" -> + Decode.map2 Tuple + (Decode.index 1 decodeValueAttributes) + (Decode.index 2 <| Decode.list lazyDecodeValue) + + "list" -> + Decode.map2 List + (Decode.index 1 decodeValueAttributes) + (Decode.index 2 <| Decode.list lazyDecodeValue) + + "record" -> + Decode.map2 Record + (Decode.index 1 decodeValueAttributes) + (Decode.index 2 + (Decode.list + (Decode.map2 Tuple.pair + (Decode.index 0 decodeName) + (Decode.index 1 <| decodeValue decodeTypeAttributes decodeValueAttributes) + ) + |> Decode.map Dict.fromList + ) + ) + + "variable" -> + Decode.map2 Variable + (Decode.index 1 decodeValueAttributes) + (Decode.index 2 decodeName) + + "reference" -> + Decode.map2 Reference + (Decode.index 1 decodeValueAttributes) + (Decode.index 2 decodeFQName) + + "field" -> + Decode.map3 Field + (Decode.index 1 decodeValueAttributes) + (Decode.index 2 <| decodeValue decodeTypeAttributes decodeValueAttributes) + (Decode.index 3 decodeName) + + "field_function" -> + Decode.map2 FieldFunction + (Decode.index 1 decodeValueAttributes) + (Decode.index 2 decodeName) + + "apply" -> + Decode.map3 Apply + (Decode.index 1 decodeValueAttributes) + (Decode.index 2 <| decodeValue decodeTypeAttributes decodeValueAttributes) + (Decode.index 3 <| decodeValue decodeTypeAttributes decodeValueAttributes) + + "lambda" -> + Decode.map3 Lambda + (Decode.index 1 decodeValueAttributes) + (Decode.index 2 <| decodePattern decodeValueAttributes) + (Decode.index 3 <| decodeValue decodeTypeAttributes decodeValueAttributes) + + "let_definition" -> + Decode.map4 LetDefinition + (Decode.index 1 decodeValueAttributes) + (Decode.index 2 decodeName) + (Decode.index 3 <| decodeDefinition decodeTypeAttributes decodeValueAttributes) + (Decode.index 4 <| decodeValue decodeTypeAttributes decodeValueAttributes) + + "let_recursion" -> + Decode.map3 LetRecursion + (Decode.index 1 decodeValueAttributes) + (Decode.index 2 + (Decode.list + (Decode.map2 Tuple.pair + (Decode.index 0 decodeName) + (Decode.index 1 <| decodeDefinition decodeTypeAttributes decodeValueAttributes) + ) + |> Decode.map Dict.fromList + ) + ) + (Decode.index 3 <| decodeValue decodeTypeAttributes decodeValueAttributes) + + "destructure" -> + Decode.map4 Destructure + (Decode.index 1 decodeValueAttributes) + (Decode.index 2 <| decodePattern decodeValueAttributes) + (Decode.index 3 <| decodeValue decodeTypeAttributes decodeValueAttributes) + (Decode.index 4 <| decodeValue decodeTypeAttributes decodeValueAttributes) + + "if_then_else" -> + Decode.map4 IfThenElse + (Decode.index 1 decodeValueAttributes) + (Decode.index 2 <| decodeValue decodeTypeAttributes decodeValueAttributes) + (Decode.index 3 <| decodeValue decodeTypeAttributes decodeValueAttributes) + (Decode.index 4 <| decodeValue decodeTypeAttributes decodeValueAttributes) + + "pattern_match" -> + Decode.map3 PatternMatch + (Decode.index 1 decodeValueAttributes) + (Decode.index 2 <| decodeValue decodeTypeAttributes decodeValueAttributes) + (Decode.index 3 <| + Decode.list + (Decode.map2 Tuple.pair + (Decode.index 0 (decodePattern decodeValueAttributes)) + (Decode.index 1 (decodeValue decodeTypeAttributes decodeValueAttributes)) + ) + ) + + "update_record" -> + Decode.map3 UpdateRecord + (Decode.index 1 decodeValueAttributes) + (Decode.index 2 (decodeValue decodeTypeAttributes decodeValueAttributes)) + (Decode.index 3 + (Decode.list + (Decode.map2 Tuple.pair + (Decode.index 0 decodeName) + (Decode.index 1 (decodeValue decodeTypeAttributes decodeValueAttributes)) + ) |> Decode.map Dict.fromList + ) + ) + + "unit" -> + Decode.map Unit + (Decode.index 1 decodeValueAttributes) + + other -> + Decode.fail <| "Unknown value type: " ++ other + ) + + +encodePattern : (a -> Encode.Value) -> Pattern a -> Encode.Value +encodePattern encodeAttributes pattern = + case pattern of + WildcardPattern a -> + Encode.list identity + [ Encode.string "wildcard_pattern" + , encodeAttributes a + ] + + AsPattern a p name -> + Encode.list identity + [ Encode.string "as_pattern" + , encodeAttributes a + , encodePattern encodeAttributes p + , encodeName name + ] + + TuplePattern a elementPatterns -> + Encode.list identity + [ Encode.string "tuple_pattern" + , encodeAttributes a + , elementPatterns |> Encode.list (encodePattern encodeAttributes) + ] + + ConstructorPattern a constructorName argumentPatterns -> + Encode.list identity + [ Encode.string "constructor_pattern" + , encodeAttributes a + , encodeFQName constructorName + , argumentPatterns |> Encode.list (encodePattern encodeAttributes) + ] + + EmptyListPattern a -> + Encode.list identity + [ Encode.string "empty_list_pattern" + , encodeAttributes a + ] + + HeadTailPattern a headPattern tailPattern -> + Encode.list identity + [ Encode.string "head_tail_pattern" + , encodeAttributes a + , encodePattern encodeAttributes headPattern + , encodePattern encodeAttributes tailPattern + ] + + LiteralPattern a value -> + Encode.list identity + [ Encode.string "literal_pattern" + , encodeAttributes a + , encodeLiteral value + ] + + UnitPattern a -> + Encode.list identity + [ Encode.string "unit_pattern" + , encodeAttributes a + ] + + +decodePattern : Decode.Decoder a -> Decode.Decoder (Pattern a) +decodePattern decodeAttributes = + let + lazyDecodePattern = + Decode.lazy <| + \_ -> + decodePattern decodeAttributes + in + Decode.index 0 Decode.string + |> Decode.andThen + (\kind -> + case kind of + "wildcard_pattern" -> + Decode.map WildcardPattern + (Decode.index 1 decodeAttributes) + + "as_pattern" -> + Decode.map3 AsPattern + (Decode.index 1 decodeAttributes) + (Decode.index 2 lazyDecodePattern) + (Decode.index 3 decodeName) + + "tuple_pattern" -> + Decode.map2 TuplePattern + (Decode.index 1 decodeAttributes) + (Decode.index 2 <| Decode.list lazyDecodePattern) + + "constructor_pattern" -> + Decode.map3 ConstructorPattern + (Decode.index 1 decodeAttributes) + (Decode.index 2 decodeFQName) + (Decode.index 3 <| Decode.list lazyDecodePattern) + + "empty_list_pattern" -> + Decode.map EmptyListPattern + (Decode.index 1 decodeAttributes) + + "head_tail_pattern" -> + Decode.map3 HeadTailPattern + (Decode.index 1 decodeAttributes) + (Decode.index 2 lazyDecodePattern) + (Decode.index 3 lazyDecodePattern) + + "literal_pattern" -> + Decode.map2 LiteralPattern + (Decode.index 1 decodeAttributes) + (Decode.index 2 decodeLiteral) + + "unit_pattern" -> + Decode.map UnitPattern + (Decode.index 1 decodeAttributes) + + other -> + Decode.fail <| "Unknown pattern type: " ++ other + ) + + +encodeSpecification : (a -> Encode.Value) -> Specification a -> Encode.Value +encodeSpecification encodeAttributes spec = + Encode.object + [ ( "inputs" + , spec.inputs + |> Encode.list + (\( argName, argType ) -> + Encode.list identity + [ encodeName argName + , encodeType encodeAttributes argType + ] + ) + ) + , ( "output", encodeType encodeAttributes spec.output ) + ] + + +decodeSpecification : Decode.Decoder ta -> Decode.Decoder (Specification ta) +decodeSpecification decodeTypeAttributes = + Decode.map2 Specification + (Decode.field "inputs" + (Decode.list + (Decode.map2 Tuple.pair + (Decode.index 0 decodeName) + (Decode.index 1 (decodeType decodeTypeAttributes)) + ) + ) + ) + (Decode.field "output" (decodeType decodeTypeAttributes)) + + +encodeDefinition : (ta -> Encode.Value) -> (va -> Encode.Value) -> Definition ta va -> Encode.Value +encodeDefinition encodeTypeAttributes encodeValueAttributes def = + Encode.object + [ ( "inputTypes" + , def.inputTypes + |> Encode.list + (\( argName, a, argType ) -> + Encode.list identity + [ encodeName argName + , encodeValueAttributes a + , encodeType encodeTypeAttributes argType + ] + ) + ) + , ( "outputType", encodeType encodeTypeAttributes def.outputType ) + , ( "body", encodeValue encodeTypeAttributes encodeValueAttributes def.body ) + ] + + +decodeDefinition : Decode.Decoder ta -> Decode.Decoder va -> Decode.Decoder (Definition ta va) +decodeDefinition decodeTypeAttributes decodeValueAttributes = + Decode.map3 Definition + (Decode.field "inputTypes" + (Decode.list + (Decode.map3 (\n a t -> ( n, a, t )) + (Decode.index 0 decodeName) + (Decode.index 1 decodeValueAttributes) + (Decode.index 2 (decodeType decodeTypeAttributes)) + ) + ) + ) + (Decode.field "outputType" (decodeType decodeTypeAttributes)) + (Decode.field "body" (Decode.lazy (\_ -> decodeValue decodeTypeAttributes decodeValueAttributes))) diff --git a/tests-integration/ir-migration/migration.test.ts b/tests-integration/ir-migration/migration.test.ts new file mode 100644 index 000000000..323e86837 --- /dev/null +++ b/tests-integration/ir-migration/migration.test.ts @@ -0,0 +1,49 @@ +// imports +const fs = require("fs"); +const util = require("util"); +const migration = require("../../ir-migration/src/main"); +const fsWriteFile = util.promisify(fs.writeFile); +const fsReadFile = util.promisify(fs.readFile); + +describe("IR Migration Test", () => { + + test("Validating If IR format is latest", async () => { + const morphirIRJSON = { + formatVersion: migration.MigrationList.length, + distribution: [], + }; + await fsWriteFile("./morphir-ir.json", JSON.stringify(morphirIRJSON)); + + const migratedIR = await migration.migrate("./", migration.MigrationList); + + expect(morphirIRJSON.formatVersion).toEqual(migratedIR.formatVersion); + }); + + + test("Validating Previous IR is Migrated", async () => { + const morphirIRJSON = { + formatVersion: 1, + distribution: [], + }; + await fsWriteFile("./morphir-ir.json", JSON.stringify(morphirIRJSON)); + + const migratedIR = await migration.migrate("./", migration.MigrationList); + + expect(migratedIR.formatVersion).toBeGreaterThan( + morphirIRJSON.formatVersion + ); + }); + + + test("Validating Specific Migration", async () => { + const morphirIRJSON = { + formatVersion: 2, + distribution: [], + }; + await fsWriteFile("./morphir-ir.json", JSON.stringify(morphirIRJSON)); + + const migratedIR = await migration.migrate("./", migration.MigrationList); + + expect(migratedIR.formatVersion).toEqual(3); + }); +});