Initial commit.

.gitignore

@@ -0,0 +1,2 @@
+elm-stuff
+.*.sw?

Buttons.elm

@@ -0,0 +1,142 @@
+module Buttons where
+
+import Dict
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Effects
+
+import Material.Button as Button exposing (Appearance(..), Coloring(..))
+import Material.Grid as Grid
+import Material.Icon as Icon
+
+
+-- MODEL
+
+
+type alias Index = (Int, Int)
+
+
+tabulate' : Int -> List a -> List (Int, a)
+tabulate' i ys =
+  case ys of
+    [] -> []
+    y :: ys -> (i, y) :: tabulate' (i+1) ys
+
+
+tabulate : List a -> List (Int, a)
+tabulate = tabulate' 0
+
+
+row : Appearance -> Bool -> List (Int, (Bool, Button.Config))
+row appearance ripple =
+  [ Plain, Colored, Primary, Accent ]
+  |> List.map (\c -> (ripple, { coloring = c, appearance = appearance }))
+  |> tabulate
+
+
+buttons : List (List (Index, (Bool, Button.Config)))
+buttons =
+  [Flat, Raised, FAB, MiniFAB, Icon]
+  |> List.concatMap (\a -> [row a False, row a True])
+  |> tabulate
+  |> List.map (\(i, row) -> List.map (\(j, x) -> ((i,j), x)) row)
+
+
+model : Model
+model =
+  { clicked = ""
+  , buttons =
+      buttons
+      |> List.concatMap (List.map <| \(idx, (ripple, _)) -> (idx, Button.model ripple))
+      |> Dict.fromList
+  }
+
+
+-- ACTION, UPDATE
+
+
+type Action = Action Index Button.Action
+
+
+type alias Model =
+  { clicked : String
+  , buttons : Dict.Dict Index Button.Model
+  }
+
+
+update : Action -> Model -> (Model, Effects.Effects Action)
+update (Action idx action) model =
+  Dict.get idx model.buttons
+  |> Maybe.map (\m0 ->
+    let
+      (m1, e) = Button.update action m0
+    in
+      ({ model | buttons = Dict.insert idx  m1 model.buttons }, Effects.map (Action idx) e)
+  )
+  |> Maybe.withDefault (model, Effects.none)
+
+
+-- 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)) ->
+      let model' =
+        Dict.get idx model.buttons |> Maybe.withDefault (Button.model False)
+      in
+        Grid.cell
+          [ Grid.col Grid.All 3]
+          [ div
+              [ style
+                [ ("text-align", "center")
+                , ("margin-top", "1em")
+                , ("margin-bottom", "1em")
+                ]
+              ]
+              [ Button.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 ]
+              ]
+          ]
+    )
+  )
+  |> Grid.grid 

Demo.elm

@@ -0,0 +1,232 @@
+import StartApp
+import Html exposing (..)
+import Html.Attributes exposing (href, class, style)
+import Signal exposing (Signal)
+import Effects exposing (..)
+import Task
+import Signal
+import Task exposing (Task)
+import Dict exposing (Dict)
+
+import Material.Textfield as Textfield
+import Material.Grid as Grid exposing (Device(..))
+import Material.Layout as Layout
+
+import Buttons
+
+
+-- MODEL
+
+
+type alias Model =
+  { layout : Layout.Model
+  , buttons : Buttons.Model
+  , t0 : Textfield.Model
+  , t1 : Textfield.Model
+  , t2 : Textfield.Model
+  , t3 : Textfield.Model
+  , t4 : Textfield.Model
+  }
+
+
+layoutModel : Layout.Model
+layoutModel =
+  { selectedTab = "Buttons"
+  , isDrawerOpen = False
+  , state = Layout.initState ["Buttons", "Grid", "Textfields"]
+  }
+
+
+model : Model
+model =
+  let t0 = Textfield.model in
+  { layout = layoutModel
+  , buttons = Buttons.model
+  , t0 = t0
+  , 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"
+           }
+  }
+
+
+-- ACTION, UPDATE
+
+
+type Action
+  = LayoutAction Layout.Action
+  | ButtonsAction Buttons.Action
+  | T0 Textfield.Action
+  | T1 Textfield.Action
+  | T2 Textfield.Action
+  | T3 Textfield.Action
+  | T4 Textfield.Action
+
+
+update : Action -> Model -> (Model, Effects.Effects Action)
+update action model =
+  case action of
+    LayoutAction a ->
+      let
+        (l, e) = Layout.update a model.layout
+      in
+        ({ model | layout = l }, Effects.map LayoutAction e)
+
+    ButtonsAction a ->
+      let (b, e) = Buttons.update a model.buttons
+      in
+        ({ model | buttons = b }, Effects.map ButtonsAction e)
+
+    T0 a ->
+      ({ model | t0 = Textfield.update a model.t0 }, 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
+
+
+type alias Addr = Signal.Address Action
+
+
+layoutConfig : Layout.Config
+layoutConfig = Layout.defaultConfig
+
+
+drawer : List Html
+drawer =
+  [ Layout.title "elm-mdl"
+  , Layout.navigation
+    [ Layout.link [] [text "Dead Link 1"]
+    , Layout.link [] [text "Dead Link 2"]
+    , Layout.link [] [text "Dead Link 3"]
+    ]
+  ]
+
+
+header : List Html
+header =
+  [ Layout.title "elm-mdl"
+  , Layout.spacer
+  , Layout.navigation
+    [ Layout.link
+      [ href "https://www.getmdl.io/components/index.html" ]
+      [ text "MDL" ]
+    ]
+  ]
+
+
+tabGrid : 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", tabButtons)
+    , ("Textfields", tabTextfields)
+    , ("Grid", tabGrid)
+    ]
+
+
+view : Signal.Address Action -> Model -> Html
+view addr model =
+  let contents =
+        Dict.get model.layout.selectedTab tabs
+        |> Maybe.withDefault tabGrid
+
+      top =
+        div
+          [ style
+            [ ("margin", "auto")
+            , ("width", "90%")
+            ]
+          ]
+          <| contents addr model
+
+      addr' = Signal.forwardTo addr LayoutAction
+
+  in
+    Layout.view addr'
+      layoutConfig model.layout
+      (Just drawer, Just header)
+      [ top ]
+
+
+init : (Model, Effects.Effects Action)
+init = (model, Effects.none)
+
+
+inputs : List (Signal.Signal Action)
+inputs =
+  [ Layout.setupSizeChangeSignal LayoutAction
+  ]
+
+
+app : StartApp.App Model
+app =
+    StartApp.start
+      { init = init
+      , view = view
+      , update = update
+      , inputs = inputs
+      }
+
+main : Signal Html
+main =
+    app.html
+
+
+-- PORTS
+
+
+port tasks : Signal (Task.Task Never ())
+port tasks =
+    app.tasks

Makefile

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

Material/Aux.elm

@@ -0,0 +1,97 @@
+module Material.Aux where
+
+import Html
+import Html.Attributes
+import Html.Events
+import Json.Decode as Json exposing ((:=))
+import Effects exposing (Effects)
+import Native.Material
+
+filter : (a -> List b -> c) -> a -> List (Maybe b) -> c
+filter elem attr html =
+  elem attr (List.filterMap (\x -> x) html)
+
+
+onClick' : Signal.Address a -> a -> Html.Attribute
+onClick' address x =
+  Html.Events.onWithOptions
+    "click"
+    { stopPropagation = True
+    , preventDefault = True
+    }
+    Json.value
+    (\_ -> Signal.message address x)
+
+
+effect : Effects b -> a -> (a, Effects b)
+effect e x = (x, e)
+
+
+pure : a -> (a, Effects b)
+pure = effect Effects.none
+
+
+clip : comparable -> comparable -> comparable -> comparable
+clip lower upper k = Basics.max lower (Basics.min k upper)
+
+
+type alias Rectangle =
+  { width : Float
+  , height : Float
+  , top : Float
+  , right : Float
+  , bottom : Float
+  , left : Float
+  }
+
+
+rectangleDecoder : Json.Decoder Rectangle
+rectangleDecoder =
+  "boundingClientRect" :=
+    Json.object6 Rectangle
+      ("width" := Json.float)
+      ("height" := Json.float)
+      ("top" := Json.float)
+      ("right" := Json.float)
+      ("bottom" := Json.float)
+      ("left" := Json.float)
+
+
+{-| Options for an event listener. If `stopPropagation` is true, it means the
+event stops traveling through the DOM so it will not trigger any other event
+listeners. If `preventDefault` is true, any built-in browser behavior related
+to the event is prevented. For example, this is used with touch events when you
+want to treat them as gestures of your own, not as scrolls. If `withGeometry`
+is true, the event object will be augmented with geometry information for the
+events target node; use `geometryDecoder` to decode.
+-}
+type alias Options =
+    { stopPropagation : Bool
+    , preventDefault : Bool
+    , withGeometry : Bool
+    }
+
+
+{-| Everything is `False` by default.
+    defaultOptions =
+        { stopPropagation = False
+        , preventDefault = False
+        , withGeometry = False
+        }
+-}
+defaultOptions : Options
+defaultOptions =
+    { stopPropagation = False
+    , preventDefault = False
+    , withGeometry = False
+    }
+
+
+on : String -> Options -> Json.Decoder a -> (a -> Signal.Message) -> Html.Attribute
+on =
+  Native.Material.on
+
+
+blurOn : String -> Html.Attribute
+blurOn evt =
+  Html.Attributes.attribute ("on" ++ evt) <| "this.blur()"

Material/Button.elm

@@ -0,0 +1,162 @@
+module Material.Button
+  ( model, update
+  , Kind(..), Coloring(..), Config
+  , view
+  ) where
+
+{-| From the [Material Design Lite documentation](http://www.getmdl.io/components/#buttons-section):
+
+> The Material Design Lite (MDL) button component is an enhanced version of the
+> standard HTML `<button>` element. A button consists of text and/or an image that
+> clearly communicates what action will occur when the user clicks or touches it.
+> The MDL button component provides various types of buttons, and allows you to
+> add both display and click effects.
+> 
+> Buttons are a ubiquitous feature of most user interfaces, regardless of a
+> site's content or function. Their design and use is therefore an important
+> factor in the overall user experience. See the button component's Material
+> Design specifications page for details.
+> 
+> The available button display types are flat (default), raised, fab, mini-fab,
+> and icon; any of these types may be plain (light gray) or colored, and may be
+> initially or programmatically disabled. The fab, mini-fab, and icon button
+> types typically use a small image as their caption rather than text.
+
+See also the
+[Material Design Specification]([https://www.google.com/design/spec/components/buttons.html).
+
+# Component
+@docs model, update
+
+# View
+@docs Kind, Coloring, Config, view
+
+-}
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Effects exposing (Effects)
+
+import Material.Aux as Aux
+import Material.Ripple as Ripple
+
+{-| MDL button.
+-}
+
+
+-- MODEL
+
+
+{-| Model of the button. Determines if the button will ripple when clicked;
+use `initState` to initalise it.
+-}
+type Model = S (Maybe Ripple.Model)
+
+
+{-| Model initialiser. Call with `True` if the button should ripple when
+clicked, `False` otherwise.
+-}
+model : Bool -> Model
+model shouldRipple =
+  if shouldRipple then
+    S (Just Ripple.model)
+  else
+    S Nothing
+
+
+-- ACTION, UPDATE
+
+
+{-| Component action. This exists exclusively to support ripple-animations.
+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
+
+
+{-| Component update.
+-}
+update : Action -> Model -> (Model, Effects Action)
+update action model =
+  case model of
+    S (Just ripple) ->
+      let (ripple', e) = Ripple.update action ripple
+      in
+        (S (Just ripple'), e)
+    S Nothing ->
+      (model, Effects.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
+color.
+-}
+type Coloring
+  = Plain
+  | Colored
+  | Primary
+  | Accent
+
+
+{-| Button configuration: Its `Kind` and `Coloring`.
+-}
+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
+      [ ("mdl-button", True)
+      , ("mdl-js-button", True)
+      , ("mdl-js-ripple-effect", model /= S Nothing)
+      -- Color effect.
+      , ("mdl-button--colored", config.coloring == Colored)
+      , ("mdl-button--primary", config.coloring == Primary)
+      , ("mdl-button--accent",  config.coloring == Accent)
+      -- Kind.
+      , ("mdl-button--raised",   config.kind == Raised)
+      , ("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 "mouseleave"
+      :: attrs)
+     (case model of
+        S (Just ripple) ->
+          Ripple.view
+            addr
+            [ class "mdl-button__ripple-container"
+            , Aux.blurOn "mouseup" ]
+            ripple
+          :: html
+        _ -> html)

Material/Card.elm

@@ -0,0 +1,14 @@
+module Card
+  {-}
+  (
+
+  )-} where
+
+type Shadow
+  = None
+  | Foo
+  {-}
+card shadow attr elem =
+  div
+    (class "")
+    -}

Material/Grid.elm

@@ -0,0 +1,155 @@
+module Material.Grid
+  ( grid
+  , size
+  , offset
+  , align
+  , cell
+  , Device(..)
+  , Align(..)
+  ) where
+
+{-| 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
+> required to correctly display blocks of content in a variety of display
+> conditions.
+> 
+> The MDL grid is defined and enclosed by a container element. A grid has 12
+> columns in the desktop screen size, 8 in the tablet size, and 4 in the phone
+> size, each size having predefined margins and gutters. Cells are laid out
+> sequentially in a row, in the order they are defined, with some exceptions:
+> 
+>   - If a cell doesn't fit in the row in one of the screen sizes, it flows
+>     into the following line.
+>   - If a cell has a specified column size equal to or larger than the number
+>     of columns for the current screen size, it takes up the entirety of its
+>     row."
+
+Example use:
+
+    import Material.Grid exposing (grid, cell, size, Device(..))
+
+    grid
+      [ cell [ size All 4 ]
+          [ h4 [] [text "Cell 1"]
+          ]
+      , cell [ offset All 2, size All 4 ]
+          [ h4 [] [text "Cell 2"]
+          , p [] [text "This cell is offset by 2"]
+          ]
+      , cell [ size All 6 ]
+          [ h4 [] [text "Cell 3"]
+          ]
+      , cell [ size Tablet 6, size Desktop 12, size Phone 2 ]
+          [ h4 [] [text "Cell 4"]
+          , p [] [text "Size varies with device"]
+          ]
+      ]
+
+# Views
+@docs grid, cell
+
+# Cell configuration
+@docs Device, size, offset, Align, align
+-}
+
+
+{- TODO.
+
+1. From MDL docs:
+
+  "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
+3. mdl-cell--stretch
+4. mdl-cell--hide-*
+-}
+
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import String
+import Material.Aux exposing (clip)
+
+
+{-| Construct a grid. Use `cell` some number of times to construct the argument list.
+-}
+grid : List Html -> Html
+grid elms =
+  div [class "mdl-grid"] elms
+
+
+{-| Device specifiers, used with `size` and `offset`.
+-}
+type Device = All | Desktop | Tablet | Phone
+
+
+{- Cell configuration. Construct with `size`, `offset`, and `align`.
+-}
+type CellConfig = C String
+
+
+suffix : Device -> String
+suffix device =
+  case device of
+    All -> ""
+    Desktop -> "-desktop"
+    Tablet -> "-tablet"
+    Phone -> "-phone"
+
+
+{-| Specify cell size. On devices of type `Device`, the
+cell being specified spans `Int` columns.
+-}
+size : Device -> Int -> CellConfig
+size device k =
+  let c =
+    case device of
+      All -> clip 1 12 k
+      Desktop -> clip 1 12 k
+      Tablet -> clip 1 8 k
+      Phone -> clip 1 4 k
+  in
+    "mdl-cell--" ++ toString c ++ "-col" ++ suffix device |> C
+
+
+{-| Specify cell offset, i.e., empty number of empty cells before the present
+one. On devices of type `Device`, leave `Int` columns blank before the present
+one begins.
+-}
+offset : Device -> Int -> CellConfig
+offset device k =
+  let c =
+    case device of
+      All -> clip 1 11 k
+      Desktop -> clip 1 11 k
+      Tablet -> clip 1 7 k
+      Phone -> clip 1 3 k
+  in
+    "mdl-cell--" ++ toString c ++ "-offset" ++ suffix device |> C
+
+
+{-| Vertical alignment of cells; use with `align`.
+-}
+type Align = Top | Middle | Bottom
+
+
+{-| Specify vertical cell alignment. See `Align`.
+-}
+align : Align -> CellConfig
+align a =
+  C <| case a of
+    Top -> "mdl-cell--top"
+    Middle -> "mdl-cell--middle"
+    Bottom -> "mdl-cell--bottom"
+
+
+{-| 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 extents elms =
+  div [class <| String.join " " ("mdl-cell" :: (List.map (\(C s) -> s) extents))] elms

Material/Icon.elm

@@ -0,0 +1,57 @@
+module Material.Icon
+  ( Size(..)
+  , view
+  , i
+  ) where
+
+{-| Convenience functions for producing Material Design Icons. Refer to
+[the Material Design Icons page](https://google.github.io/material-design-icons),
+or skip straight to the [Material Icons Library](https://design.google.com/icons/).
+
+This implementation assumes that you have
+
+    <link href="https://fonts.googleapis.com/icon?family=Material+Icons"
+      rel="stylesheet">
+
+or an equivalent means of loading the icons in your HTML header.
+
+@docs i, Size, view
+-}
+
+
+import Html exposing (i, text, Html, Attribute)
+import Html.Attributes exposing (class)
+
+
+{-| Size of an icon. Constructors indicate their pixel size, i.e.,
+`S18` is 18px. The constructor `S` gives you the default size, 24px.
+-}
+type Size
+  = S18 | S24 | S36 | S48 | S
+
+
+{-| View function for icons. Supply the
+(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.
+-}
+view : String -> Size -> List Attribute -> Html
+view name size attrs =
+  let
+    sz =
+      case size of
+        S18 -> " md-18"
+        S24 -> " md-24"
+        S36 -> " md-36"
+        S48 -> " md-48"
+        S -> ""
+  in
+    Html.i (class ("material-icons" ++ sz) :: attrs) [text name]
+
+
+{-| 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 : String -> Html
+i name = view name S []

Material/Infix.elm

@@ -0,0 +1,12 @@
+module Material.Infix where
+
+import Maybe
+
+(|?>): Maybe a -> (a -> b) -> Maybe b
+(|?>) x f = Maybe.map f x
+
+(|??>) : Maybe a -> (a -> Maybe b) -> Maybe b
+(|??>) = Maybe.andThen
+
+(|?) : Maybe a -> a -> a
+(|?) x y = Maybe.withDefault y x

Material/Layout.elm

@@ -0,0 +1,441 @@
+module Material.Layout
+  ( setupSizeChangeSignal
+  , Model, initState
+  , Action(SwitchTab, ToggleDrawer), update
+  , spacer, title, navigation, link
+  , Mode, Config, config, view
+  ) where
+
+{-| From the 
+[Material Design Lite documentation](https://www.getmdl.io/components/index.html#layout-section):
+    
+> The Material Design Lite (MDL) layout component is a comprehensive approach to
+> page layout that uses MDL development tenets, allows for efficient use of MDL
+> components, and automatically adapts to different browsers, screen sizes, and
+> devices.
+> 
+> Appropriate and accessible layout is a critical feature of all user interfaces,
+> regardless of a site's content or function. Page design and presentation is
+> therefore an important factor in the overall user experience. See the layout
+> component's 
+> [Material Design specifications page](https://www.google.com/design/spec/layout/structure.html#structure-system-bars)
+> for details.  
+>
+> Use of MDL layout principles simplifies the creation of scalable pages by
+> providing reusable components and encourages consistency across environments by
+> establishing recognizable visual elements, adhering to logical structural
+> grids, and maintaining appropriate spacing across multiple platforms and screen
+> sizes. MDL layout is extremely powerful and dynamic, allowing for great
+> consistency in outward appearance and behavior while maintaining development
+> flexibility and ease of use.
+
+# Model & Actions
+@docs Model, initState, Action, update
+
+# Sub-components
+@docs spacer, title, navigation, link
+
+# View
+@docs Mode, Config, config, view
+
+# Setup
+@docs setupSizeChangeSignal
+-}
+
+
+import Dict exposing (Dict)
+import Maybe exposing (andThen, map)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (onClick)
+import Effects exposing (Effects)
+import Window
+
+import Material.Aux exposing (..)
+import Material.Ripple as Ripple
+import Material.Icon as Icon
+
+
+-- SETUP
+
+
+{-| Setup signal for registering changes in display size. Use with StartApp
+like so, supposing you have a `LayoutAction` encapsulating actions of the
+layout:
+
+    inputs : List (Signal.Signal Action)
+    inputs =
+      [ Layout.setupSizeChangeSignal LayoutAction
+      ]
+-}
+setupSizeChangeSignal : (Action -> a) -> Signal a
+setupSizeChangeSignal f =
+  Window.width
+  |> Signal.map ((>) 1024)
+  |> Signal.dropRepeats
+  |> Signal.map (SmallScreen >> f)
+
+
+-- MODEL
+
+
+type alias TabState =
+  { titles : List String
+  , ripples : Dict String Ripple.Model
+  }
+
+type alias State' =
+  { tabs : TabState
+  , isSmallScreen : Bool
+  }
+
+
+{-| Component private state. Construct with `initState`.
+-}
+type State = S State'
+
+
+s : Model -> State'
+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
+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
+names.)
+-}
+type alias Model =
+  { selectedTab : String
+  , isDrawerOpen : Bool
+  , state : State
+  }
+
+
+{-| Initialiser for Layout component state. Supply a list of tab titles
+or the empty list if your layout should have no tabs. E.g.,
+
+    initState ["About", "Main", "Contact"]
+-}
+initState : List String -> State
+initState titles =
+  let ripples =
+    titles
+    |> List.map (\title -> (title, Ripple.model))
+    |> Dict.fromList
+  in
+    S { tabs =
+          { titles = titles
+          , ripples = ripples
+          }
+      , isSmallScreen = False -- TODO
+      }
+
+
+hasTabs : Model -> Bool
+hasTabs model =
+  case (s model).tabs.titles of
+    [] -> False
+    [x] -> False -- MDL spec says tabs should come in at least pairs.
+    _ -> True
+
+
+-- ACTIONS, UPDATE
+
+
+{-| Component actions. 
+Use `SwitchTab` to request a switch of tabs. Use `ToggleDrawer` to toggle the
+opened/closed state of the drawer.
+-}
+type Action
+  = SwitchTab String
+  | ToggleDrawer
+  -- Private
+  | SmallScreen Bool -- True means small screen
+  | ScrollTab Int
+  | Ripple String Ripple.Action
+
+
+{-| Component update.
+-}
+update : Action -> Model -> (Model, Effects Action)
+update action model =
+  let (S state) = model.state in
+  case action of
+    SmallScreen isSmall ->
+      { model
+      | state = S ({ state | isSmallScreen = isSmall })
+      , isDrawerOpen = not isSmall && model.isDrawerOpen
+      }
+      |> pure
+
+    SwitchTab tab ->
+      { model | selectedTab = tab } |> pure
+
+    ToggleDrawer ->
+      { model | isDrawerOpen = not model.isDrawerOpen } |> pure
+
+    Ripple tab action' ->
+      let
+        tabs = state.tabs
+        (state', effect) =
+          Dict.get tab tabs.ripples
+          |> Maybe.map (Ripple.update action')
+          |> Maybe.map (\(ripple', effect) ->
+            ({ state
+             | tabs =
+               { tabs
+               | ripples = Dict.insert tab ripple' tabs.ripples
+               }
+             }, Effects.map (Ripple tab) effect))
+          |> Maybe.withDefault (pure state)
+      in
+        ({ model | state = S state' }, effect)
+
+    ScrollTab tab ->
+      (model, Effects.none) -- TODO
+
+
+
+-- AUXILIARY VIEWS
+
+
+
+{-| Push subsequent elements in header row or drawer column to the right/bottom.
+-}
+spacer : Html
+spacer = div [class "mdl-layout-spacer"] []
+
+
+{-| Title in header row or drawer.
+-}
+title : String -> Html
+title t = span [class "mdl-layout__title"] [text t]
+
+
+{-| Container for links.
+-}
+navigation : List Html -> Html
+navigation contents =
+  nav [class "mdl-navigation"] contents
+
+
+{-| Link.
+-}
+link : List Attribute -> List Html -> Html
+link attrs contents =
+  a (class "mdl-navigation__link" :: attrs) contents
+
+
+
+
+-- MAIN VIEWS
+
+
+
+{-| Mode for the header.
+- A `Standard` header casts shadow, is permanently affixed to the top of the screen.
+- A `Seamed` header does not cast shadow, is permanently affixed to the top of the
+  screen.
+- A `Scroll`'ing header scrolls with contents.
+-}
+type Mode
+  = Standard
+  | Seamed
+  | Scroll
+--  | 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 config model =
+  let chevron direction offset =
+        div
+          [ classList
+              [ ("mdl-layout__tab-bar-button", True)
+              , ("mdl-layout__tab-bar-" ++ direction ++ "-button", True)
+              ]
+          ]
+          [ Icon.view ("chevron_" ++ direction) Icon.S
+              [onClick addr (ScrollTab offset)]
+                -- TODO: Scroll event
+          ]
+  in
+    div
+      [ class "mdl-layout__tab-bar-container"]
+      [ chevron "left" -100
+      , div
+          [ classList
+              [ ("mdl-layout__tab-bar", True)
+              , ("mdl-js-ripple-effect", config.rippleTabs)
+              , ("mds-js-ripple-effect--ignore-events", config.rippleTabs)
+              ]
+          ]
+          (let (S state) = model.state in
+           state.tabs.titles |> List.map (\tab ->
+            filter a
+              [ classList
+                  [ ("mdl-layout__tab", True)
+                  , ("is-active", tab == model.selectedTab)
+                  ]
+              , onClick addr (SwitchTab tab)
+              ]
+              [ text tab |> Just
+              , if config.rippleTabs then
+                  Dict.get tab state.tabs.ripples |> Maybe.map (
+                    Ripple.view
+                      (Signal.forwardTo addr (Ripple tab))
+                      [ class "mdl-layout__tab-ripple-container" ]
+                  )
+                else
+                  Nothing
+              ]
+           ))
+      , chevron "right" 100
+      ]
+
+
+headerView : Config -> Model -> (Maybe Html, Maybe (List Html), Maybe Html) ->  Html
+headerView config model (drawerButton, row, tabs) =
+  filter Html.header
+    [ classList
+        [ ("mdl-layout__header", True)
+        , ("is-casting-shadow", config.mode == Standard)
+        ]
+    ]
+    [ drawerButton
+    , row |> Maybe.map (div [ class "mdl-layout__header-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
+    [ class "mdl-layout__drawer-button"
+    , onClick addr ToggleDrawer
+    ]
+    [ Icon.i "menu" ]
+
+
+obfuscator : Addr -> Model -> Html
+obfuscator addr model =
+  div
+    [ classList
+        [ ("mdl-layout__obfuscator", True)
+        , ("is-visible", model.isDrawerOpen)
+        ]
+    , onClick addr ToggleDrawer
+    ]
+    []
+
+
+drawerView : Addr -> Model -> List Html -> Html
+drawerView addr model elems =
+  div
+    [ classList
+        [ ("mdl-layout__drawer", True)
+        , ("is-visible", model.isDrawerOpen)
+        ]
+    ]
+    elems
+
+
+type alias Content = (Maybe (List Html), Maybe (List Html))
+
+
+{-| Main layout view. The `Content` argument contains the body
+of the drawer and header (or `Nothing`). The final argument is
+the contents of the main pane.
+-}
+view : Addr -> Config -> Model -> Content -> List Html -> Html
+view addr config model (drawer, header) main =
+  let (contentDrawerButton, headerDrawerButton) =
+        case (drawer, header, config.fixedHeader) of
+          (Just _, Just _, True) ->
+            -- 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)
+
+          _ ->
+            -- No drawer: no button.
+             (Nothing, Nothing)
+      mode =
+        case config.mode of
+          Standard  -> ""
+          Scroll    -> "mdl-layout__header-scroll"
+    --      Waterfall -> "mdl-layout__header-waterfall"
+          Seamed    -> "mdl-layout__header-seamed"
+      tabs =
+        if hasTabs model then
+          tabsView addr config model |> Just
+        else
+          Nothing
+  in
+  div
+    [ class "mdl-layout__container" ]
+    [ filter div
+        [ classList
+            [ ("mdl-layout", True)
+            , ("is-upgraded", True)
+            , ("is-small-screen", let (S state) = model.state in state.isSmallScreen)
+            , ("has-drawer", drawer /= Nothing)
+            , ("has-tabs", hasTabs model)
+            , ("mdl-js-layout", True)
+            , ("mdl-layout--fixed-drawer", config.fixedDrawer && drawer /= Nothing)
+            , ("mdl-layout--fixed-header", config.fixedHeader && header /= Nothing)
+            , ("mdl-layout--fixed-tabs", config.fixedTabs && hasTabs model)
+            ]
+        ]
+        [ header |> Maybe.map (\_ -> headerView config model (headerDrawerButton, header, tabs))
+        , drawer |> Maybe.map (\_ -> obfuscator addr model)
+        , drawer |> Maybe.map (drawerView addr model)
+        , contentDrawerButton
+        , Just <| main' [ class "mdl-layout__content" ] main
+        ]
+    ]

Material/Ripple.elm

@@ -0,0 +1,184 @@
+module Material.Ripple where
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events
+import Json.Decode as Json exposing ((:=), at)
+import Effects exposing (Effects, tick, none)
+
+import Material.Aux exposing (Rectangle, rectangleDecoder, effect)
+
+
+-- MODEL
+
+
+type alias Metrics =
+  { rect : Rectangle
+  , x : Float
+  , y : Float
+  }
+
+
+type Animation
+  = Frame Int -- There is only 0 and 1.
+  | Inert
+
+
+type alias Model =
+  { animation : Animation
+  , metrics : Maybe Metrics
+  }
+
+
+model : Model
+model =
+  { animation = Inert
+  , metrics = Nothing
+  }
+
+
+-- ACTION, UPDATE
+
+
+type alias Geometry =
+  { rect : Rectangle
+  , clientX : Maybe Float
+  , clientY : Maybe Float
+  , touchX : Maybe Float
+  , touchY : Maybe Float
+  }
+
+
+geometryDecoder : Json.Decoder Geometry
+geometryDecoder =
+  Json.object5 Geometry
+    rectangleDecoder
+    (Json.maybe ("clientX" := Json.float))
+    (Json.maybe ("clientY" := Json.float))
+    (Json.maybe (at ["touches", "0", "clientX"] Json.float))
+    (Json.maybe (at ["touches", "0", "clientY"] Json.float))
+
+
+computeMetrics : Geometry -> Metrics
+computeMetrics g =
+  let
+    rect = g.rect
+    set x y = (x - rect.left, y - rect.top)
+    (x,y) = case (g.clientX, g.clientY, g.touchX, g.touchY) of
+      (Just 0.0, Just 0.0, _, _) ->
+        (rect.width / 2.0, rect.height / 2.0)
+
+      (Just x, Just y, _, _) ->
+        set x y
+
+      (_, _, Just x, Just y) ->
+        set x y
+
+      _ ->
+        Debug.crash "Impossible value from geometryDecoder"
+  in
+    { rect = rect
+    , x = x
+    , y = y
+    }
+
+
+type Action
+  = Down Geometry
+  | Up
+  | Tick
+
+
+update : Action -> Model -> (Model, Effects Action)
+update action model =
+  case action of
+    Down geometry ->
+      { model
+      | animation = Frame 0
+      , metrics = computeMetrics geometry |> Just
+      }
+      |> effect (tick <| \_ -> Tick)
+
+    Up ->
+      { model
+      | animation = Inert
+      }
+      |> effect none
+
+    Tick ->
+      { model
+      | animation = Frame 1
+      }
+      |> effect none
+
+
+
+-- VIEW
+
+
+downOn : String -> Signal.Address Action -> Attribute
+downOn name addr =
+  Material.Aux.on
+    name
+    { preventDefault = False
+    , stopPropagation = False
+    , withGeometry = True
+    }
+    geometryDecoder
+    (Down >> Signal.message addr)
+
+
+upOn : String -> Signal.Address Action -> Attribute
+upOn name addr =
+  Html.Events.on
+    name
+    (Json.succeed ())
+    ((\_ -> Up) >> Signal.message addr)
+
+
+styles : Metrics -> Int -> List (String, String)
+styles m frame =
+  let
+    scale = if frame == 0 then "scale(0.0001, 0.0001)" else ""
+    toPx k = (toString (round k))  ++ "px"
+    offset = "translate(" ++ toPx m.x ++ ", " ++ toPx m.y ++ ")"
+    transformString = "translate(-50%, -50%) " ++ offset ++ scale
+    r = m.rect
+    rippleSize = sqrt (r.width * r.width + r.height * r.height) * 2 + 2 |> toPx
+  in
+    [ ("width", rippleSize)
+    , ("height", rippleSize)
+    , ("-webkit-transform", transformString)
+    , ("-ms-transform", transformString)
+    , ("transform", transformString)
+    ]
+
+
+view : Signal.Address Action -> List Attribute -> Model -> Html
+view addr attrs model =
+  let
+    styling =
+      case (model.metrics, model.animation) of
+        (Just metrics, Frame frame) -> styles metrics frame
+        (Just metrics, Inert) -> styles metrics 1 -- Hack.
+        _ -> []
+  in
+    span
+      (  downOn "mousedown" addr
+      :: downOn "touchstart" addr
+      :: upOn "mouseup" addr
+      :: upOn "mouseleave" addr
+      :: upOn "touchend" addr
+      :: upOn "blur" addr
+      :: attrs
+      )
+      [ span
+          [ classList
+              [ ("mdl-ripple", True)
+              , ("is-animating", model.animation /= Frame 0)
+              , ("is-visible", model.animation /= Inert)
+              ]
+          , style styling
+          ]
+          []
+      ]

Material/Textfield.elm

@@ -0,0 +1,161 @@
+module Material.Textfield where
+
+{-| From the [Material Design Lite documentation](http://www.getmdl.io/components/#textfields-section):
+
+> The Material Design Lite (MDL) text field component is an enhanced version of
+> the standard HTML `<input type="text">` and `<input type="textarea">` elements.
+> A text field consists of a horizontal line indicating where keyboard input
+> can occur and, typically, text that clearly communicates the intended
+> contents of the text field. The MDL text field component provides various
+> types of text fields, and allows you to add both display and click effects.
+> 
+> Text fields are a common feature of most user interfaces, regardless of a
+> site's content or function. Their design and use is therefore an important
+> factor in the overall user experience. See the text field component's 
+> [Material  Design specifications page](https://www.google.com/design/spec/components/text-fields.html) 
+> for details.
+> 
+> The enhanced text field component has a more vivid visual look than a standard
+> text field, and may be initially or programmatically disabled. There are three
+> main types of text fields in the text field component, each with its own basic
+> coding requirements. The types are single-line, multi-line, and expandable.
+
+This implementation provides only single-line. 
+
+
+# Configuration
+@docs Kind, Label
+
+# Component
+@docs Action, Model, model, update, view
+-}
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+
+import Material.Aux exposing (..)
+
+
+-- MODEL
+
+
+{-| Label configuration. The `text` is the text of the label;
+the label floats if `float` is True.
+-}
+type alias Label =
+  { text : String
+  , float : Bool
+  }
+
+
+{-| Kind of textfield. Currently supports only single-line inputs.
+-}
+type Kind
+  = SingleLine
+  {-
+  | MultiLine (Maybe Int) -- Max no. of rows or no limit
+  -- TODO. Should prevent key event for ENTER
+  -- when number of rows exceeds maxrows argument to constructor:
+
+  MaterialTextfield.prototype.onKeyDown_ = function(event) {
+    var currentRowCount = event.target.value.split('\n').length;
+    if (event.keyCode === 13) {
+      if (currentRowCount >= this.maxRows) {
+        event.preventDefault();
+      }
+    }
+  };
+  -}
+
+
+{-| Model. The textfield is in its error-state if `error` is not `Nothing`.
+The contents of the field is `value`.
+-}
+type alias Model =
+  { label : Maybe Label
+  , error : Maybe String
+  , kind : Kind
+  , isDisabled : Bool
+  , isFocused : Bool
+  , value : String
+  }
+
+
+{-| Default model. No label, error, or value.
+-}
+model : Model
+model =
+  { label = Nothing
+  , error = Nothing
+  , kind = SingleLine
+  , isDisabled = False
+  , isFocused = False
+  , value = ""
+  }
+
+
+-- ACTIONS, UPDATE
+
+
+{-| Component actions. `Input` carries the new value of the field.
+-}
+type Action
+  = Input String
+  | Blur
+  | Focus
+
+
+{-| Component update.
+-}
+update : Action -> Model -> Model
+update action model =
+  case action of
+    Input str ->
+      { model | value = str }
+
+    Blur ->
+      { model | isFocused = False }
+
+    Focus ->
+      { model | isFocused = True }
+
+
+-- VIEW
+
+
+{-| Component view.
+-}
+view : Signal.Address Action -> Model -> Html
+view addr model =
+  let hasFloat = model.label |> Maybe.map .float |> Maybe.withDefault False
+      hasError = model.error |> Maybe.map (always True) |> Maybe.withDefault False
+  in
+    filter div
+      [ classList
+          [ ("mdl-textfield", True)
+          , ("mdl-js-textfield", True)
+          , ("is-upgraded", True)
+          , ("mdl-textfield--floating-label", hasFloat)
+          , ("is-invalid", hasError)
+          , ("is-dirty", model.value /= "")
+          , ("is-focused", model.isFocused && not model.isDisabled)
+          , ("is-disabled", model.isDisabled)
+          ]
+      ]
+      [ Just <| input
+          [ class "mdl-textfield__input"
+          , style [ ("outline", "none") ]
+          , type' "text"
+          , disabled model.isDisabled
+          , value model.value
+          , Html.Events.on "input" targetValue (\s -> Signal.message addr (Input s))
+          , onBlur addr Blur
+          , onFocus addr Focus
+          ]
+          []
+      ,   model.label |> Maybe.map (\l ->
+            label [class "mdl-textfield__label"]  [text l.text])
+      ,   model.error |> Maybe.map (\e ->
+            span [class "mdl-textfield__error"] [text e])
+      ]

elm-mdl-demo.html

@@ -0,0 +1,33 @@
+<!DOCTYPE html>
+<html>
+  <head>
+    <meta charset="UTF-8">
+    <meta name="viewport" content="width=device-width, initial-scale=1.0">
+
+    <title>elm-mdl-demo</title>
+
+    <!-- MDL -->
+    <link href='https://fonts.googleapis.com/css?family=Roboto:400,300,500|Roboto+Mono|Roboto+Condensed:400,700&subset=latin,latin-ext' rel='stylesheet' type='text/css'>
+    <link rel="stylesheet" href="https://fonts.googleapis.com/icon?family=Material+Icons">
+    <link rel="stylesheet" href="https://code.getmdl.io/1.1.1/material.min.css" />
+
+  </head>
+  <body>
+    <!-- elm -->
+    <script src="built/elm.js"></script>
+    <script>
+
+      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

@@ -0,0 +1,24 @@
+{
+    "version": "1.0.0",
+    "summary": "Material Design Lite port to Elm",
+    "repository": "https://github.com/debois/elm-mdl.git",
+    "license": "BSD3",
+    "source-directories": [
+        "."
+    ],
+    "exposed-modules": [
+        "Material.Icon",
+        "Material.Button",
+        "Material.Textfield",
+        "Material.Grid",
+        "Material.Layout"
+    ],
+    "native-modules": true,
+    "dependencies": {
+        "elm-lang/core": "3.0.0 <= v < 4.0.0",
+        "evancz/elm-effects": "2.0.1 <= v < 3.0.0",
+        "evancz/elm-html": "4.0.2 <= v < 5.0.0",
+        "evancz/start-app": "2.0.2 <= v < 3.0.0"
+    },
+    "elm-version": "0.16.0 <= v < 0.17.0"
+}