Button API, demos.

This commit is contained in:
Søren Debois 2016-03-13 22:47:00 +01:00
parent c8b82a9a41
commit 4d57d5dc12
12 changed files with 569 additions and 438 deletions

164
Demo.elm
View file

@ -6,13 +6,14 @@ import Effects exposing (..)
import Task import Task
import Signal import Signal
import Task exposing (Task) 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 -- MODEL
@ -20,40 +21,23 @@ import Buttons
type alias Model = type alias Model =
{ layout : Layout.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 : Layout.Model
layoutModel = layoutModel =
{ selectedTab = "Buttons" { defaultLayoutModel
, isDrawerOpen = False | state = Layout.initState (List.length tabs)
, state = Layout.initState ["Buttons", "Grid", "Textfields"]
} }
model : Model model : Model
model = model =
let t0 = Textfield.model in
{ layout = layoutModel { 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 type Action
= LayoutAction Layout.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) update : Action -> Model -> (Model, Effects.Effects Action)
@ -80,24 +60,15 @@ update action model =
({ model | layout = l }, Effects.map LayoutAction e) ({ model | layout = l }, Effects.map LayoutAction e)
ButtonsAction a -> ButtonsAction a ->
let (b, e) = Buttons.update a model.buttons let
(b, e) = Demo.Buttons.update a model.buttons
in in
({ model | buttons = b }, Effects.map ButtonsAction e) ({ 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 -- VIEW
@ -106,17 +77,17 @@ update action model =
type alias Addr = Signal.Address Action type alias Addr = Signal.Address Action
layoutConfig : Layout.Config
layoutConfig = Layout.defaultConfig
drawer : List Html drawer : List Html
drawer = drawer =
[ Layout.title "elm-mdl" [ Layout.title "Example drawer"
, Layout.navigation , 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 [ Layout.link
[ href "https://www.getmdl.io/components/index.html" ] [ href "https://www.getmdl.io/components/index.html" ]
[ text "MDL" ] [ 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 = 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 : Signal.Address Action -> Model -> Html
view addr model = view addr model =
let contents = let top =
Dict.get model.layout.selectedTab tabs
|> Maybe.withDefault tabGrid
top =
div div
[ style [ style
[ ("margin", "auto") [ ("margin", "auto")
, ("width", "90%") , ("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 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) init : (Model, Effects.Effects Action)

View file

@ -1,11 +1,11 @@
module Buttons where module Demo.Buttons where
import Dict import Dict
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Effects import Effects
import Material.Button as Button exposing (Appearance(..), Coloring(..)) import Material.Button as Button exposing (..)
import Material.Grid as Grid import Material.Grid as Grid
import Material.Icon as Icon import Material.Icon as Icon
@ -27,16 +27,46 @@ tabulate : List a -> List (Int, a)
tabulate = tabulate' 0 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 ] [ 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 |> tabulate
buttons : List (List (Index, (Bool, Button.Config))) buttons : List (List (Index, (Bool, String, View')))
buttons = 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]) |> List.concatMap (\a -> [row a False, row a True])
|> tabulate |> tabulate
|> List.map (\(i, row) -> List.map (\(j, x) -> ((i,j), x)) row) |> List.map (\(i, row) -> List.map (\(j, x) -> ((i,j), x)) row)
@ -47,7 +77,7 @@ model =
{ clicked = "" { clicked = ""
, buttons = , buttons =
buttons buttons
|> List.concatMap (List.map <| \(idx, (ripple, _)) -> (idx, Button.model ripple)) |> List.concatMap (List.map <| \(idx, (ripple, _, _)) -> (idx, Button.model ripple))
|> Dict.fromList |> Dict.fromList
} }
@ -79,36 +109,15 @@ update (Action idx action) model =
-- VIEW -- 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 : Signal.Address Action -> Model -> Html
view addr model = view addr model =
buttons |> List.concatMap (\row -> buttons |> List.concatMap (\row ->
row |> List.map (\(idx, (ripple, config)) -> row |> List.concatMap (\(idx, (ripple, description, view)) ->
let model' = let model' =
Dict.get idx model.buttons |> Maybe.withDefault (Button.model False) Dict.get idx model.buttons |> Maybe.withDefault (Button.model False)
in in
Grid.cell [ Grid.cell
[ Grid.col Grid.All 3] [ Grid.size Grid.All 3]
[ div [ div
[ style [ style
[ ("text-align", "center") [ ("text-align", "center")
@ -116,25 +125,18 @@ view addr model =
, ("margin-bottom", "1em") , ("margin-bottom", "1em")
] ]
] ]
[ Button.view [ view
(Signal.forwardTo addr (Action idx)) (Signal.forwardTo addr (Action idx))
config
model' 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 , div
[ style [ style
[ ("font-size", "9pt") [ ("font-size", "9pt")
, ("margin-top", "1em") , ("margin-top", "1em")
] ]
] ]
[ text <| describe ripple config ] [ text description
]
]
] ]
] ]
) )

36
Demo/Grid.elm Normal file
View file

@ -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;
}
"""]
]

View file

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

View file

@ -12,6 +12,18 @@ filter elem attr html =
elem attr (List.filterMap (\x -> x) 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' : Signal.Address a -> a -> Html.Attribute
onClick' address x = onClick' address x =
Html.Events.onWithOptions Html.Events.onWithOptions

View file

@ -1,7 +1,7 @@
module Material.Button module Material.Button
( model, update ( Model, model, Action(Click), update
, Kind(..), Coloring(..), Config , Coloring(..)
, view , flat, raised, fab, minifab, icon
) where ) where
{-| From the [Material Design Lite documentation](http://www.getmdl.io/components/#buttons-section): {-| 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). [Material Design Specification]([https://www.google.com/design/spec/components/buttons.html).
# Component # Component
@docs model, update @docs Model, model, Action, update
# View # 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 exposing (..)
import Html.Attributes 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.Aux as Aux
import Material.Ripple as Ripple import Material.Ripple as Ripple
@ -47,8 +52,8 @@ import Material.Ripple as Ripple
-- MODEL -- 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) type Model = S (Maybe Ripple.Model)
@ -67,42 +72,34 @@ model shouldRipple =
-- ACTION, UPDATE -- 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. {-| Component update.
-} -}
update : Action -> Model -> (Model, Effects Action) update : Action -> Model -> (Model, Effects Action)
update action model = update action model =
case action of
Click ->
(model, none)
Ripple action' ->
case model of case model of
S (Just ripple) -> S (Just ripple) ->
let (ripple', e) = Ripple.update action ripple let (ripple', e) = Ripple.update action' ripple
in in
(S (Just ripple'), e) (S (Just ripple'), Effects.map Ripple e)
S Nothing -> S Nothing ->
(model, Effects.none) (model, none)
-- VIEW -- 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 {-| Coloring of a button. `Plain` respectively `Colored` is the button's
uncolored respectively colored defaults. uncolored respectively colored defaults.
`Primary` respectively `Accent` chooses a colored button with the indicated `Primary` respectively `Accent` chooses a colored button with the indicated
@ -115,48 +112,123 @@ type Coloring
| Accent | 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 button
(classList [ classList
[ ("mdl-button", True) [ ("mdl-button", True)
, ("mdl-js-button", True) , ("mdl-js-button", True)
, ("mdl-js-ripple-effect", model /= S Nothing) , ("mdl-js-ripple-effect", model /= S Nothing)
-- Color effect. -- 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. -- 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) , Aux.blurOn "mouseup"
, ("mdl-button--icon", config.kind == Icon) , Aux.blurOn "mouseleave"
, onClick addr Click
] ]
:: Aux.blurOn "mouseup"
:: Aux.blurOn "mouseleave"
:: attrs)
(case model of (case model of
S (Just ripple) -> S (Just ripple) ->
Ripple.view Ripple.view
addr (Signal.forwardTo addr Ripple)
[ class "mdl-button__ripple-container" [ class "mdl-button__ripple-container"
, Aux.blurOn "mouseup" ] , Aux.blurOn "mouseup" ]
ripple ripple
:: html :: 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"

View file

@ -1,14 +1,17 @@
module Material.Grid module Material.Grid
( grid ( grid, gridWithOptions, Options
, size
, offset
, align
, cell , cell
, Device(..) , Device(..)
, Align(..) , Align(..)
, size
, offset
, align
, hide
, order
) where ) 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 > 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 > out content for multiple screen sizes. It reduces the usual coding burden
@ -30,6 +33,8 @@ Example use:
import Material.Grid exposing (grid, cell, size, Device(..)) import Material.Grid exposing (grid, cell, size, Device(..))
top : Html
top =
grid grid
[ cell [ size All 4 ] [ cell [ size All 4 ]
[ h4 [] [text "Cell 1"] [ h4 [] [text "Cell 1"]
@ -47,11 +52,16 @@ Example use:
] ]
] ]
# 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 "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." 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 exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import String 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 type Device = All | Desktop | Tablet | Phone
{- Cell configuration. Construct with `size`, `offset`, and `align`. {- 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 suffix : Device -> String
@ -112,7 +166,7 @@ size device k =
Tablet -> clip 1 8 k Tablet -> clip 1 8 k
Phone -> clip 1 4 k Phone -> clip 1 4 k
in 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 {-| 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 Tablet -> clip 1 7 k
Phone -> clip 1 3 k Phone -> clip 1 3 k
in in
"mdl-cell--" ++ toString c ++ "-offset" ++ suffix device |> C "mdl-cell--" ++ toString c ++ "-offset" ++ suffix device |> Config
{-| Vertical alignment of cells; use with `align`. {-| Vertical alignment of cells; use with `align`.
@ -140,16 +194,34 @@ type Align = Top | Middle | Bottom
-} -}
align : Align -> CellConfig align : Align -> CellConfig
align a = align a =
C <| case a of Config <| case a of
Top -> "mdl-cell--top" Top -> "mdl-cell--top"
Middle -> "mdl-cell--middle" Middle -> "mdl-cell--middle"
Bottom -> "mdl-cell--bottom" 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 a cell for use in the argument list for `grid`.
Construct the cell configuration (first argument) using `size`, `offset`, and Construct the cell configuration (first argument) using `size`, `offset`, and
`align`. Supply contents for the cell as the second argument. `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

View file

@ -31,9 +31,21 @@ type Size
{-| View function for icons. Supply the {-| 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 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 : String -> Size -> List Attribute -> Html
view name size attrs = view name size attrs =
@ -52,6 +64,13 @@ view name size attrs =
{-| Render a default-sized icon with no behaviour. The {-| Render a default-sized icon with no behaviour. The
`String` argument must be the name of a [Material Icon](https://design.google.com/icons/) `String` argument must be the name of a [Material Icon](https://design.google.com/icons/)
(replace spaces with underscores). (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 : String -> Html
i name = view name S [] i name = view name S []

View file

@ -1,9 +1,9 @@
module Material.Layout module Material.Layout
( setupSizeChangeSignal ( setupSizeChangeSignal
, Model, initState , Mode, Model, defaultLayoutModel, initState
, Action(SwitchTab, ToggleDrawer), update , Action(SwitchTab, ToggleDrawer), update
, spacer, title, navigation, link , spacer, title, navigation, link
, Mode, Config, config, view , Contents, view
) where ) where
{-| From the {-| From the
@ -30,20 +30,20 @@ module Material.Layout
> flexibility and ease of use. > flexibility and ease of use.
# Model & Actions # Model & Actions
@docs Model, initState, Action, update @docs Mode, Model, defaultLayoutModel, initState, Action, update
# Sub-components
@docs spacer, title, navigation, link
# View # View
@docs Mode, Config, config, view @docs Contents, view
## Sub-views
@docs spacer, title, navigation, link
# Setup # Setup
@docs setupSizeChangeSignal @docs setupSizeChangeSignal
-} -}
import Dict exposing (Dict) import Array exposing (Array)
import Maybe exposing (andThen, map) import Maybe exposing (andThen, map)
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
@ -79,13 +79,8 @@ setupSizeChangeSignal f =
-- MODEL -- MODEL
type alias TabState =
{ titles : List String
, ripples : Dict String Ripple.Model
}
type alias State' = type alias State' =
{ tabs : TabState { tabs : Array Ripple.Model
, isSmallScreen : Bool , 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 {-| 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 `selectedTab` will be highlighted as selected; otherwise, `selectedTab` has no
significance. `isDrawerOpen` indicates whether the drawer, if the layout has 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 = type alias Model =
{ selectedTab : String { selectedTab : Int
, isDrawerOpen : Bool , isDrawerOpen : Bool
-- Configuration
, fixedHeader : Bool
, fixedDrawer : Bool
, fixedTabs : Bool
, rippleTabs : Bool
, mode : Mode
-- State
, state : 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
|> List.map (\title -> (title, Ripple.model))
|> Dict.fromList
in
S { tabs =
{ titles = titles
, ripples = ripples
}
, isSmallScreen = False -- TODO , 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 -- 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. opened/closed state of the drawer.
-} -}
type Action type Action
= SwitchTab String = SwitchTab Int
| ToggleDrawer | ToggleDrawer
-- Private -- Private
| SmallScreen Bool -- True means small screen | SmallScreen Bool -- True means small screen
| ScrollTab Int | ScrollTab Int
| Ripple String Ripple.Action | Ripple Int Ripple.Action
{-| Component update. {-| Component update.
@ -177,19 +186,14 @@ update action model =
ToggleDrawer -> ToggleDrawer ->
{ model | isDrawerOpen = not model.isDrawerOpen } |> pure { model | isDrawerOpen = not model.isDrawerOpen } |> pure
Ripple tab action' -> Ripple tabIndex action' ->
let let
tabs = state.tabs
(state', effect) = (state', effect) =
Dict.get tab tabs.ripples Array.get tabIndex (s model).tabs
|> Maybe.map (Ripple.update action') |> Maybe.map (Ripple.update action')
|> Maybe.map (\(ripple', effect) -> |> 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) |> Maybe.withDefault (pure state)
in in
({ model | state = S state' }, effect) ({ model | state = S state' }, effect)
@ -230,7 +234,6 @@ link attrs contents =
-- MAIN VIEWS -- MAIN VIEWS
@ -248,40 +251,12 @@ type Mode
-- | Waterfall -- | 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 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 = let chevron direction offset =
div div
[ classList [ classList
@ -300,24 +275,23 @@ tabsView addr config model =
, div , div
[ classList [ classList
[ ("mdl-layout__tab-bar", True) [ ("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 filter a
[ classList [ classList
[ ("mdl-layout__tab", True) [ ("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 Ripple.view
(Signal.forwardTo addr (Ripple tab)) (Signal.forwardTo addr (Ripple tabIndex))
[ class "mdl-layout__tab-ripple-container" ] [ class "mdl-layout__tab-ripple-container" ]
) )
else 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 filter Html.header
[ classList [ classList
[ ("mdl-layout__header", True) [ ("mdl-layout__header", True)
, ("is-casting-shadow", config.mode == Standard) , ("is-casting-shadow", model.mode == Standard)
] ]
] ]
[ drawerButton [ 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 -> Html
drawerButton addr = drawerButton addr =
div div
@ -383,17 +348,29 @@ drawerView addr model elems =
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)
, main : List Html
}
{-| Main layout view.
-}
view : Addr -> Model -> Contents -> Html
view addr model { drawer, header, tabs, main } =
let
(contentDrawerButton, headerDrawerButton) =
case (drawer, header, model.fixedHeader) of
(Just _, Just _, True) -> (Just _, Just _, True) ->
-- Drawer with fixedHeader: Add the button to the header -- Drawer with fixedHeader: Add the button to the header
(Nothing, Just <| drawerButton addr) (Nothing, Just <| drawerButton addr)
@ -405,17 +382,16 @@ view addr config model (drawer, header) main =
_ -> _ ->
-- No drawer: no button. -- No drawer: no button.
(Nothing, Nothing) (Nothing, Nothing)
mode = mode =
case config.mode of case model.mode of
Standard -> "" Standard -> ""
Scroll -> "mdl-layout__header-scroll" Scroll -> "mdl-layout__header-scroll"
-- Waterfall -> "mdl-layout__header-waterfall" -- Waterfall -> "mdl-layout__header-waterfall"
Seamed -> "mdl-layout__header-seamed" Seamed -> "mdl-layout__header-seamed"
tabs =
if hasTabs model then hasHeader =
tabsView addr config model |> Just tabs /= Nothing || header /= Nothing
else
Nothing
in in
div div
[ class "mdl-layout__container" ] [ class "mdl-layout__container" ]
@ -423,16 +399,19 @@ view addr config model (drawer, header) main =
[ classList [ classList
[ ("mdl-layout", True) [ ("mdl-layout", True)
, ("is-upgraded", 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-drawer", drawer /= Nothing)
, ("has-tabs", hasTabs model) , ("has-tabs", tabs /= Nothing)
, ("mdl-js-layout", True) , ("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 (\_ -> obfuscator addr model)
, drawer |> Maybe.map (drawerView addr model) , drawer |> Maybe.map (drawerView addr model)
, contentDrawerButton , contentDrawerButton

View file

@ -14,20 +14,8 @@
</head> </head>
<body> <body>
<!-- elm --> <!-- elm -->
<script src="built/elm.js"></script> <script src="elm.js"></script>
<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> </script>
</body> </body>

View file

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