wait, i forgot a thing

This commit is contained in:
Ryan Haskell-Glatz 2019-10-11 23:26:33 -05:00
parent 4350dab437
commit a6ee2851e8
3 changed files with 105 additions and 85 deletions

View File

@ -1,6 +1,6 @@
module Main exposing (main) module Main exposing (main)
import Application exposing (Application) import Application
import Components.Layout as Layout import Components.Layout as Layout
import Flags exposing (Flags) import Flags exposing (Flags)
import Global import Global
@ -8,23 +8,24 @@ import Pages
import Route import Route
main : Application Flags Global.Model Global.Msg Pages.Model Pages.Msg main : Application.Program Flags Global.Model Global.Msg Pages.Model Pages.Msg
main = main =
Application.create Application.start <|
{ routing = Application.create
{ transition = 200 { routing =
, fromUrl = Route.fromUrl { transition = 200
, toPath = Route.toPath , fromUrl = Route.fromUrl
, toPath = Route.toPath
}
, layout =
{ init = Layout.init
, update = Layout.update
, view = Layout.view
, subscriptions = Layout.subscriptions
}
, pages =
{ init = Pages.init
, update = Pages.update
, bundle = Pages.bundle
}
} }
, layout =
{ init = Layout.init
, update = Layout.update
, view = Layout.view
, subscriptions = Layout.subscriptions
}
, pages =
{ init = Pages.init
, update = Pages.update
, bundle = Pages.bundle
}
}

View File

@ -10,7 +10,7 @@ import Application
import Application.Page as Page import Application.Page as Page
import Flags exposing (Flags) import Flags exposing (Flags)
import Global import Global
import Html import Html exposing (Html)
import Pages.Counter import Pages.Counter
import Pages.Homepage import Pages.Homepage
import Pages.NotFound import Pages.NotFound
@ -177,7 +177,7 @@ update appMsg appModel =
bundle : bundle :
Model Model
-> Application.Bundle Flags Route Global.Model Msg -> Application.Bundle Flags Route Global.Model Msg (Html Msg)
bundle appModel = bundle appModel =
case appModel of case appModel of
HomepageModel model -> HomepageModel model ->

View File

@ -1,25 +1,19 @@
module Application exposing module Application exposing
( create ( Application
, Application, Config , Bundle
, Config
, Context , Context
, init, update, keep, bundle , Program
, Update, Bundle , Update
, bundle
, create
, init
, keep
, start
, update
, usingLayout
) )
{-|
@docs create
@docs Application, Config
@docs Context
@docs init, update, keep, bundle
@docs Update, Bundle
-}
import Browser import Browser
import Browser.Navigation as Nav import Browser.Navigation as Nav
import Html exposing (Html, div) import Html exposing (Html, div)
@ -32,43 +26,24 @@ import Task
import Url exposing (Url) import Url exposing (Url)
type alias Application flags contextModel contextMsg model msg = type Application flags route contextModel contextMsg model msg appElement element
Program flags (Model flags contextModel model) (Msg contextMsg msg) = Application
{ adapters : Adapters appElement element contextMsg msg
, config : Config flags route contextModel contextMsg model msg appElement element
}
type alias Program flags contextModel contextMsg model msg =
Platform.Program flags (Model flags contextModel model) (Msg contextMsg msg)
type alias Adapters appElement element contextMsg msg = type alias Adapters appElement element contextMsg msg =
{ toLayout : appElement -> Html (Msg contextMsg msg) { toLayout : appElement -> Html (Msg contextMsg msg)
, fromHtml : Html (Msg contextMsg msg) -> appElement , fromHtml : Html (Msg contextMsg msg) -> appElement
, toHtml : (msg -> Msg contextMsg msg) -> element -> appElement , map : (msg -> Msg contextMsg msg) -> element -> Html (Msg contextMsg msg)
} }
create :
Config flags route contextModel contextMsg model msg (Html (Msg contextMsg msg))
-> Application flags contextModel contextMsg model msg
create =
createWith
{ toLayout = identity
, fromHtml = identity
, toHtml = Html.map
}
createWith :
Adapters appElement element contextMsg msg
-> Config flags route contextModel contextMsg model msg appElement
-> Application flags contextModel contextMsg model msg
createWith adapters config =
Browser.application
{ init = initWithConfig config
, update = updateWithConfig config
, view = viewWithConfig adapters config
, subscriptions = subscriptionsWithConfig config
, onUrlChange = UrlChanged
, onUrlRequest = UrlRequested
}
type alias LayoutContext route flags msg = type alias LayoutContext route flags msg =
{ navigateTo : route -> Cmd msg { navigateTo : route -> Cmd msg
, route : route , route : route
@ -76,7 +51,7 @@ type alias LayoutContext route flags msg =
} }
type alias Config flags route contextModel contextMsg model msg appElement = type alias Config flags route contextModel contextMsg model msg appElement element =
{ layout : { layout :
{ init : { init :
LayoutContext route flags (Msg contextMsg msg) LayoutContext route flags (Msg contextMsg msg)
@ -112,7 +87,7 @@ type alias Config flags route contextModel contextMsg model msg appElement =
, bundle : , bundle :
model model
-> Context flags route contextModel -> Context flags route contextModel
-> TitleViewSubs msg -> TitleViewSubs msg element
} }
, routing : , routing :
{ transition : Float { transition : Float
@ -126,8 +101,52 @@ type alias Context flags route contextModel =
Context.Context flags route contextModel Context.Context flags route contextModel
create :
Config flags route contextModel contextMsg model msg (Html (Msg contextMsg msg)) (Html msg)
-> Application flags route contextModel contextMsg model msg (Html (Msg contextMsg msg)) (Html msg)
create =
createWith
{ toLayout = identity
, fromHtml = identity
, map = Html.map
}
-- ACTUAl STUFF
usingLayout :
Adapters appElement element contextMsg msg
-> Application flags route contextModel contextMsg model msg appElement element
-> Application flags route contextModel contextMsg model msg appElement element
usingLayout adapters (Application application) =
Application { application | adapters = adapters }
createWith :
Adapters appElement element contextMsg msg
-> Config flags route contextModel contextMsg model msg appElement element
-> Application flags route contextModel contextMsg model msg appElement element
createWith adapters config =
Application
{ adapters = adapters
, config = config
}
start :
Application flags route contextModel contextMsg model msg appElement element
-> Program flags contextModel contextMsg model msg
start (Application { adapters, config }) =
Browser.application
{ init = initWithConfig config
, update = updateWithConfig config
, view = viewWithConfig adapters config
, subscriptions = subscriptionsWithConfig config
, onUrlChange = UrlChanged
, onUrlRequest = UrlRequested
}
-- ACTUAL STUFF
type alias Model flags contextModel model = type alias Model flags contextModel model =
@ -148,7 +167,7 @@ type Msg contextMsg msg
initWithConfig : initWithConfig :
Config flags route contextModel contextMsg model msg appElement Config flags route contextModel contextMsg model msg appElement element
-> flags -> flags
-> Url -> Url
-> Nav.Key -> Nav.Key
@ -195,7 +214,7 @@ delay ms msg =
updateWithConfig : updateWithConfig :
Config flags route contextModel contextMsg model msg appElement Config flags route contextModel contextMsg model msg appElement element
-> Msg contextMsg msg -> Msg contextMsg msg
-> Model flags contextModel model -> Model flags contextModel model
-> ( Model flags contextModel model, Cmd (Msg contextMsg msg) ) -> ( Model flags contextModel model, Cmd (Msg contextMsg msg) )
@ -283,7 +302,7 @@ type alias Document msg =
viewWithConfig : viewWithConfig :
Adapters appElement element contextMsg msg Adapters appElement element contextMsg msg
-> Config flags route contextModel contextMsg model msg appElement -> Config flags route contextModel contextMsg model msg appElement element
-> Model flags contextModel model -> Model flags contextModel model
-> Document (Msg contextMsg msg) -> Document (Msg contextMsg msg)
viewWithConfig adapters config model = viewWithConfig adapters config model =
@ -295,7 +314,7 @@ viewWithConfig adapters config model =
( context, pageModel ) = ( context, pageModel ) =
contextAndPage ( config, model ) contextAndPage ( config, model )
bundle_ : TitleViewSubs msg bundle_ : TitleViewSubs msg element
bundle_ = bundle_ =
config.pages.bundle pageModel context config.pages.bundle pageModel context
in in
@ -317,7 +336,7 @@ viewWithConfig adapters config model =
[ Attr.style "transition" (transitionProp config.routing.transition) [ Attr.style "transition" (transitionProp config.routing.transition)
, Attr.style "opacity" (Transitionable.pageOpacity model.page) , Attr.style "opacity" (Transitionable.pageOpacity model.page)
] ]
[ Html.map PageMsg bundle_.view [ adapters.map PageMsg bundle_.view
] ]
} }
model.context model.context
@ -327,7 +346,7 @@ viewWithConfig adapters config model =
subscriptionsWithConfig : subscriptionsWithConfig :
Config flags route contextModel contextMsg model msg appElement Config flags route contextModel contextMsg model msg appElement element
-> Model flags contextModel model -> Model flags contextModel model
-> Sub (Msg contextMsg msg) -> Sub (Msg contextMsg msg)
subscriptionsWithConfig config model = subscriptionsWithConfig config model =
@ -356,7 +375,7 @@ subscriptionsWithConfig config model =
contextAndPage : contextAndPage :
( Config flags route contextModel contextMsg model msg appElement, Model flags contextModel model ) ( Config flags route contextModel contextMsg model msg appElement element, Model flags contextModel model )
-> ( Context flags route contextModel, model ) -> ( Context flags route contextModel, model )
contextAndPage ( config, model ) = contextAndPage ( config, model ) =
( { route = config.routing.fromUrl model.url ( { route = config.routing.fromUrl model.url
@ -368,7 +387,7 @@ contextAndPage ( config, model ) =
navigateTo : navigateTo :
Config flags route contextModel contextMsg model msg appElement Config flags route contextModel contextMsg model msg appElement element
-> Url -> Url
-> route -> route
-> Cmd (Msg contextMsg msg) -> Cmd (Msg contextMsg msg)
@ -387,8 +406,8 @@ type alias Update flags route contextModel contextMsg appModel appMsg =
Context flags route contextModel -> ( appModel, Cmd appMsg, Cmd contextMsg ) Context flags route contextModel -> ( appModel, Cmd appMsg, Cmd contextMsg )
type alias Bundle flags route contextModel appMsg = type alias Bundle flags route contextModel appMsg appElement =
Context flags route contextModel -> TitleViewSubs appMsg Context flags route contextModel -> TitleViewSubs appMsg appElement
init : init :
@ -424,20 +443,20 @@ keep model _ =
( model, Cmd.none, Cmd.none ) ( model, Cmd.none, Cmd.none )
type alias TitleViewSubs appMsg = type alias TitleViewSubs appMsg appElement =
{ title : String { title : String
, view : Html appMsg , view : appElement
, subscriptions : Sub appMsg , subscriptions : Sub appMsg
} }
bundle : bundle :
((msg -> appMsg) -> pageElement -> Html appMsg) ((msg -> appMsg) -> pageElement -> appElement)
-> ->
{ page : Page route flags contextModel contextMsg model msg appModel appMsg pageElement { page : Page route flags contextModel contextMsg model msg appModel appMsg pageElement
, model : model , model : model
} }
-> Bundle flags route contextModel appMsg -> Bundle flags route contextModel appMsg appElement
bundle toHtml config context = bundle toHtml config context =
{ title = { title =
Page.title Page.title