diff --git a/cli/gen-package/elm.json b/cli/gen-package/elm.json index d6e701f..c511563 100644 --- a/cli/gen-package/elm.json +++ b/cli/gen-package/elm.json @@ -1,33 +1,41 @@ { - "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": "1.2.2" + }, + "indirect": { + "elm/random": "1.0.0" + } } - }, - "test-dependencies": { - "direct": {}, - "indirect": {} - } } diff --git a/cli/gen-package/src/Generate.elm b/cli/gen-package/src/Generate.elm index f4349a6..dd181de 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, parseSources) {-| -} @@ -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,42 @@ block2Case thisModule union = ) ) + 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 +378,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 +863,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 +1307,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 = diff --git a/cli/gen-package/tests/Tests.elm b/cli/gen-package/tests/Tests.elm new file mode 100644 index 0000000..748b0fb --- /dev/null +++ b/cli/gen-package/tests/Tests.elm @@ -0,0 +1,82 @@ +module Tests exposing (suite) + +import DocsFromSource +import Expect +import Generate +import Test exposing (Test, test) + + +source : String +source = + """module Foo exposing (a) + +import Imported exposing (Foo(..)) + + +type alias Foo a = + Imported.Foo a + + +a : Foo Int +a = + Debug.todo "" +""" + + +expected : String +expected = + """module Gen.Foo exposing ( moduleName_, a, values_ ) + +{-| +# Generated bindings for Foo + +@docs moduleName_, a, values_ +-} + + +import Elm +import Elm.Annotation as Type + + +{-| The name of this module. -} +moduleName_ : List String +moduleName_ = + [ "Foo" ] + + +{-| a: Foo.Foo Int -} +a : Elm.Expression +a = + Elm.value + { importFrom = [ "Foo" ] + , name = "a" + , annotation = Just (Type.namedWith [ "Foo" ] "Foo" [ Type.int ]) + } + + +values_ : { a : Elm.Expression } +values_ = + { a = + Elm.value + { importFrom = [ "Foo" ] + , name = "a" + , annotation = Just (Type.namedWith [ "Foo" ] "Foo" [ Type.int ]) + } + }""" + + +suite : Test +suite = + test "Aliases are codegenned properly" <| + \_ -> + case DocsFromSource.fromSource source of + Err _ -> + Expect.fail "Could not parse source" + + Ok file -> + Generate.moduleToFile file + |> Expect.equal + { path = "Gen/Foo.elm" + , contents = expected + , warnings = [] + }