ryannhg/elm-spa
1
1
Fork 0
mirror of https://github.com/ryannhg/elm-spa.git synced 2024-11-22 09:44:55 +03:00
Code Issues Packages Projects Releases Wiki Activity

thats the magic of macys

Browse Source
This commit is contained in:
Ryan Haskell-Glatz 2019-10-04 20:14:18 -05:00
parent a6e5229c82
commit 7f5f61e957
16 changed files with 767 additions and 268 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
elm.json
View File

@ -1,24 +1,19 @@
{ {
"type": "application", "type": "package",
"source-directories": [ "name": "ryannhg/elm-app",
"src" "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": { "dependencies": {
"direct": { "elm/browser": "1.0.1",
"elm/browser": "1.0.1", "elm/core": "1.0.2",
"elm/core": "1.0.2", "elm/html": "1.0.0",
"elm/html": "1.0.0", "elm/url": "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"
}
}, },
"test-dependencies": { "test-dependencies": {}
"direct": {},
"indirect": {}
}
} }

1
examples/basic/index.html
View File

@ -5,6 +5,7 @@
<meta name="viewport" content="width=device-width, initial-scale=1.0"> <meta name="viewport" content="width=device-width, initial-scale=1.0">
<meta http-equiv="X-UA-Compatible" content="ie=edge"> <meta http-equiv="X-UA-Compatible" content="ie=edge">
<title>Document</title> <title>Document</title>
<link rel="stylesheet" href="./main.css">
</head> </head>
<body> <body>
<div id="app"></div> <div id="app"></div>

79
examples/basic/main.css Normal file
View File

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

141
examples/basic/src/App.elm
View File

@ -1,13 +1,13 @@
module App exposing module App exposing
( Model ( Model
, Msg , Msg
, bundle
, init , init
, subscriptions
, update , update
, view
) )
import Application.Page as Page exposing (Context) import Application.Page as Page exposing (Context)
import Browser
import Context import Context
import Flags exposing (Flags) import Flags exposing (Flags)
import Html exposing (Html) import Html exposing (Html)
@ -15,6 +15,7 @@ import Pages.Counter
import Pages.Homepage import Pages.Homepage
import Pages.NotFound import Pages.NotFound
import Pages.Random import Pages.Random
import Pages.SignIn
import Route exposing (Route) import Route exposing (Route)
@ -22,6 +23,7 @@ type Model
= HomepageModel () = HomepageModel ()
| CounterModel Pages.Counter.Model | CounterModel Pages.Counter.Model
| RandomModel Pages.Random.Model | RandomModel Pages.Random.Model
| SignInModel Pages.SignIn.Model
| NotFoundModel () | NotFoundModel ()
@ -29,18 +31,21 @@ type Msg
= HomepageMsg Never = HomepageMsg Never
| CounterMsg Pages.Counter.Msg | CounterMsg Pages.Counter.Msg
| RandomMsg Pages.Random.Msg | RandomMsg Pages.Random.Msg
| SignInMsg Pages.SignIn.Msg
| NotFoundMsg Never | NotFoundMsg Never
pages = pages =
{ homepage = { homepage =
Page.static Page.static
{ view = Pages.Homepage.view { title = Pages.Homepage.title
, view = Pages.Homepage.view
, toModel = HomepageModel , toModel = HomepageModel
} }
, counter = , counter =
Page.sandbox Page.sandbox
{ init = Pages.Counter.init { title = Pages.Counter.title
, init = Pages.Counter.init
, update = Pages.Counter.update , update = Pages.Counter.update
, view = Pages.Counter.view , view = Pages.Counter.view
, toModel = CounterModel , toModel = CounterModel
@ -48,16 +53,28 @@ pages =
} }
, random = , random =
Page.element Page.element
{ init = Pages.Random.init { title = Pages.Random.title
, init = Pages.Random.init
, update = Pages.Random.update , update = Pages.Random.update
, subscriptions = Pages.Random.subscriptions , subscriptions = Pages.Random.subscriptions
, view = Pages.Random.view , view = Pages.Random.view
, toModel = RandomModel , toModel = RandomModel
, toMsg = RandomMsg , 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 = , notFound =
Page.static Page.static
{ view = Pages.NotFound.view { title = Pages.NotFound.title
, view = Pages.NotFound.view
, toModel = NotFoundModel , toModel = NotFoundModel
} }
} }
@ -70,23 +87,33 @@ init context =
case context.route of case context.route of
Route.Homepage -> Route.Homepage ->
Page.init Page.init
{ page = pages.homepage } { page = pages.homepage
context , context = context
}
Route.Counter -> Route.Counter ->
Page.init Page.init
{ page = pages.counter } { page = pages.counter
context , context = context
}
Route.Random -> Route.Random ->
Page.init Page.init
{ page = pages.random } { page = pages.random
context , context = context
}
Route.SignIn ->
Page.init
{ page = pages.signIn
, context = context
}
Route.NotFound -> Route.NotFound ->
Page.init Page.init
{ page = pages.notFound } { page = pages.notFound
context , context = context
}
update : update :
@ -101,8 +128,8 @@ update context appMsg appModel =
{ page = pages.homepage { page = pages.homepage
, msg = msg , msg = msg
, model = model , model = model
, context = context
} }
context
( HomepageModel _, _ ) -> ( HomepageModel _, _ ) ->
( appModel ( appModel
@ -115,8 +142,8 @@ update context appMsg appModel =
{ page = pages.counter { page = pages.counter
, msg = msg , msg = msg
, model = model , model = model
, context = context
} }
context
( CounterModel _, _ ) -> ( CounterModel _, _ ) ->
( appModel ( appModel
@ -129,8 +156,8 @@ update context appMsg appModel =
{ page = pages.random { page = pages.random
, msg = msg , msg = msg
, model = model , model = model
, context = context
} }
context
( RandomModel _, _ ) -> ( RandomModel _, _ ) ->
( appModel ( appModel
@ -138,13 +165,27 @@ update context appMsg appModel =
, Cmd.none , 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 ) -> ( NotFoundModel model, NotFoundMsg msg ) ->
Page.update Page.update
{ page = pages.notFound { page = pages.notFound
, msg = msg , msg = msg
, model = model , model = model
, context = context
} }
context
( NotFoundModel _, _ ) -> ( NotFoundModel _, _ ) ->
( appModel ( appModel
@ -153,71 +194,43 @@ update context appMsg appModel =
) )
subscriptions : bundle :
Context Flags Route Context.Model Context Flags Route Context.Model
-> Model -> Model
-> Sub Msg -> Page.Bundle Msg
subscriptions context appModel = bundle context appModel =
case appModel of case appModel of
HomepageModel model -> HomepageModel model ->
Page.subscriptions Page.bundle
{ page = pages.homepage { page = pages.homepage
, model = model , model = model
, context = context
} }
context
CounterModel model -> CounterModel model ->
Page.subscriptions Page.bundle
{ page = pages.counter { page = pages.counter
, model = model , model = model
, context = context
} }
context
RandomModel model -> RandomModel model ->
Page.subscriptions Page.bundle
{ page = pages.random { page = pages.random
, model = model , model = model
, context = context
}
SignInModel model ->
Page.bundle
{ page = pages.signIn
, model = model
, context = context
} }
context
NotFoundModel model -> NotFoundModel model ->
Page.subscriptions Page.bundle
{ page = pages.notFound { page = pages.notFound
, model = model , 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

88
examples/basic/src/Context.elm
View File

@ -1,26 +1,29 @@
module Context exposing module Context exposing
( Model ( Model
, Msg , Msg(..)
, init , init
, subscriptions , subscriptions
, update , update
, view , view
) )
import Application
import Data.User exposing (User)
import Flags exposing (Flags) import Flags exposing (Flags)
import Html exposing (..) import Html exposing (..)
import Html.Attributes as Attr import Html.Attributes as Attr exposing (class)
import Html.Events as Events import Html.Events as Events
import Route exposing (Route) import Route exposing (Route)
import Utils.Cmd
type alias Model = type alias Model =
{ user : Maybe String { user : Maybe User
} }
type Msg type Msg
= SignIn String = SignIn (Result String User)
| SignOut | SignOut
@ -31,18 +34,25 @@ init route flags =
) )
update : Route -> Msg -> Model -> ( Model, Cmd Msg ) update :
update route msg model = Application.Messages Route msg
-> Route
-> Msg
-> Model
-> ( Model, Cmd Msg, Cmd msg )
update { navigateTo } route msg model =
case msg of case msg of
SignIn user -> SignIn (Ok user) ->
( { model | user = Just user } ( { model | user = Just user }
, Cmd.none , Cmd.none
, navigateTo Route.Homepage
) )
SignIn (Err _) ->
Utils.Cmd.pure model
SignOut -> SignOut ->
( { model | user = Nothing } Utils.Cmd.pure { model | user = Nothing }
, Cmd.none
)
view : view :
@ -53,19 +63,17 @@ view :
} }
-> Html msg -> Html msg
view { context, route, toMsg, viewPage } = view { context, route, toMsg, viewPage } =
div [ Attr.class "layout" ] div [ class "layout" ]
[ Html.map toMsg (viewNavbar route context) [ Html.map toMsg (viewNavbar route context)
, br [] [] , div [ class "container" ] [ viewPage ]
, viewPage
, br [] []
, Html.map toMsg (viewFooter context) , Html.map toMsg (viewFooter context)
] ]
viewNavbar : Route -> Model -> Html Msg viewNavbar : Route -> Model -> Html Msg
viewNavbar currentRoute model = viewNavbar currentRoute model =
header [ Attr.class "navbar" ] header [ class "navbar" ]
[ ul [] [ div [ class "navbar__links" ]
(List.map (List.map
(viewLink currentRoute) (viewLink currentRoute)
[ Route.Homepage, Route.Counter, Route.Random ] [ Route.Homepage, Route.Counter, Route.Random ]
@ -75,31 +83,53 @@ viewNavbar currentRoute model =
button [ Events.onClick SignOut ] [ text <| "Sign out" ] button [ Events.onClick SignOut ] [ text <| "Sign out" ]
Nothing -> Nothing ->
button [ Events.onClick (SignIn "Ryan") ] [ text "Sign in" ] a [ Attr.href "/sign-in" ] [ text "Sign in" ]
] ]
viewLink : Route -> Route -> Html msg viewLink : Route -> Route -> Html msg
viewLink currentRoute route = viewLink currentRoute route =
li [] a
[ a [ class "navbar__link-item"
[ Attr.href (Route.toPath route) , Attr.href (Route.toPath route)
, Attr.style "font-weight" , Attr.style "font-weight"
(if route == currentRoute then (if route == currentRoute then
"bold" "bold"
else else
"normal" "normal"
) )
]
[ text (Route.title route) ]
] ]
[ 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 -> Html Msg
viewFooter model = viewFooter model =
footer [ Attr.class "footer" ] 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
] ]

28
examples/basic/src/Data/User.elm Normal file
View File

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

9
examples/basic/src/Main.elm
View File

@ -24,9 +24,10 @@ main =
, page = , page =
{ init = App.init { init = App.init
, update = App.update , update = App.update
, view = App.view , bundle = App.bundle
, subscriptions = App.subscriptions }
, route =
{ fromUrl = Route.fromUrl
, toPath = Route.toPath
} }
, toRoute = Route.fromUrl
, title = Route.title
} }

24
examples/basic/src/Pages/Counter.elm
View File

@ -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 exposing (..)
import Html.Events as Events import Html.Events as Events
@ -14,6 +21,11 @@ type Msg
| Decrement | Decrement
title : Model -> String
title model =
"Counter: " ++ String.fromInt model.counter ++ " | elm-app"
init : Model init : Model
init = init =
{ counter = 0 { counter = 0
@ -33,7 +45,11 @@ update msg model =
view : Model -> Html Msg view : Model -> Html Msg
view model = view model =
div [] div []
[ button [ Events.onClick Decrement ] [ text "-" ] [ h1 [] [ text "Counter!" ]
, text (String.fromInt model.counter) , p [] [ text "Even the browser tab updates!" ]
, button [ Events.onClick Increment ] [ text "+" ] , div []
[ button [ Events.onClick Decrement ] [ text "-" ]
, text (String.fromInt model.counter)
, button [ Events.onClick Increment ] [ text "+" ]
]
] ]

17
examples/basic/src/Pages/Homepage.elm
View File

@ -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 Never
view = view =
Html.text "Homepage!" div []
[ h1 [] [ text "Homepage!" ]
, p [] [ text "It's boring, but it works!" ]
]

20
examples/basic/src/Pages/NotFound.elm
View File

@ -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 Never
view = view =
Html.text "Page not found..." div []
[ h1 [] [ text "Page not found!" ]
, p []
[ text "Is this space? Am I in "
, em [] [ text "space?" ]
]
]

22
examples/basic/src/Pages/Random.elm
View File

@ -3,6 +3,7 @@ module Pages.Random exposing
, Msg , Msg
, init , init
, subscriptions , subscriptions
, title
, update , update
, view , view
) )
@ -23,6 +24,11 @@ type Msg
| GotOutcome Int | GotOutcome Int
title : Model -> String
title model =
"Random | elm-app"
init : Flags -> ( Model, Cmd Msg ) init : Flags -> ( Model, Cmd Msg )
init _ = init _ =
( { roll = Nothing } ( { roll = Nothing }
@ -52,12 +58,16 @@ update msg model =
view : Model -> Html Msg view : Model -> Html Msg
view model = view model =
div [] div []
[ button [ Events.onClick Roll ] [ text "Roll" ] [ h1 [] [ text "Random!" ]
, p [] , p [] [ text "Did somebody say 'random numbers pls'?" ]
[ model.roll , div []
|> Maybe.map String.fromInt [ button [ Events.onClick Roll ] [ text "Roll" ]
|> Maybe.withDefault "Click the button!" , p []
|> text [ model.roll
|> Maybe.map String.fromInt
|> Maybe.withDefault "Click the button!"
|> text
]
] ]
] ]

136
examples/basic/src/Pages/SignIn.elm Normal file
View File

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

50
examples/basic/src/Route.elm
View File

@ -1,4 +1,4 @@
module Route exposing (Route(..), fromUrl, title, toPath) module Route exposing (Route(..), fromUrl, toPath)
import Url exposing (Url) import Url exposing (Url)
import Url.Parser as Parser exposing (Parser) import Url.Parser as Parser exposing (Parser)
@ -6,6 +6,7 @@ import Url.Parser as Parser exposing (Parser)
type Route type Route
= Homepage = Homepage
| SignIn
| Counter | Counter
| Random | Random
| NotFound | NotFound
@ -13,46 +14,31 @@ type Route
fromUrl : Url -> Route fromUrl : Url -> Route
fromUrl = fromUrl =
Parser.parse router >> Maybe.withDefault NotFound Parser.parse
(Parser.oneOf
[ Parser.map Homepage Parser.top
router : Parser (Route -> Route) Route , Parser.map SignIn (Parser.s "sign-in")
router = , Parser.map Counter (Parser.s "counter")
Parser.oneOf , Parser.map Random (Parser.s "random")
[ Parser.map Homepage Parser.top ]
, Parser.map Counter (Parser.s "counter") )
, Parser.map Random (Parser.s "random") >> Maybe.withDefault NotFound
]
toPath : Route -> String toPath : Route -> String
toPath route = toPath route =
(String.join "/" >> (++) "/") <|
case route of
Homepage ->
[]
Counter ->
[ "counter" ]
Random ->
[ "random" ]
NotFound ->
[ "not-found" ]
title : Route -> String
title route =
case route of case route of
Homepage -> Homepage ->
"Home" "/"
SignIn ->
"/sign-in"
Counter -> Counter ->
"Counter" "/counter"
Random -> Random ->
"Random" "/random"
NotFound -> NotFound ->
"Not found" "/not-found"

19
examples/basic/src/Utils/Cmd.elm Normal file
View File

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

246
src/Application.elm
View File

@ -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 Application.Page exposing (Context)
import Browser import Browser
@ -10,10 +33,107 @@ import Task
import Url exposing (Url) 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 = type alias Application flags contextModel contextMsg model msg =
Program flags (Model flags contextModel model) (Msg contextMsg 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 = type alias Model flags contextModel model =
{ key : Nav.Key { key : Nav.Key
, url : Url , url : Url
@ -73,45 +193,11 @@ type Msg contextMsg msg
| PageMsg msg | PageMsg msg
type alias Config flags route contextModel contextMsg model msg = type alias Messages route msg =
{ context : { navigateTo : route -> Cmd msg
{ 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
} }
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 : init :
Config flags route contextModel contextMsg model msg Config flags route contextModel contextMsg model msg
-> flags -> flags
@ -121,7 +207,7 @@ init :
init config flags url key = init config flags url key =
let let
route = route =
config.toRoute url config.route.fromUrl url
( contextModel, contextCmd ) = ( contextModel, contextCmd ) =
config.context.init route flags config.context.init route flags
@ -181,7 +267,7 @@ update config msg model =
let let
( pageModel, pageCmd, contextCmd ) = ( pageModel, pageCmd, contextCmd ) =
config.page.init config.page.init
{ route = config.toRoute url { route = config.route.fromUrl url
, flags = model.flags , flags = model.flags
, context = model.context , context = model.context
} }
@ -194,16 +280,27 @@ update config msg model =
) )
ContextMsg msg_ -> ContextMsg msg_ ->
Tuple.mapBoth let
(\context -> { model | context = context }) ( contextModel, contextCmd, globalCmd ) =
(Cmd.map ContextMsg) config.context.update
(config.context.update (config.toRoute model.url) msg_ model.context) { 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_ -> PageMsg msg_ ->
let let
( pageModel, pageCmd, contextCmd ) = ( pageModel, pageCmd, contextCmd ) =
config.page.update config.page.update
{ route = config.toRoute model.url { route = config.route.fromUrl model.url
, flags = model.flags , flags = model.flags
, context = model.context , context = model.context
} }
@ -257,15 +354,19 @@ view config model =
Loaded _ -> Loaded _ ->
"1" "1"
( context, pageModel ) =
contextAndPage ( config, model )
in in
{ title = config.title (config.toRoute model.url) { title = config.page.bundle context pageModel |> .title
, body = , body =
[ div [ div
[ Attr.style "transition" (transitionProp config.transition) [ Attr.class "app"
, Attr.style "transition" (transitionProp config.transition)
, Attr.style "opacity" (layoutOpacity model.page) , Attr.style "opacity" (layoutOpacity model.page)
] ]
[ config.context.view [ config.context.view
{ route = config.toRoute model.url { route = config.route.fromUrl model.url
, toMsg = ContextMsg , toMsg = ContextMsg
, context = model.context , context = model.context
, viewPage = , viewPage =
@ -274,13 +375,7 @@ view config model =
, Attr.style "opacity" (pageOpacity model.page) , Attr.style "opacity" (pageOpacity model.page)
] ]
[ Html.map PageMsg [ Html.map PageMsg
(config.page.view (config.page.bundle context pageModel |> .view)
{ route = config.toRoute model.url
, flags = model.flags
, context = model.context
}
(unwrap model.page)
)
] ]
} }
] ]
@ -293,14 +388,39 @@ subscriptions :
-> Model flags contextModel model -> Model flags contextModel model
-> Sub (Msg contextMsg msg) -> Sub (Msg contextMsg msg)
subscriptions config model = subscriptions config model =
let
( context, pageModel ) =
contextAndPage ( config, model )
in
Sub.batch Sub.batch
[ Sub.map ContextMsg (config.context.subscriptions (config.toRoute model.url) model.context) [ Sub.map ContextMsg (config.context.subscriptions (config.route.fromUrl model.url) model.context)
, Sub.map PageMsg , Sub.map PageMsg (config.page.bundle context pageModel |> .subscriptions)
(config.page.subscriptions
{ route = config.toRoute model.url
, flags = model.flags
, context = model.context
}
(unwrap model.page)
)
] ]
-- 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

122
src/Application/Page.elm
View File

@ -1,16 +1,38 @@
module Application.Page exposing module Application.Page exposing
( Context ( static, sandbox, element, page
, Page , init, update, bundle
, element , Context
, init , Bundle
, page
, sandbox
, static
, subscriptions
, update
, view
) )
{-| 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) 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 = 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 ) , update : Context flags route contextModel -> msg -> model -> ( model, Cmd msg, Cmd contextMsg )
, subscriptions : Context flags route contextModel -> model -> Sub msg , subscriptions : Context flags route contextModel -> model -> Sub msg
, view : Context flags route contextModel -> model -> Html 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 : init :
{ page : Page route flags contextModel contextMsg model msg appModel appMsg { page : Page route flags contextModel contextMsg model msg appModel appMsg
, context : Context flags route contextModel
} }
-> Context flags route contextModel
-> ( appModel, Cmd appMsg, Cmd contextMsg ) -> ( appModel, Cmd appMsg, Cmd contextMsg )
init config context = init config =
config.page.init context config.page.init config.context
|> mapTruple |> mapTruple
{ fromMsg = config.page.toMsg { fromMsg = config.page.toMsg
, fromModel = config.page.toModel , fromModel = config.page.toModel
@ -52,37 +75,46 @@ update :
{ page : Page route flags contextModel contextMsg model msg appModel appMsg { page : Page route flags contextModel contextMsg model msg appModel appMsg
, msg : msg , msg : msg
, model : model , model : model
, context : Context flags route contextModel
} }
-> Context flags route contextModel
-> ( appModel, Cmd appMsg, Cmd contextMsg ) -> ( appModel, Cmd appMsg, Cmd contextMsg )
update config context = update config =
config.page.update context config.msg config.model config.page.update config.context config.msg config.model
|> mapTruple |> mapTruple
{ fromMsg = config.page.toMsg { fromMsg = config.page.toMsg
, fromModel = config.page.toModel , fromModel = config.page.toModel
} }
subscriptions : type alias Bundle appMsg =
{ page : Page route flags contextModel contextMsg model msg appModel appMsg { title : String
, model : model , 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 { page : Page route flags contextModel contextMsg model msg appModel appMsg
, model : model , 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 : static :
{ view : Html Never { title : String
, view : Html Never
, toModel : () -> appModel , toModel : () -> appModel
} }
-> Page route flags contextModel contextMsg () Never appModel appMsg -> Page route flags contextModel contextMsg () Never appModel appMsg
static config = 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 ) , update = \c m model -> ( model, Cmd.none, Cmd.none )
, subscriptions = \c m -> Sub.none , subscriptions = \c m -> Sub.none
, view = \c m -> Html.map never config.view , view = \c m -> Html.map never config.view
@ -105,7 +139,8 @@ static config =
sandbox : sandbox :
{ init : model { title : model -> String
, init : model
, update : msg -> model -> model , update : msg -> model -> model
, view : model -> Html msg , view : model -> Html msg
, toMsg : msg -> appMsg , toMsg : msg -> appMsg
@ -113,7 +148,8 @@ sandbox :
} }
-> Page route flags contextModel contextMsg model msg appModel appMsg -> Page route flags contextModel contextMsg model msg appModel appMsg
sandbox config = 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 ) , update = \c msg model -> ( config.update msg model, Cmd.none, Cmd.none )
, subscriptions = \c m -> Sub.none , subscriptions = \c m -> Sub.none
, view = \c model -> config.view model , view = \c model -> config.view model
@ -123,7 +159,8 @@ sandbox config =
element : element :
{ init : flags -> ( model, Cmd msg ) { title : model -> String
, init : flags -> ( model, Cmd msg )
, update : msg -> model -> ( model, Cmd msg ) , update : msg -> model -> ( model, Cmd msg )
, subscriptions : model -> Sub msg , subscriptions : model -> Sub msg
, view : model -> Html msg , view : model -> Html msg
@ -136,7 +173,8 @@ element config =
appendCmd ( model, cmd ) = appendCmd ( model, cmd ) =
( model, cmd, Cmd.none ) ( model, cmd, Cmd.none )
in 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 , update = \c msg model -> config.update msg model |> appendCmd
, subscriptions = \c model -> config.subscriptions model , subscriptions = \c model -> config.subscriptions model
, view = \c model -> config.view model , view = \c model -> config.view model
@ -146,8 +184,9 @@ element config =
page : page :
{ init : Context flags route contextModel -> ( model, Cmd msg ) { title : Context flags route contextModel -> model -> String
, update : Context flags route contextModel -> msg -> model -> ( model, Cmd msg ) , 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 , subscriptions : Context flags route contextModel -> model -> Sub msg
, view : Context flags route contextModel -> model -> Html msg , view : Context flags route contextModel -> model -> Html msg
, toMsg : msg -> appMsg , toMsg : msg -> appMsg
@ -159,8 +198,9 @@ page config =
appendCmd ( model, cmd ) = appendCmd ( model, cmd ) =
( model, cmd, Cmd.none ) ( model, cmd, Cmd.none )
in in
{ init = \c -> config.init c |> appendCmd { title = config.title
, update = \c msg model -> config.update c msg model |> appendCmd , init = config.init
, update = config.update
, subscriptions = \c model -> config.subscriptions c model , subscriptions = \c model -> config.subscriptions c model
, view = \c model -> config.view c model , view = \c model -> config.view c model
, toMsg = config.toMsg , toMsg = config.toMsg