From d12d3bfbc99b186b7c4612bea64fbd25f79edcb7 Mon Sep 17 00:00:00 2001 From: Elorm-Axolu Date: Thu, 13 Jul 2023 08:26:02 +0000 Subject: [PATCH 1/4] missing dick sdk function 80% completed --- src/Morphir/IR/SDK/Dict.elm | 270 +++++++++++++++++- src/Morphir/Value/Native.elm | 45 ++- .../reference-model/morphir-tests.json | 92 ++++++ .../src/Morphir/Reference/Model/SDK/Dict.elm | 31 +- 4 files changed, 415 insertions(+), 23 deletions(-) diff --git a/src/Morphir/IR/SDK/Dict.elm b/src/Morphir/IR/SDK/Dict.elm index c08ac42f1..b14184483 100644 --- a/src/Morphir/IR/SDK/Dict.elm +++ b/src/Morphir/IR/SDK/Dict.elm @@ -29,8 +29,10 @@ import Morphir.IR.SDK.List exposing (listType) import Morphir.IR.SDK.Maybe exposing (just, maybeType, nothing) import Morphir.IR.Type as Type exposing (Specification(..), Type(..)) import Morphir.IR.Value as Value exposing (RawValue, Value) +import Morphir.SDK.Dict as SDKDict +import Morphir.SDK.ResultList as ResultList import Morphir.Value.Error exposing (Error(..)) -import Morphir.Value.Native as Native +import Morphir.Value.Native as Native exposing (eval1) import Morphir.Value.Native.Comparable exposing (compareValue) @@ -41,7 +43,7 @@ moduleName = typeSpec : Specification () typeSpec = - DerivedTypeSpecification [["comparable"], ["v"] ] + DerivedTypeSpecification [ [ "comparable" ], [ "v" ] ] { baseType = listType () (Type.Tuple () [ tVar "comparable", tVar "v" ]) , toBaseType = toFQName moduleName "toList" , fromBaseType = toFQName moduleName "fromList" @@ -149,7 +151,6 @@ fromListValue a list = Value.Apply a (Value.Reference a ( [ [ "morphir" ], [ "s", "d", "k" ] ], [ [ "dict" ] ], [ "from", "list" ] )) list - nativeFunctions : List ( String, Native.Function ) nativeFunctions = [ ( "empty" @@ -300,6 +301,8 @@ nativeFunctions = Err (UnexpectedArguments [ dict ]) ) ) + + {- Query -} , ( "isEmpty" , Native.unaryStrict (\_ dict -> @@ -458,7 +461,7 @@ nativeFunctions = Err (UnexpectedArguments [ dict ]) ) ) - , ( "value" + , ( "values" , Native.unaryStrict (\_ dict -> case dict of @@ -488,12 +491,257 @@ nativeFunctions = Err (UnexpectedArguments [ dict ]) ) ) - , ( "toList", Native.unaryStrict (\_ arg -> - case arg of - Value.Apply _ (Value.Reference _ ( [ [ "morphir" ], [ "s", "d", "k" ] ], [ [ "dict" ] ], [ "from", "list" ] )) list -> - Ok list - _ -> - Err (UnexpectedArguments [ arg ]) - )) + , ( "toList" + , Native.unaryStrict + (\eval arg -> + case eval arg of + Ok (Value.Apply _ (Value.Reference _ ( [ [ "morphir" ], [ "s", "d", "k" ] ], [ [ "dict" ] ], [ "from", "list" ] )) list) -> + Ok list + + e -> + let + _ = + Debug.log "err" e + in + Err (UnexpectedArguments [ arg |> Debug.log "toListErr" ]) + ) + ) , ( "fromList", Native.unaryStrict (\_ arg -> Ok (fromListValue () arg)) ) + + --, ( "map" + -- , Native.eval2 SDKDict.map + -- (Native.decodeFun2 Native.encodeRaw Native.encodeRaw Native.decodeRaw) + -- (Native.decodeDict Native.decodeRaw Native.decodeRaw) + -- (Native.encodeDict Native.encodeRaw Native.encodeRaw Native.encodeMaybeResult) + -- ) + , ( "map" + , \eval args -> + case args of + [ func, dict ] -> + case eval dict of + Ok (Value.Apply _ (Value.Reference _ ( [ [ "morphir" ], [ "s", "d", "k" ] ], [ [ "dict" ] ], [ "from", "list" ] )) arg) -> + case arg of + Value.List _ list -> + let + map ls resList = + case ls of + [] -> + Ok resList + + (Value.Tuple _ [ key, value ]) :: rest -> + eval (Value.Apply () (Value.Apply () func key) value) + |> Result.map (\newValue -> resList ++ [ Value.Tuple () [ key, newValue ] ]) + |> Result.andThen (map rest) + + _ -> + Err TupleExpected + in + map list [] + |> Result.map (Value.List ()) + |> Result.map (fromListValue ()) + + _ -> + Err (ExpectedList arg) + + _ -> + Err (UnexpectedArguments [ dict ]) + + _ -> + Err (UnexpectedArguments (args |> Debug.log "args")) + ) + , ( "foldl" + , \eval args -> + case args of + [ func, acc, dict ] -> + case eval dict of + Ok (Value.Apply _ (Value.Reference _ ( [ [ "morphir" ], [ "s", "d", "k" ] ], [ [ "dict" ] ], [ "from", "list" ] )) arg) -> + eval arg + |> Result.andThen + (\evaluatedDict -> + case evaluatedDict of + Value.List () list -> + --let + -- foldl ls rest = + -- case ls of + -- [] -> + -- Ok rest + -- head :: tail -> + -- case head of + -- Value.Tuple () [key, value]-> + -- eval (Value.Apply () (Value.Apply () func key) value) + -- + -- + --in + -- + list + |> List.foldl + (\next resultSoFar -> + resultSoFar + |> Result.andThen + (\soFar -> + eval next + |> Result.andThen + (\evaluatedNext -> + eval (Value.Apply () (Value.Apply () func evaluatedNext) soFar) + ) + ) + ) + (eval acc) + + _ -> + Err (ExpectedList evaluatedDict) + ) + + _ -> + Err (UnexpectedArguments [ dict ]) + + _ -> + Err (UnexpectedArguments args) + ) + , ( "foldr" + , \eval args -> + case args of + [ func, acc, dict ] -> + case dict of + Value.Apply _ (Value.Reference _ ( [ [ "morphir" ], [ "s", "d", "k" ] ], [ [ "dict" ] ], [ "from", "list" ] )) arg -> + eval arg + |> Result.andThen + (\evaluatedDict -> + case evaluatedDict of + Value.List () list -> + list + |> List.foldr + (\next resultSoFar -> + resultSoFar + |> Result.andThen + (\soFar -> + eval next + |> Result.andThen + (\evaluatedNext -> + eval (Value.Apply () (Value.Apply () func evaluatedNext) soFar) + ) + ) + ) + (eval acc) + + _ -> + Err (ExpectedList evaluatedDict) + ) + + _ -> + Err (UnexpectedArguments [ dict ]) + + _ -> + Err (UnexpectedArguments args) + ) + , ( "filter" + , \eval args -> + case args of + [ func, dict ] -> + case dict of + Value.Apply _ (Value.Reference _ ( [ [ "morphir" ], [ "s", "d", "k" ] ], [ [ "dict" ] ], [ "from", "list" ] )) arg -> + eval arg + |> Result.andThen + (\evaluatedArg1 -> + case evaluatedArg1 of + Value.List () listItems -> + let + evaluate : List RawValue -> List RawValue -> Result Error (List RawValue) + evaluate list items = + case items of + [] -> + Ok list + + head :: tail -> + case eval (Value.Apply () func head) of + Ok (Value.Apply () (Value.Constructor _ ( [ [ "morphir" ], [ "s", "d", "k" ] ], [ [ "maybe" ] ], [ "just" ] )) value) -> + evaluate (list ++ [ value ]) tail + + Ok (Value.Constructor _ ( [ [ "morphir" ], [ "s", "d", "k" ] ], [ [ "maybe" ] ], [ "nothing" ] )) -> + evaluate list tail + + Ok other -> + Err (ExpectedBoolLiteral other) + + Err other -> + Err other + in + listItems |> evaluate [] |> Result.map (Value.List ()) + + _ -> + Err (ExpectedList evaluatedArg1) + ) + + _ -> + Err (UnexpectedArguments [ dict ]) + + _ -> + Err (UnexpectedArguments args) + ) + , ( "partition" + , \eval args -> + case args of + [ fun, dict ] -> + case dict of + Value.Apply _ (Value.Reference _ ( [ [ "morphir" ], [ "s", "d", "k" ] ], [ [ "dict" ] ], [ "from", "list" ] )) arg -> + eval arg + |> Result.andThen + (\evaluatedArg1 -> + case evaluatedArg1 of + Value.List () listItems -> + let + evaluate : List RawValue -> List RawValue -> List RawValue -> Result Error ( List RawValue, List RawValue ) + evaluate list1 list2 items = + case items of + [] -> + Ok ( list1, list2 ) + + head1 :: tail1 -> + case eval (Value.Apply () fun head1) of + Ok (Value.Literal _ (BoolLiteral True)) -> + evaluate (list1 ++ [ head1 ]) list2 tail1 + + Ok (Value.Literal _ (BoolLiteral False)) -> + evaluate list1 (list2 ++ [ head1 ]) tail1 + + Ok other -> + Err (ExpectedBoolLiteral other) + + Err other -> + Err other + in + listItems + |> evaluate [] [] + |> Result.map + (\( list1, list2 ) -> + Value.Tuple () [ Value.List () list1, Value.List () list2 ] + ) + + _ -> + Err (ExpectedList evaluatedArg1) + ) + + _ -> + Err (UnexpectedArguments [ dict ]) + + _ -> + Err (UnexpectedArguments args) + ) + + --, ("union" + -- , \eval args -> + -- case args of + -- [dict1, dict2]-> + -- case (dict1, dict2) of + -- (Value.Apply _ (Value.Reference _ ( [ [ "morphir" ], [ "s", "d", "k" ] ], [ [ "dict" ] ], [ "from", "list" ] )) arg1, Value.Apply _ (Value.Reference _ ( [ [ "morphir" ], [ "s", "d", "k" ] ], [ [ "dict" ] ], [ "from", "list" ] )) arg2) -> + -- case (arg1, arg2) of + -- [Value.List _ list1, Value.List _ list2] -> + -- + -- _-> + -- Err (ExpectedList arg1, ExpectedList arg2) + -- _-> + -- Err (UnexpectedArguments [ dict1, dict2 ]) + -- _-> + -- Err (UnexpectedArguments args) + -- ) ] diff --git a/src/Morphir/Value/Native.elm b/src/Morphir/Value/Native.elm index d5767e58d..44cf671ac 100644 --- a/src/Morphir/Value/Native.elm +++ b/src/Morphir/Value/Native.elm @@ -3,7 +3,7 @@ module Morphir.Value.Native exposing , Eval , unaryLazy, unaryStrict, binaryLazy, binaryStrict, boolLiteral, charLiteral, eval0, eval1, eval2, eval3 , floatLiteral, intLiteral, oneOf, stringLiteral, decimalLiteral - , decodeFun1, decodeList, decodeLiteral, decodeMaybe, decodeLocalDate, decodeRaw, decodeTuple2, encodeList, encodeLiteral, encodeMaybe, encodeLocalDate, encodeMaybeResult, encodeRaw, encodeResultList, encodeTuple2 + , decodeFun1, decodeList, decodeLiteral, decodeMaybe, decodeLocalDate, decodeRaw, decodeTuple2, encodeList, encodeLiteral, encodeMaybe, encodeLocalDate, encodeMaybeResult, encodeRaw, encodeResultList, encodeTuple2, decodeDict, decodeFun2, encodeDict , trinaryLazy, trinaryStrict ) @@ -39,7 +39,7 @@ Various utilities to help with implementing native functions. @docs unaryLazy, unaryStrict, binaryLazy, binaryStrict, boolLiteral, charLiteral, eval0, eval1, eval2, eval3 @docs floatLiteral, intLiteral, oneOf, stringLiteral, decimalLiteral -@docs decodeFun1, decodeList, decodeLiteral, decodeMaybe, decodeLocalDate, decodeRaw, decodeTuple2, encodeList, encodeLiteral, encodeMaybe, encodeLocalDate, encodeMaybeResult, encodeRaw, encodeResultList, encodeTuple2 +@docs decodeFun1, decodeList, decodeLiteral, decodeMaybe, decodeLocalDate, decodeRaw, decodeTuple2, encodeList, encodeLiteral, encodeMaybe, encodeLocalDate, encodeMaybeResult, encodeRaw, encodeResultList, encodeTuple2, decodeDict, decodeFun2, encodeDict @docs trinaryLazy, trinaryStrict -} @@ -47,6 +47,7 @@ Various utilities to help with implementing native functions. import Morphir.IR.Literal exposing (Literal(..)) import Morphir.IR.Value as Value exposing (RawValue, Value) import Morphir.SDK.Decimal exposing (Decimal) +import Morphir.SDK.Dict as Dict exposing (Dict) import Morphir.SDK.LocalDate as LocalDate exposing (LocalDate) import Morphir.SDK.ResultList as ListOfResults import Morphir.Value.Error exposing (Error(..)) @@ -242,6 +243,28 @@ decodeList decodeItem eval value = Err error +{-| -} +decodeDict : Decoder k -> Decoder v -> Decoder (Dict k v) +decodeDict decodeKey decodeValue eval value = + case eval value of + Ok (Value.Apply _ (Value.Reference _ ( [ [ "morphir" ], [ "s", "d", "k" ] ], [ [ "dict" ] ], [ "from", "list" ] )) list) -> + list + |> decodeList (decodeTuple2 ( decodeKey, decodeValue )) eval + |> Result.map Dict.fromList + + Ok _ -> + Err (ExpectedList value) + + Err error -> + Err error + + +encodeDict : Encode k -> Encode v -> Dict k v -> Result Error RawValue +encodeDict encodeKey encodeValue dict = + Dict.toList dict + |> encodeList (encodeTuple2 ( encodeKey, encodeValue )) + + {-| -} encodeTuple2 : ( Encode a, Encode b ) -> ( a, b ) -> Result Error RawValue encodeTuple2 ( encodeA, encodeB ) ( a, b ) = @@ -275,6 +298,24 @@ decodeFun1 encodeA decodeR eval fun = ) +{-| -} +decodeFun2 : Encode a -> Encode b -> Decoder r -> Decoder (a -> b -> Result Error r) +decodeFun2 encodeA encodeB decodeR eval fun = + Ok + (\a b -> + encodeA a + |> Result.andThen + (\arg1 -> + encodeB b + |> Result.andThen + (\arg2 -> + eval (Value.Apply () (Value.Apply () fun arg1) arg2) + |> Result.andThen (decodeR eval) + ) + ) + ) + + {-| -} boolLiteral : Literal -> Result Error Bool boolLiteral lit = diff --git a/tests-integration/reference-model/morphir-tests.json b/tests-integration/reference-model/morphir-tests.json index 27cc404ec..9a47ae81f 100644 --- a/tests-integration/reference-model/morphir-tests.json +++ b/tests-integration/reference-model/morphir-tests.json @@ -214,6 +214,98 @@ } ] ], + [ + [ + [ + [ + "morphir" + ], + [ + "reference" + ], + [ + "model" + ] + ], + [ + [ + "s", + "d", + "k" + ], + [ + "dict" + ] + ], + [ + "dict", + "is", + "empty" + ] + ], + [ + { + "inputs": [ + [ + [ + "hi", + "hi" + ] + ] + ], + "expectedOutput": false, + "description": "" + } + ] + ], + [ + [ + [ + [ + "morphir" + ], + [ + "reference" + ], + [ + "model" + ] + ], + [ + [ + "s", + "d", + "k" + ], + [ + "dict" + ] + ], + [ + "map", + "users" + ] + ], + [ + { + "inputs": [ + [ + [ + "el", + "er" + ] + ] + ], + "expectedOutput": [ + [ + "el", + "eler" + ] + ], + "description": "" + } + ] + ], [ [ [ diff --git a/tests-integration/reference-model/src/Morphir/Reference/Model/SDK/Dict.elm b/tests-integration/reference-model/src/Morphir/Reference/Model/SDK/Dict.elm index dd9daa7d9..95b5704c5 100644 --- a/tests-integration/reference-model/src/Morphir/Reference/Model/SDK/Dict.elm +++ b/tests-integration/reference-model/src/Morphir/Reference/Model/SDK/Dict.elm @@ -3,52 +3,52 @@ module Morphir.Reference.Model.SDK.Dict exposing (..) import Dict exposing (Dict) -dictEmpty : Dict k v +dictEmpty : Dict String String dictEmpty = Dict.empty -dictSingleton : comparable -> b -> Dict comparable b +dictSingleton : String -> String -> Dict String String dictSingleton key value = Dict.singleton key value -dictIsEmpty : Dict k v -> Bool +dictIsEmpty : Dict String String -> Bool dictIsEmpty dictionary = Dict.isEmpty dictionary -dictRemove : comparable -> Dict comparable v -> Dict comparable v +dictRemove : String -> Dict String String -> Dict String String dictRemove key dict = Dict.remove key dict -dictMember : comparable -> Dict comparable v -> Bool +dictMember : String -> Dict String String -> Bool dictMember key dict = Dict.member key dict -dictSize : Dict k v -> Int +dictSize : Dict String String -> Int dictSize dict = Dict.size dict -dictKeys : Dict k v -> List k +dictKeys : Dict String String -> List String dictKeys dict = Dict.keys dict -dictValues : Dict k v -> List v +dictValues : Dict String String -> List String dictValues dict = Dict.values dict -dictToList : Dict k v -> List ( k, v ) +dictToList : Dict String String -> List ( String, String ) dictToList dict = Dict.toList dict -dictInsert : comparable -> b -> Dict comparable b -> Dict comparable b +dictInsert : String -> String -> Dict String String -> Dict String String dictInsert key value dict = Dict.insert key value dict @@ -61,3 +61,14 @@ initialUsers = updatedUsers : Dict number String updatedUsers = Dict.update 1 (Maybe.map (\name -> String.append name " Johnson")) initialUsers + + +mapUsers : Dict String String -> Dict String String +mapUsers dict = + Dict.map (\id name -> id ++ name) dict + + + +--dictFoldl : Dict String String -> List String +--dictFoldl dict = +-- Dict.foldl (\_ x acc -> x :: acc) [] dict From 12c6bafacaab9027f4fb6e7b6eaef73a4496349d Mon Sep 17 00:00:00 2001 From: Elorm-Axolu Date: Thu, 13 Jul 2023 08:47:14 +0000 Subject: [PATCH 2/4] missing dick sdk function 80% completed --- src/Morphir/Value/Native.elm | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Morphir/Value/Native.elm b/src/Morphir/Value/Native.elm index 44cf671ac..4a681f75f 100644 --- a/src/Morphir/Value/Native.elm +++ b/src/Morphir/Value/Native.elm @@ -259,6 +259,7 @@ decodeDict decodeKey decodeValue eval value = Err error +{-| -} encodeDict : Encode k -> Encode v -> Dict k v -> Result Error RawValue encodeDict encodeKey encodeValue dict = Dict.toList dict From 7f8f66299f15c26f8e8667a7425636179c0c9937 Mon Sep 17 00:00:00 2001 From: Elorm-Axolu Date: Thu, 13 Jul 2023 08:55:27 +0000 Subject: [PATCH 3/4] missing dick sdk function 80% completed --- .../reference-model/morphir-tests.json | 310 +----------------- 1 file changed, 4 insertions(+), 306 deletions(-) diff --git a/tests-integration/reference-model/morphir-tests.json b/tests-integration/reference-model/morphir-tests.json index 9a47ae81f..5c54563a1 100644 --- a/tests-integration/reference-model/morphir-tests.json +++ b/tests-integration/reference-model/morphir-tests.json @@ -1,263 +1,4 @@ [ - [ - [ - [ - [ - "morphir" - ], - [ - "reference" - ], - [ - "model" - ] - ], - [ - [ - "relational" - ] - ], - [ - "inner", - "join", - "1" - ] - ], - [ - { - "inputs": [ - [], - [] - ], - "expectedOutput": [], - "description": "" - }, - { - "inputs": [ - [ - { - "companyName": "foo", - "position": "12w21w" - } - ], - [] - ], - "expectedOutput": [], - "description": "" - }, - { - "inputs": [ - [ - { - "companyName": "foo", - "position": "12w21w" - } - ], - [ - { - "name": "foo", - "numberOfEmployees": 123 - } - ] - ], - "expectedOutput": [ - { - "position": "12w21w", - "companySize": 123 - } - ], - "description": "" - }, - { - "inputs": [ - [ - { - "companyName": "foo", - "position": "12w21w" - } - ], - [ - { - "name": "bar", - "numberOfEmployees": 123 - } - ] - ], - "expectedOutput": [], - "description": "" - }, - { - "inputs": [ - [ - { - "companyName": "bar", - "position": "efewfwe" - }, - { - "companyName": "foo", - "position": "12w21w" - } - ], - [ - { - "name": "foo", - "numberOfEmployees": 123 - }, - { - "name": "bar", - "numberOfEmployees": 456 - } - ] - ], - "expectedOutput": [ - { - "position": "efewfwe", - "companySize": 456 - }, - { - "position": "12w21w", - "companySize": 123 - } - ], - "description": "" - } - ] - ], - [ - [ - [ - [ - "morphir" - ], - [ - "reference" - ], - [ - "model" - ] - ], - [ - [ - "relational" - ] - ], - [ - "left", - "join", - "1" - ] - ], - [ - { - "inputs": [ - [ - { - "companyName": "foo", - "position": "wedfef" - } - ], - [] - ], - "expectedOutput": [ - { - "position": "wedfef", - "companySize": 0 - } - ], - "description": "" - }, - { - "inputs": [ - [ - { - "companyName": "foo", - "position": "wedfef" - } - ], - [ - { - "name": "foo", - "numberOfEmployees": 12312 - } - ] - ], - "expectedOutput": [ - { - "position": "wedfef", - "companySize": 12312 - } - ], - "description": "" - }, - { - "inputs": [ - [ - { - "companyName": "foo", - "position": "wedfef" - } - ], - [ - { - "name": "bar", - "numberOfEmployees": 12312 - } - ] - ], - "expectedOutput": [ - { - "position": "wedfef", - "companySize": 0 - } - ], - "description": "" - } - ] - ], - [ - [ - [ - [ - "morphir" - ], - [ - "reference" - ], - [ - "model" - ] - ], - [ - [ - "s", - "d", - "k" - ], - [ - "dict" - ] - ], - [ - "dict", - "is", - "empty" - ] - ], - [ - { - "inputs": [ - [ - [ - "hi", - "hi" - ] - ] - ], - "expectedOutput": false, - "description": "" - } - ] - ], [ [ [ @@ -291,62 +32,19 @@ "inputs": [ [ [ - "el", - "er" + "car", + "work" ] ] ], "expectedOutput": [ [ - "el", - "eler" + "car", + "carwork" ] ], "description": "" } ] - ], - [ - [ - [ - [ - "morphir" - ], - [ - "reference" - ], - [ - "model" - ] - ], - [ - [ - "test", - "model" - ], - [ - "testing" - ] - ], - [ - "add", - "7" - ] - ], - [ - { - "inputs": [ - 1, - 2, - 3, - 4, - 5, - 6, - 7 - ], - "expectedOutput": 28, - "description": "" - } - ] ] ] \ No newline at end of file From 3214ed9af9064902f9713a09e75ecfc94cf3157c Mon Sep 17 00:00:00 2001 From: Elorm-Axolu Date: Fri, 14 Jul 2023 13:57:27 +0000 Subject: [PATCH 4/4] missing dick sdk function 90% completed --- cli/src/Morphir/Elm/CLI.elm | 10 +- src/Morphir/IR/SDK/Dict.elm | 149 +++++++++++------- .../reference-model/morphir-tests.json | 17 ++ .../src/Morphir/Reference/Model/SDK/Dict.elm | 22 ++- 4 files changed, 140 insertions(+), 58 deletions(-) diff --git a/cli/src/Morphir/Elm/CLI.elm b/cli/src/Morphir/Elm/CLI.elm index ac9545083..3bfd6f1f7 100644 --- a/cli/src/Morphir/Elm/CLI.elm +++ b/cli/src/Morphir/Elm/CLI.elm @@ -189,8 +189,14 @@ update msg model = let resultIR : Result Decode.Error Distribution resultIR = - distributionJson - |> Decode.decodeValue DistributionCodec.decodeVersionedDistribution + case distributionJson |> Decode.decodeValue DistributionCodec.decodeVersionedDistribution of + Ok packageDist -> + case packageDist of + Library packageName dependencies packageDef -> + Ok (Library packageName (Dict.union Frontend.defaultDependencies dependencies) packageDef) + + Err err -> + Err err in case resultIR of Ok ir -> diff --git a/src/Morphir/IR/SDK/Dict.elm b/src/Morphir/IR/SDK/Dict.elm index b14184483..7e16d01cf 100644 --- a/src/Morphir/IR/SDK/Dict.elm +++ b/src/Morphir/IR/SDK/Dict.elm @@ -560,33 +560,34 @@ nativeFunctions = (\evaluatedDict -> case evaluatedDict of Value.List () list -> - --let - -- foldl ls rest = - -- case ls of - -- [] -> - -- Ok rest - -- head :: tail -> - -- case head of - -- Value.Tuple () [key, value]-> - -- eval (Value.Apply () (Value.Apply () func key) value) - -- - -- - --in - -- - list - |> List.foldl - (\next resultSoFar -> - resultSoFar - |> Result.andThen - (\soFar -> - eval next - |> Result.andThen - (\evaluatedNext -> - eval (Value.Apply () (Value.Apply () func evaluatedNext) soFar) - ) - ) + eval acc + |> Result.andThen + (\evalAcc -> + let + foldl ls res = + case ls of + [] -> + Ok res + + head :: tail -> + case head of + Value.Tuple () [ key, value ] -> + --eval acc + -- |> Result.andThen + -- (\soFar -> + eval + (Value.Apply () + (Value.Apply () (Value.Apply () func key) value) + res + ) + |> Result.andThen (foldl tail) + + --) + _ -> + Err TupleExpected + in + foldl list evalAcc ) - (eval acc) _ -> Err (ExpectedList evaluatedDict) @@ -605,24 +606,62 @@ nativeFunctions = case dict of Value.Apply _ (Value.Reference _ ( [ [ "morphir" ], [ "s", "d", "k" ] ], [ [ "dict" ] ], [ "from", "list" ] )) arg -> eval arg + |> Debug.log "arg" |> Result.andThen (\evaluatedDict -> case evaluatedDict of Value.List () list -> - list - |> List.foldr - (\next resultSoFar -> - resultSoFar - |> Result.andThen - (\soFar -> - eval next - |> Result.andThen - (\evaluatedNext -> - eval (Value.Apply () (Value.Apply () func evaluatedNext) soFar) - ) - ) + eval acc + |> Debug.log "acc" + |> Result.andThen + (\evalAcc -> + let + foldr ls res = + case ls |> Debug.log "todo" of + [] -> + Ok res + + head :: tail -> + foldr tail res + |> Debug.log "todo" + |> Result.andThen + (\result -> + case head of + Value.Tuple () [ key, value ] -> + eval + (Value.Apply () + (Value.Apply () + (Value.Apply () func key) + value + ) + result + ) + + _ -> + Err TupleExpected + ) + + --case head of + -- Value.Tuple () [ key, value ] -> + -- tailRes + -- |> Debug.log "tail" + -- |> Result.andThen + -- (\result -> + -- eval + -- (Value.Apply () + -- (Value.Apply () + -- (Value.Apply () func key) + -- value + -- ) + -- result + -- ) + -- ) + -- + -- _ -> + -- Err TupleExpected + in + foldr list evalAcc ) - (eval acc) _ -> Err (ExpectedList evaluatedDict) @@ -646,27 +685,31 @@ nativeFunctions = case evaluatedArg1 of Value.List () listItems -> let - evaluate : List RawValue -> List RawValue -> Result Error (List RawValue) - evaluate list items = - case items of + evaluate list res = + case list of [] -> - Ok list + Ok res head :: tail -> - case eval (Value.Apply () func head) of - Ok (Value.Apply () (Value.Constructor _ ( [ [ "morphir" ], [ "s", "d", "k" ] ], [ [ "maybe" ] ], [ "just" ] )) value) -> - evaluate (list ++ [ value ]) tail + case head of + Value.Tuple () [ key, value ] -> + case eval (Value.Apply () (Value.Apply () func key) value) of + Ok (Value.Literal _ (BoolLiteral True)) -> + evaluate tail (res ++ [ Value.Tuple () [ key, value ] ]) - Ok (Value.Constructor _ ( [ [ "morphir" ], [ "s", "d", "k" ] ], [ [ "maybe" ] ], [ "nothing" ] )) -> - evaluate list tail + Ok (Value.Literal _ (BoolLiteral False)) -> + evaluate tail tail - Ok other -> - Err (ExpectedBoolLiteral other) + Ok other -> + Err (ExpectedBoolLiteral other) - Err other -> - Err other + Err other -> + Err other + + _ -> + Err TupleExpected in - listItems |> evaluate [] |> Result.map (Value.List ()) + evaluate listItems [] |> Result.map (Value.List ()) |> Result.map (fromListValue ()) _ -> Err (ExpectedList evaluatedArg1) diff --git a/tests-integration/reference-model/morphir-tests.json b/tests-integration/reference-model/morphir-tests.json index 5c54563a1..8a998ecfd 100644 --- a/tests-integration/reference-model/morphir-tests.json +++ b/tests-integration/reference-model/morphir-tests.json @@ -44,6 +44,23 @@ ] ], "description": "" + }, + { + "inputs": [ + [ + [ + "2", + "elor" + ] + ] + ], + "expectedOutput": [ + [ + "2", + "2elor" + ] + ], + "description": "" } ] ] diff --git a/tests-integration/reference-model/src/Morphir/Reference/Model/SDK/Dict.elm b/tests-integration/reference-model/src/Morphir/Reference/Model/SDK/Dict.elm index 95b5704c5..08674b95c 100644 --- a/tests-integration/reference-model/src/Morphir/Reference/Model/SDK/Dict.elm +++ b/tests-integration/reference-model/src/Morphir/Reference/Model/SDK/Dict.elm @@ -68,7 +68,23 @@ mapUsers dict = Dict.map (\id name -> id ++ name) dict +type alias Person = + { name : String + , age : Int + } ---dictFoldl : Dict String String -> List String ---dictFoldl dict = --- Dict.foldl (\_ x acc -> x :: acc) [] dict + +dictFoldl : Dict String Person -> Int +dictFoldl dict = + Dict.foldl (\_ person acc -> acc + person.age) 0 dict + + + +--dictFoldr : Dict String Person -> List Int +--dictFoldr dict = +-- Dict.foldr (\_ person acc -> person.age :: acc) [] dict +-- +-- +--filter : Dict String Person -> Dict String Person +--filter dict = +-- Dict.filter (\name person -> name == person.name) dict