dillonkearns/elm-pages-v3-beta
1
1
Fork 0
mirror of https://github.com/dillonkearns/elm-pages-v3-beta.git synced 2024-11-28 14:34:18 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #316 from dillonkearns/elm-codegen

Browse Source 
Generate Route.elm with elm-codegen
This commit is contained in:
Dillon Kearns 2022-09-15 09:30:27 -07:00 committed by GitHub
commit 51d58d801a
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
31 changed files with 1254 additions and 205 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.github/workflows/ci.yml vendored
View File

@ -7,6 +7,7 @@ on:
pull_request:
branches:
- master
- serverless-latest
env:
SESSION_SECRET: hello
@ -71,7 +72,7 @@ jobs:
run: lamdera make --docs docs.json
- name: Setup for cypress
run: (cd examples/end-to-end && npm install && npx elm-tooling install && rm -rf elm-stuff && npx elm-pages codegen && lamdera make app/Route/Index.elm)
run: (cd examples/end-to-end && npm install && npx elm-tooling install && rm -rf elm-stuff && npx elm-pages gen && lamdera make app/Route/Index.elm)
- name: Cypress tests
uses: cypress-io/github-action@v4
with:

1
.gitignore vendored
View File

@ -10,4 +10,5 @@ tests/VerifyExamples/
cypress/videos
cypress/screenshots
.idea
generated/

2
codegen/.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
Gen/

449
codegen/Generate.elm Normal file
View File

@ -0,0 +1,449 @@
port module Generate exposing (main)
{-| -}
import Elm exposing (File)
import Elm.Annotation
import Elm.Case
import Elm.CodeGen
import Elm.Declare
import Elm.Op
import Elm.Pretty
import Gen.Basics
import Gen.CodeGen.Generate exposing (Error)
import Gen.Html
import Gen.Html.Attributes
import Gen.List
import Gen.Path
import Gen.Server.Response
import Gen.String
import Gen.Tuple
import Pages.Internal.RoutePattern as RoutePattern exposing (RoutePattern)
import Pretty
import Regex exposing (Regex)
type alias Flags =
{ templates : List (List String)
, basePath : String
}
main : Program Flags () ()
main =
Platform.worker
{ init =
\{ templates, basePath } ->
( ()
, onSuccessSend [ file templates basePath ]
)
, update =
\_ model ->
( model, Cmd.none )
, subscriptions = \_ -> Sub.none
}
file : List (List String) -> String -> Elm.File
file templates basePath =
let
routes : List RoutePattern.RoutePattern
routes =
templates
|> List.filterMap RoutePattern.fromModuleName
segmentsToRouteFn : { declaration : Elm.Declaration, call : Elm.Expression -> Elm.Expression, callFrom : List String -> Elm.Expression -> Elm.Expression }
segmentsToRouteFn =
segmentsToRoute routes
routeToPathFn : { declaration : Elm.Declaration, call : Elm.Expression -> Elm.Expression, callFrom : List String -> Elm.Expression -> Elm.Expression }
routeToPathFn =
routeToPath routes
toPath : { declaration : Elm.Declaration, call : Elm.Expression -> Elm.Expression, callFrom : List String -> Elm.Expression -> Elm.Expression }
toPath =
Elm.Declare.fn "toPath"
( "route", Elm.Annotation.named [] "Route" |> Just )
(\route ->
Gen.Path.call_.fromString
(Gen.String.call_.join
(Elm.string "/")
(Elm.Op.append
baseUrlAsPath.reference
(routeToPathFn.call route)
)
)
|> Elm.withType (Elm.Annotation.named [ "Path" ] "Path")
)
baseUrlAsPath : { declaration : Elm.Declaration, reference : Elm.Expression, referenceFrom : List String -> Elm.Expression }
baseUrlAsPath =
topLevelValue
"baseUrlAsPath"
(Gen.List.call_.filter
(Elm.fn ( "item", Nothing )
(\item ->
Gen.Basics.call_.not
(Gen.String.call_.isEmpty item)
)
)
(Gen.String.call_.split (Elm.string "/")
baseUrl.reference
)
)
urlToRoute : Elm.Declaration
urlToRoute =
Elm.declaration "urlToRoute"
(Elm.fn
( "url"
, Elm.Annotation.extensible "url" [ ( "path", Elm.Annotation.string ) ]
|> Just
)
(\url ->
segmentsToRouteFn.call
(splitPath.call
(url |> Elm.get "path")
)
|> Elm.withType (Elm.Annotation.maybe (Elm.Annotation.named [] "Route"))
)
)
withoutBaseUrl : Elm.Declaration
withoutBaseUrl =
Elm.declaration "withoutBaseUrl"
(Elm.fn ( "path", Just Elm.Annotation.string )
(\path ->
Elm.ifThen
(path |> Gen.String.call_.startsWith baseUrl.reference)
(Gen.String.call_.dropLeft
(Gen.String.call_.length baseUrl.reference)
path
)
path
)
)
toString : { declaration : Elm.Declaration, call : Elm.Expression -> Elm.Expression, callFrom : List String -> Elm.Expression -> Elm.Expression }
toString =
Elm.Declare.fn "toString"
( "route", Elm.Annotation.named [] "Route" |> Just )
(\route -> Gen.Path.toAbsolute (toPath.call route))
redirectTo : Elm.Declaration
redirectTo =
Elm.declaration "redirectTo"
(Elm.fn ( "route", Elm.Annotation.named [] "Route" |> Just )
(\route ->
Gen.Server.Response.call_.temporaryRedirect
(toString.call route)
|> Elm.withType
(Elm.Annotation.namedWith [ "Server", "Response" ]
"Response"
[ Elm.Annotation.var "data"
, Elm.Annotation.var "error"
]
)
)
)
toLink : { declaration : Elm.Declaration, call : Elm.Expression -> Elm.Expression -> Elm.Expression, callFrom : List String -> Elm.Expression -> Elm.Expression -> Elm.Expression }
toLink =
Elm.Declare.fn2 "toLink"
( "toAnchorTag", Nothing )
( "route", Just (Elm.Annotation.named [] "Route") )
(\toAnchorTag route ->
Elm.apply
toAnchorTag
[ Elm.list
[ route |> toString.call |> Gen.Html.Attributes.call_.href
, Gen.Html.Attributes.attribute "elm-pages:prefetch" ""
]
]
)
link : Elm.Declaration
link =
Elm.declaration "link"
(Elm.fn3
( "attributes", Nothing )
( "children", Nothing )
( "route", Just (Elm.Annotation.named [] "Route") )
(\attributes children route ->
toLink.call
(Elm.fn
( "anchorAttrs", Nothing )
(\anchorAttrs ->
Gen.Html.call_.a
(Elm.Op.append anchorAttrs attributes)
children
)
)
route
)
)
baseUrl : { declaration : Elm.Declaration, reference : Elm.Expression, referenceFrom : List String -> Elm.Expression }
baseUrl =
topLevelValue "baseUrl" (Elm.string basePath)
in
Elm.file
[ "Route" ]
([ [ Elm.customType "Route" (routes |> List.map RoutePattern.toVariant)
, segmentsToRouteFn.declaration
, urlToRoute
, baseUrl.declaration
, routeToPathFn.declaration
, baseUrlAsPath.declaration
, toPath.declaration
, toString.declaration
, redirectTo
, toLink.declaration
, link
, withoutBaseUrl
]
|> List.map expose
, [ splitPath.declaration
, maybeToList.declaration
]
]
|> List.concat
)
splitPath : { declaration : Elm.Declaration, call : Elm.Expression -> Elm.Expression, callFrom : List String -> Elm.Expression -> Elm.Expression }
splitPath =
Elm.Declare.fn "splitPath"
( "path", Just Gen.Path.annotation_.path )
(\path ->
Gen.List.call_.filter
(Elm.fn ( "item", Just Elm.Annotation.string )
(\item -> Elm.Op.notEqual item (Elm.string ""))
)
(Gen.String.call_.split (Elm.string "/") path)
)
maybeToList : { declaration : Elm.Declaration, call : Elm.Expression -> Elm.Expression, callFrom : List String -> Elm.Expression -> Elm.Expression }
maybeToList =
Elm.Declare.fn "maybeToList"
( "maybeString", Just (Elm.Annotation.maybe Elm.Annotation.string) )
(\maybeString ->
Elm.Case.maybe maybeString
{ nothing = Elm.list []
, just = ( "string", \string -> Elm.list [ string ] )
}
|> Elm.withType (Elm.Annotation.list Elm.Annotation.string)
)
segmentsToRoute :
List RoutePattern
-> { declaration : Elm.Declaration, call : Elm.Expression -> Elm.Expression, callFrom : List String -> Elm.Expression -> Elm.Expression }
segmentsToRoute routes =
Elm.Declare.fn "segmentsToRoute"
( "segments"
, Elm.Annotation.list Elm.Annotation.string |> Just
)
(\segments ->
let
alreadyHasCatchallBranch : Bool
alreadyHasCatchallBranch =
routes
|> List.map RoutePattern.toVariantName
|> List.any
(\{ params } ->
case params of
[ RoutePattern.OptionalSplatParam2 ] ->
True
_ ->
False
)
in
(((routes
|> List.concatMap RoutePattern.routeToBranch
|> List.map (Tuple.mapSecond (\constructRoute -> Elm.CodeGen.apply [ Elm.CodeGen.val "Just", constructRoute ]))
)
++ (if alreadyHasCatchallBranch then
[]
else
[ ( Elm.CodeGen.allPattern, Elm.CodeGen.val "Nothing" ) ]
)
)
|> Elm.CodeGen.caseExpr (Elm.CodeGen.val "segments")
)
|> Elm.Pretty.prettyExpression
|> Pretty.pretty 120
|> Elm.val
|> Elm.withType
(Elm.Annotation.named [] "Route"
|> Elm.Annotation.maybe
)
)
routeToPath : List RoutePattern -> { declaration : Elm.Declaration, call : Elm.Expression -> Elm.Expression, callFrom : List String -> Elm.Expression -> Elm.Expression }
routeToPath routes =
Elm.Declare.fn "routeToPath"
( "route", Just (Elm.Annotation.named [] "Route") )
(\route_ ->
Elm.Case.custom route_
(Elm.Annotation.list Elm.Annotation.string)
(routes
|> List.map
(\route ->
case
RoutePattern.toVariantName route
|> .params
|> List.filter
(\param ->
case param of
RoutePattern.StaticParam _ ->
False
_ ->
True
)
of
[] ->
Elm.Case.branch0 (RoutePattern.toVariantName route |> .variantName)
(RoutePattern.toVariantName route
|> .params
|> List.map
(\param ->
case param of
RoutePattern.StaticParam name ->
[ Elm.string (toKebab name) ]
|> Elm.list
RoutePattern.DynamicParam name ->
Elm.list []
RoutePattern.OptionalParam2 name ->
Elm.list []
RoutePattern.RequiredSplatParam2 ->
Elm.val "TODO"
RoutePattern.OptionalSplatParam2 ->
Elm.val "TODO"
)
|> Elm.list
)
nonEmptyDynamicParams ->
Elm.Case.branch1 (RoutePattern.toVariantName route |> .variantName)
( "params", Elm.Annotation.record [] )
(\params ->
RoutePattern.toVariantName route
|> .params
|> List.map
(\param ->
case param of
RoutePattern.StaticParam name ->
[ Elm.string (toKebab name) ]
|> Elm.list
RoutePattern.DynamicParam name ->
[ Elm.get name params ]
|> Elm.list
RoutePattern.OptionalParam2 name ->
maybeToList.call (Elm.get name params)
RoutePattern.RequiredSplatParam2 ->
Elm.Op.cons (Gen.Tuple.first (Elm.get "splat" params)) (Gen.Tuple.second (Elm.get "splat" params))
RoutePattern.OptionalSplatParam2 ->
Elm.get "splat" params
)
|> Elm.list
)
)
)
|> Gen.List.call_.concat
|> Elm.withType (Elm.Annotation.list Elm.Annotation.string)
)
topLevelValue :
String
-> Elm.Expression
->
{ declaration : Elm.Declaration
, reference : Elm.Expression
, referenceFrom : List String -> Elm.Expression
}
topLevelValue name expression =
let
declaration_ :
{ declaration : Elm.Declaration
, call : List Elm.Expression -> Elm.Expression
, callFrom : List String -> List Elm.Expression -> Elm.Expression
}
declaration_ =
Elm.Declare.function name
[]
(\_ -> expression)
in
{ declaration = declaration_.declaration
, reference = declaration_.call []
, referenceFrom = \from -> declaration_.callFrom from []
}
expose : Elm.Declaration -> Elm.Declaration
expose declaration =
declaration
|> Elm.exposeWith
{ exposeConstructor = True
, group = Nothing
}
{-| Decapitalize the first letter of a string.
decapitalize "This is a phrase" == "this is a phrase"
decapitalize "Hello, World" == "hello, World"
-}
decapitalize : String -> String
decapitalize word =
-- Source: https://github.com/elm-community/string-extra/blob/4.0.1/src/String/Extra.elm
changeCase Char.toLower word
{-| Change the case of the first letter of a string to either uppercase or
lowercase, depending of the value of `wantedCase`. This is an internal
function for use in `toSentenceCase` and `decapitalize`.
-}
changeCase : (Char -> Char) -> String -> String
changeCase mutator word =
-- Source: https://github.com/elm-community/string-extra/blob/4.0.1/src/String/Extra.elm
String.uncons word
|> Maybe.map (\( head, tail ) -> String.cons (mutator head) tail)
|> Maybe.withDefault ""
toKebab : String -> String
toKebab string =
string
|> decapitalize
|> String.trim
|> Regex.replace (regexFromString "([A-Z])") (.match >> String.append "-")
|> Regex.replace (regexFromString "[_-\\s]+") (always "-")
|> String.toLower
regexFromString : String -> Regex
regexFromString =
Regex.fromString >> Maybe.withDefault Regex.never
port onSuccessSend : List File -> Cmd msg
port onFailureSend : List Error -> Cmd msg
port onInfoSend : String -> Cmd msg

12
codegen/elm.codegen.json Normal file
View File

@ -0,0 +1,12 @@
{
"elm-codegen-version": "0.2.0",
"codegen-helpers": {
"packages": {
"elm/core": "1.0.5",
"elm/html": "1.0.0"
},
"local": [
"src/"
]
}
}

38
codegen/elm.json Normal file
View File

@ -0,0 +1,38 @@
{
"type": "application",
"source-directories": [
".",
"../src/"
],
"elm-version": "0.19.1",
"dependencies": {
"direct": {
"elm/browser": "1.0.2",
"elm/core": "1.0.5",
"elm/html": "1.0.0",
"elm/json": "1.1.3",
"elm/regex": "1.0.0",
"mdgriffith/elm-codegen": "2.0.0",
"the-sett/elm-pretty-printer": "3.0.0",
"the-sett/elm-syntax-dsl": "6.0.2"
},
"indirect": {
"Chadtech/elm-bool-extra": "2.4.2",
"elm/parser": "1.1.0",
"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.6.0",
"elm-community/maybe-extra": "5.3.0",
"miniBill/elm-unicode": "1.0.2",
"rtfeldman/elm-hex": "1.0.0",
"stil4m/elm-syntax": "7.2.9",
"stil4m/structured-writer": "1.0.3"
}
},
"test-dependencies": {
"direct": {},
"indirect": {}
}
}

2
docs.json
View File

File diff suppressed because one or more lines are too long

4
elm.json
View File

@ -65,11 +65,13 @@
"robinheghan/fnv1a": "1.0.0 <= v < 2.0.0",
"rtfeldman/elm-css": "17.1.1 <= v < 18.0.0",
"stil4m/elm-syntax": "7.2.7 <= v < 8.0.0",
"the-sett/elm-syntax-dsl": "6.0.2 <= v < 7.0.0",
"turboMaCk/non-empty-list-alias": "1.2.0 <= v < 2.0.0",
"vito/elm-ansi": "10.0.1 <= v < 11.0.0"
},
"test-dependencies": {
"avh4/elm-program-test": "3.1.0 <= v < 4.0.0",
"elm-explorations/test": "1.2.2 <= v < 2.0.0"
"elm-explorations/test": "1.2.2 <= v < 2.0.0",
"the-sett/elm-pretty-printer": "3.0.0 <= v < 4.0.0"
}
}

7
examples/base-path/elm.json
View File

@ -41,23 +41,26 @@
"robinheghan/fnv1a": "1.0.0",
"robinheghan/murmur3": "1.0.0",
"rtfeldman/elm-css": "16.1.1",
"the-sett/elm-pretty-printer": "3.0.0",
"the-sett/elm-syntax-dsl": "6.0.2",
"tripokey/elm-fuzzy": "5.2.1",
"turboMaCk/non-empty-list-alias": "1.2.0",
"vito/elm-ansi": "10.0.1",
"zwilias/json-decode-exploration": "6.0.0"
},
"indirect": {
"Chadtech/elm-bool-extra": "2.4.2",
"bburdette/toop": "1.0.1",
"elm/file": "1.0.5",
"elm/random": "1.0.0",
"elm-community/basics-extra": "4.1.0",
"elm-community/maybe-extra": "5.3.0",
"fredcy/elm-parseint": "2.0.1",
"mgold/elm-nonempty-list": "4.2.0",
"miniBill/elm-unicode": "1.0.2",
"rtfeldman/elm-hex": "1.0.0",
"stil4m/elm-syntax": "7.2.9",
"stil4m/structured-writer": "1.0.3",
"the-sett/elm-pretty-printer": "3.0.0"
"stil4m/structured-writer": "1.0.3"
}
},
"test-dependencies": {

2
examples/base-path/package-lock.json generated
View File

@ -55,6 +55,7 @@
"@types/node": "12.20.12",
"@types/serve-static": "^1.15.0",
"cypress": "^10.6.0",
"elm-codegen": "^0.2.0",
"elm-optimize-level-2": "^0.1.5",
"elm-review": "^2.7.4",
"elm-test": "^0.19.1-revision9",
@ -1565,6 +1566,7 @@
"cross-spawn": "7.0.3",
"cypress": "^10.6.0",
"devcert": "^1.2.2",
"elm-codegen": "^0.2.0",
"elm-doc-preview": "^5.0.5",
"elm-hot": "^1.1.6",
"elm-optimize-level-2": "^0.1.5",

7
examples/docs/elm.json
View File

@ -44,14 +44,18 @@
"robinheghan/fnv1a": "1.0.0",
"robinheghan/murmur3": "1.0.0",
"rtfeldman/elm-css": "16.1.1",
"the-sett/elm-pretty-printer": "3.0.0",
"the-sett/elm-syntax-dsl": "6.0.2",
"turboMaCk/non-empty-list-alias": "1.2.0",
"vito/elm-ansi": "10.0.1"
},
"indirect": {
"Chadtech/elm-bool-extra": "2.4.2",
"billstclair/elm-xml-eeue56": "2.0.0",
"dmy/elm-imf-date-time": "1.0.1",
"elm/file": "1.0.5",
"elm-community/basics-extra": "4.1.0",
"elm-community/maybe-extra": "5.3.0",
"fredcy/elm-parseint": "2.0.1",
"justinmimbs/time-extra": "1.1.0",
"lazamar/dict-parser": "1.0.2",
@ -60,8 +64,7 @@
"rtfeldman/elm-iso8601-date-strings": "1.1.4",
"ryannhg/date-format": "2.3.0",
"stil4m/elm-syntax": "7.2.9",
"stil4m/structured-writer": "1.0.3",
"the-sett/elm-pretty-printer": "3.0.0"
"stil4m/structured-writer": "1.0.3"
}
},
"test-dependencies": {

6
examples/end-to-end/elm.json
View File

@ -44,11 +44,14 @@
"noahzgordon/elm-color-extra": "1.0.2",
"robinheghan/fnv1a": "1.0.0",
"rtfeldman/elm-css": "16.1.1",
"the-sett/elm-pretty-printer": "3.0.0",
"the-sett/elm-syntax-dsl": "6.0.2",
"turboMaCk/non-empty-list-alias": "1.2.0",
"vito/elm-ansi": "10.0.1",
"ymtszw/elm-xml-decode": "3.2.1"
},
"indirect": {
"Chadtech/elm-bool-extra": "2.4.2",
"elm/file": "1.0.5",
"elm-community/basics-extra": "4.1.0",
"elm-community/maybe-extra": "5.3.0",
@ -57,8 +60,7 @@
"miniBill/elm-unicode": "1.0.2",
"rtfeldman/elm-hex": "1.0.0",
"stil4m/elm-syntax": "7.2.9",
"stil4m/structured-writer": "1.0.3",
"the-sett/elm-pretty-printer": "3.0.0"
"stil4m/structured-writer": "1.0.3"
}
},
"test-dependencies": {

2
examples/end-to-end/package-lock.json generated
View File

@ -53,6 +53,7 @@
"@types/node": "12.20.12",
"@types/serve-static": "^1.15.0",
"cypress": "^10.6.0",
"elm-codegen": "^0.2.0",
"elm-optimize-level-2": "^0.1.5",
"elm-review": "^2.7.4",
"elm-test": "^0.19.1-revision9",
@ -1493,6 +1494,7 @@
"cross-spawn": "7.0.3",
"cypress": "^10.6.0",
"devcert": "^1.2.2",
"elm-codegen": "^0.2.0",
"elm-doc-preview": "^5.0.5",
"elm-hot": "^1.1.6",
"elm-optimize-level-2": "^0.1.5",

7
examples/escaping/elm.json
View File

@ -41,23 +41,26 @@
"robinheghan/fnv1a": "1.0.0",
"robinheghan/murmur3": "1.0.0",
"rtfeldman/elm-css": "16.1.1",
"the-sett/elm-pretty-printer": "3.0.0",
"the-sett/elm-syntax-dsl": "6.0.2",
"tripokey/elm-fuzzy": "5.2.1",
"turboMaCk/non-empty-list-alias": "1.2.0",
"vito/elm-ansi": "10.0.1",
"zwilias/json-decode-exploration": "6.0.0"
},
"indirect": {
"Chadtech/elm-bool-extra": "2.4.2",
"bburdette/toop": "1.0.1",
"elm/file": "1.0.5",
"elm/random": "1.0.0",
"elm-community/basics-extra": "4.1.0",
"elm-community/maybe-extra": "5.3.0",
"fredcy/elm-parseint": "2.0.1",
"mgold/elm-nonempty-list": "4.2.0",
"miniBill/elm-unicode": "1.0.2",
"rtfeldman/elm-hex": "1.0.0",
"stil4m/elm-syntax": "7.2.9",
"stil4m/structured-writer": "1.0.3",
"the-sett/elm-pretty-printer": "3.0.0"
"stil4m/structured-writer": "1.0.3"
}
},
"test-dependencies": {

2
examples/escaping/package-lock.json generated
View File

@ -52,6 +52,7 @@
"@types/node": "12.20.12",
"@types/serve-static": "^1.15.0",
"cypress": "^10.6.0",
"elm-codegen": "^0.2.0",
"elm-optimize-level-2": "^0.1.5",
"elm-review": "^2.7.4",
"elm-test": "^0.19.1-revision9",
@ -5932,6 +5933,7 @@
"cross-spawn": "7.0.3",
"cypress": "^10.6.0",
"devcert": "^1.2.2",
"elm-codegen": "^0.2.0",
"elm-doc-preview": "^5.0.5",
"elm-hot": "^1.1.6",
"elm-optimize-level-2": "^0.1.5",

7
examples/routing/elm.json
View File

@ -37,18 +37,21 @@
"noahzgordon/elm-color-extra": "1.0.2",
"robinheghan/fnv1a": "1.0.0",
"rtfeldman/elm-css": "16.1.1",
"the-sett/elm-pretty-printer": "3.0.0",
"the-sett/elm-syntax-dsl": "6.0.2",
"turboMaCk/non-empty-list-alias": "1.2.0",
"vito/elm-ansi": "10.0.1"
},
"indirect": {
"Chadtech/elm-bool-extra": "2.4.2",
"elm/file": "1.0.5",
"elm-community/basics-extra": "4.1.0",
"elm-community/maybe-extra": "5.3.0",
"fredcy/elm-parseint": "2.0.1",
"miniBill/elm-unicode": "1.0.2",
"rtfeldman/elm-hex": "1.0.0",
"stil4m/elm-syntax": "7.2.9",
"stil4m/structured-writer": "1.0.3",
"the-sett/elm-pretty-printer": "3.0.0"
"stil4m/structured-writer": "1.0.3"
}
},
"test-dependencies": {

2
examples/routing/package-lock.json generated
View File

@ -54,6 +54,7 @@
"@types/node": "12.20.12",
"@types/serve-static": "^1.15.0",
"cypress": "^10.6.0",
"elm-codegen": "^0.2.0",
"elm-optimize-level-2": "^0.1.5",
"elm-review": "^2.7.4",
"elm-test": "^0.19.1-revision9",
@ -1506,6 +1507,7 @@
"cross-spawn": "7.0.3",
"cypress": "^10.6.0",
"devcert": "^1.2.2",
"elm-codegen": "^0.2.0",
"elm-doc-preview": "^5.0.5",
"elm-hot": "^1.1.6",
"elm-optimize-level-2": "^0.1.5",

16
examples/todos/codegen/Cli.elm
View File

@ -114,11 +114,18 @@ createFile moduleName =
Elm.Case.custom msg
(Elm.Annotation.named [] "Msg")
[ Elm.Case.branch0 "NoOp"
(Elm.tuple model Gen.Effect.none)
(Elm.tuple model
(Gen.Effect.none
|> Elm.withType effectType
)
)
]
, init =
\pageUrl sharedModel app ->
Elm.tuple (Elm.record []) Gen.Effect.none
Elm.tuple (Elm.record [])
(Gen.Effect.none
|> Elm.withType effectType
)
, subscriptions =
\maybePageUrl routeParams path sharedModel model ->
Gen.Platform.Sub.none
@ -129,6 +136,11 @@ createFile moduleName =
}
effectType : Elm.Annotation.Annotation
effectType =
Elm.Annotation.namedWith [ "Effect" ] "Effect" [ Elm.Annotation.var "msg" ]
port print : String -> Cmd msg

5
examples/todos/codegen/elm.json
View File

@ -13,15 +13,18 @@
"elm/html": "1.0.0",
"elm/json": "1.1.3",
"elm/regex": "1.0.0",
"mdgriffith/elm-codegen": "2.0.0"
"mdgriffith/elm-codegen": "2.0.0",
"the-sett/elm-syntax-dsl": "6.0.2"
},
"indirect": {
"Chadtech/elm-bool-extra": "2.4.2",
"elm/parser": "1.1.0",
"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.6.0",
"elm-community/maybe-extra": "5.3.0",
"miniBill/elm-unicode": "1.0.2",
"rtfeldman/elm-hex": "1.0.0",
"stil4m/elm-syntax": "7.2.9",

7
examples/todos/elm.json
View File

@ -44,21 +44,24 @@
"robinheghan/fnv1a": "1.0.0",
"rtfeldman/elm-css": "16.1.1",
"rtfeldman/elm-iso8601-date-strings": "1.1.4",
"the-sett/elm-pretty-printer": "3.0.0",
"the-sett/elm-syntax-dsl": "6.0.2",
"turboMaCk/non-empty-list-alias": "1.2.0",
"vito/elm-ansi": "10.0.1"
},
"indirect": {
"Chadtech/elm-bool-extra": "2.4.2",
"elm/file": "1.0.5",
"elm/random": "1.0.0",
"elm-community/basics-extra": "4.1.0",
"elm-community/maybe-extra": "5.3.0",
"fredcy/elm-parseint": "2.0.1",
"j-maas/elm-ordered-containers": "1.0.0",
"lukewestby/elm-string-interpolate": "1.0.4",
"miniBill/elm-unicode": "1.0.2",
"rtfeldman/elm-hex": "1.0.0",
"stil4m/elm-syntax": "7.2.9",
"stil4m/structured-writer": "1.0.3",
"the-sett/elm-pretty-printer": "3.0.0"
"stil4m/structured-writer": "1.0.3"
}
},
"test-dependencies": {

2
examples/todos/send-grid

@ -1 +1 @@
Subproject commit 7cf8516df2f9e4c6995a544217bf87ec57701c9f
Subproject commit c05ffc2c4e2a872e8e862082104c81d87b83d553

8
generator/src/cli.js
View File

@ -8,6 +8,7 @@ const init = require("./init.js");
const codegen = require("./codegen.js");
const fs = require("fs");
const path = require("path");
const { restoreColorSafe } = require("./error-formatter");
const commander = require("commander");
const { compileCliApp } = require("./compile-elm.js");
@ -124,6 +125,7 @@ async function main() {
if (!fs.existsSync(expectedFilePath)) {
throw `I couldn't find a module named ${expectedFilePath}`;
}
try {
await codegen.generate("");
await runElmCodegenInstall();
await compileCliApp(
@ -131,12 +133,14 @@ async function main() {
{},
`${splitModuleName.join("/")}.elm`,
path.join(process.cwd(), "codegen/elm-stuff/scaffold.js"),
// "elm-stuff/scaffold.js",
"codegen",
path.join(process.cwd(), "codegen/elm-stuff/scaffold.js")
// "elm-stuff/scaffold.js"
);
} catch (error) {
console.log(restoreColorSafe(error));
process.exit(1);
}
const elmScaffoldProgram = getAt(
splitModuleName,

12
generator/src/codegen.js
View File

@ -16,8 +16,11 @@ global.builtAt = new Date();
* @param {string} basePath
*/
async function generate(basePath) {
const cliCode = generateTemplateModuleConnector(basePath, "cli");
const browserCode = generateTemplateModuleConnector(basePath, "browser");
const cliCode = await generateTemplateModuleConnector(basePath, "cli");
const browserCode = await generateTemplateModuleConnector(
basePath,
"browser"
);
ensureDirSync("./elm-stuff");
ensureDirSync("./.elm-pages");
ensureDirSync("./gen");
@ -83,7 +86,10 @@ async function newCopyBoth(modulePath) {
}
async function generateClientFolder(basePath) {
const browserCode = generateTemplateModuleConnector(basePath, "browser");
const browserCode = await generateTemplateModuleConnector(
basePath,
"browser"
);
const uiFileContent = elmPagesUiFile();
ensureDirSync("./elm-stuff/elm-pages/client/app");
ensureDirSync("./elm-stuff/elm-pages/client/.elm-pages");

186
generator/src/generate-template-module-connector.js
View File

@ -2,12 +2,14 @@ const globby = require("globby");
const path = require("path");
const mm = require("micromatch");
const routeHelpers = require("./route-codegen-helpers");
const { runElmCodegenInstall } = require("./elm-codegen");
const { compileCliApp } = require("./compile-elm");
/**
* @param {string} basePath
* @param {'browser' | 'cli'} phase
*/
function generateTemplateModuleConnector(basePath, phase) {
async function generateTemplateModuleConnector(basePath, phase) {
const templates = globby.sync(["app/Route/**/*.elm"], {}).map((file) => {
const captures = mm.capture("app/Route/**/*.elm", file);
if (captures) {
@ -36,6 +38,10 @@ function generateTemplateModuleConnector(basePath, phase) {
],
};
}
const routesModule = await runElmCodegenCli(
sortTemplates(templates),
basePath
);
return {
mainModule: `port module Main exposing (..)
@ -997,151 +1003,51 @@ decodeBytes bytesDecoder items =
-- Lamdera.Wire3.bytesDecodeStrict bytesDecoder items
|> Result.fromMaybe "Decoding error"
`,
routesModule: `module Route exposing (baseUrlAsPath, Route(..), link, matchers, routeToPath, toLink, urlToRoute, toPath, redirectTo, toString)
{-|
@docs Route, link, matchers, routeToPath, toLink, urlToRoute, toPath, redirectTo, toString, baseUrlAsPath
-}
import Server.Response
import Html exposing (Attribute, Html)
import Html.Attributes as Attr
import Path exposing (Path)
import Pages.Internal.Router
import Pattern
{-| -}
type Route
= ${templates.map(routeHelpers.routeVariantDefinition).join("\n | ")}
{-| -}
urlToRoute : { url | path : String } -> Maybe Route
urlToRoute url =
url.path
|> withoutBaseUrl
|> Pages.Internal.Router.firstMatch matchers
baseUrl : String
baseUrl =
"${basePath}"
{-| -}
baseUrlAsPath : List String
baseUrlAsPath =
baseUrl
|> String.split "/"
|> List.filter (not << String.isEmpty)
withoutBaseUrl path =
if (path |> String.startsWith baseUrl) then
String.dropLeft (String.length baseUrl) path
else
path
{-| -}
matchers : List (Pages.Internal.Router.Matcher Route)
matchers =
[ ${sortTemplates(templates)
.map(
(name) => `{ pattern = "^${routeRegex(name).pattern}$"
, toRoute = ${routeRegex(name).toRoute}
}\n`
)
.join(" , ")}
]
{-| -}
routeToPath : Route -> List String
routeToPath route =
case route of
${templates
.map(
(name) =>
`${routeHelpers.routeVariant(name)}${
routeHelpers.parseRouteParams(name).length === 0
? ""
: ` params`
} ->\n List.concat [ ${routeHelpers
.parseRouteParamsWithStatic(name)
.map((param) => {
switch (param.kind) {
case "static": {
return param.name === "Index"
? `[]`
: `[ "${camelToKebab(param.name)}" ]`;
}
case "optional": {
return `Pages.Internal.Router.maybeToList params.${param.name}`;
}
case "required-splat": {
return `Pages.Internal.Router.nonEmptyToList params.${param.name}`;
}
case "dynamic": {
return `[ params.${param.name} ]`;
}
case "optional-splat": {
return `params.${param.name}`;
}
}
})} ]`
)
.join("\n ")}
{-| -}
toPath : Route -> Path
toPath route =
(baseUrlAsPath ++ (route |> routeToPath)) |> String.join "/" |> Path.fromString
{-| -}
toString : Route -> String
toString route =
route |> toPath |> Path.toAbsolute
{-| -}
toLink : (List (Attribute msg) -> tag) -> Route -> tag
toLink toAnchorTag route =
toAnchorTag
[ route |> toString |> Attr.href
, Attr.attribute "elm-pages:prefetch" ""
]
{-| -}
link : List (Attribute msg) -> List (Html msg) -> Route -> Html msg
link attributes children route =
toLink
(\\anchorAttrs ->
Html.a
(anchorAttrs ++ attributes)
children
)
route
{-| -}
redirectTo : Route -> Server.Response.Response data error
redirectTo route =
route
|> toString
|> Server.Response.temporaryRedirect
`,
routesModule,
fetcherModules: templates.map((name) => {
return [name, fetcherModule(name)];
}),
};
}
async function runElmCodegenCli(templates, basePath) {
// await runElmCodegenInstall();
await compileCliApp(
// { debug: true },
{},
`Generate.elm`,
path.join(process.cwd(), "elm-stuff/elm-pages-codegen.js"),
path.join(__dirname, "../../codegen"),
path.join(process.cwd(), "elm-stuff/elm-pages-codegen.js")
);
// TODO use uncached require here to prevent stale code from running
const promise = new Promise((resolve, reject) => {
const elmPagesCodegen = require(path.join(
process.cwd(),
"./elm-stuff/elm-pages-codegen.js"
)).Elm.Generate;
const app = elmPagesCodegen.init({
flags: { templates: templates, basePath },
});
if (app.ports.onSuccessSend) {
app.ports.onSuccessSend.subscribe(resolve);
}
if (app.ports.onInfoSend) {
app.ports.onInfoSend.subscribe((info) => console.log(info));
}
if (app.ports.onFailureSend) {
app.ports.onFailureSend.subscribe(reject);
}
});
const filesToGenerate = await promise;
return filesToGenerate[0].contents;
}
function emptyRouteParams(name) {
return routeHelpers.parseRouteParams(name).length === 0;
}

45
package-lock.json generated
View File

@ -43,6 +43,7 @@
"@types/node": "12.20.12",
"@types/serve-static": "^1.15.0",
"cypress": "^10.6.0",
"elm-codegen": "^0.2.0",
"elm-optimize-level-2": "^0.1.5",
"elm-review": "^2.7.4",
"elm-test": "^0.19.1-revision9",
@ -1680,6 +1681,30 @@
"resolved": "https://registry.npmjs.org/ee-first/-/ee-first-1.1.1.tgz",
"integrity": "sha1-WQxhFWsK4vTwJVcyoViyZrxWsh0="
},
"node_modules/elm-codegen": {
"version": "0.2.0",
"resolved": "https://registry.npmjs.org/elm-codegen/-/elm-codegen-0.2.0.tgz",
"integrity": "sha512-JXEbEl8wctVf47uH8M9gE5YF59e7YcSsBjofsPihepRSpPya+IYcva0qANlmNp1/N/p4T0HXXPbSiI3ake47VA==",
"dev": true,
"dependencies": {
"chalk": "^4.1.1",
"chokidar": "^3.5.1",
"commander": "^8.3.0",
"node-elm-compiler": "^5.0.6"
},
"bin": {
"elm-codegen": "bin/elm-codegen"
}
},
"node_modules/elm-codegen/node_modules/commander": {
"version": "8.3.0",
"resolved": "https://registry.npmjs.org/commander/-/commander-8.3.0.tgz",
"integrity": "sha512-OkTL9umf+He2DZkUq8f8J9of7yL6RJKI24dVITBmNfZBmri9zYZQrKkuXiKhyfPSu8tUhnVBB1iKXevvnlR4Ww==",
"dev": true,
"engines": {
"node": ">= 12"
}
},
"node_modules/elm-doc-preview": {
"version": "5.0.5",
"resolved": "https://registry.npmjs.org/elm-doc-preview/-/elm-doc-preview-5.0.5.tgz",
@ -8111,6 +8136,26 @@
"resolved": "https://registry.npmjs.org/ee-first/-/ee-first-1.1.1.tgz",
"integrity": "sha1-WQxhFWsK4vTwJVcyoViyZrxWsh0="
},
"elm-codegen": {
"version": "0.2.0",
"resolved": "https://registry.npmjs.org/elm-codegen/-/elm-codegen-0.2.0.tgz",
"integrity": "sha512-JXEbEl8wctVf47uH8M9gE5YF59e7YcSsBjofsPihepRSpPya+IYcva0qANlmNp1/N/p4T0HXXPbSiI3ake47VA==",
"dev": true,
"requires": {
"chalk": "^4.1.1",
"chokidar": "^3.5.1",
"commander": "^8.3.0",
"node-elm-compiler": "^5.0.6"
},
"dependencies": {
"commander": {
"version": "8.3.0",
"resolved": "https://registry.npmjs.org/commander/-/commander-8.3.0.tgz",
"integrity": "sha512-OkTL9umf+He2DZkUq8f8J9of7yL6RJKI24dVITBmNfZBmri9zYZQrKkuXiKhyfPSu8tUhnVBB1iKXevvnlR4Ww==",
"dev": true
}
}
},
"elm-doc-preview": {
"version": "5.0.5",
"resolved": "https://registry.npmjs.org/elm-doc-preview/-/elm-doc-preview-5.0.5.tgz",

2
package.json
View File

@ -10,6 +10,7 @@
"test": "./test.sh",
"test:snapshot": "(cd examples/escaping && npm install && npm test) && (cd examples/base-path && npm install && npm test)",
"cypress": "npm start & cypress run",
"prepare": "elm-codegen install",
"review": "elm-review"
},
"repository": "https://github.com/dillonkearns/elm-pages",
@ -54,6 +55,7 @@
"@types/node": "12.20.12",
"@types/serve-static": "^1.15.0",
"cypress": "^10.6.0",
"elm-codegen": "^0.2.0",
"elm-optimize-level-2": "^0.1.5",
"elm-review": "^2.7.4",
"elm-test": "^0.19.1-revision9",

38
src/Pages/Generate.elm
View File

@ -1,8 +1,8 @@
module Pages.Generate exposing (Type(..), serverRender, buildWithLocalState, buildNoState)
module Pages.Generate exposing (Type(..), serverRender, buildWithLocalState, buildNoState, Builder)
{-|
@docs Type, serverRender, buildWithLocalState, buildNoState
@docs Type, serverRender, buildWithLocalState, buildNoState, Builder
-}
@ -28,6 +28,7 @@ typeToDeclaration name type_ =
Elm.customType name variants
{-| -}
type Builder
= Builder
{ data : ( Type, Elm.Expression -> Elm.Expression )
@ -122,6 +123,11 @@ userFunction :
-> Elm.File
userFunction moduleName definitions =
let
viewFn :
{ declaration : Elm.Declaration
, call : Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression
, callFrom : List String -> Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression
}
viewFn =
case definitions.localState of
Just _ ->
@ -141,7 +147,12 @@ userFunction moduleName definitions =
Nothing ->
let
thing =
viewDeclaration :
{ declaration : Elm.Declaration
, call : Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression
, callFrom : List String -> Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression
}
viewDeclaration =
Elm.Declare.fn3 "view"
( "maybeUrl"
, "PageUrl"
@ -155,11 +166,21 @@ userFunction moduleName definitions =
( "app", Just appType )
(definitions.view Elm.unit)
in
{ declaration = thing.declaration
, call = \_ -> thing.call
, callFrom = \a b c d -> thing.callFrom a c d
{ declaration = viewDeclaration.declaration
, call = \_ -> viewDeclaration.call
, callFrom = \a _ c d -> viewDeclaration.callFrom a c d
}
localDefinitions :
Maybe
{ updateFn :
{ declaration : Elm.Declaration
, call : Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression
, callFrom : List String -> Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression
}
, initFn : { declaration : Elm.Declaration, call : Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression, callFrom : List String -> Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression }
, subscriptionsFn : { declaration : Elm.Declaration, call : Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression, callFrom : List String -> Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression -> Elm.Expression }
}
localDefinitions =
definitions.localState
|> Maybe.map
@ -204,6 +225,7 @@ userFunction moduleName definitions =
}
)
dataFn : { declaration : Elm.Declaration, call : Elm.Expression -> Elm.Expression, callFrom : List String -> Elm.Expression -> Elm.Expression }
dataFn =
Elm.Declare.fn "data"
( "routeParams"
@ -213,6 +235,7 @@ userFunction moduleName definitions =
)
(definitions.data >> Elm.withType (myType "Data"))
actionFn : { declaration : Elm.Declaration, call : Elm.Expression -> Elm.Expression, callFrom : List String -> Elm.Expression -> Elm.Expression }
actionFn =
Elm.Declare.fn "action"
( "routeParams"
@ -222,6 +245,7 @@ userFunction moduleName definitions =
)
(definitions.action >> Elm.withType (myType "ActionData"))
headFn : { declaration : Elm.Declaration, call : Elm.Expression -> Elm.Expression, callFrom : List String -> Elm.Expression -> Elm.Expression }
headFn =
Elm.Declare.fn "head"
( "app", Just appType )
@ -309,10 +333,12 @@ userFunction moduleName definitions =
)
localType : String -> Elm.Annotation.Annotation
localType =
Elm.Annotation.named []
myType : String -> Elm.Annotation.Annotation
myType dataType =
Elm.Annotation.namedWith [ "Server", "Request" ]
"Parser"

8
src/Pages/Internal/Platform.elm
View File

@ -558,10 +558,6 @@ update config appMsg model =
redirectPending : Bool
redirectPending =
newUrl /= urlWithoutRedirectResolution
stayingOnSamePath : Bool
stayingOnSamePath =
newUrl.path == model.url.path
in
if redirectPending then
( { model
@ -582,6 +578,10 @@ update config appMsg model =
else
let
stayingOnSamePath : Bool
stayingOnSamePath =
newUrl.path == model.url.path
( newPageData, newSharedData, newActionData ) =
case newData of
ResponseSketch.RenderPage pageData actionData ->

368
src/Pages/Internal/RoutePattern.elm
View File

@ -1,16 +1,19 @@
module Pages.Internal.RoutePattern exposing
( Ending(..), RoutePattern, Segment(..), view
, Param(..), fromModuleName, toRouteParamTypes, toRouteParamsRecord
( Ending(..), RoutePattern, Segment(..), view, toVariant, routeToBranch
, Param(..), RouteParam(..), fromModuleName, toRouteParamTypes, toRouteParamsRecord, toVariantName
)
{-| Exposed for internal use only (used in generated code).
@docs Ending, RoutePattern, Segment, view
@docs Ending, RoutePattern, Segment, view, toVariant, routeToBranch
-}
import Elm
import Elm.Annotation exposing (Annotation)
import Elm.CodeGen
import Html exposing (Html)
import Regex exposing (Regex)
{-| -}
@ -43,7 +46,7 @@ fromModuleName moduleNameSegments =
|> Just
[] ->
Nothing
Just { segments = [], ending = Nothing }
toRouteParamsRecord : RoutePattern -> List ( String, Annotation )
@ -56,7 +59,7 @@ toRouteParamsRecord pattern =
[]
DynamicSegment name ->
[ ( name, Elm.Annotation.string ) ]
[ ( name |> decapitalize, Elm.Annotation.string ) ]
)
)
++ (case pattern.ending of
@ -78,7 +81,7 @@ toRouteParamsRecord pattern =
]
Just (Optional name) ->
[ ( name
[ ( name |> decapitalize
, Elm.Annotation.maybe Elm.Annotation.string
)
]
@ -95,7 +98,7 @@ toRouteParamTypes pattern =
[]
DynamicSegment name ->
[ ( name, RequiredParam ) ]
[ ( name |> decapitalize, RequiredParam ) ]
)
)
++ (case pattern.ending of
@ -115,15 +118,327 @@ toRouteParamTypes pattern =
]
Just (Optional name) ->
[ ( name
[ ( name |> decapitalize
, OptionalParam
)
]
)
routeToBranch : RoutePattern -> List ( Elm.CodeGen.Pattern, Elm.CodeGen.Expression )
routeToBranch route =
case route.segments of
[ StaticSegment "Index" ] ->
[ ( Elm.CodeGen.listPattern [], Elm.CodeGen.val "Index" ) ]
--[]
segments ->
case route.ending of
Just ending ->
[ ( (case ending of
Optional _ ->
Elm.CodeGen.listPattern
_ ->
unconsPattern
)
((route.segments
|> List.map
(\segment ->
case segment of
StaticSegment name ->
Elm.CodeGen.stringPattern (toKebab name)
DynamicSegment name ->
Elm.CodeGen.varPattern (decapitalize name)
)
)
++ (case ending of
Optional name ->
[ Elm.CodeGen.varPattern (decapitalize name) ]
RequiredSplat ->
[ Elm.CodeGen.varPattern "splatFirst"
, Elm.CodeGen.varPattern "splatRest"
]
OptionalSplat ->
[ Elm.CodeGen.varPattern "splat" ]
)
)
, toRecordVariant False route
)
]
++ (case ending of
Optional optionalName ->
[ ( Elm.CodeGen.listPattern
(route.segments
|> List.map
(\segment ->
case segment of
StaticSegment name ->
Elm.CodeGen.stringPattern (toKebab name)
DynamicSegment name ->
Elm.CodeGen.varPattern (decapitalize name)
)
)
, toRecordVariant True route
)
]
_ ->
[]
)
Nothing ->
[ ( Elm.CodeGen.listPattern
(route.segments
|> List.map
(\segment ->
case segment of
StaticSegment name ->
Elm.CodeGen.stringPattern (toKebab name)
DynamicSegment name ->
Elm.CodeGen.varPattern (decapitalize name)
)
)
, toRecordVariant False route
)
]
type RouteParam
= StaticParam String
| DynamicParam String
| OptionalParam2 String
| RequiredSplatParam2
| OptionalSplatParam2
toVariantName : RoutePattern -> { variantName : String, params : List RouteParam }
toVariantName route =
let
something : List ( String, Maybe RouteParam )
something =
route.segments
|> List.map
(\segment ->
case segment of
DynamicSegment name ->
( name ++ "_"
, DynamicParam (decapitalize name)
|> Just
)
StaticSegment name ->
( name
, if name == "Index" then
Nothing
else
Just (StaticParam (decapitalize name))
)
)
something2 : List ( String, Maybe RouteParam )
something2 =
something
++ ([ Maybe.map
(\ending ->
case ending of
Optional name ->
( name ++ "__"
, Just (OptionalParam2 (decapitalize name))
)
RequiredSplat ->
( "SPLAT_"
, RequiredSplatParam2
|> Just
)
OptionalSplat ->
( "SPLAT__"
, OptionalSplatParam2
|> Just
)
)
route.ending
]
|> List.filterMap identity
)
in
something2
|> List.map Tuple.first
|> String.join "__"
|> (\name ->
{ variantName = name
, params = something2 |> List.filterMap Tuple.second
}
)
toRecordVariant : Bool -> RoutePattern -> Elm.CodeGen.Expression
toRecordVariant nothingCase route =
let
constructorName : String
constructorName =
route |> toVariantName |> .variantName
innerType : Maybe Elm.CodeGen.Expression
innerType =
case fieldThings of
[] ->
Nothing
nonEmpty ->
nonEmpty |> Elm.CodeGen.record |> Just
fieldThings : List ( String, Elm.CodeGen.Expression )
fieldThings =
route
|> toVariantName
|> .params
|> List.filterMap
(\param ->
case param of
OptionalParam2 name ->
Just
( decapitalize name
, if nothingCase then
Elm.CodeGen.val "Nothing"
else
[ Elm.CodeGen.val "Just", Elm.CodeGen.val (decapitalize name) ] |> Elm.CodeGen.apply
)
StaticParam name ->
Nothing
DynamicParam name ->
Just
( decapitalize name
, Elm.CodeGen.val (decapitalize name)
)
RequiredSplatParam2 ->
Just
( "splat"
, Elm.CodeGen.tuple [ Elm.CodeGen.val "splatFirst", Elm.CodeGen.val "splatRest" ]
)
OptionalSplatParam2 ->
Just ( "splat", Elm.CodeGen.val "splat" )
)
in
case innerType of
Just innerRecord ->
Elm.CodeGen.apply
[ constructorName |> Elm.CodeGen.val
, innerRecord
]
Nothing ->
constructorName |> Elm.CodeGen.val
{-| -}
toVariant : RoutePattern -> Elm.Variant
toVariant pattern =
if List.isEmpty pattern.segments && pattern.ending == Nothing then
Elm.variant "Index"
else
let
allSegments : List ( String, Maybe ( String, Annotation ) )
allSegments =
(pattern.segments
|> List.map
(\segment ->
case segment of
DynamicSegment name ->
( name ++ "_", Just ( decapitalize name, Elm.Annotation.string ) )
StaticSegment name ->
( name, Nothing )
)
)
++ ([ Maybe.map endingToVariantName pattern.ending
]
|> List.filterMap identity
)
fieldThings : List ( String, Annotation )
fieldThings =
allSegments
|> List.filterMap Tuple.second
noArgsOrNonEmptyRecordArg : List Annotation
noArgsOrNonEmptyRecordArg =
case fieldThings of
[] ->
[]
nonEmpty ->
nonEmpty |> Elm.Annotation.record |> List.singleton
in
Elm.variantWith
(allSegments
|> List.map Tuple.first
|> String.join "__"
)
noArgsOrNonEmptyRecordArg
endingToVariantNameFields : Ending -> ( String, Maybe ( String, Elm.CodeGen.Expression ) )
endingToVariantNameFields ending =
case ending of
Optional name ->
( name ++ "__"
, Just ( decapitalize name, [ Elm.CodeGen.val "Just", Elm.CodeGen.val (decapitalize name) ] |> Elm.CodeGen.apply )
)
RequiredSplat ->
( "SPLAT_"
, Just
( "splat"
, Elm.CodeGen.tuple
[ Elm.CodeGen.val "splatFirst"
, Elm.CodeGen.val "splatRest"
]
)
)
OptionalSplat ->
( "SPLAT__"
, Just ( "splat", Elm.CodeGen.val "splat" )
)
endingToVariantName : Ending -> ( String, Maybe ( String, Annotation ) )
endingToVariantName ending =
case ending of
Optional name ->
( name ++ "__", Just ( decapitalize name, Elm.Annotation.maybe Elm.Annotation.string ) )
RequiredSplat ->
( "SPLAT_"
, Just
( "splat"
, Elm.Annotation.tuple
Elm.Annotation.string
(Elm.Annotation.list Elm.Annotation.string)
)
)
OptionalSplat ->
( "SPLAT__"
, Just
( "splat"
, Elm.Annotation.list Elm.Annotation.string
)
)
{-| -}
@ -199,7 +514,6 @@ tryAsEnding segment =
else if segment |> String.endsWith "__" then
(segment
|> String.dropRight 2
|> decapitalize
|> Optional
)
|> Just
@ -213,13 +527,10 @@ segmentToParam segment =
if segment |> String.endsWith "_" then
segment
|> String.dropRight 1
|> decapitalize
|> DynamicSegment
else
segment
|> String.dropRight 1
|> decapitalize
|> StaticSegment
@ -250,3 +561,34 @@ type Param
| OptionalParam
| RequiredSplatParam
| OptionalSplatParam
unconsPattern : List Elm.CodeGen.Pattern -> Elm.CodeGen.Pattern
unconsPattern list =
case list of
[] ->
Elm.CodeGen.listPattern []
listFirst :: listRest ->
List.foldl
(\soFar item ->
soFar
|> Elm.CodeGen.unConsPattern item
)
listFirst
listRest
toKebab : String -> String
toKebab string =
string
|> decapitalize
|> String.trim
|> Regex.replace (regexFromString "([A-Z])") (.match >> String.append "-")
|> Regex.replace (regexFromString "[_-\\s]+") (always "-")
|> String.toLower
regexFromString : String -> Regex
regexFromString =
Regex.fromString >> Maybe.withDefault Regex.never

10
src/Pages/Review/NoContractViolations.elm
View File

@ -209,7 +209,7 @@ routeParamsMatchesNameOrError annotation moduleName =
Ok actualStringFields ->
let
expectedFields : Dict String RoutePattern.Param
expectedFields : Dict String Param
expectedFields =
expectedRouteParamsFromModuleName moduleName
in
@ -241,7 +241,7 @@ expectedFieldsToRecordString moduleName =
)
expectedRouteParamsFromModuleName : List String -> Dict String RoutePattern.Param
expectedRouteParamsFromModuleName : List String -> Dict String Param
expectedRouteParamsFromModuleName moduleSegments =
case moduleSegments of
"Route" :: segments ->
@ -258,12 +258,12 @@ expectedRouteParamsFromModuleName moduleSegments =
stringFields :
Node TypeAnnotation
-> Result (Error {}) (Dict String (Result (Node TypeAnnotation) RoutePattern.Param))
-> Result (Error {}) (Dict String (Result (Node TypeAnnotation) Param))
stringFields typeAnnotation =
case Node.value typeAnnotation of
TypeAnnotation.Record recordDefinition ->
let
fields : Dict String (Result (Node TypeAnnotation) RoutePattern.Param)
fields : Dict String (Result (Node TypeAnnotation) Param)
fields =
recordDefinition
|> List.map Node.value
@ -287,7 +287,7 @@ stringFields typeAnnotation =
)
paramType : Node TypeAnnotation -> Result (Node TypeAnnotation) RoutePattern.Param
paramType : Node TypeAnnotation -> Result (Node TypeAnnotation) Param
paramType typeAnnotation =
case Node.value typeAnnotation of
TypeAnnotation.Tupled [ first, second ] ->

177
tests/Pages/RouteParamsTest.elm
View File

@ -1,8 +1,13 @@
module Pages.RouteParamsTest exposing (..)
module Pages.RouteParamsTest exposing (suite)
import Elm
import Elm.Annotation
import Expect
import Elm.CodeGen
import Elm.Pretty
import Elm.ToString
import Expect exposing (Expectation)
import Pages.Internal.RoutePattern as RoutePattern
import Pretty
import Test exposing (Test, describe, test)
@ -67,4 +72,172 @@ suite =
[ ( "section", Elm.Annotation.maybe Elm.Annotation.string )
]
)
, describe "toRouteVariant"
[ test "root route" <|
\() ->
[]
|> expectRouteDefinition
(Elm.variant "Index")
, test "static-only route" <|
\() ->
RoutePattern.fromModuleName [ "About" ]
|> Maybe.map RoutePattern.toVariant
|> Expect.equal
(Just (Elm.variant "About"))
, test "dynamic param" <|
\() ->
[ "User", "Id_" ]
|> expectRouteDefinition
(Elm.variantWith "User__Id_"
[ Elm.Annotation.record
[ ( "id", Elm.Annotation.string )
]
]
)
, test "required splat" <|
\() ->
[ "Username_", "Repo_", "Blob", "SPLAT_" ]
|> expectRouteDefinition
(Elm.variantWith "Username___Repo___Blob__SPLAT_"
[ Elm.Annotation.record
[ ( "username", Elm.Annotation.string )
, ( "repo", Elm.Annotation.string )
, ( "splat"
, Elm.Annotation.tuple
Elm.Annotation.string
(Elm.Annotation.list Elm.Annotation.string)
)
]
]
)
, test "optional splat" <|
\() ->
[ "SPLAT__" ]
|> expectRouteDefinition
(Elm.variantWith "SPLAT__"
[ Elm.Annotation.record
[ ( "splat"
, Elm.Annotation.list Elm.Annotation.string
)
]
]
)
, test "optional param" <|
\() ->
[ "Docs", "Section__" ]
|> expectRouteDefinition
(Elm.variantWith "Docs__Section__"
[ Elm.Annotation.record
[ ( "section"
, Elm.Annotation.maybe Elm.Annotation.string
)
]
]
)
]
, describe "toCase"
[ test "root route" <|
\() ->
[ "Index" ]
|> testCaseGenerator
[ ( Elm.CodeGen.listPattern []
, Elm.CodeGen.val "Index"
)
]
, test "dynamic segment" <|
\() ->
[ "User", "Id_" ]
|> testCaseGenerator
[ ( Elm.CodeGen.listPattern
[ Elm.CodeGen.stringPattern "user"
, Elm.CodeGen.varPattern "id"
]
, Elm.CodeGen.val "User__Id_ { id = id }"
)
]
, test "optional ending" <|
\() ->
[ "Docs", "Section__" ]
|> testCaseGenerator
[ ( Elm.CodeGen.listPattern
[ Elm.CodeGen.stringPattern "docs"
, Elm.CodeGen.varPattern "section"
]
, Elm.CodeGen.val "Docs__Section__ { section = Just section }"
)
, ( Elm.CodeGen.listPattern
[ Elm.CodeGen.stringPattern "docs"
]
, Elm.CodeGen.val "Docs__Section__ { section = Nothing }"
)
]
, test "required splat" <|
\() ->
[ "Username_", "Repo_", "Blob", "SPLAT_" ]
|> testCaseGenerator
[ ( --Elm. """username :: repo :: "blob" :: splatFirst :: splatRest"""
--( Elm.CodeGen.unConsPattern
unconsPattern
[ Elm.CodeGen.varPattern "username"
, Elm.CodeGen.varPattern "repo"
, Elm.CodeGen.stringPattern "blob"
, Elm.CodeGen.varPattern "splatFirst"
, Elm.CodeGen.varPattern "splatRest"
]
, Elm.CodeGen.val
"Username___Repo___Blob__SPLAT_ { username = username, repo = repo, splat = ( splatFirst, splatRest ) }"
)
]
]
]
unconsPattern : List Elm.CodeGen.Pattern -> Elm.CodeGen.Pattern
unconsPattern list =
case list of
[] ->
Elm.CodeGen.listPattern []
listFirst :: listRest ->
List.foldl
(\soFar item ->
soFar
|> Elm.CodeGen.unConsPattern item
)
listFirst
listRest
testCaseGenerator : List ( Elm.CodeGen.Pattern, Elm.CodeGen.Expression ) -> List String -> Expectation
testCaseGenerator expected moduleName =
RoutePattern.fromModuleName moduleName
|> Maybe.map (RoutePattern.routeToBranch >> List.map toStringCase)
|> Maybe.withDefault [ ( "<ERROR>", "<ERROR>" ) ]
|> Expect.equal (expected |> List.map toStringCase)
toStringCase : ( Elm.CodeGen.Pattern, Elm.CodeGen.Expression ) -> ( String, String )
toStringCase branch =
branch
|> Tuple.mapBoth
(Elm.Pretty.prettyPattern
>> Pretty.pretty 120
)
(Elm.Pretty.prettyExpression
>> Pretty.pretty 120
)
expectRouteDefinition : Elm.Variant -> List String -> Expectation
expectRouteDefinition expected moduleName =
RoutePattern.fromModuleName moduleName
|> Maybe.map (RoutePattern.toVariant >> toString)
|> Maybe.withDefault "<ERROR>"
|> Expect.equal (expected |> toString)
toString : Elm.Variant -> String
toString variants =
Elm.customType "Route" [ variants ]
|> Elm.ToString.declaration
|> .body