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/http": "2.0.0",
"elm/json": "1.1.3",
"elm/url": "1.0.0",
"mdgriffith/elm-ui": "1.1.8"
},
"indirect": {
"elm/bytes": "1.0.8",
"elm/file": "1.0.5",
"elm/time": "1.0.0",
"elm/url": "1.0.0",
"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)
import Browser
import Browser exposing (UrlRequest)
import Browser.Navigation as Nav
import Element exposing (..)
import Element.Font as Font
import Element.Region as Region
import Files
import Html exposing (Html)
import MainPage
import Route exposing (Route)
import Url exposing (Url)
type Model
= PageMain MainPage.Model
type alias 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
= MsgMain MainPage.Msg
= LinkClicked UrlRequest
| UrlChanged Url
| HomePageMsg MainPage.Msg
| FilesPageMsg Files.Msg
initModel : Model
initModel =
PageMain MainPage.initModel
combineModel : ( MainPage.Model, Cmd MainPage.Msg ) -> ( Model, Cmd Msg )
combineModel ( mainPageModell, cmd ) =
( PageMain mainPageModell, Cmd.map MsgMain cmd )
-- Update --
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case ( msg, model ) of
( MsgMain l_msg, PageMain l_model ) ->
combineModel (MainPage.update l_msg l_model)
case ( msg, model.page ) of
( HomePageMsg subMsg, Home pageModel ) ->
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)
)
-- ( _, _ ) ->
-- Debug.todo "branch '( Decrement, _ )' not implemented"
Browser.External url ->
( 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
@@ -43,23 +134,35 @@ view model =
[ Font.size 20
]
<|
case model of
PageMain mainModell ->
MainPage.view mainModell |> Element.map MsgMain
case model.page of
Home mainModell ->
MainPage.view mainModell |> Element.map HomePageMsg
FilesPage pageModel ->
Files.view pageModel |> Element.map FilesPageMsg
_ ->
el
[ Region.heading 1
, Font.size 36
]
(text "Non")
-- (_) ->
-- el
-- [ Region.heading 1
-- , Font.size 36](text "Non")
documentView : Model -> Browser.Document Msg
documentView model =
{ title = "localTube"
, body = [ view model ]
}
main : Program () Model Msg
main =
Browser.element
{ init = \_ -> ( initModel, Cmd.none )
, view = view
Browser.application
{ init = init
, view = documentView
, update = update
, 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")
]