diff --git a/cli/gen-package/elm.json b/cli/gen-package/elm.json index d6e701f..f406918 100644 --- a/cli/gen-package/elm.json +++ b/cli/gen-package/elm.json @@ -1,33 +1,47 @@ { - "type": "application", - "source-directories": ["src", "codegen", "../../src"], - "elm-version": "0.19.1", - "dependencies": { - "direct": { - "Chadtech/elm-bool-extra": "2.4.2", - "elm/browser": "1.0.2", - "elm/core": "1.0.5", - "elm/html": "1.0.0", - "elm/json": "1.1.3", - "elm/parser": "1.1.0", - "elm/project-metadata-utils": "1.0.2", - "elm-community/maybe-extra": "5.2.0", - "rtfeldman/elm-hex": "1.0.0", - "stil4m/elm-syntax": "7.2.4", - "the-sett/elm-pretty-printer": "3.0.0" + "type": "application", + "source-directories": [ + "src", + "codegen", + "../../src" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "Chadtech/elm-bool-extra": "2.4.2", + "elm/browser": "1.0.2", + "elm/core": "1.0.5", + "elm/html": "1.0.0", + "elm/json": "1.1.3", + "elm/parser": "1.1.0", + "elm/project-metadata-utils": "1.0.2", + "elm-community/maybe-extra": "5.2.0", + "rtfeldman/elm-hex": "1.0.0", + "stil4m/elm-syntax": "7.2.4", + "the-sett/elm-pretty-printer": "3.0.0" + }, + "indirect": { + "elm/time": "1.0.0", + "elm/url": "1.0.0", + "elm/virtual-dom": "1.0.2", + "elm-community/basics-extra": "4.1.0", + "elm-community/list-extra": "8.3.0", + "miniBill/elm-unicode": "1.0.2", + "stil4m/structured-writer": "1.0.3" + } }, - "indirect": { - "elm/time": "1.0.0", - "elm/url": "1.0.0", - "elm/virtual-dom": "1.0.2", - "elm-community/basics-extra": "4.1.0", - "elm-community/list-extra": "8.3.0", - "miniBill/elm-unicode": "1.0.2", - "stil4m/structured-writer": "1.0.3" + "test-dependencies": { + "direct": { + "elm-explorations/test": "2.2.0", + "miniBill/elm-diff": "1.1.0", + "wolfadex/elm-ansi": "3.0.0" + }, + "indirect": { + "avh4/elm-color": "1.0.0", + "elm/bytes": "1.0.8", + "elm/random": "1.0.0", + "elm/regex": "1.0.0", + "elmcraft/core-extra": "2.2.0" + } } - }, - "test-dependencies": { - "direct": {}, - "indirect": {} - } } diff --git a/cli/gen-package/src/Generate.elm b/cli/gen-package/src/Generate.elm index f4349a6..2ec25d1 100644 --- a/cli/gen-package/src/Generate.elm +++ b/cli/gen-package/src/Generate.elm @@ -1,4 +1,4 @@ -module Generate exposing (main) +module Generate exposing (main, moduleToFile) {-| -} @@ -6,13 +6,14 @@ import DocsFromSource import Elm import Elm.Annotation as Annotation import Elm.Arg -import Elm.Op import Elm.Docs import Elm.Gen +import Elm.Op import Elm.Syntax.TypeAnnotation import Elm.Type import Gen.Elm import Gen.Elm.Annotation as GenType +import Gen.Elm.Arg import Gen.Elm.Case import Gen.List import Gen.Tuple @@ -20,7 +21,7 @@ import Internal.Compiler as Compiler import Internal.Format as Format import Internal.Write as Write import Json.Decode as Json -import Gen.Elm.Arg + main : Program Json.Value () () main = @@ -129,7 +130,7 @@ moduleToFile docs = in Elm.fileWith modName { docs = - "# Generated bindings for " ++ String.join "." sourceModName + "# Generated bindings for " ++ String.join "." sourceModName , aliases = [ ( [ "Elm", "Annotation" ], "Type" ) ] @@ -307,21 +308,21 @@ block2Case thisModule union = (Elm.fn2 (Elm.Arg.var (union.name ++ "Expression")) (Elm.Arg.varWith (union.name ++ "Tags") - (Annotation.record - (List.map - (\(tagname, subtypes) -> - ( tagname - , Annotation.function - (List.map - (\_ -> Gen.Elm.annotation_.expression) - subtypes + (Annotation.record + (List.map + (\( tagname, subtypes ) -> + ( tagname + , Annotation.function + (List.map + (\_ -> Gen.Elm.annotation_.expression) + subtypes + ) + Gen.Elm.annotation_.expression + ) ) - Gen.Elm.annotation_.expression + union.tags ) - ) - union.tags ) - ) ) (\express tagRecord -> Gen.Elm.Case.custom express @@ -333,41 +334,40 @@ block2Case thisModule union = ) ) + +toBranch : List String -> Elm.Expression -> ( String, List Elm.Type.Type ) -> Maybe Elm.Expression toBranch thisModule tagRecord ( tagname, subtypes ) = let - moduleName = - Elm.list (List.map Elm.string thisModule) - extractSubTypes i subs exp = - case subs of - [] -> - exp - - (subtype :: remain) -> - let - - subtypeName = - case typeToName subtype of - Nothing -> "arg_" ++ (String.fromInt i) - - Just name -> name - - newExp = - exp - |> Elm.Op.pipe - (Elm.apply Gen.Elm.Arg.values_.item - [ Gen.Elm.Arg.varWith - (Format.formatValue subtypeName) - (typeToExpression thisModule subtype) - ] - ) - in - extractSubTypes (i + 1) remain newExp + case subs of + [] -> + exp + subtype :: remain -> + let + subtypeName = + case typeToName subtype of + Nothing -> + "arg_" ++ String.fromInt i + + Just name -> + name + + newExp = + exp + |> Elm.Op.pipe + (Elm.apply Gen.Elm.Arg.values_.item + [ Gen.Elm.Arg.varWith + (Format.formatValue subtypeName) + (typeToExpression thisModule subtype) + ] + ) + in + extractSubTypes (i + 1) remain newExp in Gen.Elm.Case.call_.branch (Gen.Elm.Arg.customType tagname (Elm.get tagname tagRecord) - |> extractSubTypes 0 subtypes + |> extractSubTypes 0 subtypes ) basicsIdentity |> Just @@ -376,10 +376,10 @@ toBranch thisModule tagRecord ( tagname, subtypes ) = basicsIdentity : Elm.Expression basicsIdentity = Elm.value - { importFrom = [ "Basics" ] - , name = "identity" - , annotation = Just (Annotation.function [ Annotation.var "a" ] (Annotation.var "a")) - } + { importFrom = [ "Basics" ] + , name = "identity" + , annotation = Just (Annotation.function [ Annotation.var "a" ] (Annotation.var "a")) + } block2Maker : List String -> Elm.Docs.Block -> Maybe Elm.Expression @@ -861,10 +861,10 @@ generateBlocks thisModule block = ] _ -> - let - name = - Format.formatValue value.name - in + let + name = + Format.formatValue value.name + in [ Elm.declaration name (valueWith thisModule value.name @@ -1305,16 +1305,31 @@ typeToName elmType = Elm.Type.Record fields maybeExtensible -> maybeExtensible + isPrimitiveTypeName : String -> Bool isPrimitiveTypeName name = case name of - "List.List" -> True - "Basics.Bool" -> True - "Basics.Float" -> True - "Basics.Int" -> True - "String.String" -> True - "Char.Char" -> True - _ -> False + "List.List" -> + True + + "Basics.Bool" -> + True + + "Basics.Float" -> + True + + "Basics.Int" -> + True + + "String.String" -> + True + + "Char.Char" -> + True + + _ -> + False + typeToExpression : List String -> Elm.Type.Type -> Elm.Expression typeToExpression thisModule elmType = @@ -1429,6 +1444,13 @@ namedWithType thisModule name types = "Sub" (List.map (typeToExpression thisModule) types) + [ typeName ] -> + -- This is a type from the current module + GenType.namedWith + thisModule + typeName + (List.map (typeToExpression thisModule) types) + _ -> let fragsLength = diff --git a/cli/gen-package/tests/Tests.elm b/cli/gen-package/tests/Tests.elm new file mode 100644 index 0000000..bd2fc23 --- /dev/null +++ b/cli/gen-package/tests/Tests.elm @@ -0,0 +1,129 @@ +module Tests exposing (suite) + +import Ansi.Color +import Diff +import Diff.ToString +import DocsFromSource +import Expect +import Generate +import Test exposing (Test, test) + + +suite : Test +suite = + testBinding "Parser" parserModule parserBindings + + +testBinding : String -> String -> String -> Test +testBinding label input output = + test ("Produces the right bindings for " ++ label) <| + \_ -> + case DocsFromSource.fromSource input of + Err e -> + Expect.fail e + + Ok parsed -> + (Generate.moduleToFile parsed).contents + |> expectEqualMultiline output + + +expectEqualMultiline : String -> String -> Expect.Expectation +expectEqualMultiline exp actual = + if exp == actual then + Expect.pass + + else + let + header : String + header = + Ansi.Color.fontColor Ansi.Color.blue "Diff from expected to actual:" + in + Expect.fail + (header + ++ "\n" + ++ (Diff.diffLinesWith + (Diff.defaultOptions + |> Diff.ignoreLeadingWhitespace + ) + exp + actual + |> Diff.ToString.diffToString { context = 4, color = True } + ) + ) + + +parserModule : String +parserModule = + """module Parser exposing (Trailing(..)) + +type Trailing + = Optional + | Forbidden +""" + + +parserBindings : String +parserBindings = + """module Gen.Parser exposing ( moduleName_, annotation_, make_, caseOf_ ) + +{-| +# Generated bindings for Parser + +@docs moduleName_, annotation_, make_, caseOf_ +-} + + +import Elm +import Elm.Annotation as Type +import Elm.Arg +import Elm.Case + + +{-| The name of this module. -} +moduleName_ : List String +moduleName_ = + [ "Parser" ] + + +annotation_ : { trailing : Type.Annotation } +annotation_ = + { trailing = Type.namedWith [ "Parser" ] "Trailing" [] } + + +make_ : { optional : Elm.Expression, forbidden : Elm.Expression } +make_ = + { optional = + Elm.value + { importFrom = [ "Parser" ] + , name = "Optional" + , annotation = Just (Type.namedWith [ "Parser" ] "Trailing" []) + } + , forbidden = + Elm.value + { importFrom = [ "Parser" ] + , name = "Forbidden" + , annotation = Just (Type.namedWith [ "Parser" ] "Trailing" []) + } + } + + +caseOf_ : + { trailing : + Elm.Expression + -> { optional : Elm.Expression, forbidden : Elm.Expression } + -> Elm.Expression + } +caseOf_ = + { trailing = + \\trailingExpression trailingTags -> + Elm.Case.custom + trailingExpression + (Type.namedWith [ "Parser" ] "Trailing" []) + [ Elm.Case.branch + (Elm.Arg.customType "Optional" trailingTags.optional) + Basics.identity + , Elm.Case.branch + (Elm.Arg.customType "Forbidden" trailingTags.forbidden) + Basics.identity + ] + }"""