elm-pages-v3-beta/codegen/Generate.elm

348 lines
13 KiB
Elm
Raw Normal View History

port module Generate exposing (main)
2022-09-12 20:16:00 +03:00
{-| -}
import Elm exposing (File)
import Elm.Annotation
2022-09-13 18:17:23 +03:00
import Elm.Case
import Elm.CodeGen
import Elm.Declare
import Elm.Op
import Elm.Pretty
import Gen.Basics
2022-09-12 22:16:18 +03:00
import Gen.CodeGen.Generate exposing (Error)
2022-09-13 20:38:16 +03:00
import Gen.Html
2022-09-13 20:31:01 +03:00
import Gen.Html.Attributes
import Gen.List
import Gen.Path
import Gen.Server.Response
import Gen.String
import Pages.Internal.RoutePattern as RoutePattern exposing (RoutePattern)
import Pretty
2022-09-12 20:16:00 +03:00
type alias Flags =
{ templates : List (List String)
, basePath : String
}
main : Program Flags () ()
2022-09-12 20:16:00 +03:00
main =
Platform.worker
{ init =
\{ templates, basePath } ->
( ()
, onSuccessSend [ file templates basePath ]
)
, update =
\_ model ->
( model, Cmd.none )
, subscriptions = \_ -> Sub.none
}
2022-09-12 20:16:00 +03:00
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)
)
2022-09-13 18:17:23 +03:00
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 ->
2022-09-13 18:50:40 +03:00
(((routes
|> List.concatMap RoutePattern.routeToBranch
|> List.map (Tuple.mapSecond (\constructRoute -> Elm.CodeGen.apply [ Elm.CodeGen.val "Just", constructRoute ]))
2022-09-13 18:50:40 +03:00
)
++ [ ( 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
)
)
2022-09-13 18:17:23 +03:00
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 name ]
|> Elm.list
RoutePattern.DynamicParam name ->
Elm.list []
RoutePattern.OptionalParam2 name ->
Elm.list []
)
|> 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 name ]
|> Elm.list
RoutePattern.DynamicParam name ->
[ Elm.get name params ]
|> Elm.list
RoutePattern.OptionalParam2 name ->
maybeToList.call (Elm.get name params)
)
|> Elm.list
)
)
)
|> Gen.List.call_.concat
|> Elm.withType (Elm.Annotation.list Elm.Annotation.string)
)
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
in
Elm.file
[ "Route" ]
2022-09-12 20:16:00 +03:00
[ Elm.customType "Route"
2022-09-12 22:16:18 +03:00
(routes |> List.map RoutePattern.toVariant)
|> expose
, segmentsToRouteFn.declaration |> expose
, splitPath.declaration
, 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"))
)
)
|> expose
, Elm.declaration "baseUrl" (Elm.string basePath)
|> expose
2022-09-13 18:17:23 +03:00
, maybeToList.declaration
, routeToPath routes |> .declaration |> expose
, Elm.declaration "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 "/")
(Elm.val "baseUrl")
)
)
|> expose
, Elm.declaration "toPath"
(Elm.fn ( "route", Elm.Annotation.named [] "Route" |> Just )
(\route ->
Gen.Path.call_.fromString
(Gen.String.call_.join
(Elm.string "/")
(Elm.Op.append
(Elm.val "baseUrlAsPath")
(Elm.apply (Elm.val "routeToPath")
[ route ]
)
)
)
|> Elm.withType (Elm.Annotation.named [ "Path" ] "Path")
)
)
|> expose
2022-09-13 18:20:29 +03:00
, toString.declaration
|> expose
, Elm.declaration "redirectTo"
(Elm.fn ( "route", Elm.Annotation.named [] "Route" |> Just )
(\route ->
Gen.Server.Response.call_.temporaryRedirect
2022-09-13 18:20:29 +03:00
(toString.call route)
|> Elm.withType
(Elm.Annotation.namedWith [ "Server", "Response" ]
"Response"
[ Elm.Annotation.var "data"
, Elm.Annotation.var "error"
]
)
)
)
|> expose
2022-09-13 20:31:01 +03:00
, Elm.declaration "toLink"
(Elm.fn2
( "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" ""
]
]
)
)
|> expose
2022-09-13 20:38:16 +03:00
, 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
)
)
|> expose
2022-09-13 20:47:03 +03:00
, Elm.declaration "withoutBaseUrl"
(Elm.fn ( "path", Just Elm.Annotation.string )
(\path ->
Elm.ifThen
(path |> Gen.String.call_.startsWith (Elm.val "baseUrl"))
(Gen.String.call_.dropLeft
(Gen.String.call_.length (Elm.val "baseUrl"))
path
)
path
)
)
|> expose
2022-09-12 20:16:00 +03:00
]
2022-09-13 20:38:16 +03:00
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" ""
]
]
)
2022-09-13 18:20:29 +03:00
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
(Elm.apply (Elm.val "toPath") [ route ])
)
expose : Elm.Declaration -> Elm.Declaration
expose declaration =
declaration
|> Elm.exposeWith
{ exposeConstructor = True
, group = Nothing
}
port onSuccessSend : List File -> Cmd msg
port onFailureSend : List Error -> Cmd msg
port onInfoSend : String -> Cmd msg