Merge pull request #316 from dillonkearns/elm-codegen

Generate Route.elm with elm-codegen

.github/workflows/ci.yml

@@ -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:

.gitignore

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

codegen/.gitignore

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

codegen/Generate.elm

@@ -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

codegen/elm.codegen.json

@@ -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/"
+        ]
+    }
+}

codegen/elm.json

@@ -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": {}
+    }
+}

elm.json

@@ -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"
     }
 }

examples/base-path/elm.json

@@ -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",
+            "stil4m/structured-writer": "1.0.3"
-            "the-sett/elm-pretty-printer": "3.0.0"
         }
     },
     "test-dependencies": {

examples/base-path/package-lock.json

@@ -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",

examples/docs/elm.json

@@ -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",
+            "stil4m/structured-writer": "1.0.3"
-            "the-sett/elm-pretty-printer": "3.0.0"
         }
     },
     "test-dependencies": {

examples/end-to-end/elm.json

@@ -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",
+            "stil4m/structured-writer": "1.0.3"
-            "the-sett/elm-pretty-printer": "3.0.0"
         }
     },
     "test-dependencies": {

examples/end-to-end/package-lock.json

@@ -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",

examples/escaping/elm.json

@@ -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",
+            "stil4m/structured-writer": "1.0.3"
-            "the-sett/elm-pretty-printer": "3.0.0"
         }
     },
     "test-dependencies": {

examples/escaping/package-lock.json

@@ -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",

examples/routing/elm.json

@@ -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",
+            "stil4m/structured-writer": "1.0.3"
-            "the-sett/elm-pretty-printer": "3.0.0"
         }
     },
     "test-dependencies": {

examples/routing/package-lock.json

@@ -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",

examples/todos/codegen/Cli.elm

@@ -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
 
 

examples/todos/codegen/elm.json

@@ -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",

examples/todos/elm.json

@@ -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",
+            "stil4m/structured-writer": "1.0.3"
-            "the-sett/elm-pretty-printer": "3.0.0"
         }
     },
     "test-dependencies": {

examples/todos/send-grid

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

generator/src/cli.js

@@ -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,

generator/src/codegen.js

@@ -16,8 +16,11 @@ global.builtAt = new Date();
  * @param {string} basePath
  */
 async function generate(basePath) {
-  const cliCode = generateTemplateModuleConnector(basePath, "cli");
+  const cliCode = await generateTemplateModuleConnector(basePath, "cli");
-  const browserCode = generateTemplateModuleConnector(basePath, "browser");
+  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");

generator/src/generate-template-module-connector.js

@@ -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)
+    routesModule,
-
-{-|
-
-@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
-`,
     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;
 }

package-lock.json

@@ -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",

package.json

@@ -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",

src/Pages/Generate.elm

@@ -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
+                    { declaration = viewDeclaration.declaration
-                    , call = \_ -> thing.call
+                    , call = \_ -> viewDeclaration.call
-                    , callFrom = \a b c d -> thing.callFrom a c d
+                    , 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"

src/Pages/Internal/Platform.elm

@@ -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 ->

src/Pages/Internal/RoutePattern.elm

@@ -1,16 +1,19 @@
 module Pages.Internal.RoutePattern exposing
-    ( Ending(..), RoutePattern, Segment(..), view
+    ( Ending(..), RoutePattern, Segment(..), view, toVariant, routeToBranch
-    , Param(..), fromModuleName, toRouteParamTypes, toRouteParamsRecord
+    , 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

src/Pages/Review/NoContractViolations.elm

@@ -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 ] ->

tests/Pages/RouteParamsTest.elm

@@ -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