add: Single Page routing

This commit is contained in:
Simon Hardt
2021-05-29 00:12:22 +02:00
parent cb63d33c56
commit a374a7c01a
4 changed files with 237 additions and 28 deletions

View File

@@ -12,13 +12,13 @@
"elm/html": "1.0.0", "elm/html": "1.0.0",
"elm/http": "2.0.0", "elm/http": "2.0.0",
"elm/json": "1.1.3", "elm/json": "1.1.3",
"elm/url": "1.0.0",
"mdgriffith/elm-ui": "1.1.8" "mdgriffith/elm-ui": "1.1.8"
}, },
"indirect": { "indirect": {
"elm/bytes": "1.0.8", "elm/bytes": "1.0.8",
"elm/file": "1.0.5", "elm/file": "1.0.5",
"elm/time": "1.0.0", "elm/time": "1.0.0",
"elm/url": "1.0.0",
"elm/virtual-dom": "1.0.2" "elm/virtual-dom": "1.0.2"
} }
}, },

View File

@@ -0,0 +1,78 @@
module Files exposing (..)
import Element exposing (..)
import Element.Background as Background
import Element.Border as Border
import Element.Font as Font
import Element.Input as Input
import Element.Region as Region
import Http
import MainPage exposing (Msg)
type alias File =
{ name : String
, source : String
, id : Int
, status : String
}
-- Model --
type alias Model =
{ files : List File
, filter : String
}
initModel : Model
initModel =
{ files = []
, filter = ""
}
-- Messages --
type Msg
= Reload
-- | QueryRequestResult (Result Http.Error _)
-- Request --
-- Update --
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
_ ->
( model, Cmd.none )
-- View --
view : Model -> Element Msg
view model =
Element.column
[ width (px 800)
, height shrink
, centerX
, spacing 36
, padding 10
]
[ el
[ Region.heading 1
, alignLeft
, Font.size 36
]
(text "Files")
]

View File

@@ -1,40 +1,131 @@
module Main exposing (main) module Main exposing (main)
import Browser import Browser exposing (UrlRequest)
import Browser.Navigation as Nav
import Element exposing (..) import Element exposing (..)
import Element.Font as Font import Element.Font as Font
import Element.Region as Region
import Files
import Html exposing (Html) import Html exposing (Html)
import MainPage import MainPage
import Route exposing (Route)
import Url exposing (Url)
type Model type alias Model =
= PageMain MainPage.Model { route : Route
, page : Page
, navKey : Nav.Key
}
type Page
= NotFound
| Home MainPage.Model
| FilesPage Files.Model
--initModel : Model
--initModel =
-- PageMain MainPage.initModel
init : () -> Url -> Nav.Key -> ( Model, Cmd Msg )
init _ url navKey =
let
model =
{ route = Route.parseUrl url
, page = NotFound
, navKey = navKey
}
in
initCurrentPage ( model, Cmd.none )
initCurrentPage : ( Model, Cmd Msg ) -> ( Model, Cmd Msg )
initCurrentPage ( model, existingCmds ) =
let
( currentPage, mappedPageCmds ) =
case model.route of
Route.NotFound ->
( NotFound, Cmd.none )
Route.Home ->
let
( pageModel, pageCmd ) =
( MainPage.initModel, Cmd.none )
in
( Home pageModel, Cmd.map HomePageMsg pageCmd )
Route.Files ->
let
( pageModel, pageCmd ) =
( Files.initModel, Cmd.none )
in
( FilesPage pageModel, Cmd.map FilesPageMsg pageCmd )
in
( { model | page = currentPage }
, Cmd.batch [ existingCmds, mappedPageCmds ]
)
-- Message --
type Msg type Msg
= MsgMain MainPage.Msg = LinkClicked UrlRequest
| UrlChanged Url
| HomePageMsg MainPage.Msg
| FilesPageMsg Files.Msg
initModel : Model
initModel =
PageMain MainPage.initModel
-- Update --
combineModel : ( MainPage.Model, Cmd MainPage.Msg ) -> ( Model, Cmd Msg )
combineModel ( mainPageModell, cmd ) =
( PageMain mainPageModell, Cmd.map MsgMain cmd )
update : Msg -> Model -> ( Model, Cmd Msg ) update : Msg -> Model -> ( Model, Cmd Msg )
update msg model = update msg model =
case ( msg, model ) of case ( msg, model.page ) of
( MsgMain l_msg, PageMain l_model ) -> ( HomePageMsg subMsg, Home pageModel ) ->
combineModel (MainPage.update l_msg l_model) let
( updatePageModel, updateCmd ) =
MainPage.update subMsg pageModel
in
( { model | page = Home updatePageModel }
, Cmd.map HomePageMsg updateCmd
)
( FilesPageMsg subMsg, FilesPage pageModel ) ->
let
( updatePageModel, updateCmd ) =
Files.update subMsg pageModel
in
( { model | page = FilesPage updatePageModel }
, Cmd.map FilesPageMsg updateCmd
)
( LinkClicked urlRequest, _ ) ->
case urlRequest of
Browser.Internal url ->
( model
, Nav.pushUrl model.navKey (Url.toString url)
)
-- ( _, _ ) -> Browser.External url ->
-- Debug.todo "branch '( Decrement, _ )' not implemented" ( model, Nav.load url )
( UrlChanged url, _ ) ->
let
newRoute =
Route.parseUrl url
in
( { model | route = newRoute }, Cmd.none )
|> initCurrentPage
( _, _ ) ->
( model, Cmd.none )
view : Model -> Html Msg view : Model -> Html Msg
@@ -43,23 +134,35 @@ view model =
[ Font.size 20 [ Font.size 20
] ]
<| <|
case model of case model.page of
PageMain mainModell -> Home mainModell ->
MainPage.view mainModell |> Element.map MsgMain MainPage.view mainModell |> Element.map HomePageMsg
FilesPage pageModel ->
Files.view pageModel |> Element.map FilesPageMsg
_ ->
el
[ Region.heading 1
, Font.size 36
]
(text "Non")
documentView : Model -> Browser.Document Msg
-- (_) -> documentView model =
-- el { title = "localTube"
-- [ Region.heading 1 , body = [ view model ]
-- , Font.size 36](text "Non") }
main : Program () Model Msg main : Program () Model Msg
main = main =
Browser.element Browser.application
{ init = \_ -> ( initModel, Cmd.none ) { init = init
, view = view , view = documentView
, update = update , update = update
, subscriptions = \_ -> Sub.none , subscriptions = \_ -> Sub.none
, onUrlRequest = LinkClicked
, onUrlChange = UrlChanged
} }

View File

@@ -0,0 +1,28 @@
module Route exposing (..)
import Url exposing (Url)
import Url.Parser exposing (..)
type Route
= NotFound
| Home
| Files
parseUrl : Url -> Route
parseUrl url =
case parse matchRoute url of
Just route ->
route
Nothing ->
NotFound
matchRoute : Parser (Route -> a) a
matchRoute =
oneOf
[ map Home top
, map Files (s "files")
]