From 6c18aac0fb51ad11cd0a77e3a1703858537f7b7a Mon Sep 17 00:00:00 2001 From: Decio Ferreira Date: Wed, 9 Oct 2024 23:10:10 +0100 Subject: [PATCH] fixes #35 `guida diff elm/json 1.0.0 1.1.2` shows wrong result --- elm.json | 76 +++++++++++---------- src/Builder/Build.elm | 10 +-- src/Builder/Deps/Diff.elm | 6 +- src/Builder/Deps/Registry.elm | 4 +- src/Compiler/Canonicalize/Expression.elm | 18 ++--- src/Compiler/Elm/Compiler/Type.elm | 87 +++++++++++++++++++++--- src/Compiler/Elm/Docs.elm | 55 +++++++++++++-- src/Compiler/Generate/JavaScript.elm | 8 +-- src/Data/Graph.elm | 4 +- src/Terminal/Diff.elm | 7 +- src/Terminal/Terminal/Chomp.elm | 4 +- src/Utils/Main.elm | 14 +++- 12 files changed, 208 insertions(+), 85 deletions(-) diff --git a/elm.json b/elm.json index 646804763..fb85f4db8 100644 --- a/elm.json +++ b/elm.json @@ -1,41 +1,43 @@ { - "type": "application", - "source-directories": ["src"], - "elm-version": "0.19.1", - "dependencies": { - "direct": { - "andre-dietrich/parser-combinators": "4.1.0", - "dasch/levenshtein": "1.0.3", - "elm/browser": "1.0.2", - "elm/bytes": "1.0.8", - "elm/core": "1.0.5", - "elm/html": "1.0.0", - "elm/json": "1.1.3", - "elm/parser": "1.1.0", - "elm/time": "1.0.0", - "elm-community/array-extra": "2.6.0", - "elm-community/basics-extra": "4.1.0", - "elm-community/list-extra": "8.7.0", - "elm-community/maybe-extra": "5.3.0", - "guida-lang/glsl": "1.0.0", - "mgold/elm-nonempty-list": "4.2.0", - "pilatch/flip": "1.0.0", - "rtfeldman/elm-hex": "1.0.0", - "the-sett/elm-pretty-printer": "3.1.0", - "zwilias/elm-rosetree": "1.5.0" + "type": "application", + "source-directories": [ + "src" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "andre-dietrich/parser-combinators": "4.1.0", + "dasch/levenshtein": "1.0.3", + "elm/browser": "1.0.2", + "elm/bytes": "1.0.8", + "elm/core": "1.0.5", + "elm/html": "1.0.0", + "elm/json": "1.1.3", + "elm/parser": "1.1.0", + "elm/time": "1.0.0", + "elm-community/array-extra": "2.6.0", + "elm-community/basics-extra": "4.1.0", + "elm-community/list-extra": "8.7.0", + "elm-community/maybe-extra": "5.3.0", + "guida-lang/glsl": "1.0.0", + "mgold/elm-nonempty-list": "4.2.0", + "rtfeldman/elm-hex": "1.0.0", + "the-sett/elm-pretty-printer": "3.1.0", + "zwilias/elm-rosetree": "1.5.0" + }, + "indirect": { + "elm/random": "1.0.0", + "elm/regex": "1.0.0", + "elm/url": "1.0.0", + "elm/virtual-dom": "1.0.3", + "fredcy/elm-parseint": "2.0.1", + "pilatch/flip": "1.0.0" + } }, - "indirect": { - "elm/random": "1.0.0", - "elm/regex": "1.0.0", - "elm/url": "1.0.0", - "elm/virtual-dom": "1.0.3", - "fredcy/elm-parseint": "2.0.1" + "test-dependencies": { + "direct": { + "elm-explorations/test": "2.2.0" + }, + "indirect": {} } - }, - "test-dependencies": { - "direct": { - "elm-explorations/test": "2.2.0" - }, - "indirect": {} - } } diff --git a/src/Builder/Build.elm b/src/Builder/Build.elm index 0fa0e130c..dc7626d0c 100644 --- a/src/Builder/Build.elm +++ b/src/Builder/Build.elm @@ -15,6 +15,7 @@ module Builder.Build exposing , writeDocs ) +import Basics.Extra exposing (flip) import Builder.Elm.Details as Details import Builder.Elm.Outline as Outline import Builder.File as File @@ -46,7 +47,6 @@ import Data.Graph as Graph import Data.IO as IO exposing (IO, IORef(..)) import Data.Map as Dict exposing (Dict) import Data.Set as EverySet -import Flip import Json.Decode as Decode import Json.Encode as Encode import Utils.Crash exposing (crash) @@ -360,7 +360,7 @@ crawlModule ((Env _ root projectType srcDirs buildID locals foreigns) as env) mv fileName = ModuleName.toFilePath name ++ ".elm" in - Utils.filterM File.exists (List.map (Flip.flip addRelative fileName) srcDirs) + Utils.filterM File.exists (List.map (flip addRelative fileName) srcDirs) |> IO.bind (\paths -> case paths of @@ -1818,11 +1818,7 @@ bResultEncoder bResult = , ( "local", Details.localEncoder local ) , ( "iface", I.interfaceEncoder iface ) , ( "objects", Opt.localGraphEncoder objects ) - , ( "docs" - , docs - |> Maybe.map Docs.jsonModuleEncoder - |> Maybe.withDefault Encode.null - ) + , ( "docs", E.maybe Docs.jsonModuleEncoder docs ) ] RCached main lastChange (MVar ref) -> diff --git a/src/Builder/Deps/Diff.elm b/src/Builder/Deps/Diff.elm index 1b1043a6b..7a2f7028e 100644 --- a/src/Builder/Deps/Diff.elm +++ b/src/Builder/Deps/Diff.elm @@ -253,11 +253,11 @@ isEquivalentRenaming varPairs = allUnique list = List.length list == EverySet.size (EverySet.fromList compare list) in - case List.filterMap verify renamings of - [] -> + case Utils.maybeMapM verify renamings of + Nothing -> False - verifiedRenamings -> + Just verifiedRenamings -> List.all compatibleVars verifiedRenamings && allUnique (List.map Tuple.second verifiedRenamings) diff --git a/src/Builder/Deps/Registry.elm b/src/Builder/Deps/Registry.elm index 8d383405a..dfef4553e 100644 --- a/src/Builder/Deps/Registry.elm +++ b/src/Builder/Deps/Registry.elm @@ -12,6 +12,7 @@ module Builder.Deps.Registry exposing , update ) +import Basics.Extra exposing (flip) import Builder.Deps.Website as Website import Builder.File as File import Builder.Http as Http @@ -24,7 +25,6 @@ import Compiler.Json.Encode as E import Compiler.Parse.Primitives as P import Data.IO as IO exposing (IO(..)) import Data.Map as Dict exposing (Dict) -import Flip import Json.Decode as Decode import Json.Encode as Encode @@ -104,7 +104,7 @@ allPkgsDecoder = toKnownVersions : List V.Version -> D.Decoder () KnownVersions toKnownVersions versions = - case List.sortWith (Flip.flip V.compare) versions of + case List.sortWith (flip V.compare) versions of v :: vs -> D.pure (KnownVersions v vs) diff --git a/src/Compiler/Canonicalize/Expression.elm b/src/Compiler/Canonicalize/Expression.elm index d21e3de40..9c26978a0 100644 --- a/src/Compiler/Canonicalize/Expression.elm +++ b/src/Compiler/Canonicalize/Expression.elm @@ -6,6 +6,7 @@ module Compiler.Canonicalize.Expression exposing , verifyBindings ) +import Basics.Extra exposing (flip) import Compiler.AST.Canonical as Can import Compiler.AST.Source as Src import Compiler.AST.Utils.Binop as Binop @@ -25,7 +26,6 @@ import Compiler.Reporting.Result as R import Compiler.Reporting.Warning as W import Data.Graph as Graph import Data.Map as Dict exposing (Dict) -import Flip import List.Extra as List import Prelude import Utils.Main as Utils @@ -359,16 +359,16 @@ addBindingsHelp bindings (A.At region pattern) = bindings Src.PTuple a b cs -> - List.foldl (Flip.flip addBindingsHelp) bindings (a :: b :: cs) + List.foldl (flip addBindingsHelp) bindings (a :: b :: cs) Src.PCtor _ _ patterns -> - List.foldl (Flip.flip addBindingsHelp) bindings patterns + List.foldl (flip addBindingsHelp) bindings patterns Src.PCtorQual _ _ _ patterns -> - List.foldl (Flip.flip addBindingsHelp) bindings patterns + List.foldl (flip addBindingsHelp) bindings patterns Src.PList patterns -> - List.foldl (Flip.flip addBindingsHelp) bindings patterns + List.foldl (flip addBindingsHelp) bindings patterns Src.PCons hd tl -> addBindingsHelp (addBindingsHelp bindings hd) tl @@ -533,16 +533,16 @@ getPatternNames names (A.At region pattern) = names Src.PTuple a b cs -> - List.foldl (Flip.flip getPatternNames) (getPatternNames (getPatternNames names a) b) cs + List.foldl (flip getPatternNames) (getPatternNames (getPatternNames names a) b) cs Src.PCtor _ _ args -> - List.foldl (Flip.flip getPatternNames) names args + List.foldl (flip getPatternNames) names args Src.PCtorQual _ _ _ args -> - List.foldl (Flip.flip getPatternNames) names args + List.foldl (flip getPatternNames) names args Src.PList patterns -> - List.foldl (Flip.flip getPatternNames) names patterns + List.foldl (flip getPatternNames) names patterns Src.PCons hd tl -> getPatternNames (getPatternNames names hd) tl diff --git a/src/Compiler/Elm/Compiler/Type.elm b/src/Compiler/Elm/Compiler/Type.elm index de09629ae..effd4bf15 100644 --- a/src/Compiler/Elm/Compiler/Type.elm +++ b/src/Compiler/Elm/Compiler/Type.elm @@ -7,6 +7,7 @@ module Compiler.Elm.Compiler.Type exposing , encode , encodeMetadata , jsonDecoder + , jsonEncoder , toDoc ) @@ -22,6 +23,7 @@ import Compiler.Reporting.Doc as D import Compiler.Reporting.Render.Type as RT import Compiler.Reporting.Render.Type.Localizer as L import Json.Decode as Decode +import Json.Encode as Encode import Utils.Crash exposing (crash) @@ -199,15 +201,84 @@ toVariantObject ( name, args ) = -- ENCODERS and DECODERS +jsonEncoder : Type -> Encode.Value +jsonEncoder type_ = + case type_ of + Lambda arg body -> + Encode.object + [ ( "type", Encode.string "Lambda" ) + , ( "arg", jsonEncoder arg ) + , ( "body", jsonEncoder body ) + ] + + Var name -> + Encode.object + [ ( "type", Encode.string "Var" ) + , ( "name", Encode.string name ) + ] + + Type name args -> + Encode.object + [ ( "type", Encode.string "Type" ) + , ( "name", Encode.string name ) + , ( "args", Encode.list jsonEncoder args ) + ] + + Record fields ext -> + Encode.object + [ ( "type", Encode.string "Record" ) + , ( "fields", Encode.list (E.jsonPair Encode.string jsonEncoder) fields ) + , ( "ext", E.maybe Encode.string ext ) + ] + + Unit -> + Encode.object + [ ( "type", Encode.string "Unit" ) + ] + + Tuple a b cs -> + Encode.object + [ ( "type", Encode.string "Tuple" ) + , ( "a", jsonEncoder a ) + , ( "b", jsonEncoder b ) + , ( "cs", Encode.list jsonEncoder cs ) + ] + + jsonDecoder : Decode.Decoder Type jsonDecoder = - Decode.string + Decode.field "type" Decode.string |> Decode.andThen - (\str -> - case P.fromByteString parser (\_ _ -> ()) str of - Ok type_ -> - Decode.succeed type_ - - Err _ -> - Decode.fail ("failed to parse package name: " ++ str) + (\type_ -> + case type_ of + "Lambda" -> + Decode.map2 Lambda + (Decode.field "arg" jsonDecoder) + (Decode.field "body" jsonDecoder) + + "Var" -> + Decode.map Var + (Decode.field "name" Decode.string) + + "Type" -> + Decode.map2 Type + (Decode.field "name" Decode.string) + (Decode.field "args" (Decode.list jsonDecoder)) + + "Record" -> + Decode.map2 Record + (Decode.field "fields" (Decode.list (D.jsonPair Decode.string jsonDecoder))) + (Decode.field "ext" (Decode.maybe Decode.string)) + + "Unit" -> + Decode.succeed Unit + + "Tuple" -> + Decode.map3 Tuple + (Decode.field "a" jsonDecoder) + (Decode.field "b" jsonDecoder) + (Decode.field "cs" (Decode.list jsonDecoder)) + + _ -> + Decode.fail ("Failed to decode Type's type: " ++ type_) ) diff --git a/src/Compiler/Elm/Docs.elm b/src/Compiler/Elm/Docs.elm index 025a92388..fc3a67af8 100644 --- a/src/Compiler/Elm/Docs.elm +++ b/src/Compiler/Elm/Docs.elm @@ -15,6 +15,7 @@ module Compiler.Elm.Docs exposing , jsonModuleEncoder ) +import Basics.Extra exposing (flip) import Compiler.AST.Canonical as Can import Compiler.AST.Source as Src import Compiler.AST.Utils.Binop as Binop @@ -35,7 +36,6 @@ import Compiler.Reporting.Annotation as A import Compiler.Reporting.Error.Docs as E import Compiler.Reporting.Result as Result import Data.Map as Dict exposing (Dict) -import Flip import Json.Decode as Decode import Json.Encode as Encode import Utils.Main as Utils @@ -735,7 +735,7 @@ gatherTypes decls types = gatherTypes subDecls (addDef types def) Can.DeclareRec def defs subDecls -> - gatherTypes subDecls (List.foldl (Flip.flip addDef) (addDef types def) defs) + gatherTypes subDecls (List.foldl (flip addDef) (addDef types def) defs) Can.SaveTheEnvironment -> types @@ -770,8 +770,15 @@ jsonDecoder = jsonModuleEncoder : Module -> Encode.Value -jsonModuleEncoder = - E.toJsonValue << encodeModule +jsonModuleEncoder (Module name comment unions aliases values binops) = + Encode.object + [ ( "name", Encode.string name ) + , ( "comment", Encode.string comment ) + , ( "unions", E.assocListDict Encode.string jsonUnionEncoder unions ) + , ( "aliases", E.assocListDict Encode.string jsonAliasEncoder aliases ) + , ( "values", E.assocListDict Encode.string jsonValueEncoder values ) + , ( "binops", E.assocListDict Encode.string jsonBinopEncoder binops ) + ] jsonModuleDecoder : Decode.Decoder Module @@ -785,14 +792,30 @@ jsonModuleDecoder = (Decode.field "binops" (D.assocListDict compare Decode.string jsonBinopDecoder)) +jsonUnionEncoder : Union -> Encode.Value +jsonUnionEncoder (Union comment args cases) = + Encode.object + [ ( "comment", Encode.string comment ) + , ( "args", Encode.list Encode.string args ) + , ( "cases", Encode.list (E.jsonPair Encode.string (Encode.list Type.jsonEncoder)) cases ) + ] + + jsonUnionDecoder : Decode.Decoder Union jsonUnionDecoder = Decode.map3 Union (Decode.field "comment" Decode.string) (Decode.field "args" (Decode.list Decode.string)) - (Decode.field "cases" - (Decode.list (D.jsonPair Decode.string (Decode.list Type.jsonDecoder))) - ) + (Decode.field "cases" (Decode.list (D.jsonPair Decode.string (Decode.list Type.jsonDecoder)))) + + +jsonAliasEncoder : Alias -> Encode.Value +jsonAliasEncoder (Alias comment args type_) = + Encode.object + [ ( "comment", Encode.string comment ) + , ( "args", Encode.list Encode.string args ) + , ( "type", Type.jsonEncoder type_ ) + ] jsonAliasDecoder : Decode.Decoder Alias @@ -803,6 +826,14 @@ jsonAliasDecoder = (Decode.field "type" Type.jsonDecoder) +jsonValueEncoder : Value -> Encode.Value +jsonValueEncoder (Value comment type_) = + Encode.object + [ ( "comment", Encode.string comment ) + , ( "type", Type.jsonEncoder type_ ) + ] + + jsonValueDecoder : Decode.Decoder Value jsonValueDecoder = Decode.map2 Value @@ -810,6 +841,16 @@ jsonValueDecoder = (Decode.field "type" Type.jsonDecoder) +jsonBinopEncoder : Binop -> Encode.Value +jsonBinopEncoder (Binop comment type_ associativity precedence) = + Encode.object + [ ( "comment", Encode.string comment ) + , ( "type", Type.jsonEncoder type_ ) + , ( "associativity", Binop.associativityEncoder associativity ) + , ( "precedence", Binop.precedenceEncoder precedence ) + ] + + jsonBinopDecoder : Decode.Decoder Binop jsonBinopDecoder = Decode.map4 Binop diff --git a/src/Compiler/Generate/JavaScript.elm b/src/Compiler/Generate/JavaScript.elm index 135d33773..dee087335 100644 --- a/src/Compiler/Generate/JavaScript.elm +++ b/src/Compiler/Generate/JavaScript.elm @@ -4,6 +4,7 @@ module Compiler.Generate.JavaScript exposing , generateForReplEndpoint ) +import Basics.Extra exposing (flip) import Compiler.AST.Canonical as Can import Compiler.AST.Optimized as Opt import Compiler.Data.Index as Index @@ -21,7 +22,6 @@ import Compiler.Reporting.Render.Type.Localizer as L import Data.Map as Dict exposing (Dict) import Data.Maybe as Maybe import Data.Set as EverySet exposing (EverySet) -import Flip import Json.Encode as Encode import Utils.Crash exposing (crash) import Utils.Main as Utils @@ -216,7 +216,7 @@ addGlobalHelp mode graph global state = -- This is required given that it looks like `Data.Set.union` sorts its elements List.sortWith Opt.compareGlobal (EverySet.toList deps) in - List.foldl (Flip.flip (addGlobal mode graph)) someState sortedDeps + List.foldl (flip (addGlobal mode graph)) someState sortedDeps in case Utils.find global graph of Opt.Define expr deps -> @@ -489,7 +489,7 @@ generateManager mode graph (Opt.Global ((ModuleName.Canonical _ moduleName) as h JS.ExprAssign managerLVar <| JS.ExprCall (JS.ExprRef (JsName.fromKernel Name.platform "createManager")) args in - addStmt (List.foldl (Flip.flip (addGlobal mode graph)) state deps) <| + addStmt (List.foldl (flip (addGlobal mode graph)) state deps) <| JS.Block (createManager :: stmts) @@ -574,7 +574,7 @@ generateExports mode (Trie maybeMain subs) = ++ name ++ "':" ++ generateExports mode subTrie - ++ List.foldl (Flip.flip (addSubTrie mode)) "}" otherSubTries + ++ List.foldl (flip (addSubTrie mode)) "}" otherSubTries addSubTrie : Mode.Mode -> String -> ( Name.Name, Trie ) -> String diff --git a/src/Data/Graph.elm b/src/Data/Graph.elm index ac8dc99f1..43d0944ff 100644 --- a/src/Data/Graph.elm +++ b/src/Data/Graph.elm @@ -28,8 +28,8 @@ module Data.Graph exposing , vertices ) +import Basics.Extra exposing (flip) import Data.Map as Dict exposing (Dict) -import Flip import Set exposing (Set) import Tree exposing (Tree) import Utils.Main as Utils @@ -262,7 +262,7 @@ list is not within the given @Bounds@. -} buildG : Bounds -> List Edge -> Graph buildG = - accumArray (Flip.flip (::)) [] + accumArray (flip (::)) [] {-| (O(V+E)). The graph obtained by reversing all edges. diff --git a/src/Terminal/Diff.elm b/src/Terminal/Diff.elm index 31e1fe044..15931a869 100644 --- a/src/Terminal/Diff.elm +++ b/src/Terminal/Diff.elm @@ -3,6 +3,7 @@ module Terminal.Diff exposing , run ) +import Basics.Extra exposing (flip) import Builder.BackgroundWriter as BW import Builder.Build as Build import Builder.Deps.Diff as DD exposing (Changes(..), ModuleChanges(..), PackageChanges(..)) @@ -360,7 +361,7 @@ changesToDoc categoryName unions aliases values binops = else Just <| D.vcat <| - D.plus (D.fromChars categoryName) (D.fromChars ":") + D.append (D.fromChars categoryName) (D.fromChars ":") :: unions ++ aliases ++ binops @@ -381,7 +382,7 @@ unionToDoc localizer name (Docs.Union _ tvars ctors) = D.hang 4 (D.sep (setup - :: List.map2 D.plus + :: List.map2 (flip D.plus) (D.fromChars "=" :: List.repeat (List.length ctors - 1) (D.fromChars "|")) (List.map ctorDoc ctors) ) @@ -404,7 +405,7 @@ aliasToDoc localizer name (Docs.Alias _ tvars tipe) = valueToDoc : L.Localizer -> Name.Name -> Docs.Value -> D.Doc valueToDoc localizer name (Docs.Value _ tipe) = - D.hang 4 <| D.sep [ D.plus (D.fromName name) (D.fromChars ":"), typeDoc localizer tipe ] + D.hang 4 <| D.sep [ D.fromName name |> D.plus (D.fromChars ":"), typeDoc localizer tipe ] binopToDoc : L.Localizer -> Name.Name -> Docs.Binop -> D.Doc diff --git a/src/Terminal/Terminal/Chomp.elm b/src/Terminal/Terminal/Chomp.elm index cd2a2ce36..4f27a3221 100644 --- a/src/Terminal/Terminal/Chomp.elm +++ b/src/Terminal/Terminal/Chomp.elm @@ -12,9 +12,9 @@ module Terminal.Terminal.Chomp exposing , pure ) +import Basics.Extra exposing (flip) import Data.IO as IO exposing (IO) import Data.Maybe as Maybe -import Flip import Terminal.Terminal.Internal exposing (ArgError(..), Args(..), CompleteArgs(..), Error(..), Expectation(..), Flag(..), FlagError(..), Flags(..), Parser(..), RequiredArgs(..)) @@ -111,7 +111,7 @@ chompArgsHelp : chompArgsHelp suggest chunks completeArgsList revSuggest revArgErrors = case completeArgsList of [] -> - ( List.foldl (Flip.flip addSuggest) (IO.pure []) revSuggest + ( List.foldl (flip addSuggest) (IO.pure []) revSuggest , Err (BadArgs (List.reverse revArgErrors)) ) diff --git a/src/Utils/Main.elm b/src/Utils/Main.elm index 0a4508acb..7f3e6ae24 100644 --- a/src/Utils/Main.elm +++ b/src/Utils/Main.elm @@ -107,6 +107,7 @@ module Utils.Main exposing , mapUnions , mapUnionsWith , maybeEncoder + , maybeMapM , maybeTraverse , maybeTraverseStateT , maybeTraverseTask @@ -150,6 +151,7 @@ module Utils.Main exposing ) import Array exposing (Array) +import Basics.Extra exposing (flip) import Builder.Reporting.Task as Task exposing (Task) import Compiler.Data.Index as Index import Compiler.Data.NonEmptyList as NE @@ -157,7 +159,6 @@ import Compiler.Reporting.Result as R import Data.IO as IO exposing (IO(..), IORef(..)) import Data.Map as Dict exposing (Dict) import Data.Set as EverySet exposing (EverySet) -import Flip exposing (flip) import Json.Decode as Decode import Json.Encode as Encode import Maybe.Extra as Maybe @@ -445,6 +446,11 @@ mapM = listTraverse +maybeMapM : (a -> Maybe b) -> List a -> Maybe (List b) +maybeMapM = + listMaybeTraverse + + mapMArray : (a -> IO b) -> Array a -> IO (Array b) mapMArray = arrayTraverse @@ -516,6 +522,12 @@ listTraverse f = (IO.pure []) +listMaybeTraverse : (a -> Maybe b) -> List a -> Maybe (List b) +listMaybeTraverse f = + List.foldr (\a -> Maybe.andThen (\c -> Maybe.map (\va -> va :: c) (f a))) + (Just []) + + nonEmptyListTraverse : (a -> IO b) -> NE.Nonempty a -> IO (NE.Nonempty b) nonEmptyListTraverse f (NE.Nonempty x list) = List.foldl (\a -> IO.bind (\c -> IO.fmap (\va -> NE.cons va c) (f a)))