Cleanup routing

tapglue · Dec 2, 2016 · 4e42f32 · 4e42f32
1 parent a616f49
commit 4e42f32
Show file tree

Hide file tree

Showing 2 changed files with 56 additions and 62 deletions.
diff --git a/cmd/console/Console.elm b/cmd/console/Console.elm
@@ -4,7 +4,6 @@ import Html exposing (..)
 import Html.Attributes exposing (class, href, id, placeholder, title, type_, value)
 import Html.Events exposing (onClick, onInput, onSubmit)
 import Navigation
-import UrlParser as Url exposing ((</>), (<?>), s, int, stringParam, top)
 
 import App
 import Route
@@ -27,8 +26,7 @@ type alias Flags =
 
 type alias Model =
     { appModel : App.Model
-    , debug : Bool
-    , route : (Maybe Route.Route)
+    , route : Route.Model
     , zone : String
     }
 
@@ -37,29 +35,19 @@ type alias Tag = List (Html Msg) -> Html Msg
 init : Flags -> Navigation.Location -> (Model, Cmd Msg)
 init {zone} location =
     let
-        route = Route.parse location
+        (routeModel, _) = Route.init location
+
+        (appModel, appCmd) = App.init
     in
-        case route of
-            Nothing ->
-                (Model App.initModel (isDebug location) route zone, Cmd.none)
-            Just (Route.App id) ->
-                (Model App.initModel (isDebug location) route zone, Cmd.none)
-            Just Route.Apps ->
-                let
-                    (appModel, appCmd) = App.init
-                in
-                    (Model appModel (isDebug location) route zone, Cmd.map AppMsg appCmd)
-            Just Route.Home ->
-                (Model App.initModel (isDebug location) route zone, Cmd.none)
+        (Model appModel routeModel zone, Cmd.map AppMsg appCmd)
 
 -- UPDATE
 
 type Msg
     = AppMsg App.Msg
     | LocationChange Navigation.Location
-    | NavigateApp String
-    | NavigateApps
-    | NavigateHome
+    | Navigate Route.Route
+    | RouteMsg Route.Msg
 
 update : Msg -> Model -> (Model, Cmd Msg)
 update msg model =
@@ -71,21 +59,16 @@ update msg model =
                 ({ model | appModel = appModel }, Cmd.map AppMsg appCmd)
         LocationChange location ->
             let
-                newRoute = Route.parse location
+                (routeModel, routeCmd) = Route.update (Route.Change location) model.route
+            in
+                ({ model | route = routeModel }, Cmd.map RouteMsg routeCmd)
+        Navigate route ->
+            (model, Cmd.map RouteMsg (Route.navigate route))
+        RouteMsg routeMsg ->
+            let
+                (routeModel, routeCmd) = Route.update routeMsg model.route
             in
-                if newRoute == Just Route.Apps then
-                    let
-                        (appModel, appCmd) = App.init
-                    in
-                        ({ model | appModel = appModel, route = newRoute }, Cmd.map AppMsg appCmd)
-                else
-                    ({ model | route = newRoute }, Cmd.none)
-        NavigateApp id ->
-            (model, Navigation.newUrl (Route.construct (Route.App id)))
-        NavigateApps ->
-            (model, Navigation.newUrl (Route.construct Route.Apps))
-        NavigateHome ->
-            (model, Navigation.newUrl (Route.construct Route.Home))
+                ({ model | route = routeModel }, Cmd.map RouteMsg routeCmd)
 
 
 -- SUBSCRIPTION
@@ -99,7 +82,7 @@ subscriptions model =
 view : Model -> Html Msg
 view model =
     let
-        content = case model.route of
+        content = case model.route.current of
             Nothing ->
                 h3 [] [ text "Looks like we couldn't find the page you were looking for." ]
             Just (Route.App id) ->
@@ -132,7 +115,7 @@ viewContext model =
     in
         viewContainer (section [ class sectionClass, id "context" ])
             [ h2 []
-                [ a [ onClick NavigateApps, title "Apps" ]
+                [ a [ onClick (Navigate Route.Apps), title "Apps" ]
                     [ span [ class "icon nc-icon-glyph ui-2_layers" ] []
                     , span [] [ text "Apps" ]
                     ]
@@ -143,7 +126,7 @@ viewContext model =
 viewAppSelected : App.App -> Html Msg
 viewAppSelected app =
     nav []
-        [ a [ onClick (NavigateApp app.id), title app.name ]
+        [ a [ onClick (Navigate (Route.App app.id)), title app.name ]
             [ span [] [ text app.name ]
             ]
         ]
@@ -157,31 +140,15 @@ viewContainer elem content =
 
 viewDebug : Model -> Html Msg
 viewDebug model =
-    if model.debug then
-        div [ class "debug" ]
-          [ text (toString model)
-          ]
-    else
-        div [] []
+    div [ class "debug" ]
+      [ text (toString model)
+      ]
 
 viewHeader : Html Msg
 viewHeader =
     h1 []
-        [ a [ onClick NavigateHome, title "Home" ]
+        [ a [ onClick (Navigate Route.Home), title "Home" ]
             [ strong [] [ text "SocialPath" ]
             , span [] [ text "Console" ]
             ]
-        ]
-
--- ROUTING
-
-isDebug : Navigation.Location -> Bool
-isDebug location =
-    let
-        debug = Url.parsePath (Url.s "" <?> stringParam "debug") location
-    in
-        case debug of
-            Nothing ->
-                False
-            Just debug ->
-                Maybe.withDefault "false" debug == "true"
+        ]
diff --git a/cmd/console/Route.elm b/cmd/console/Route.elm
@@ -1,13 +1,36 @@
 module Route exposing (..)
 
-import Navigation exposing (Location)
+import Navigation exposing (Location, newUrl)
 import UrlParser exposing (Parser, (</>), map, oneOf, parsePath, top, s, string)
 
+-- MODEL
+
+type alias Model =
+    { current : (Maybe Route)
+    }
+
 type Route
     = App String
     | Apps
     | Home
 
+init : Location -> (Model, Cmd Msg)
+init location =
+    (Model (parse location), Cmd.none)
+
+--  UPDATE
+
+type Msg
+    = Change Location
+
+update : Msg -> Model -> (Model, Cmd Msg)
+update msg model =
+    case msg of
+        Change location ->
+            ({ model | current = (parse location) }, Cmd.none)
+
+-- HELPER
+
 construct : Route -> String
 construct route =
     case route of
@@ -18,14 +41,18 @@ construct route =
         Home ->
             "/"
 
+navigate : Route -> Cmd Msg
+navigate route =
+    newUrl (construct route)
+
+parse : Location -> (Maybe Route)
+parse location =
+    parsePath routes location
+
 routes : Parser (Route -> a) a
 routes =
     oneOf
         [ map Home top
         , map App (s "apps" </> string)
         , map Apps (s "apps")
         ]
-
-parse : Location -> (Maybe Route)
-parse location =
-    parsePath routes location