elm-pages 3.0.0-beta.8 → 3.0.0

package/src/Pages/Script.elm

@@ -0,0 +1,166 @@
+module Pages.Script exposing
+    ( Script
+    , withCliOptions, withoutCliOptions
+    , writeFile
+    , log
+    , Error(..)
+    )
+
+{-| An elm-pages Script is a way to execute an `elm-pages` `BackendTask`.
+
+Read more about using the `elm-pages` CLI to run (or bundle) scripts, plus a brief tutorial, at <https://elm-pages.com/docs/elm-pages-scripts>.
+
+@docs Script
+
+
+## Defining Scripts
+
+@docs withCliOptions, withoutCliOptions
+
+
+## File System Utilities
+
+@docs writeFile
+
+
+## Utilities
+
+@docs log
+
+
+## Errors
+
+@docs Error
+
+-}
+
+import BackendTask exposing (BackendTask)
+import BackendTask.Http
+import BackendTask.Internal.Request
+import Cli.OptionsParser as OptionsParser
+import Cli.Program as Program
+import FatalError exposing (FatalError)
+import Json.Decode as Decode
+import Json.Encode as Encode
+import Pages.Internal.Script
+
+
+{-| The type for your `run` function that can be executed by `elm-pages run`.
+-}
+type alias Script =
+    Pages.Internal.Script.Script
+
+
+{-| The recoverable error type for file writes. You can use `BackendTask.allowFatal` if you want to allow the program to crash
+with an error message if a file write is unsuccessful.
+-}
+type Error
+    = --TODO make more descriptive
+      FileWriteError
+
+
+{-| Write a file to the file system.
+
+    module MyScript exposing (run)
+
+    import BackendTask
+    import Pages.Script as Script
+
+    run =
+        Script.withoutCliOptions
+            (Script.writeFile
+                { path = "hello.json"
+                , body = """{ "message": "Hello, World!" }"""
+                }
+                |> BackendTask.allowFatal
+            )
+
+-}
+writeFile : { path : String, body : String } -> BackendTask { fatal : FatalError, recoverable : Error } ()
+writeFile { path, body } =
+    BackendTask.Internal.Request.request
+        { name = "write-file"
+        , body =
+            BackendTask.Http.jsonBody
+                (Encode.object
+                    [ ( "path", Encode.string path )
+                    , ( "body", Encode.string body )
+                    ]
+                )
+        , expect =
+            -- TODO decode possible error details here
+            BackendTask.Http.expectJson (Decode.succeed ())
+        }
+
+
+{-| Log to stdout.
+
+    module MyScript exposing (run)
+
+    import BackendTask
+    import Pages.Script as Script
+
+    run =
+        Script.withoutCliOptions
+            (Script.log "Hello!"
+                |> BackendTask.allowFatal
+            )
+
+-}
+log : String -> BackendTask error ()
+log message =
+    BackendTask.Internal.Request.request
+        { name = "log"
+        , body =
+            BackendTask.Http.jsonBody
+                (Encode.object
+                    [ ( "message", Encode.string message )
+                    ]
+                )
+        , expect = BackendTask.Http.expectJson (Decode.succeed ())
+        }
+
+
+{-| Define a simple Script (no CLI Options).
+
+    module MyScript exposing (run)
+
+    import BackendTask
+    import Pages.Script as Script
+
+    run =
+        Script.withoutCliOptions
+            (Script.log "Hello!"
+                |> BackendTask.allowFatal
+            )
+
+-}
+withoutCliOptions : BackendTask FatalError () -> Script
+withoutCliOptions execute =
+    Pages.Internal.Script.Script
+        (\_ ->
+            Program.config
+                |> Program.add
+                    (OptionsParser.build ())
+                |> Program.mapConfig
+                    (\() ->
+                        execute
+                    )
+        )
+
+
+{-| Same as [`withoutCliOptions`](#withoutCliOptions), but allows you to define a CLI Options Parser so the user can
+pass in additional options for the script.
+
+Uses <https://package.elm-lang.org/packages/dillonkearns/elm-cli-options-parser/latest/>.
+
+Read more at <https://elm-pages.com/docs/elm-pages-scripts/#adding-command-line-options>.
+
+-}
+withCliOptions : Program.Config cliOptions -> (cliOptions -> BackendTask FatalError ()) -> Script
+withCliOptions config execute =
+    Pages.Internal.Script.Script
+        (\_ ->
+            config
+                |> Program.mapConfig execute
+        )

package/src/Pages/SiteConfig.elm

@@ -1,10 +1,11 @@
 module Pages.SiteConfig exposing (SiteConfig)
 
-import DataSource exposing (DataSource)
+import BackendTask exposing (BackendTask)
+import FatalError exposing (FatalError)
 import Head
 
 
 type alias SiteConfig =
     { canonicalUrl : String
-    , head : DataSource (List Head.Tag)
+    , head : BackendTask FatalError (List Head.Tag)
     }

package/src/Pages/StaticHttp/Request.elm

@@ -11,7 +11,7 @@ type alias Request =
     , method : String
     , headers : List ( String, String )
     , body : Body
-    , useCache : Bool
+    , cacheOptions : Maybe Encode.Value
     }
 
 
@@ -40,5 +40,5 @@ codec =
         |> Codec.field "method" .method Codec.string
         |> Codec.field "headers" .headers (Codec.list (Codec.tuple Codec.string Codec.string))
         |> Codec.field "body" .body StaticHttpBody.codec
-        |> Codec.field "useCache" .useCache Codec.bool
+        |> Codec.nullableField "cacheOptions" .cacheOptions Codec.value
         |> Codec.buildObject

package/src/Pages/StaticHttpRequest.elm

@@ -1,8 +1,7 @@
-module Pages.StaticHttpRequest exposing (Error(..), MockResolver, RawRequest(..), Status(..), cacheRequestResolution, mockResolve, resolve, resolveUrls, toBuildError)
+module Pages.StaticHttpRequest exposing (Error(..), MockResolver, RawRequest(..), Status(..), cacheRequestResolution, mockResolve, toBuildError)
 
 import BuildError exposing (BuildError)
-import Dict
-import List.Extra
+import Json.Encode
 import Pages.StaticHttp.Request
 import RequestsAndPending exposing (RequestsAndPending)
 import TerminalText as Terminal
@@ -13,30 +12,19 @@ type alias MockResolver =
     -> Maybe RequestsAndPending.Response
 
 
-type RawRequest value
-    = Request (List Pages.StaticHttp.Request.Request) (Maybe MockResolver -> RequestsAndPending -> RawRequest value)
-    | RequestError Error
-    | ApiRoute value
+type RawRequest error value
+    = Request (List Pages.StaticHttp.Request.Request) (Maybe MockResolver -> RequestsAndPending -> RawRequest error value)
+    | ApiRoute (Result error value)
 
 
 type Error
-    = MissingHttpResponse String (List Pages.StaticHttp.Request.Request)
-    | DecoderError String
+    = DecoderError String
     | UserCalledStaticHttpFail String
 
 
 toBuildError : String -> Error -> BuildError
 toBuildError path error =
     case error of
-        MissingHttpResponse missingKey _ ->
-            { title = "Missing Http Response"
-            , message =
-                [ Terminal.text missingKey
-                ]
-            , path = path
-            , fatal = True
-            }
-
         DecoderError decodeErrorMessage ->
             { title = "Static Http Decoding Error"
             , message =
@@ -49,107 +37,43 @@ toBuildError path error =
         UserCalledStaticHttpFail decodeErrorMessage ->
             { title = "Called Static Http Fail"
             , message =
-                [ Terminal.text <| "I ran into a call to `DataSource.fail` with message: " ++ decodeErrorMessage
+                [ Terminal.text <| "I ran into a call to `BackendTask.fail` with message: " ++ decodeErrorMessage
                 ]
             , path = path
             , fatal = True
             }
 
 
-resolve : RawRequest value -> RequestsAndPending -> Result Error value
-resolve request rawResponses =
-    case request of
-        RequestError error ->
-            Err error
-
-        Request _ lookupFn ->
-            case lookupFn Nothing rawResponses of
-                nextRequest ->
-                    resolve nextRequest rawResponses
-
-        ApiRoute value ->
-            Ok value
-
-
-mockResolve : RawRequest value -> MockResolver -> Result Error value
+mockResolve : RawRequest error value -> MockResolver -> Result error value
 mockResolve request mockResolver =
     case request of
-        RequestError error ->
-            Err error
-
         Request _ lookupFn ->
-            case lookupFn (Just mockResolver) Dict.empty of
+            case lookupFn (Just mockResolver) (Json.Encode.object []) of
                 nextRequest ->
                     mockResolve nextRequest mockResolver
 
         ApiRoute value ->
-            Ok value
-
-
-resolveUrls : RawRequest value -> RequestsAndPending -> List Pages.StaticHttp.Request.Request
-resolveUrls request rawResponses =
-    resolveUrlsHelp rawResponses [] request
-
-
-resolveUrlsHelp : RequestsAndPending -> List Pages.StaticHttp.Request.Request -> RawRequest value -> List Pages.StaticHttp.Request.Request
-resolveUrlsHelp rawResponses soFar request =
-    case request of
-        RequestError error ->
-            case error of
-                MissingHttpResponse _ next ->
-                    (soFar ++ next)
-                        |> List.Extra.uniqueBy Pages.StaticHttp.Request.hash
-
-                _ ->
-                    soFar
-
-        Request urlList lookupFn ->
-            resolveUrlsHelp
-                rawResponses
-                (soFar ++ urlList)
-                (lookupFn Nothing rawResponses)
-
-        ApiRoute _ ->
-            soFar
+            value
 
 
 cacheRequestResolution :
-    RawRequest value
+    RawRequest error value
     -> RequestsAndPending
-    -> Status value
+    -> Status error value
 cacheRequestResolution request rawResponses =
-    cacheRequestResolutionHelp [] rawResponses request
-
-
-type Status value
-    = Incomplete (List Pages.StaticHttp.Request.Request)
-    | HasPermanentError Error
-    | Complete
-
-
-cacheRequestResolutionHelp :
-    List Pages.StaticHttp.Request.Request
-    -> RequestsAndPending
-    -> RawRequest value
-    -> Status value
-cacheRequestResolutionHelp foundUrls rawResponses request =
     case request of
-        RequestError error ->
-            case error of
-                MissingHttpResponse _ _ ->
-                    -- TODO do I need to pass through continuation URLs here? -- Incomplete (urlList ++ foundUrls)
-                    Incomplete foundUrls
+        Request urlList lookupFn ->
+            if List.isEmpty urlList then
+                cacheRequestResolution (lookupFn Nothing rawResponses) rawResponses
 
-                DecoderError _ ->
-                    HasPermanentError error
+            else
+                Incomplete urlList (Request [] lookupFn)
 
-                UserCalledStaticHttpFail _ ->
-                    HasPermanentError error
+        ApiRoute value ->
+            Complete value
 
-        Request urlList lookupFn ->
-            cacheRequestResolutionHelp urlList
-                rawResponses
-                (lookupFn Nothing rawResponses)
 
-        ApiRoute _ ->
-            Complete
+type Status error value
+    = Incomplete (List Pages.StaticHttp.Request.Request) (RawRequest error value)
+    | HasPermanentError Error
+    | Complete (Result error value)

package/src/Pages/Url.elm

@@ -12,7 +12,7 @@ If you refer to a local page, like `Route.Index |> Route.toPath |> Pages.Url.fro
 -}
 
 import Pages.Internal.String as String
-import Path exposing (Path)
+import UrlPath exposing (UrlPath)
 
 
 {-| -}
@@ -22,9 +22,9 @@ type Url
 
 
 {-| -}
-fromPath : Path -> Url
+fromPath : UrlPath -> Url
 fromPath path =
-    path |> Path.toAbsolute |> Internal
+    path |> UrlPath.toAbsolute |> Internal
 
 
 {-| -}

package/src/PagesMsg.elm

@@ -0,0 +1,88 @@
+module PagesMsg exposing
+    ( PagesMsg
+    , fromMsg
+    , map, noOp
+    )
+
+{-| In `elm-pages`, Route modules have their own `Msg` type which can be used like a normal TEA (The Elm Architecture) app.
+But the `Msg` defined in a `Route` module is wrapped in the `PagesMsg` type.
+
+@docs PagesMsg
+
+You can wrap your Route Module's `Msg` using `fromMsg`.
+
+@docs fromMsg
+
+@docs map, noOp
+
+-}
+
+import Pages.Internal.Msg
+
+
+{-| -}
+type alias PagesMsg userMsg =
+    Pages.Internal.Msg.Msg userMsg
+
+
+{-|
+
+    import Form
+    import Pages.Form
+    import PagesMsg exposing (PagesMsg)
+
+    type Msg
+        = ToggleMenu
+
+    view :
+        Maybe PageUrl
+        -> Shared.Model
+        -> Model
+        -> App Data ActionData RouteParams
+        -> View (PagesMsg Msg)
+    view maybeUrl sharedModel model app =
+        { title = "My Page"
+        , view =
+            [ button
+                -- we need to wrap our Route module's `Msg` here so we have a `PagesMsg Msg`
+                [ onClick (PagesMsg.fromMsg ToggleMenu) ]
+                []
+
+            -- `Pages.Form.renderHtml` gives us `Html (PagesMsg msg)`, so we don't need to wrap its Msg type
+            , logoutForm
+                |> Pages.Form.renderHtml []
+                    Pages.Form.Serial
+                    (Form.options "logout"
+                        |> Form.withOnSubmit (\_ -> NewItemSubmitted)
+                    )
+                    app
+            ]
+        }
+
+-}
+fromMsg : userMsg -> PagesMsg userMsg
+fromMsg userMsg =
+    Pages.Internal.Msg.UserMsg userMsg
+
+
+{-| A Msg that is handled by the elm-pages framework and does nothing. Helpful for when you don't want to register a callback.
+
+    import Browser.Dom as Dom
+    import PagesMsg exposing (PagesMsg)
+    import Task
+
+    resetViewport : Cmd (PagesMsg msg)
+    resetViewport =
+        Dom.setViewport 0 0
+            |> Task.perform (\() -> PagesMsg.noOp)
+
+-}
+noOp : PagesMsg userMsg
+noOp =
+    Pages.Internal.Msg.NoOp
+
+
+{-| -}
+map : (a -> b) -> PagesMsg a -> PagesMsg b
+map mapFn msg =
+    Pages.Internal.Msg.map mapFn msg

package/src/QueryParams.elm

@@ -1,189 +1,38 @@
 module QueryParams exposing
     ( QueryParams
-    , Parser
-    , andThen, fail, fromResult, fromString, optionalString, parse, string, strings, succeed
-    , map2, oneOf
-    , toDict, toString
+    , fromString
+    , toString
     )
 
-{-| Represents the query portion of a URL. You can use `toDict` or `toString` to turn it into basic types, or you can
-parse it into a custom type using the other functions in this module.
-
-@docs QueryParams
-
-
-## Parsing
-
-@docs Parser
-
-@docs andThen, fail, fromResult, fromString, optionalString, parse, string, strings, succeed
-
-
-## Combining
-
-@docs map2, oneOf
-
-
-## Accessing as Built-In Types
-
-@docs toDict, toString
-
--}
-
 import Dict exposing (Dict)
 import Url
 
 
 {-| -}
-type QueryParams
-    = QueryParams String
-
-
-{-| -}
-type Parser a
-    = Parser (Dict String (List String) -> Result String a)
-
-
-{-| -}
-succeed : a -> Parser a
-succeed value =
-    Parser (\_ -> Ok value)
-
-
-{-| -}
-fail : String -> Parser a
-fail errorMessage =
-    Parser (\_ -> Err errorMessage)
-
-
-{-| -}
-fromResult : Result String a -> Parser a
-fromResult result =
-    Parser (\_ -> result)
-
-
-{-| -}
-andThen : (a -> Parser b) -> Parser a -> Parser b
-andThen andThenFn (Parser parser) =
-    Parser
-        (\dict ->
-            case Result.map andThenFn (parser dict) of
-                Ok (Parser result) ->
-                    result dict
-
-                Err error ->
-                    Err error
-        )
-
-
-{-| -}
-oneOf : List (Parser a) -> Parser a
-oneOf parsers =
-    Parser
-        (tryParser parsers)
-
-
-{-| -}
-tryParser : List (Parser a) -> Dict String (List String) -> Result String a
-tryParser parsers dict =
-    case parsers of
-        [] ->
-            Err ""
-
-        (Parser nextParser) :: otherParsers ->
-            case nextParser dict of
-                Ok okValue ->
-                    Ok okValue
-
-                Err _ ->
-                    tryParser otherParsers dict
-
-
-{-| -}
-map2 : (a -> b -> combined) -> Parser a -> Parser b -> Parser combined
-map2 func (Parser a) (Parser b) =
-    Parser <|
-        \dict ->
-            Result.map2 func (a dict) (b dict)
-
-
-{-| -}
-optionalString : String -> Parser (Maybe String)
-optionalString key =
-    custom key
-        (\stringList ->
-            case stringList of
-                str :: _ ->
-                    Ok (Just str)
-
-                _ ->
-                    Ok Nothing
-        )
-
-
-{-| -}
-string : String -> Parser String
-string key =
-    custom key
-        (\stringList ->
-            case stringList of
-                [ str ] ->
-                    Ok str
-
-                _ ->
-                    Err ("Missing key " ++ key)
-        )
-
-
-{-| -}
-custom : String -> (List String -> Result String a) -> Parser a
-custom key customFn =
-    Parser <|
-        \dict ->
-            customFn (Maybe.withDefault [] (Dict.get key dict))
-
-
-{-| -}
-strings : String -> Parser (List String)
-strings key =
-    custom key
-        (\stringList -> Ok stringList)
-
-
-{-| -}
-fromString : String -> QueryParams
-fromString =
-    QueryParams
+type alias QueryParams =
+    Dict String (List String)
 
 
 {-| -}
 toString : QueryParams -> String
-toString (QueryParams queryParams) =
+toString queryParams =
     queryParams
-
-
-{-| -}
-parse : Parser a -> QueryParams -> Result String a
-parse (Parser queryParser) queryParams =
-    queryParams
-        |> toDict
-        |> queryParser
-
-
-{-| -}
-toDict : QueryParams -> Dict String (List String)
-toDict (QueryParams queryParams) =
-    prepareQuery (Just queryParams)
-
-
-prepareQuery : Maybe String -> Dict String (List String)
-prepareQuery maybeQuery =
-    case maybeQuery of
-        Nothing ->
-            Dict.empty
-
-        Just qry ->
-            List.foldr addParam Dict.empty (String.split "&" qry)
+        |> Dict.toList
+        |> List.concatMap
+            (\( key, values ) ->
+                values
+                    |> List.map
+                        (\value ->
+                            key ++ "=" ++ value
+                        )
+            )
+        |> String.join "&"
+
+
+{-| -}
+fromString : String -> Dict String (List String)
+fromString query =
+    List.foldr addParam Dict.empty (String.split "&" query)
 
 
 addParam : String -> Dict String (List String) -> Dict String (List String)