Merge (some re-ordering).

elm-package.json

@@ -9,7 +9,7 @@
     ],
     "exposed-modules": [
         "Material",
-        "Material.Style", 
+        "Material.Style",
         "Material.Color",
         "Material.Icon",
         "Material.Button",
@@ -24,7 +24,8 @@
         "evancz/elm-effects": "2.0.1 <= v < 3.0.0",
         "evancz/elm-html": "4.0.2 <= v < 5.0.0",
         "evancz/elm-markdown": "2.0.1 <= v < 3.0.0",
-        "evancz/start-app": "2.0.2 <= v < 3.0.0"
+        "evancz/start-app": "2.0.2 <= v < 3.0.0",
+        "sporto/hop": "3.0.0 <= v < 4.0.0"
     },
     "elm-version": "0.16.0 <= v < 0.17.0"
-}
+}

examples/Demo.elm

@@ -1,3 +1,4 @@
+module Main (..) where
 import StartApp
 import Html exposing (..)
 import Html.Attributes exposing (href, class, style)
@@ -8,7 +9,13 @@ import Signal
 import Task exposing (Task)
 import Array exposing (Array)
 
+import Hop
+import Hop.Types
+import Hop.Navigate exposing (navigateTo)
+import Hop.Matchers exposing (match1)
+
 import Material.Color as Color
+import Material.Layout
 import Material.Layout as Layout exposing (defaultLayoutModel)
 import Material.Helpers exposing (lift, lift')
 import Material.Style as Style
@@ -19,8 +26,39 @@ import Demo.Grid
 import Demo.Textfields
 import Demo.Snackbar
 import Demo.Badges
+
 --import Demo.Template
 
+
+-- ROUTING 
+
+
+type Route 
+  = Tab Int
+  | E404
+
+
+type alias Routing = 
+  ( Route, Hop.Types.Location )
+
+route0 : Routing 
+route0 = 
+  ( Tab 0, Hop.Types.newLocation )
+
+
+router : Hop.Types.Router Route
+router =
+  Hop.new
+    { notFound = E404
+    , matchers = 
+        (  match1 (Tab 0) "/"
+        :: (tabs |> List.indexedMap (\idx (_, path, _) -> 
+              match1 (Tab idx) ("/" ++ path))
+           )
+        )
+    }
+
+
 -- MODEL
 
 
@@ -33,6 +71,7 @@ layoutModel =
 
 type alias Model =
   { layout : Layout.Model
+  , routing : Routing
   , buttons : Demo.Buttons.Model
   , textfields : Demo.Textfields.Model
   , snackbar : Demo.Snackbar.Model
@@ -43,51 +82,93 @@ type alias Model =
 model : Model
 model =
   { layout = layoutModel
+  , routing = route0 
   , buttons = Demo.Buttons.model
   , textfields = Demo.Textfields.model
   , snackbar = Demo.Snackbar.model
-  --, template = Demo.Template.model
+      --, template = Demo.Template.model
   }
 
 
+
 -- ACTION, UPDATE
 
 
 type Action
-  = LayoutAction Layout.Action
+  -- Hop
+  = ApplyRoute ( Route, Hop.Types.Location )
+  | HopAction ()
+  -- Tabs
+  | LayoutAction Layout.Action
   | ButtonsAction Demo.Buttons.Action
   | TextfieldAction Demo.Textfields.Action
   | SnackbarAction Demo.Snackbar.Action
-  --| TemplateAction Demo.Template.Action
+--| TemplateAction Demo.Template.Action
 
 
-update : Action -> Model -> (Model, Effects.Effects Action)
+nth : Int -> List a -> Maybe a
+nth k xs = 
+  List.drop k xs |> List.head
+
+
+update : Action -> Model -> ( Model, Effects Action )
 update action model =
-  case Debug.log "Action: " action of
-    LayoutAction    a -> lift  .layout     (\m x->{m|layout    =x}) LayoutAction   Layout.update          a model
+  case action of
+    LayoutAction a ->
+      let
+        ( lifted, layoutFx ) =
+          lift .layout (\m x -> { m | layout = x }) LayoutAction Layout.update a model
+        routeFx =
+          case a of 
+            Layout.SwitchTab k -> 
+              nth k tabs 
+              |> Maybe.map (\(_, path, _) -> Effects.map HopAction (navigateTo path))
+              |> Maybe.withDefault Effects.none
+            _ -> 
+              Effects.none
+      in
+        ( lifted, Effects.batch [ layoutFx, routeFx ] )
+
+    ApplyRoute route -> 
+      ( { model 
+        | routing = route 
+        , layout = setTab model.layout (fst route)
+        }
+      , Effects.none
+      )
+
+    HopAction _ ->
+      ( model, Effects.none )
+
+
     ButtonsAction   a -> lift  .buttons    (\m x->{m|buttons   =x}) ButtonsAction  Demo.Buttons.update    a model
+
     TextfieldAction a -> lift  .textfields (\m x->{m|textfields=x}) TextfieldAction Demo.Textfields.update a model
+
     SnackbarAction  a -> lift  .snackbar   (\m x->{m|snackbar  =x}) SnackbarAction Demo.Snackbar.update   a model
+
     --TemplateAction  a -> lift  .template   (\m x->{m|template  =x}) TemplateAction Demo.Template.update   a model
 
+        
 
 -- VIEW
 
 
-type alias Addr = Signal.Address Action
+type alias Addr =
+  Signal.Address Action
 
 
 drawer : List Html
 drawer =
   [ Layout.title "Example drawer"
   , Layout.navigation
-    [ Layout.link
-      [href "https://github.com/debois/elm-mdl"]
-      [text "github"]
-    , Layout.link
-      [href "http://package.elm-lang.org/packages/debois/elm-mdl/latest/"]
-      [text "elm-package"]
-    ]
+      [ Layout.link
+          [ href "https://github.com/debois/elm-mdl" ]
+          [ text "github" ]
+      , Layout.link
+          [ href "http://package.elm-lang.org/packages/debois/elm-mdl/latest/" ]
+          [ text "elm-package" ]
+      ]
   ]
 
 
@@ -96,41 +177,57 @@ header =
   [ Layout.title "elm-mdl"
   , Layout.spacer
   , Layout.navigation
-    [ Layout.link
-      [ href "https://www.getmdl.io/components/index.html" ]
-      [ text "MDL" ]
-    , Layout.link
-      [ href "https://www.google.com/design/spec/material-design/introduction.html"]
-      [ text "Material Design"]
-    ]
+      [ Layout.link
+          [ href "https://www.getmdl.io/components/index.html" ]
+          [ text "MDL" ]
+      , Layout.link
+          [ href "https://www.google.com/design/spec/material-design/introduction.html" ]
+          [ text "Material Design" ]
+      ]
   ]
 
 
-tabs : List (String, Addr -> Model -> Html)
+tabs : List (String, String, Addr -> Model -> Html)
 tabs =
-  [ ("Snackbar", \addr model ->
+  [ ("Snackbar", "snackbar", \addr model ->
       Demo.Snackbar.view (Signal.forwardTo addr SnackbarAction) model.snackbar)
-  , ("Textfields", \addr model ->
+  , ("Textfields", "textfields", \addr model ->
       Demo.Textfields.view (Signal.forwardTo addr TextfieldAction) model.textfields)
-  , ("Buttons", \addr model ->
+  , ("Buttons", "buttons", \addr model ->
       Demo.Buttons.view (Signal.forwardTo addr ButtonsAction) model.buttons)
-  , ("Grid", \addr model -> Demo.Grid.view)
-  , ("Badges", \addr model -> Demo.Badges.view )
+  , ("Grid", "grid", \addr model -> Demo.Grid.view)
+  , ("Badges", "badges", \addr model -> Demo.Badges.view )
   {-
   , ("Template", \addr model -> 
       [Demo.Template.view (Signal.forwardTo addr TemplateAction) model.template])
   -}
   ]
 
+
+e404 : Addr -> Model -> Html 
+e404 _ _ =  
+  div 
+    [ 
+    ]
+    [ Style.styled Html.h1
+        [ Style.cs "mdl-typography--display-4" ]
+        []
+        [ text "404" ]
+    ]
+
+
 tabViews : Array (Addr -> Model -> Html)
-tabViews = List.map snd tabs |> Array.fromList
+tabViews = List.map (\(_,_,v) -> v) tabs |> Array.fromList
 
 
 tabTitles : List Html
-tabTitles = List.map (fst >> text) tabs
+tabTitles =
+  List.map (\(x,_,_) -> text x) tabs
+
 
 stylesheet : Html
-stylesheet = Style.stylesheet """
+stylesheet =
+  Style.stylesheet """
   blockquote:before { content: none; }
   blockquote:after { content: none; }
   blockquote {
@@ -154,25 +251,37 @@ stylesheet = Style.stylesheet """
 """
 
 
+setTab : Layout.Model -> Route -> Layout.Model
+setTab layout route =
+  let 
+    idx = 
+      case route of 
+        Tab k -> k
+        E404 -> -1 
+  in 
+    { layout | selectedTab = idx }
+
+
 view : Signal.Address Action -> Model -> Html
 view addr model =
-  let top =
-        div
-          [ style
-            [ ("margin", "auto")
-            , ("padding-left", "5%")
-            , ("padding-right", "5%")
+  let
+    top =
+      div
+        [ style
+            [ ( "margin", "auto" )
+            , ( "padding-left", "5%" )
+            , ( "padding-right", "5%" )
             ]
-          ]
-          [ (Array.get model.layout.selectedTab tabViews
-             |> Maybe.withDefault (\addr model ->
-                  div [] [text "This can't happen."]
-                )
-            ) addr model
-          ]
-
+        ]
+        [ (Array.get model.layout.selectedTab tabViews
+            |> Maybe.withDefault e404)
+           addr
+           model
+        ]
   in
-    Layout.view (Signal.forwardTo addr LayoutAction) model.layout
+    Layout.view
+      (Signal.forwardTo addr LayoutAction)
+      model.layout
       { header = Just header
       , drawer = Just drawer
       , tabs = Just tabTitles
@@ -185,28 +294,31 @@ view addr model =
     |> Scheme.topWithScheme Color.Teal Color.Red
 
 
-init : (Model, Effects.Effects Action)
-init = (model, Effects.none)
+init : ( Model, Effects.Effects Action )
+init =
+  ( model, Effects.none )
 
 
 inputs : List (Signal.Signal Action)
 inputs =
   [ Layout.setupSizeChangeSignal LayoutAction
+  , Signal.map ApplyRoute router.signal
   ]
 
 
 app : StartApp.App Model
 app =
-    StartApp.start
-      { init = init
-      , view = view
-      , update = update
-      , inputs = inputs
-      }
+  StartApp.start
+    { init = init
+    , view = view
+    , update = update
+    , inputs = inputs
+    }
+
 
 main : Signal Html
 main =
-    app.html
+  app.html
 
 
 -- PORTS
@@ -214,4 +326,9 @@ main =
 
 port tasks : Signal (Task.Task Never ())
 port tasks =
-    app.tasks
+  app.tasks
+
+
+port routeRunTask : Task () ()
+port routeRunTask =
+  router.run