From 7f5f61e957befd0603943cb08d0f10346767981d Mon Sep 17 00:00:00 2001 From: Ryan Haskell-Glatz Date: Fri, 4 Oct 2019 20:14:18 -0500 Subject: [PATCH] thats the magic of macys --- elm.json | 33 ++-- examples/basic/index.html | 1 + examples/basic/main.css | 79 +++++++++ examples/basic/src/App.elm | 141 ++++++++------- examples/basic/src/Context.elm | 88 ++++++--- examples/basic/src/Data/User.elm | 28 +++ examples/basic/src/Main.elm | 9 +- examples/basic/src/Pages/Counter.elm | 24 ++- examples/basic/src/Pages/Homepage.elm | 17 +- examples/basic/src/Pages/NotFound.elm | 20 ++- examples/basic/src/Pages/Random.elm | 22 ++- examples/basic/src/Pages/SignIn.elm | 136 ++++++++++++++ examples/basic/src/Route.elm | 50 ++---- examples/basic/src/Utils/Cmd.elm | 19 ++ src/Application.elm | 246 +++++++++++++++++++------- src/Application/Page.elm | 122 ++++++++----- 16 files changed, 767 insertions(+), 268 deletions(-) create mode 100644 examples/basic/main.css create mode 100644 examples/basic/src/Data/User.elm create mode 100644 examples/basic/src/Pages/SignIn.elm create mode 100644 examples/basic/src/Utils/Cmd.elm diff --git a/elm.json b/elm.json index d4e48cc..1221de1 100644 --- a/elm.json +++ b/elm.json @@ -1,24 +1,19 @@ { - "type": "application", - "source-directories": [ - "src" + "type": "package", + "name": "ryannhg/elm-app", + "summary": "an experiment for making single page apps with Elm", + "license": "BSD-3-Clause", + "version": "0.1.0", + "exposed-modules": [ + "Application", + "Application.Page" ], - "elm-version": "0.19.0", + "elm-version": "0.19.0 <= v < 0.20.0", "dependencies": { - "direct": { - "elm/browser": "1.0.1", - "elm/core": "1.0.2", - "elm/html": "1.0.0", - "elm/url": "1.0.0" - }, - "indirect": { - "elm/json": "1.1.3", - "elm/time": "1.0.0", - "elm/virtual-dom": "1.0.2" - } + "elm/browser": "1.0.1", + "elm/core": "1.0.2", + "elm/html": "1.0.0", + "elm/url": "1.0.0" }, - "test-dependencies": { - "direct": {}, - "indirect": {} - } + "test-dependencies": {} } \ No newline at end of file diff --git a/examples/basic/index.html b/examples/basic/index.html index 3e943e1..d993891 100644 --- a/examples/basic/index.html +++ b/examples/basic/index.html @@ -5,6 +5,7 @@ Document +
diff --git a/examples/basic/main.css b/examples/basic/main.css new file mode 100644 index 0000000..dadf240 --- /dev/null +++ b/examples/basic/main.css @@ -0,0 +1,79 @@ +html, body { + height: 100%; +} + +body { + margin: 0; + font-family: -apple-system, BlinkMacSystemFont, 'Segoe UI', Roboto, Oxygen, Ubuntu, Cantarell, 'Open Sans', 'Helvetica Neue', sans-serif; +} + +.app { + height: 100%; + padding: 2rem 1rem; + box-sizing: border-box; + max-width: 720px; + margin: 0 auto; +} + +.navbar { + display: flex; + justify-content: space-between; +} + +.navbar__links { + display: flex; + align-items: baseline; +} +.navbar__links > *:first-child { + font-size: 20px; +} +.navbar__links > :not(:first-child) { + margin-left: 1rem; +} + +input { + padding: 0.25rem 0.5rem; + border: solid 1px #ccc; + font-size: inherit; + font-family: inherit; + margin-top: 0.5rem; +} + +.button { + border: solid 1px #ccc; + padding: 0.5rem 1.5rem; + background: #06f; + color: white; + font-family: inherit; + font-size: inherit; + border-radius: 4px; +} + +label { + display: block; + margin-bottom: 1rem; +} + +label div { + font-weight: bold; +} + +.layout { + display: flex; + flex-direction: column; + height: 100%; + box-sizing: border-box; +} +.layout > * { + width: 100%; +} + +.container { + flex: 1 0 auto; + padding: 2rem 0; + box-sizing: border-box; +} + +footer { + padding-bottom: 1rem; +} \ No newline at end of file diff --git a/examples/basic/src/App.elm b/examples/basic/src/App.elm index b7baa69..967a7e0 100644 --- a/examples/basic/src/App.elm +++ b/examples/basic/src/App.elm @@ -1,13 +1,13 @@ module App exposing ( Model , Msg + , bundle , init - , subscriptions , update - , view ) import Application.Page as Page exposing (Context) +import Browser import Context import Flags exposing (Flags) import Html exposing (Html) @@ -15,6 +15,7 @@ import Pages.Counter import Pages.Homepage import Pages.NotFound import Pages.Random +import Pages.SignIn import Route exposing (Route) @@ -22,6 +23,7 @@ type Model = HomepageModel () | CounterModel Pages.Counter.Model | RandomModel Pages.Random.Model + | SignInModel Pages.SignIn.Model | NotFoundModel () @@ -29,18 +31,21 @@ type Msg = HomepageMsg Never | CounterMsg Pages.Counter.Msg | RandomMsg Pages.Random.Msg + | SignInMsg Pages.SignIn.Msg | NotFoundMsg Never pages = { homepage = Page.static - { view = Pages.Homepage.view + { title = Pages.Homepage.title + , view = Pages.Homepage.view , toModel = HomepageModel } , counter = Page.sandbox - { init = Pages.Counter.init + { title = Pages.Counter.title + , init = Pages.Counter.init , update = Pages.Counter.update , view = Pages.Counter.view , toModel = CounterModel @@ -48,16 +53,28 @@ pages = } , random = Page.element - { init = Pages.Random.init + { title = Pages.Random.title + , init = Pages.Random.init , update = Pages.Random.update , subscriptions = Pages.Random.subscriptions , view = Pages.Random.view , toModel = RandomModel , toMsg = RandomMsg } + , signIn = + Page.page + { title = Pages.SignIn.title + , init = Pages.SignIn.init + , update = Pages.SignIn.update + , subscriptions = Pages.SignIn.subscriptions + , view = Pages.SignIn.view + , toModel = SignInModel + , toMsg = SignInMsg + } , notFound = Page.static - { view = Pages.NotFound.view + { title = Pages.NotFound.title + , view = Pages.NotFound.view , toModel = NotFoundModel } } @@ -70,23 +87,33 @@ init context = case context.route of Route.Homepage -> Page.init - { page = pages.homepage } - context + { page = pages.homepage + , context = context + } Route.Counter -> Page.init - { page = pages.counter } - context + { page = pages.counter + , context = context + } Route.Random -> Page.init - { page = pages.random } - context + { page = pages.random + , context = context + } + + Route.SignIn -> + Page.init + { page = pages.signIn + , context = context + } Route.NotFound -> Page.init - { page = pages.notFound } - context + { page = pages.notFound + , context = context + } update : @@ -101,8 +128,8 @@ update context appMsg appModel = { page = pages.homepage , msg = msg , model = model + , context = context } - context ( HomepageModel _, _ ) -> ( appModel @@ -115,8 +142,8 @@ update context appMsg appModel = { page = pages.counter , msg = msg , model = model + , context = context } - context ( CounterModel _, _ ) -> ( appModel @@ -129,8 +156,8 @@ update context appMsg appModel = { page = pages.random , msg = msg , model = model + , context = context } - context ( RandomModel _, _ ) -> ( appModel @@ -138,13 +165,27 @@ update context appMsg appModel = , Cmd.none ) + ( SignInModel model, SignInMsg msg ) -> + Page.update + { page = pages.signIn + , msg = msg + , model = model + , context = context + } + + ( SignInModel _, _ ) -> + ( appModel + , Cmd.none + , Cmd.none + ) + ( NotFoundModel model, NotFoundMsg msg ) -> Page.update { page = pages.notFound , msg = msg , model = model + , context = context } - context ( NotFoundModel _, _ ) -> ( appModel @@ -153,71 +194,43 @@ update context appMsg appModel = ) -subscriptions : +bundle : Context Flags Route Context.Model -> Model - -> Sub Msg -subscriptions context appModel = + -> Page.Bundle Msg +bundle context appModel = case appModel of HomepageModel model -> - Page.subscriptions + Page.bundle { page = pages.homepage , model = model + , context = context } - context CounterModel model -> - Page.subscriptions + Page.bundle { page = pages.counter , model = model + , context = context } - context RandomModel model -> - Page.subscriptions + Page.bundle { page = pages.random , model = model + , context = context + } + + SignInModel model -> + Page.bundle + { page = pages.signIn + , model = model + , context = context } - context NotFoundModel model -> - Page.subscriptions + Page.bundle { page = pages.notFound , model = model + , context = context } - context - - -view : - Context Flags Route Context.Model - -> Model - -> Html Msg -view context appModel = - case appModel of - HomepageModel model -> - Page.view - { page = pages.homepage - , model = model - } - context - - CounterModel model -> - Page.view - { page = pages.counter - , model = model - } - context - - RandomModel model -> - Page.view - { page = pages.random - , model = model - } - context - - NotFoundModel model -> - Page.view - { page = pages.notFound - , model = model - } - context diff --git a/examples/basic/src/Context.elm b/examples/basic/src/Context.elm index 0f05e1f..9b6dc71 100644 --- a/examples/basic/src/Context.elm +++ b/examples/basic/src/Context.elm @@ -1,26 +1,29 @@ module Context exposing ( Model - , Msg + , Msg(..) , init , subscriptions , update , view ) +import Application +import Data.User exposing (User) import Flags exposing (Flags) import Html exposing (..) -import Html.Attributes as Attr +import Html.Attributes as Attr exposing (class) import Html.Events as Events import Route exposing (Route) +import Utils.Cmd type alias Model = - { user : Maybe String + { user : Maybe User } type Msg - = SignIn String + = SignIn (Result String User) | SignOut @@ -31,18 +34,25 @@ init route flags = ) -update : Route -> Msg -> Model -> ( Model, Cmd Msg ) -update route msg model = +update : + Application.Messages Route msg + -> Route + -> Msg + -> Model + -> ( Model, Cmd Msg, Cmd msg ) +update { navigateTo } route msg model = case msg of - SignIn user -> + SignIn (Ok user) -> ( { model | user = Just user } , Cmd.none + , navigateTo Route.Homepage ) + SignIn (Err _) -> + Utils.Cmd.pure model + SignOut -> - ( { model | user = Nothing } - , Cmd.none - ) + Utils.Cmd.pure { model | user = Nothing } view : @@ -53,19 +63,17 @@ view : } -> Html msg view { context, route, toMsg, viewPage } = - div [ Attr.class "layout" ] + div [ class "layout" ] [ Html.map toMsg (viewNavbar route context) - , br [] [] - , viewPage - , br [] [] + , div [ class "container" ] [ viewPage ] , Html.map toMsg (viewFooter context) ] viewNavbar : Route -> Model -> Html Msg viewNavbar currentRoute model = - header [ Attr.class "navbar" ] - [ ul [] + header [ class "navbar" ] + [ div [ class "navbar__links" ] (List.map (viewLink currentRoute) [ Route.Homepage, Route.Counter, Route.Random ] @@ -75,31 +83,53 @@ viewNavbar currentRoute model = button [ Events.onClick SignOut ] [ text <| "Sign out" ] Nothing -> - button [ Events.onClick (SignIn "Ryan") ] [ text "Sign in" ] + a [ Attr.href "/sign-in" ] [ text "Sign in" ] ] viewLink : Route -> Route -> Html msg viewLink currentRoute route = - li [] - [ a - [ Attr.href (Route.toPath route) - , Attr.style "font-weight" - (if route == currentRoute then - "bold" + a + [ class "navbar__link-item" + , Attr.href (Route.toPath route) + , Attr.style "font-weight" + (if route == currentRoute then + "bold" - else - "normal" - ) - ] - [ text (Route.title route) ] + else + "normal" + ) ] + [ text (linkLabel route) ] + + +linkLabel : Route -> String +linkLabel route = + case route of + Route.Homepage -> + "Home" + + Route.Counter -> + "Counter" + + Route.SignIn -> + "Sign In" + + Route.Random -> + "Random" + + Route.NotFound -> + "Not found" viewFooter : Model -> Html Msg viewFooter model = footer [ Attr.class "footer" ] - [ model.user |> Maybe.withDefault "Not signed in" |> text + [ model.user + |> Maybe.map Data.User.username + |> Maybe.withDefault "not signed in" + |> (++) "Current user: " + |> text ] diff --git a/examples/basic/src/Data/User.elm b/examples/basic/src/Data/User.elm new file mode 100644 index 0000000..c211231 --- /dev/null +++ b/examples/basic/src/Data/User.elm @@ -0,0 +1,28 @@ +module Data.User exposing (User, signIn, username) + +import Utils.Cmd + + +type User + = User String + + +username : User -> String +username (User username_) = + username_ + + +signIn : + { username : String + , password : String + , msg : Result String User -> msg + } + -> Cmd msg +signIn options = + (Utils.Cmd.toCmd << options.msg) <| + case ( options.username, options.password ) of + ( _, "password" ) -> + Ok (User options.username) + + _ -> + Err "Sign in failed." diff --git a/examples/basic/src/Main.elm b/examples/basic/src/Main.elm index 6984d4c..7375965 100644 --- a/examples/basic/src/Main.elm +++ b/examples/basic/src/Main.elm @@ -24,9 +24,10 @@ main = , page = { init = App.init , update = App.update - , view = App.view - , subscriptions = App.subscriptions + , bundle = App.bundle + } + , route = + { fromUrl = Route.fromUrl + , toPath = Route.toPath } - , toRoute = Route.fromUrl - , title = Route.title } diff --git a/examples/basic/src/Pages/Counter.elm b/examples/basic/src/Pages/Counter.elm index 2786fb4..8696268 100644 --- a/examples/basic/src/Pages/Counter.elm +++ b/examples/basic/src/Pages/Counter.elm @@ -1,4 +1,11 @@ -module Pages.Counter exposing (Model, Msg, init, update, view) +module Pages.Counter exposing + ( Model + , Msg + , init + , title + , update + , view + ) import Html exposing (..) import Html.Events as Events @@ -14,6 +21,11 @@ type Msg | Decrement +title : Model -> String +title model = + "Counter: " ++ String.fromInt model.counter ++ " | elm-app" + + init : Model init = { counter = 0 @@ -33,7 +45,11 @@ update msg model = view : Model -> Html Msg view model = div [] - [ button [ Events.onClick Decrement ] [ text "-" ] - , text (String.fromInt model.counter) - , button [ Events.onClick Increment ] [ text "+" ] + [ h1 [] [ text "Counter!" ] + , p [] [ text "Even the browser tab updates!" ] + , div [] + [ button [ Events.onClick Decrement ] [ text "-" ] + , text (String.fromInt model.counter) + , button [ Events.onClick Increment ] [ text "+" ] + ] ] diff --git a/examples/basic/src/Pages/Homepage.elm b/examples/basic/src/Pages/Homepage.elm index e9adf8a..ff03fd9 100644 --- a/examples/basic/src/Pages/Homepage.elm +++ b/examples/basic/src/Pages/Homepage.elm @@ -1,8 +1,19 @@ -module Pages.Homepage exposing (view) +module Pages.Homepage exposing + ( title + , view + ) -import Html exposing (Html) +import Html exposing (..) + + +title : String +title = + "Homepage" view : Html Never view = - Html.text "Homepage!" + div [] + [ h1 [] [ text "Homepage!" ] + , p [] [ text "It's boring, but it works!" ] + ] diff --git a/examples/basic/src/Pages/NotFound.elm b/examples/basic/src/Pages/NotFound.elm index ac61ce9..c1ee2bb 100644 --- a/examples/basic/src/Pages/NotFound.elm +++ b/examples/basic/src/Pages/NotFound.elm @@ -1,8 +1,22 @@ -module Pages.NotFound exposing (view) +module Pages.NotFound exposing + ( title + , view + ) -import Html exposing (Html) +import Html exposing (..) + + +title : String +title = + "Not found." view : Html Never view = - Html.text "Page not found..." + div [] + [ h1 [] [ text "Page not found!" ] + , p [] + [ text "Is this space? Am I in " + , em [] [ text "space?" ] + ] + ] diff --git a/examples/basic/src/Pages/Random.elm b/examples/basic/src/Pages/Random.elm index f974f53..704caf5 100644 --- a/examples/basic/src/Pages/Random.elm +++ b/examples/basic/src/Pages/Random.elm @@ -3,6 +3,7 @@ module Pages.Random exposing , Msg , init , subscriptions + , title , update , view ) @@ -23,6 +24,11 @@ type Msg | GotOutcome Int +title : Model -> String +title model = + "Random | elm-app" + + init : Flags -> ( Model, Cmd Msg ) init _ = ( { roll = Nothing } @@ -52,12 +58,16 @@ update msg model = view : Model -> Html Msg view model = div [] - [ button [ Events.onClick Roll ] [ text "Roll" ] - , p [] - [ model.roll - |> Maybe.map String.fromInt - |> Maybe.withDefault "Click the button!" - |> text + [ h1 [] [ text "Random!" ] + , p [] [ text "Did somebody say 'random numbers pls'?" ] + , div [] + [ button [ Events.onClick Roll ] [ text "Roll" ] + , p [] + [ model.roll + |> Maybe.map String.fromInt + |> Maybe.withDefault "Click the button!" + |> text + ] ] ] diff --git a/examples/basic/src/Pages/SignIn.elm b/examples/basic/src/Pages/SignIn.elm new file mode 100644 index 0000000..482b6f2 --- /dev/null +++ b/examples/basic/src/Pages/SignIn.elm @@ -0,0 +1,136 @@ +module Pages.SignIn exposing + ( Model + , Msg + , init + , subscriptions + , title + , update + , view + ) + +import Application.Page exposing (Context) +import Context +import Data.User as User exposing (User) +import Flags exposing (Flags) +import Html exposing (..) +import Html.Attributes as Attr +import Html.Events as Events +import Route exposing (Route) +import Utils.Cmd + + +type alias Model = + { username : String + , password : String + } + + +type Msg + = Update Field String + | AttemptSignIn + + +type Field + = Username + | Password + + +title : Context Flags Route Context.Model -> Model -> String +title { context } model = + case context.user of + Just user -> + "Sign out " ++ User.username user ++ " | elm-app" + + Nothing -> + "Sign in | elm-app" + + +init : + Context Flags Route Context.Model + -> ( Model, Cmd Msg, Cmd Context.Msg ) +init _ = + Utils.Cmd.pure { username = "", password = "" } + + +update : + Context Flags Route Context.Model + -> Msg + -> Model + -> ( Model, Cmd Msg, Cmd Context.Msg ) +update _ msg model = + case msg of + Update Username value -> + Utils.Cmd.pure { model | username = value } + + Update Password value -> + Utils.Cmd.pure { model | password = value } + + AttemptSignIn -> + ( model + , Cmd.none + , User.signIn + { username = model.username + , password = model.password + , msg = Context.SignIn + } + ) + + +view : + Context Flags Route Context.Model + -> Model + -> Html Msg +view _ model = + div [] + [ h1 [] [ text "Sign in" ] + , p [] [ text "and update some user state!" ] + , Html.form [ Events.onSubmit AttemptSignIn ] + [ viewInput + { label = "Username" + , fieldType = "text" + , value = model.username + , onInput = Update Username + } + , viewInput + { label = "Password" + , fieldType = "password" + , value = model.password + , onInput = Update Password + } + , p [] + [ button + [ Attr.class "button" + , Attr.type_ "submit" + ] + [ text "Sign in" + ] + ] + ] + ] + + +viewInput : + { label : String + , fieldType : String + , value : String + , onInput : String -> msg + } + -> Html msg +viewInput options = + label [] + [ div [] [ text options.label ] + , input + [ Attr.value options.value + , Attr.type_ options.fieldType + , Events.onInput options.onInput + ] + [] + ] + + +subscriptions : + Context Flags Route Context.Model + -> Model + -> Sub Msg +subscriptions _ model = + Sub.none diff --git a/examples/basic/src/Route.elm b/examples/basic/src/Route.elm index ae07188..d4febd0 100644 --- a/examples/basic/src/Route.elm +++ b/examples/basic/src/Route.elm @@ -1,4 +1,4 @@ -module Route exposing (Route(..), fromUrl, title, toPath) +module Route exposing (Route(..), fromUrl, toPath) import Url exposing (Url) import Url.Parser as Parser exposing (Parser) @@ -6,6 +6,7 @@ import Url.Parser as Parser exposing (Parser) type Route = Homepage + | SignIn | Counter | Random | NotFound @@ -13,46 +14,31 @@ type Route fromUrl : Url -> Route fromUrl = - Parser.parse router >> Maybe.withDefault NotFound - - -router : Parser (Route -> Route) Route -router = - Parser.oneOf - [ Parser.map Homepage Parser.top - , Parser.map Counter (Parser.s "counter") - , Parser.map Random (Parser.s "random") - ] + Parser.parse + (Parser.oneOf + [ Parser.map Homepage Parser.top + , Parser.map SignIn (Parser.s "sign-in") + , Parser.map Counter (Parser.s "counter") + , Parser.map Random (Parser.s "random") + ] + ) + >> Maybe.withDefault NotFound toPath : Route -> String toPath route = - (String.join "/" >> (++) "/") <| - case route of - Homepage -> - [] - - Counter -> - [ "counter" ] - - Random -> - [ "random" ] - - NotFound -> - [ "not-found" ] - - -title : Route -> String -title route = case route of Homepage -> - "Home" + "/" + + SignIn -> + "/sign-in" Counter -> - "Counter" + "/counter" Random -> - "Random" + "/random" NotFound -> - "Not found" + "/not-found" diff --git a/examples/basic/src/Utils/Cmd.elm b/examples/basic/src/Utils/Cmd.elm new file mode 100644 index 0000000..39f34ca --- /dev/null +++ b/examples/basic/src/Utils/Cmd.elm @@ -0,0 +1,19 @@ +module Utils.Cmd exposing + ( pure + , toCmd + ) + +import Task + + +pure : model -> ( model, Cmd a, Cmd b ) +pure model = + ( model + , Cmd.none + , Cmd.none + ) + + +toCmd : msg -> Cmd msg +toCmd msg = + Task.perform identity (Task.succeed msg) diff --git a/src/Application.elm b/src/Application.elm index 1d528cc..af69372 100644 --- a/src/Application.elm +++ b/src/Application.elm @@ -1,4 +1,27 @@ -module Application exposing (Application, create) +module Application exposing + ( Application + , create + , Messages + ) + +{-| A package for building single page apps with Elm! + + +# Application + +@docs Application + + +# Creating applications + +@docs create + + +# Navigating all smooth-like + +@docs Messages + +-} import Application.Page exposing (Context) import Browser @@ -10,10 +33,107 @@ import Task import Url exposing (Url) +{-| A type that's provided for type annotations! + +Instead of `Program Flags Model Msg`, you can use this type to annotate your main method: + + main : Application Flags Context.Model Context.Msg App.Model App.Msg + main = + Application.create { ... } + +-} type alias Application flags contextModel contextMsg model msg = Program flags (Model flags contextModel model) (Msg contextMsg msg) +type alias Config flags route contextModel contextMsg model msg = + { context : + { init : + route + -> flags + -> ( contextModel, Cmd contextMsg ) + , update : + Messages route (Msg contextMsg msg) + -> route + -> contextMsg + -> contextModel + -> ( contextModel, Cmd contextMsg, Cmd (Msg contextMsg msg) ) + , subscriptions : + route + -> contextModel + -> Sub contextMsg + , view : + { route : route + , context : contextModel + , toMsg : contextMsg -> Msg contextMsg msg + , viewPage : Html (Msg contextMsg msg) + } + -> Html (Msg contextMsg msg) + } + , page : + { init : + Context flags route contextModel + -> ( model, Cmd msg, Cmd contextMsg ) + , update : + Context flags route contextModel + -> msg + -> model + -> ( model, Cmd msg, Cmd contextMsg ) + , bundle : + Context flags route contextModel + -> model + -> Application.Page.Bundle msg + } + , route : + { fromUrl : Url -> route + , toPath : route -> String + } + , transition : Float + } + + +{-| The way to create an `Application`! + +Provide this function with a configuration, and it will bundle things up for you. + +Here's an example (from the `examples/basic` folder of this repo): + + main : Application Flags Context.Model Context.Msg App.Model App.Msg + main = + Application.create + { transition = 200 + , context = + { init = Context.init + , update = Context.update + , view = Context.view + , subscriptions = Context.subscriptions + } + , page = + { init = App.init + , update = App.update + , bundle = App.view + } + , route = + { fromUrl = Route.fromUrl + , toPath = Route.toPath + } + } + +-} +create : + Config flags route contextModel contextMsg model msg + -> Application flags contextModel contextMsg model msg +create config = + Browser.application + { init = init config + , update = update config + , view = view config + , subscriptions = subscriptions config + , onUrlChange = UrlChanged + , onUrlRequest = UrlRequested + } + + type alias Model flags contextModel model = { key : Nav.Key , url : Url @@ -73,45 +193,11 @@ type Msg contextMsg msg | PageMsg msg -type alias Config flags route contextModel contextMsg model msg = - { context : - { init : route -> flags -> ( contextModel, Cmd contextMsg ) - , update : route -> contextMsg -> contextModel -> ( contextModel, Cmd contextMsg ) - , subscriptions : route -> contextModel -> Sub contextMsg - , view : - { route : route - , context : contextModel - , toMsg : contextMsg -> Msg contextMsg msg - , viewPage : Html (Msg contextMsg msg) - } - -> Html (Msg contextMsg msg) - } - , page : - { init : Context flags route contextModel -> ( model, Cmd msg, Cmd contextMsg ) - , update : Context flags route contextModel -> msg -> model -> ( model, Cmd msg, Cmd contextMsg ) - , subscriptions : Context flags route contextModel -> model -> Sub msg - , view : Context flags route contextModel -> model -> Html msg - } - , toRoute : Url -> route - , title : route -> String - , transition : Float +type alias Messages route msg = + { navigateTo : route -> Cmd msg } -create : - Config flags route contextModel contextMsg model msg - -> Application flags contextModel contextMsg model msg -create config = - Browser.application - { init = init config - , update = update config - , view = view config - , subscriptions = subscriptions config - , onUrlChange = UrlChanged - , onUrlRequest = UrlRequested - } - - init : Config flags route contextModel contextMsg model msg -> flags @@ -121,7 +207,7 @@ init : init config flags url key = let route = - config.toRoute url + config.route.fromUrl url ( contextModel, contextCmd ) = config.context.init route flags @@ -181,7 +267,7 @@ update config msg model = let ( pageModel, pageCmd, contextCmd ) = config.page.init - { route = config.toRoute url + { route = config.route.fromUrl url , flags = model.flags , context = model.context } @@ -194,16 +280,27 @@ update config msg model = ) ContextMsg msg_ -> - Tuple.mapBoth - (\context -> { model | context = context }) - (Cmd.map ContextMsg) - (config.context.update (config.toRoute model.url) msg_ model.context) + let + ( contextModel, contextCmd, globalCmd ) = + config.context.update + { navigateTo = navigateTo config model.url + } + (config.route.fromUrl model.url) + msg_ + model.context + in + ( { model | context = contextModel } + , Cmd.batch + [ Cmd.map ContextMsg contextCmd + , globalCmd + ] + ) PageMsg msg_ -> let ( pageModel, pageCmd, contextCmd ) = config.page.update - { route = config.toRoute model.url + { route = config.route.fromUrl model.url , flags = model.flags , context = model.context } @@ -257,15 +354,19 @@ view config model = Loaded _ -> "1" + + ( context, pageModel ) = + contextAndPage ( config, model ) in - { title = config.title (config.toRoute model.url) + { title = config.page.bundle context pageModel |> .title , body = [ div - [ Attr.style "transition" (transitionProp config.transition) + [ Attr.class "app" + , Attr.style "transition" (transitionProp config.transition) , Attr.style "opacity" (layoutOpacity model.page) ] [ config.context.view - { route = config.toRoute model.url + { route = config.route.fromUrl model.url , toMsg = ContextMsg , context = model.context , viewPage = @@ -274,13 +375,7 @@ view config model = , Attr.style "opacity" (pageOpacity model.page) ] [ Html.map PageMsg - (config.page.view - { route = config.toRoute model.url - , flags = model.flags - , context = model.context - } - (unwrap model.page) - ) + (config.page.bundle context pageModel |> .view) ] } ] @@ -293,14 +388,39 @@ subscriptions : -> Model flags contextModel model -> Sub (Msg contextMsg msg) subscriptions config model = + let + ( context, pageModel ) = + contextAndPage ( config, model ) + in Sub.batch - [ Sub.map ContextMsg (config.context.subscriptions (config.toRoute model.url) model.context) - , Sub.map PageMsg - (config.page.subscriptions - { route = config.toRoute model.url - , flags = model.flags - , context = model.context - } - (unwrap model.page) - ) + [ Sub.map ContextMsg (config.context.subscriptions (config.route.fromUrl model.url) model.context) + , Sub.map PageMsg (config.page.bundle context pageModel |> .subscriptions) ] + + + +-- UTILS + + +contextAndPage : + ( Config flags route contextModel contextMsg model msg, Model flags contextModel model ) + -> ( Application.Page.Context flags route contextModel, model ) +contextAndPage ( config, model ) = + ( { route = config.route.fromUrl model.url + , flags = model.flags + , context = model.context + } + , unwrap model.page + ) + + +navigateTo : + Config flags route contextModel contextMsg model msg + -> Url + -> route + -> Cmd (Msg contextMsg msg) +navigateTo config url route = + Task.succeed (config.route.toPath route) + |> Task.map (\path -> { url | path = path }) + |> Task.map Browser.Internal + |> Task.perform UrlRequested diff --git a/src/Application/Page.elm b/src/Application/Page.elm index 71efb41..290e76d 100644 --- a/src/Application/Page.elm +++ b/src/Application/Page.elm @@ -1,16 +1,38 @@ module Application.Page exposing - ( Context - , Page - , element - , init - , page - , sandbox - , static - , subscriptions - , update - , view + ( static, sandbox, element, page + , init, update, bundle + , Context + , Bundle ) +{-| A package for building single page apps with Elm! + + +# Page + +These functions convert your pages into one consistent `Page` type. + +This makes writing top-level functions like `init`, `update`, `view`, and `subscriptions` easy, without making pages themselves unnecessarily complex. + +You can check out [a full example here](https://github.com/ryannhg/elm-app/tree/master/examples/basic) to understand how these functions are used. + +@docs static, sandbox, element, page + + +# Helpers + +@docs init, update, bundle + + +# Related types + +@docs Context + +@docs Bundle + +-} + +import Browser import Html exposing (Html) @@ -22,7 +44,8 @@ type alias Context flags route contextModel = type alias Page route flags contextModel contextMsg model msg appModel appMsg = - { init : Context flags route contextModel -> ( model, Cmd msg, Cmd contextMsg ) + { title : Context flags route contextModel -> model -> String + , init : Context flags route contextModel -> ( model, Cmd msg, Cmd contextMsg ) , update : Context flags route contextModel -> msg -> model -> ( model, Cmd msg, Cmd contextMsg ) , subscriptions : Context flags route contextModel -> model -> Sub msg , view : Context flags route contextModel -> model -> Html msg @@ -37,11 +60,11 @@ type alias Page route flags contextModel contextMsg model msg appModel appMsg = init : { page : Page route flags contextModel contextMsg model msg appModel appMsg + , context : Context flags route contextModel } - -> Context flags route contextModel -> ( appModel, Cmd appMsg, Cmd contextMsg ) -init config context = - config.page.init context +init config = + config.page.init config.context |> mapTruple { fromMsg = config.page.toMsg , fromModel = config.page.toModel @@ -52,37 +75,46 @@ update : { page : Page route flags contextModel contextMsg model msg appModel appMsg , msg : msg , model : model + , context : Context flags route contextModel } - -> Context flags route contextModel -> ( appModel, Cmd appMsg, Cmd contextMsg ) -update config context = - config.page.update context config.msg config.model +update config = + config.page.update config.context config.msg config.model |> mapTruple { fromMsg = config.page.toMsg , fromModel = config.page.toModel } -subscriptions : - { page : Page route flags contextModel contextMsg model msg appModel appMsg - , model : model +type alias Bundle appMsg = + { title : String + , view : Html appMsg + , subscriptions : Sub appMsg } - -> Context flags route contextModel - -> Sub appMsg -subscriptions config context = - config.page.subscriptions context config.model - |> Sub.map config.page.toMsg -view : +bundle : { page : Page route flags contextModel contextMsg model msg appModel appMsg , model : model + , context : Context flags route contextModel + } + -> Bundle appMsg +bundle config = + { title = + config.page.title + config.context + config.model + , view = + Html.map config.page.toMsg <| + config.page.view + config.context + config.model + , subscriptions = + Sub.map config.page.toMsg <| + config.page.subscriptions + config.context + config.model } - -> Context flags route contextModel - -> Html appMsg -view config context = - config.page.view context config.model - |> Html.map config.page.toMsg @@ -90,12 +122,14 @@ view config context = static : - { view : Html Never + { title : String + , view : Html Never , toModel : () -> appModel } -> Page route flags contextModel contextMsg () Never appModel appMsg static config = - { init = \c -> ( (), Cmd.none, Cmd.none ) + { title = \c m -> config.title + , init = \c -> ( (), Cmd.none, Cmd.none ) , update = \c m model -> ( model, Cmd.none, Cmd.none ) , subscriptions = \c m -> Sub.none , view = \c m -> Html.map never config.view @@ -105,7 +139,8 @@ static config = sandbox : - { init : model + { title : model -> String + , init : model , update : msg -> model -> model , view : model -> Html msg , toMsg : msg -> appMsg @@ -113,7 +148,8 @@ sandbox : } -> Page route flags contextModel contextMsg model msg appModel appMsg sandbox config = - { init = \c -> ( config.init, Cmd.none, Cmd.none ) + { title = \c model -> config.title model + , init = \c -> ( config.init, Cmd.none, Cmd.none ) , update = \c msg model -> ( config.update msg model, Cmd.none, Cmd.none ) , subscriptions = \c m -> Sub.none , view = \c model -> config.view model @@ -123,7 +159,8 @@ sandbox config = element : - { init : flags -> ( model, Cmd msg ) + { title : model -> String + , init : flags -> ( model, Cmd msg ) , update : msg -> model -> ( model, Cmd msg ) , subscriptions : model -> Sub msg , view : model -> Html msg @@ -136,7 +173,8 @@ element config = appendCmd ( model, cmd ) = ( model, cmd, Cmd.none ) in - { init = \c -> config.init c.flags |> appendCmd + { title = \c model -> config.title model + , init = \c -> config.init c.flags |> appendCmd , update = \c msg model -> config.update msg model |> appendCmd , subscriptions = \c model -> config.subscriptions model , view = \c model -> config.view model @@ -146,8 +184,9 @@ element config = page : - { init : Context flags route contextModel -> ( model, Cmd msg ) - , update : Context flags route contextModel -> msg -> model -> ( model, Cmd msg ) + { title : Context flags route contextModel -> model -> String + , init : Context flags route contextModel -> ( model, Cmd msg, Cmd contextMsg ) + , update : Context flags route contextModel -> msg -> model -> ( model, Cmd msg, Cmd contextMsg ) , subscriptions : Context flags route contextModel -> model -> Sub msg , view : Context flags route contextModel -> model -> Html msg , toMsg : msg -> appMsg @@ -159,8 +198,9 @@ page config = appendCmd ( model, cmd ) = ( model, cmd, Cmd.none ) in - { init = \c -> config.init c |> appendCmd - , update = \c msg model -> config.update c msg model |> appendCmd + { title = config.title + , init = config.init + , update = config.update , subscriptions = \c model -> config.subscriptions c model , view = \c model -> config.view c model , toMsg = config.toMsg