Button API, demos.

Demo.elm

@@ -6,13 +6,14 @@ import Effects exposing (..)
 import Task
 import Signal
 import Task exposing (Task)
-import Dict exposing (Dict)
+import Array exposing (Array)
 
-import Material.Textfield as Textfield
+import Material.Layout as Layout exposing (defaultLayoutModel)
-import Material.Grid as Grid exposing (Device(..))
+import Material
-import Material.Layout as Layout
 
-import Buttons
+import Demo.Buttons
+import Demo.Grid
+import Demo.Textfields
 
 
 -- MODEL
@@ -20,40 +21,23 @@ import Buttons
 
 type alias Model =
   { layout : Layout.Model
-  , buttons : Buttons.Model
+  , buttons : Demo.Buttons.Model
-  , t0 : Textfield.Model
+  , textfields : Demo.Textfields.Model
-  , t1 : Textfield.Model
-  , t2 : Textfield.Model
-  , t3 : Textfield.Model
-  , t4 : Textfield.Model
   }
 
 
 layoutModel : Layout.Model
 layoutModel =
-  { selectedTab = "Buttons"
+  { defaultLayoutModel
-  , isDrawerOpen = False
+  | state = Layout.initState (List.length tabs)
-  , state = Layout.initState ["Buttons", "Grid", "Textfields"]
   }
 
 
 model : Model
 model =
-  let t0 = Textfield.model in
   { layout = layoutModel
-  , buttons = Buttons.model
+  , buttons = Demo.Buttons.model
-  , t0 = t0
+  , textfields = Demo.Textfields.model
-  , t1 = { t0 | label = Just { text = "Labelled", float = False } }
-  , t2 = { t0 | label = Just { text = "Floating label", float = True }}
-  , t3 = { t0
-         | label = Just { text = "Disabled", float = False }
-         , isDisabled = True
-         }
-  , t4 = { t0
-           | label = Just { text = "With error and value", float = False }
-           , error = Just "The input is wrong!"
-           , value = "Incorrect input"
-           }
   }
 
 
@@ -62,12 +46,8 @@ model =
 
 type Action
   = LayoutAction Layout.Action
-  | ButtonsAction Buttons.Action
+  | ButtonsAction Demo.Buttons.Action
-  | T0 Textfield.Action
+  | TextfieldAction Demo.Textfields.Action
-  | T1 Textfield.Action
-  | T2 Textfield.Action
-  | T3 Textfield.Action
-  | T4 Textfield.Action
 
 
 update : Action -> Model -> (Model, Effects.Effects Action)
@@ -80,24 +60,15 @@ update action model =
         ({ model | layout = l }, Effects.map LayoutAction e)
 
     ButtonsAction a ->
-      let (b, e) = Buttons.update a model.buttons
+      let
+        (b, e) = Demo.Buttons.update a model.buttons
       in
         ({ model | buttons = b }, Effects.map ButtonsAction e)
 
-    T0 a ->
+    TextfieldAction a ->
-      ({ model | t0 = Textfield.update a model.t0 }, Effects.none)
+      ({ model | textfields = Demo.Textfields.update a model.textfields }
-
+      , Effects.none
-    T1 a ->
+      )
-      ({ model | t1 = Textfield.update a model.t1 }, Effects.none)
-
-    T2 a ->
-      ({ model | t2 = Textfield.update a model.t2 }, Effects.none)
-
-    T3 a ->
-      ({ model | t3 = Textfield.update a model.t3 }, Effects.none)
-
-    T4 a ->
-      ({ model | t4 = Textfield.update a model.t4 }, Effects.none)
 
 
 -- VIEW
@@ -106,17 +77,17 @@ update action model =
 type alias Addr = Signal.Address Action
 
 
-layoutConfig : Layout.Config
-layoutConfig = Layout.defaultConfig
-
 
 drawer : List Html
 drawer =
-  [ Layout.title "elm-mdl"
+  [ Layout.title "Example drawer"
   , Layout.navigation
-    [ Layout.link [] [text "Dead Link 1"]
+    [ Layout.link
-    , Layout.link [] [text "Dead Link 2"]
+      [href "https://groups.google.com/forum/#!forum/elm-discuss"]
-    , Layout.link [] [text "Dead Link 3"]
+      [text "Elm Discuss"]
+    , Layout.link
+      [href "http://elm-lang.org"]
+      [text "Elm"]
     ]
   ]
 
@@ -129,75 +100,54 @@ header =
     [ 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"]
     ]
   ]
 
 
-tabGrid : Addr -> Model -> List Html
+tabs : List (String, Addr -> Model -> List Html)
-tabGrid addr model =
-  [ Grid.grid
-      [ Grid.cell [ Grid.col All 4 ]
-          [ h4 [] [text "Cell 1"] ]
-      , Grid.cell [ Grid.offset All 2, Grid.col All 4 ]
-          [ h4 [] [text "Cell 2"], p [] [text "This cell is offset by 2"] ]
-      , Grid.cell [ Grid.col All 6 ]
-          [ h4 [] [text "Cell 3"] ]
-      , Grid.cell [ Grid.col Tablet 6, Grid.col Desktop 12, Grid.col Phone 2 ]
-          [ h4 [] [text "Cell 4"], p [] [text "Size varies with device"] ]
-      ]
-  ]
-
-
-tabButtons : Addr -> Model -> List Html
-tabButtons addr model =
-  [ Buttons.view (Signal.forwardTo addr ButtonsAction) model.buttons ]
-
-
-tabTextfields : Addr -> Model -> List Html
-tabTextfields addr model   =
-  let fwd = Signal.forwardTo addr in
-  [ Textfield.view (fwd T0) model.t0
-  , Textfield.view (fwd T1) model.t1
-  , Textfield.view (fwd T2) model.t2
-  , Textfield.view (fwd T3) model.t3
-  , Textfield.view (fwd T4) model.t4
-  ]
-  |> List.map (\elem -> Grid.cell [ Grid.col All 4 ] [elem])
-  |> (\content -> [Grid.grid content])
-
-
-
-tabs : Dict String (Addr -> Model -> List Html)
 tabs =
-  Dict.fromList
+  [ ("Buttons", \addr model ->
-    [ ("Buttons", tabButtons)
+      [Demo.Buttons.view (Signal.forwardTo addr ButtonsAction) model.buttons])
-    , ("Textfields", tabTextfields)
+  , ("Textfields", \addr model ->
-    , ("Grid", tabGrid)
+      [Demo.Textfields.view (Signal.forwardTo addr TextfieldAction) model.textfields])
-    ]
+  , ("Grid", \addr model -> Demo.Grid.view)
+  ]
+
+
+tabViews : Array (Addr -> Model -> List Html)
+tabViews = List.map snd tabs |> Array.fromList
+
+
+tabTitles : List Html
+tabTitles = List.map (fst >> text) tabs
 
 
 view : Signal.Address Action -> Model -> Html
 view addr model =
-  let contents =
+  let top =
-        Dict.get model.layout.selectedTab tabs
-        |> Maybe.withDefault tabGrid
-
-      top =
         div
           [ style
             [ ("margin", "auto")
             , ("width", "90%")
             ]
           ]
-          <| contents addr model
+          ((Array.get model.layout.selectedTab tabViews
-
+           |> Maybe.withDefault (\addr model ->
-      addr' = Signal.forwardTo addr LayoutAction
+             [div [] [text "This can't happen."]]
+           )
+          ) addr model)
 
   in
-    Layout.view addr'
+    Layout.view (Signal.forwardTo addr LayoutAction) model.layout
-      layoutConfig model.layout
+      { header = Just header
-      (Just drawer, Just header)
+      , drawer = Just drawer
-      [ top ]
+      , tabs = Just tabTitles
+      , main = [ top ]
+      }
+    |> Material.topWithColors Material.Teal Material.Red
 
 
 init : (Model, Effects.Effects Action)

Demo/Buttons.elm

@@ -1,11 +1,11 @@
-module Buttons where
+module Demo.Buttons where
 
 import Dict
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Effects
 
-import Material.Button as Button exposing (Appearance(..), Coloring(..))
+import Material.Button as Button exposing (..)
 import Material.Grid as Grid
 import Material.Icon as Icon
 
@@ -27,16 +27,46 @@ tabulate : List a -> List (Int, a)
 tabulate = tabulate' 0
 
 
-row : Appearance -> Bool -> List (Int, (Bool, Button.Config))
+type alias View =
-row appearance ripple =
+  Signal.Address Button.Action -> Button.Model -> Coloring -> List Html -> Html
+
+type alias View' =
+  Signal.Address Button.Action -> Button.Model -> Html
+
+
+view' : View -> Coloring -> Html -> Signal.Address Button.Action -> Button.Model -> Html
+view' view coloring elem addr model =
+  view addr model coloring [elem]
+
+
+describe : String -> Bool -> Coloring -> String
+describe kind ripple coloring =
+  let
+    c =
+      case coloring of
+        Plain -> "plain"
+        Colored -> "colored"
+        Primary -> "primary"
+        Accent -> "accent"
+  in
+    kind ++ ", " ++ c ++ if ripple then " w/ripple" else ""
+
+
+row : (String, Html, View) -> Bool -> List (Int, (Bool, String, View'))
+row (kind, elem, v) ripple =
   [ Plain, Colored, Primary, Accent ]
-  |> List.map (\c -> (ripple, { coloring = c, appearance = appearance }))
+  |> List.map (\c -> (ripple, describe kind ripple c, view' v c elem))
   |> tabulate
 
 
-buttons : List (List (Index, (Bool, Button.Config)))
+buttons : List (List (Index, (Bool, String, View')))
 buttons =
-  [Flat, Raised, FAB, MiniFAB, Icon]
+  [ ("flat", text "Flat Button", Button.flat)
+  , ("raised", text "Raised Button", Button.raised)
+  , ("FAB", Icon.i "add", Button.fab)
+  , ("mini-FAB", Icon.i "zoom_in", Button.minifab)
+  , ("icon", Icon.i "flight_land", Button.icon)
+  ]
   |> List.concatMap (\a -> [row a False, row a True])
   |> tabulate
   |> List.map (\(i, row) -> List.map (\(j, x) -> ((i,j), x)) row)
@@ -47,7 +77,7 @@ model =
   { clicked = ""
   , buttons =
       buttons
-      |> List.concatMap (List.map <| \(idx, (ripple, _)) -> (idx, Button.model ripple))
+      |> List.concatMap (List.map <| \(idx, (ripple, _, _)) -> (idx, Button.model ripple))
       |> Dict.fromList
   }
 
@@ -79,36 +109,15 @@ update (Action idx action) model =
 -- VIEW
 
 
-describe : Bool -> Button.Config -> String
-describe ripple config =
-  let
-    appearance =
-      case config.appearance of
-        Flat -> "flat"
-        Raised -> "raised"
-        FAB -> "FAB"
-        MiniFAB -> "mini-FAB"
-        Icon -> "icon"
-    coloring =
-      case config.coloring of
-        Plain -> "plain"
-        Colored -> "colored"
-        Primary -> "primary"
-        Accent -> "accent"
-  in
-    appearance ++ ", " ++ coloring ++ if ripple then " w/ripple" else ""
-
-
-
 view : Signal.Address Action -> Model -> Html
 view addr model =
   buttons |> List.concatMap (\row ->
-    row |> List.map (\(idx, (ripple, config)) ->
+    row |> List.concatMap (\(idx, (ripple, description, view)) ->
       let model' =
         Dict.get idx model.buttons |> Maybe.withDefault (Button.model False)
       in
-        Grid.cell
+        [ Grid.cell
-          [ Grid.col Grid.All 3]
+          [ Grid.size Grid.All 3]
           [ div
               [ style
                 [ ("text-align", "center")
@@ -116,27 +125,20 @@ view addr model =
                 , ("margin-bottom", "1em")
                 ]
               ]
-              [ Button.view
+              [ view
                   (Signal.forwardTo addr (Action idx))
-                  config
                   model'
-                  []
-                  [ case config.appearance of
-                      Flat -> text <| "Flat Button"
-                      Raised -> text <| "Raised Button"
-                      FAB -> Icon.i "add"
-                      MiniFAB -> Icon.i "zoom_in"
-                      Icon -> Icon.i "flight_land"
-                  ]
               , div
                   [ style
                     [ ("font-size", "9pt")
                     , ("margin-top", "1em")
                     ]
                   ]
-                  [ text <| describe ripple config ]
+                  [ text description
+                  ]
               ]
           ]
+        ]
     )
   )
   |> Grid.grid

Demo/Grid.elm

@@ -0,0 +1,36 @@
+module Demo.Grid where
+
+import Material.Grid exposing (..)
+import Html exposing (..)
+
+
+view : List Html
+view =
+  [ [1..12]
+    |> List.map (\i -> cell [size All 1] [text "1"])
+    |> grid
+  , [1 .. 3]
+    |> List.map (\i -> cell [size All 4] [text <| "4"])
+    |> grid
+  , [ cell [size All 6] [text "6"]
+    , cell [size All 4] [text "4"]
+    , cell [size All 2] [text "2"]
+    ] |> grid
+  , [ cell [size All 6, size Tablet 8] [text "6 (8 tablet)"]
+    , cell [size All 4, size Tablet 6] [text "4 (6 tablet)"]
+    , cell [size All 2, size Phone 4] [text "2 (4 phone)"]
+    ] |> grid
+  , Html.node "style" [] [text """
+      .mdl-cell {
+        text-sizing: border-box;
+        background-color: #BDBDBD;
+        height: 200px;
+        padding-left: 8px;
+        padding-top: 4px;
+        color: white;
+      }
+      .mdl-grid:first-of-type .mdl-cell {
+        height: 50px;
+      }
+    """]
+  ]

Makefile

@@ -1,5 +1,5 @@
 elm.js:
-	elm-make elm-mdl-demo.elm --output elm.js
+	elm-make Demo.elm --output elm.js
 
 clean:
 	rm -rf elm-stuff/build-artifacts elm.js

Material/Aux.elm

@@ -12,6 +12,18 @@ filter elem attr html =
   elem attr (List.filterMap (\x -> x) html)
 
 
+mapWithIndex : (Int -> a -> b) -> List a -> List b
+mapWithIndex f xs =
+  let
+    loop k ys =
+      case ys of
+        [] -> []
+        y :: ys -> f k y :: loop (k+1) ys
+  in
+    loop 0 xs
+
+
+
 onClick' : Signal.Address a -> a -> Html.Attribute
 onClick' address x =
   Html.Events.onWithOptions

Material/Button.elm

@@ -1,7 +1,7 @@
 module Material.Button
-  ( model, update
+  ( Model, model, Action(Click), update
-  , Kind(..), Coloring(..), Config
+  , Coloring(..)
-  , view
+  , flat, raised, fab, minifab, icon
   ) where
 
 {-| From the [Material Design Lite documentation](http://www.getmdl.io/components/#buttons-section):
@@ -26,16 +26,21 @@ See also the
 [Material Design Specification]([https://www.google.com/design/spec/components/buttons.html).
 
 # Component
-@docs model, update
+@docs Model, model, Action, update
 
 # View
-@docs Kind, Coloring, Config, view
+Refer to the
+[Material Design Specification](https://www.google.com/design/spec/components/buttons.html)
+for details about what type of buttons are appropriate for which situations.
+
+@docs Coloring, flat, raised, fab, minifab, icon
 
 -}
 
 import Html exposing (..)
 import Html.Attributes exposing (..)
-import Effects exposing (Effects)
+import Html.Events exposing (onClick)
+import Effects exposing (Effects, none)
 
 import Material.Aux as Aux
 import Material.Ripple as Ripple
@@ -47,8 +52,8 @@ import Material.Ripple as Ripple
 -- MODEL
 
 
-{-| Model of the button. Determines if the button will ripple when clicked;
+{-| Model of the button; common to all kinds of button.
-use `initState` to initalise it.
+Use `model` to initalise it.
 -}
 type Model = S (Maybe Ripple.Model)
 
@@ -67,42 +72,34 @@ model shouldRipple =
 -- ACTION, UPDATE
 
 
-{-| Component action. This exists exclusively to support ripple-animations.
+{-| Component action. The `Click` action fires when the button is clicked.
-To repsond to clicks, disable the button etc., supply event-handler attributes
-to `view` as you would a regular button.
 -}
-type alias Action = Ripple.Action
+type Action
+  = Ripple Ripple.Action
+  | Click
 
 
 {-| Component update.
 -}
 update : Action -> Model -> (Model, Effects Action)
 update action model =
-  case model of
+  case action of
-    S (Just ripple) ->
+    Click ->
-      let (ripple', e) = Ripple.update action ripple
+      (model, none)
-      in
+
-        (S (Just ripple'), e)
+    Ripple action' ->
-    S Nothing ->
+      case model of
-      (model, Effects.none)
+        S (Just ripple) ->
+          let (ripple', e) = Ripple.update action' ripple
+          in
+            (S (Just ripple'), Effects.map Ripple e)
+        S Nothing ->
+          (model, none)
 
 
 -- VIEW
 
 
-{-| Type of button. Refer to the
-[Material Design Specification](https://www.google.com/design/spec/components/buttons.html)
-for what these look like and what they
-are supposed to be used for.
--}
-type Kind
-  = Flat
-  | Raised
-  | FAB
-  | MiniFAB
-  | Icon
-
-
 {-| Coloring of a button. `Plain` respectively `Colored` is the button's
 uncolored respectively colored defaults.
 `Primary` respectively `Accent` chooses a colored button with the indicated
@@ -115,48 +112,123 @@ type Coloring
   | Accent
 
 
-{-| Button configuration: Its `Kind` and `Coloring`.
+view : String -> Signal.Address Action -> Model -> Coloring -> List Html -> Html
--}
+view kind addr model coloring html =
-type alias Config =
-  { kind : Kind
-  , coloring : Coloring
-  }
-
-
-{-| Construct a button view. Kind and coloring is given by 
-`Config`. To interact with the button, supply the usual
-event-handler attributes, e.g., `onClick`. To disable the button, add the
-standard HTML `disabled` attribute.
-
-NB! This implementation will override the properties `class`, `onmouseup`, 
-and `onmouseleave` even if you specify them as part of `List Attributes`. 
--}
-view : Signal.Address Action -> Config -> Model -> List Attribute -> List Html -> Html
-view addr config model attrs html =
   button
-    (classList
+    [ classList
       [ ("mdl-button", True)
       , ("mdl-js-button", True)
       , ("mdl-js-ripple-effect", model /= S Nothing)
       -- Color effect.
-      , ("mdl-button--colored", config.coloring == Colored)
+      , ("mdl-button--colored", coloring == Colored)
-      , ("mdl-button--primary", config.coloring == Primary)
+      , ("mdl-button--primary", coloring == Primary)
-      , ("mdl-button--accent",  config.coloring == Accent)
+      , ("mdl-button--accent",  coloring == Accent)
       -- Kind.
-      , ("mdl-button--raised",   config.kind == Raised)
+      , (kind, kind /= "")
-      , ("mdl-button--fab",      config.kind == FAB || config.kind == MiniFAB)
-      , ("mdl-button--mini-fab", config.kind == MiniFAB)
-      , ("mdl-button--icon",     config.kind == Icon)
       ]
-      :: Aux.blurOn "mouseup"
+    , Aux.blurOn "mouseup"
-      :: Aux.blurOn "mouseleave"
+    , Aux.blurOn "mouseleave"
-      :: attrs)
+    , onClick addr Click
-     (case model of
+    ]
-        S (Just ripple) ->
+    (case model of
-          Ripple.view
+      S (Just ripple) ->
-            addr
+        Ripple.view
-            [ class "mdl-button__ripple-container"
+          (Signal.forwardTo addr Ripple)
-            , Aux.blurOn "mouseup" ]
+          [ class "mdl-button__ripple-container"
-            ripple
+          , Aux.blurOn "mouseup" ]
-          :: html
+          ripple
-        _ -> html)
+        :: html
+      _ -> html)
+
+
+{-| From the
+[Material Design Specification](https://www.google.com/design/spec/components/buttons.html#buttons-flat-buttons):
+
+> Flat buttons are printed on material. They do not lift, but fill with color on
+> press.
+>
+> Use flat buttons in the following locations:
+>
+>  - On toolbars
+>  - In dialogs, to unify the button action with the dialog content
+>  - Inline, with padding, so the user can easily find them
+
+Example use (uncolored flat button, assuming properly setup model):
+
+    import Material.Button as Button
+
+    flatButton : Html
+    flatButton = Button.flat addr model Button.Plain [text "Click me!"]
+
+-}
+flat : Signal.Address Action -> Model -> Coloring -> List Html -> Html
+flat = view ""
+
+
+{-| From the
+[Material Design Specification](https://www.google.com/design/spec/components/buttons.html#buttons-raised-buttons):
+
+> Raised buttons add dimension to mostly flat layouts. They emphasize functions
+> on busy or wide spaces.
+>
+> Raised buttons behave like a piece of material resting on another sheet –
+> they lift and fill with color on press.
+
+Example use (colored raised button, assuming properly setup model):
+
+    import Material.Button as Button
+
+    raisedButton : Html
+    raisedButton = Button.raised addr model Button.Colored [text "Click me!"]
+
+-}
+raised : Signal.Address Action -> Model -> Coloring -> List Html -> Html
+raised = view "mdl-button--raised"
+
+
+{-| Floating Action Button. From the
+[Material Design Specification](https://www.google.com/design/spec/components/buttons-floating-action-button.html):
+
+> Floating action buttons are used for a promoted action. They are distinguished
+> by a circled icon floating above the UI and have motion behaviors that include
+> morphing, launching, and a transferring anchor point.
+>
+> Floating action buttons come in two sizes:
+>
+>  - Default size: For most use cases
+>  - Mini size: Only used to create visual continuity with other screen elements
+
+This constructor produces the default size, use `minifab` to get the mini-size.
+
+Example use (colored with a '+' icon):
+
+    import Material.Button as Button
+    import Material.Icon as Icon
+
+    fabButton : Html
+    fabButton = fab addr model Colored [Icon.i "add"]
+-}
+fab : Signal.Address Action -> Model -> Coloring -> List Html -> Html
+fab = view "mdl-button--fab"
+
+
+{-| Mini-sized variant of a Floating Action Button; refer to `fab`.
+-}
+minifab : Signal.Address Action -> Model -> Coloring -> List Html -> Html
+minifab = view "mdl-button--mini-fab"
+
+
+{-| The [Material Design Lite implementation](https://www.getmdl.io/components/index.html#buttons-section)
+also offers an "icon button", which we
+re-implement here. See also
+[Material Design Specification](http://www.google.com/design/spec/components/buttons.html#buttons-toggle-buttons).
+Example use (no color, displaying a '+' icon):
+
+    import Material.Button as Button
+    import Material.Icon as Icon
+
+    iconButton : Html
+    iconButton = icon addr model Plain [Icon.i "add"]
+-}
+icon : Signal.Address Action -> Model -> Coloring -> List Html -> Html
+icon = view "mdl-button--icon"

Material/Grid.elm

@@ -1,14 +1,17 @@
 module Material.Grid
-  ( grid
+  ( grid, gridWithOptions, Options
-  , size
-  , offset
-  , align
   , cell
   , Device(..)
   , Align(..)
+  , size
+  , offset
+  , align
+  , hide
+  , order
   ) where
 
-{-| From the [Material Design Lite documentation](http://www.getmdl.io/components/#layout-section/grid):
+{-| From the
+[Material Design Lite documentation](http://www.getmdl.io/components/#layout-section/grid):
 
 > The Material Design Lite (MDL) grid component is a simplified method for laying
 > out content for multiple screen sizes. It reduces the usual coding burden
@@ -30,28 +33,35 @@ Example use:
 
     import Material.Grid exposing (grid, cell, size, Device(..))
 
-    grid
+    top : Html
-      [ cell [ size All 4 ]
+    top =
-          [ h4 [] [text "Cell 1"]
+      grid
-          ]
+        [ cell [ size All 4 ]
-      , cell [ offset All 2, size All 4 ]
+            [ h4 [] [text "Cell 1"]
-          [ h4 [] [text "Cell 2"]
+            ]
-          , p [] [text "This cell is offset by 2"]
+        , cell [ offset All 2, size All 4 ]
-          ]
+            [ h4 [] [text "Cell 2"]
-      , cell [ size All 6 ]
+            , p [] [text "This cell is offset by 2"]
-          [ h4 [] [text "Cell 3"]
+            ]
-          ]
+        , cell [ size All 6 ]
-      , cell [ size Tablet 6, size Desktop 12, size Phone 2 ]
+            [ h4 [] [text "Cell 3"]
-          [ h4 [] [text "Cell 4"]
+            ]
-          , p [] [text "Size varies with device"]
+        , cell [ size Tablet 6, size Desktop 12, size Phone 2 ]
-          ]
+            [ h4 [] [text "Cell 4"]
-      ]
+            , p [] [text "Size varies with device"]
+            ]
+        ]
 
-# Views
+# Grid container
-@docs grid, cell
+@docs grid, Options, gridWithOptions
 
-# Cell configuration
+# Cells
-@docs Device, size, offset, Align, align
+
+Cells are configured with a `List CellConfig`; this configuration dictates the
+size, offset, and alignment behaviour of the cell. Construct
+individual `CellConfig` elements using `size`, `offset`, and `align`.
+
+@docs cell, Device, size, offset, Align, align, hide, order
 -}
 
 
@@ -62,33 +72,77 @@ Example use:
   "You can set a maximum grid width, after which the grid stays centered with
    padding on either side, by setting its max-width CSS property."
 
-2. mdl-grid--no-spacing
+2. mdl-cell--stretch
-3. mdl-cell--stretch
-4. mdl-cell--hide-*
 -}
 
 
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import String
-import Material.Aux exposing (clip)
+import Material.Aux exposing (clip, filter)
 
 
-{-| Construct a grid. Use `cell` some number of times to construct the argument list.
+{-| The `spacing` parameter indicates whether or not the grid should have
+spacing between cells. The `maxWidth` parameter, which must be a valid CSS
+dimension, indicates the maximum
+width of the grid; if the grid is in a larger container, it stays centered with
+padding on either side.
 -}
-grid : List Html -> Html
+type alias Options =
-grid elms =
+  { spacing : Bool
-  div [class "mdl-grid"] elms
+  , maxWidth : Maybe String
+  }
 
 
-{-| Device specifiers, used with `size` and `offset`.
+{-| By default, a grid has spacing between columns, but no maximum width.
+-}
+defaultOptions : Options
+defaultOptions =
+  { spacing = True
+  , maxWidth = Nothing
+  }
+
+
+{-| Construct a grid with options.
+-}
+gridWithOptions : Options -> List Cell -> Html
+gridWithOptions options elms =
+  div
+    [ classList
+        [ ("mdl-grid", True)
+        , ("mdl-grid--no-spacing", not options.spacing)
+        ]
+    , style (
+        options.maxWidth
+        |> Maybe.map (\maxwidth -> [("max-width", maxwidth)])
+        |> Maybe.withDefault []
+      )
+    ]
+    (List.map (\(Cell elm) -> elm) elms)
+
+
+{-| Construct a grid with default options (i.e., default spacing, no
+maximum width.) Use `cell` some number of times to construct the argument
+list.
+-}
+grid : List Cell -> Html
+grid = gridWithOptions defaultOptions
+
+
+{-| Device specifiers, used with `size` and `offset`. (A `Device` really
+encapsulates a screen size.)
 -}
 type Device = All | Desktop | Tablet | Phone
 
 
 {- Cell configuration. Construct with `size`, `offset`, and `align`.
 -}
-type CellConfig = C String
+type CellConfig = Config String
+
+
+{- Opaque cell type.
+-}
+type Cell = Cell Html
 
 
 suffix : Device -> String
@@ -112,7 +166,7 @@ size device k =
       Tablet -> clip 1 8 k
       Phone -> clip 1 4 k
   in
-    "mdl-cell--" ++ toString c ++ "-col" ++ suffix device |> C
+    "mdl-cell--" ++ toString c ++ "-col" ++ suffix device |> Config
 
 
 {-| Specify cell offset, i.e., empty number of empty cells before the present
@@ -128,7 +182,7 @@ offset device k =
       Tablet -> clip 1 7 k
       Phone -> clip 1 3 k
   in
-    "mdl-cell--" ++ toString c ++ "-offset" ++ suffix device |> C
+    "mdl-cell--" ++ toString c ++ "-offset" ++ suffix device |> Config
 
 
 {-| Vertical alignment of cells; use with `align`.
@@ -140,16 +194,34 @@ type Align = Top | Middle | Bottom
 -}
 align : Align -> CellConfig
 align a =
-  C <| case a of
+  Config <| case a of
     Top -> "mdl-cell--top"
     Middle -> "mdl-cell--middle"
     Bottom -> "mdl-cell--bottom"
 
 
+{-| Specify that a cell should be hidden on given `Device`.
+-}
+hide : Device -> CellConfig
+hide device =
+  Config <| case device of
+    All -> ""
+    _ -> "mdl-cell--hide-" ++ suffix device
+
+
+{-| Specify that a cell should re-order itself to position 'Int' on `Device`.
+-}
+order : Device -> Int -> CellConfig
+order device n =
+  Config <| "mdl-cell--order-" ++ (toString <| clip 1 12 n) ++ suffix device
+
+
 {-| Construct a cell for use in the argument list for `grid`.
 Construct the cell configuration (first argument) using `size`, `offset`, and
 `align`. Supply contents for the cell as the second argument.
 -}
-cell : List CellConfig -> List Html -> Html
+cell : List CellConfig -> List Html -> Cell
-cell extents elms =
+cell configs elms =
-  div [class <| String.join " " ("mdl-cell" :: (List.map (\(C s) -> s) extents))] elms
+  Cell <| div
+    [class <| String.join " " ("mdl-cell" :: (List.map (\(Config s) -> s) configs))]
+    elms

Material/Icon.elm

@@ -31,9 +31,21 @@ type Size
 
 
 {-| View function for icons. Supply the
-(Material Icons Library)[https://design.google.com/icons/] name as
+[Material Icons Library](https://design.google.com/icons/) name as
 the first argument (replace spaces with underscores); and the size of the icon
-as the second.
+as the second. Do not use this function to produce clickable icons; use
+icon buttons in Material.Button for that.
+
+I.e., to produce a 48px
+["trending flat"](https://design.google.com/icons/#ic_trending_flat) icon with
+no attributes:
+
+    import Material.Icon as Icon
+
+    icon : Html
+    icon = Icon.view "trending_flat" Icon.S48 []
+
+This function will override any `class` set in `List Attribute`.
 -}
 view : String -> Size -> List Attribute -> Html
 view name size attrs =
@@ -52,6 +64,13 @@ view name size attrs =
 {-| Render a default-sized icon with no behaviour. The
 `String` argument must be the name of a [Material Icon](https://design.google.com/icons/)
 (replace spaces with underscores).
+
+I.e., to produce a default size (24xp) "trending flat" icon:
+
+    import Material.Icon as Icon
+
+    icon : Html
+    icon = Icon.i "trending_flat"
 -}
 i : String -> Html
 i name = view name S []

Material/Layout.elm

@@ -1,9 +1,9 @@
 module Material.Layout
   ( setupSizeChangeSignal
-  , Model, initState
+  , Mode, Model, defaultLayoutModel, initState
   , Action(SwitchTab, ToggleDrawer), update
   , spacer, title, navigation, link
-  , Mode, Config, config, view
+  , Contents, view
   ) where
 
 {-| From the
@@ -30,20 +30,20 @@ module Material.Layout
 > flexibility and ease of use.
 
 # Model & Actions
-@docs Model, initState, Action, update
+@docs Mode, Model, defaultLayoutModel, initState, Action, update
-
-# Sub-components
-@docs spacer, title, navigation, link
 
 # View
-@docs Mode, Config, config, view
+@docs Contents, view
+
+## Sub-views
+@docs spacer, title, navigation, link
 
 # Setup
 @docs setupSizeChangeSignal
 -}
 
 
-import Dict exposing (Dict)
+import Array exposing (Array)
 import Maybe exposing (andThen, map)
 import Html exposing (..)
 import Html.Attributes exposing (..)
@@ -79,13 +79,8 @@ setupSizeChangeSignal f =
 -- MODEL
 
 
-type alias TabState =
-  { titles : List String
-  , ripples : Dict String Ripple.Model
-  }
-
 type alias State' =
-  { tabs : TabState
+  { tabs : Array Ripple.Model
   , isSmallScreen : Bool
   }
 
@@ -102,44 +97,58 @@ s model = case model.state of (S state) -> state
 {-| Layout model. If your layout view has tabs, any tab with the same name as
 `selectedTab` will be highlighted as selected; otherwise, `selectedTab` has no
 significance. `isDrawerOpen` indicates whether the drawer, if the layout has
-such, is open; otherwise, it has no significance. The `state` is the opaque
+such, is open; otherwise, it has no significance.
-layout component state; use the function `initState` to construct it. (The names
+
-of your tabs lives in this state; so you must use `initState` to set those
+The header disappears on small devices unless
-names.)
+`fixedHeader` is true. The drawer opens and closes with user interactions
+unless `fixedDrawer` is true, in which case it is permanently open on large
+screens. Tabs scroll horisontally unless `fixedTabs` is true.
+Finally, the header respects `mode`
+
+The `state` is the opaque
+layout component state; use the function `initState` to construct it. If you
+change the number of tabs, you must re-initialise this state.
 -}
 type alias Model =
-  { selectedTab : String
+  { selectedTab : Int
   , isDrawerOpen : Bool
+  -- Configuration
+  , fixedHeader : Bool
+  , fixedDrawer : Bool
+  , fixedTabs : Bool
+  , rippleTabs : Bool
+  , mode : Mode
+  -- State
   , state : State
   }
 
 
-{-| Initialiser for Layout component state. Supply a list of tab titles
+{-| Initialiser for Layout component state. Supply a number of tabs you
-or the empty list if your layout should have no tabs. E.g.,
+use in your layout. If you subsequently change the number of tabs, you
-
+must re-initialise the state.
-    initState ["About", "Main", "Contact"]
 -}
-initState : List String -> State
+initState : Int -> State
-initState titles =
+initState no_tabs =
-  let ripples =
+  S { tabs = Array.repeat no_tabs Ripple.model
-    titles
+    , isSmallScreen = False -- TODO
-    |> List.map (\title -> (title, Ripple.model))
+    }
-    |> Dict.fromList
-  in
-    S { tabs =
-          { titles = titles
-          , ripples = ripples
-          }
-      , isSmallScreen = False -- TODO
-      }
 
 
-hasTabs : Model -> Bool
+{-| Default configuration of the layout: Fixed header, non-fixed drawer,
-hasTabs model =
+non-fixed tabs, tabs do not ripple, tab 0 is selected, standard header
-  case (s model).tabs.titles of
+behaviour.
-    [] -> False
+-}
-    [x] -> False -- MDL spec says tabs should come in at least pairs.
+defaultLayoutModel : Model
-    _ -> True
+defaultLayoutModel =
+  { selectedTab = 0
+  , isDrawerOpen = False
+  , fixedHeader = True
+  , fixedDrawer = False
+  , fixedTabs = False
+  , rippleTabs = True
+  , mode = Standard
+  , state = initState 0
+  }
 
 
 -- ACTIONS, UPDATE
@@ -150,12 +159,12 @@ Use `SwitchTab` to request a switch of tabs. Use `ToggleDrawer` to toggle the
 opened/closed state of the drawer.
 -}
 type Action
-  = SwitchTab String
+  = SwitchTab Int
   | ToggleDrawer
   -- Private
   | SmallScreen Bool -- True means small screen
   | ScrollTab Int
-  | Ripple String Ripple.Action
+  | Ripple Int Ripple.Action
 
 
 {-| Component update.
@@ -177,19 +186,14 @@ update action model =
     ToggleDrawer ->
       { model | isDrawerOpen = not model.isDrawerOpen } |> pure
 
-    Ripple tab action' ->
+    Ripple tabIndex action' ->
       let
-        tabs = state.tabs
         (state', effect) =
-          Dict.get tab tabs.ripples
+          Array.get tabIndex (s model).tabs
           |> Maybe.map (Ripple.update action')
           |> Maybe.map (\(ripple', effect) ->
-            ({ state
+            ({ state | tabs = Array.set tabIndex ripple' (s model).tabs }
-             | tabs =
+            , Effects.map (Ripple tabIndex) effect))
-               { tabs
-               | ripples = Dict.insert tab ripple' tabs.ripples
-               }
-             }, Effects.map (Ripple tab) effect))
           |> Maybe.withDefault (pure state)
       in
         ({ model | state = S state' }, effect)
@@ -230,7 +234,6 @@ link attrs contents =
 
 
 
-
 -- MAIN VIEWS
 
 
@@ -248,40 +251,12 @@ type Mode
 --  | Waterfall
 
 
-{-| Layout view configuration. The header disappears on small devices unless
-`fixedHeader` is true. The drawer opens and closes with user interactions
-unless `fixedDrawer` is true, in which case it is permanently open on large
-screens. Tabs scroll horisontally unless `fixedTabs` is true. Tabs have a
-ripple-animation when clicked if `rippleTabs` is true. Finally, the header
-respects `mode`
- -}
-type alias Config =
-  { fixedHeader : Bool
-  , fixedDrawer : Bool
-  , fixedTabs : Bool
-  , rippleTabs : Bool
-  , mode : Mode
-  }
-
-
-{-| Default configuration of the layout: Fixed header, non-fixed drawer,
-non-fixed tabs, tabs ripple, standard header behaviour.
--}
-config : Config
-config =
-  { fixedHeader = True
-  , fixedDrawer = False
-  , fixedTabs = False
-  , rippleTabs = True
-  , mode = Standard
-  }
-
 
 type alias Addr = Signal.Address Action
 
 
-tabsView : Addr -> Config -> Model -> Html
+tabsView : Addr -> Model -> List Html -> Html
-tabsView addr config model =
+tabsView addr model tabs =
   let chevron direction offset =
         div
           [ classList
@@ -300,24 +275,23 @@ tabsView addr config model =
       , div
           [ classList
               [ ("mdl-layout__tab-bar", True)
-              , ("mdl-js-ripple-effect", config.rippleTabs)
+              , ("mdl-js-ripple-effect", model.rippleTabs)
-              , ("mds-js-ripple-effect--ignore-events", config.rippleTabs)
+              , ("mds-js-ripple-effect--ignore-events", model.rippleTabs)
               ]
           ]
-          (let (S state) = model.state in
+          (tabs |> mapWithIndex (\tabIndex tab ->
-           state.tabs.titles |> List.map (\tab ->
             filter a
               [ classList
                   [ ("mdl-layout__tab", True)
-                  , ("is-active", tab == model.selectedTab)
+                  , ("is-active", tabIndex == model.selectedTab)
                   ]
-              , onClick addr (SwitchTab tab)
+              , onClick addr (SwitchTab tabIndex)
               ]
-              [ text tab |> Just
+              [ Just tab
-              , if config.rippleTabs then
+              , if model.rippleTabs then
-                  Dict.get tab state.tabs.ripples |> Maybe.map (
+                  Array.get tabIndex (s model).tabs |> Maybe.map (
                     Ripple.view
-                      (Signal.forwardTo addr (Ripple tab))
+                      (Signal.forwardTo addr (Ripple tabIndex))
                       [ class "mdl-layout__tab-ripple-container" ]
                   )
                 else
@@ -328,12 +302,12 @@ tabsView addr config model =
       ]
 
 
-headerView : Config -> Model -> (Maybe Html, Maybe (List Html), Maybe Html) ->  Html
+headerView : Model -> (Maybe Html, Maybe (List Html), Maybe Html) ->  Html
-headerView config model (drawerButton, row, tabs) =
+headerView model (drawerButton, row, tabs) =
   filter Html.header
     [ classList
         [ ("mdl-layout__header", True)
-        , ("is-casting-shadow", config.mode == Standard)
+        , ("is-casting-shadow", model.mode == Standard)
         ]
     ]
     [ drawerButton
@@ -342,15 +316,6 @@ headerView config model (drawerButton, row, tabs) =
     ]
 
 
-{-}
-visibilityClasses : Visibility -> List (String, Bool)
-visibilityClasses v =
-  [ ("mdl-layout--large-screen-only", v == LargeScreenOnly)
-  , ("mdl-layout--small-screen-only", v == SmallScreenOnly)
-  ]
--}
-
-
 drawerButton : Addr -> Html
 drawerButton addr =
   div
@@ -383,39 +348,50 @@ drawerView addr model elems =
     elems
 
 
-type alias Content = (Maybe (List Html), Maybe (List Html))
+{-| Content of the layout only (contents of main pane is set elsewhere). Every
+part is optional. If `header` is `Nothing`, tabs will not be shown.
 
-
+The `header` and `drawer` contains the contents of the header row and drawer,
-{-| Main layout view. The `Content` argument contains the body
+respectively.  Use `spacer`, `title`, `nav`, and
-of the drawer and header (or `Nothing`). The final argument is
+`link`, as well as regular Html to construct these. The `tabs` contains
-the contents of the main pane.
+the title of each tab.
 -}
-view : Addr -> Config -> Model -> Content -> List Html -> Html
+type alias Contents =
-view addr config model (drawer, header) main =
+  { header : Maybe (List Html)
-  let (contentDrawerButton, headerDrawerButton) =
+  , drawer : Maybe (List Html)
-        case (drawer, header, config.fixedHeader) of
+  , tabs : Maybe (List Html)
-          (Just _, Just _, True) ->
+  , main : List Html
-            -- Drawer with fixedHeader: Add the button to the header
+  }
-             (Nothing, Just <| drawerButton addr)
 
-          (Just _, _, _) ->
-            -- Drawer, no or non-fixed header: Add the button before contents.
-             (Just <| drawerButton addr, Nothing)
 
-          _ ->
+{-| Main layout view.
-            -- No drawer: no button.
+-}
-             (Nothing, Nothing)
+view : Addr -> Model -> Contents -> Html
-      mode =
+view addr model { drawer, header, tabs, main } =
-        case config.mode of
+  let
-          Standard  -> ""
+    (contentDrawerButton, headerDrawerButton) =
-          Scroll    -> "mdl-layout__header-scroll"
+      case (drawer, header, model.fixedHeader) of
-    --      Waterfall -> "mdl-layout__header-waterfall"
+        (Just _, Just _, True) ->
-          Seamed    -> "mdl-layout__header-seamed"
+          -- Drawer with fixedHeader: Add the button to the header
-      tabs =
+           (Nothing, Just <| drawerButton addr)
-        if hasTabs model then
+
-          tabsView addr config model |> Just
+        (Just _, _, _) ->
-        else
+          -- Drawer, no or non-fixed header: Add the button before contents.
-          Nothing
+           (Just <| drawerButton addr, Nothing)
+
+        _ ->
+          -- No drawer: no button.
+           (Nothing, Nothing)
+
+    mode =
+      case model.mode of
+        Standard  -> ""
+        Scroll    -> "mdl-layout__header-scroll"
+        -- Waterfall -> "mdl-layout__header-waterfall"
+        Seamed    -> "mdl-layout__header-seamed"
+
+    hasHeader =
+      tabs /= Nothing || header /= Nothing
   in
   div
     [ class "mdl-layout__container" ]
@@ -423,16 +399,19 @@ view addr config model (drawer, header) main =
         [ classList
             [ ("mdl-layout", True)
             , ("is-upgraded", True)
-            , ("is-small-screen", let (S state) = model.state in state.isSmallScreen)
+            , ("is-small-screen", (s model).isSmallScreen)
             , ("has-drawer", drawer /= Nothing)
-            , ("has-tabs", hasTabs model)
+            , ("has-tabs", tabs /= Nothing)
             , ("mdl-js-layout", True)
-            , ("mdl-layout--fixed-drawer", config.fixedDrawer && drawer /= Nothing)
+            , ("mdl-layout--fixed-drawer", model.fixedDrawer && drawer /= Nothing)
-            , ("mdl-layout--fixed-header", config.fixedHeader && header /= Nothing)
+            , ("mdl-layout--fixed-header", model.fixedHeader && hasHeader)
-            , ("mdl-layout--fixed-tabs", config.fixedTabs && hasTabs model)
+            , ("mdl-layout--fixed-tabs", model.fixedTabs && tabs /= Nothing)
             ]
         ]
-        [ header |> Maybe.map (\_ -> headerView config model (headerDrawerButton, header, tabs))
+        [ if hasHeader then
+            Just <| headerView model (headerDrawerButton, header, Maybe.map (tabsView addr model) tabs)
+          else
+            Nothing
         , drawer |> Maybe.map (\_ -> obfuscator addr model)
         , drawer |> Maybe.map (drawerView addr model)
         , contentDrawerButton

components.html

@@ -14,20 +14,8 @@
   </head>
   <body>
     <!-- elm -->
-    <script src="built/elm.js"></script>
+    <script src="elm.js"></script>
     <script>
-
+      app = Elm.fullscreen(Elm.Main);
-      var isSmallScreenQuery = window.matchMedia('(max-width: 1024px)');
-
-      app = Elm.fullscreen(Elm.Main,
-        { isSmallScreenSignal : isSmallScreenQuery.matches
-        }
-      );
-
-      /* Connect Material/isSmallScreenSignal. */
-      isSmallScreenQuery.addListener(function () {
-        app.ports.isSmallScreenSignal.send(isSmallScreenQuery.matches);
-      });
-
     </script>
   </body>

elm-package.json

@@ -7,6 +7,7 @@
         "."
     ],
     "exposed-modules": [
+        "Material",
         "Material.Icon",
         "Material.Button",
         "Material.Textfield",