Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix binding codegen for shadowed aliases #105

Open
wants to merge 2 commits into
base: main
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
66 changes: 37 additions & 29 deletions cli/gen-package/elm.json
Original file line number Diff line number Diff line change
@@ -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": {}
}
}
129 changes: 73 additions & 56 deletions cli/gen-package/src/Generate.elm
Original file line number Diff line number Diff line change
@@ -1,26 +1,27 @@
module Generate exposing (main)
module Generate exposing (main, moduleToFile, parseSources)

{-| -}

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
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 =
Expand Down Expand Up @@ -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" )
]
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 =
Expand Down
82 changes: 82 additions & 0 deletions cli/gen-package/tests/Tests.elm
Original file line number Diff line number Diff line change
@@ -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 = []
}
Loading