mirror of
https://github.com/correl/elm-mdl.git
synced 2024-11-23 11:09:51 +00:00
merge
This commit is contained in:
Søren Debois
commit
4e9b8e6746
26 changed files with 2412 additions and 453 deletions
|
|
@ -3,4 +3,7 @@ install:
|
|||
- npm install -g elm
|
||||
- elm-package install -y
|
||||
script:
|
||||
- elm-make --yes examples/Component.elm
|
||||
- elm-make --yes examples/Component-TEA.elm
|
||||
- elm-make --yes examples/Demo.elm
|
||||
|
||||
|
|
|
|||
11
Makefile
11
Makefile
|
|
@ -1,6 +1,9 @@
|
|||
PAGES=../elm-mdl-gh-pages
|
||||
|
||||
elm.js:
|
||||
comp:
|
||||
elm-make examples/Component.elm --warn --output elm.js
|
||||
|
||||
demo:
|
||||
elm-make examples/Demo.elm --warn --output elm.js
|
||||
|
||||
wip-pages :
|
||||
|
|
@ -11,14 +14,14 @@ pages :
|
|||
elm-make examples/Demo.elm --output $(PAGES)/elm.js
|
||||
(cd $(PAGES); git commit -am "Update."; git push origin gh-pages)
|
||||
|
||||
clean :
|
||||
cleanish :
|
||||
rm -f elm.js index.html
|
||||
|
||||
veryclean :
|
||||
clean :
|
||||
rm -rf elm-stuff/build-artifacts
|
||||
|
||||
distclean : clean
|
||||
rm -rf elm-stuff
|
||||
|
||||
|
||||
.PHONY : pages elm.js clean veryclean distclean
|
||||
.PHONY : pages elm.js clean cleanish distclean
|
||||
|
|
|
|||
|
|
@ -1,5 +1,7 @@
|
|||
# Material Design Components in Elm
|
||||
|
||||
[](https://travis-ci.org/debois/elm-mdl)
|
||||
|
||||
Port of Google's
|
||||
[Material Design Lite](https://www.getmdl.io/)
|
||||
CSS/JS implementation of the
|
||||
|
|
|
|||
|
|
@ -9,13 +9,14 @@
|
|||
],
|
||||
"exposed-modules": [
|
||||
"Material",
|
||||
"Material.Style",
|
||||
"Material.Style",
|
||||
"Material.Color",
|
||||
"Material.Icon",
|
||||
"Material.Button",
|
||||
"Material.Textfield",
|
||||
"Material.Layout",
|
||||
"Material.Grid"
|
||||
"Material.Grid",
|
||||
"Material.Component"
|
||||
],
|
||||
"dependencies": {
|
||||
"debois/elm-dom": "1.0.0 <= v < 2.0.0",
|
||||
|
|
@ -23,7 +24,8 @@
|
|||
"evancz/elm-effects": "2.0.1 <= v < 3.0.0",
|
||||
"evancz/elm-html": "4.0.2 <= v < 5.0.0",
|
||||
"evancz/elm-markdown": "2.0.1 <= v < 3.0.0",
|
||||
"evancz/start-app": "2.0.2 <= v < 3.0.0"
|
||||
"evancz/start-app": "2.0.2 <= v < 3.0.0",
|
||||
"sporto/hop": "3.0.0 <= v < 4.0.0"
|
||||
},
|
||||
"elm-version": "0.16.0 <= v < 0.17.0"
|
||||
}
|
||||
}
|
||||
146
examples/Component-TEA.elm
Normal file
146
examples/Component-TEA.elm
Normal file
|
|
@ -0,0 +1,146 @@
|
|||
import StartApp
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (href, class, style)
|
||||
import Effects exposing (Effects, Never)
|
||||
import Task exposing (Task)
|
||||
|
||||
import Material.Button as Button
|
||||
import Material.Scheme
|
||||
|
||||
|
||||
-- MODEL
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ count : Int
|
||||
, increaseButtonModel : Button.Model
|
||||
, resetButtonModel : Button.Model
|
||||
}
|
||||
|
||||
|
||||
model : Model
|
||||
model =
|
||||
{ count = 0
|
||||
, increaseButtonModel = Button.model True -- With ripple animation
|
||||
, resetButtonModel = Button.model False -- Without ripple animation
|
||||
}
|
||||
|
||||
|
||||
-- ACTION, UPDATE
|
||||
|
||||
|
||||
type Action
|
||||
= IncreaseButtonAction Button.Action
|
||||
| ResetButtonAction Button.Action
|
||||
|
||||
|
||||
increase : Model -> Model
|
||||
increase model =
|
||||
{ model | count = model.count + 1 }
|
||||
|
||||
|
||||
reset : Model -> Model
|
||||
reset model =
|
||||
{ model | count = 0 }
|
||||
|
||||
|
||||
|
||||
update : Action -> Model -> (Model, Effects Action)
|
||||
update action model =
|
||||
case Debug.log "" action of
|
||||
IncreaseButtonAction action' ->
|
||||
let
|
||||
(submodel, fx) =
|
||||
Button.update action' model.increaseButtonModel
|
||||
model' =
|
||||
case action' of
|
||||
Button.Click ->
|
||||
increase model
|
||||
_ ->
|
||||
model
|
||||
in
|
||||
( { model' | increaseButtonModel = submodel }
|
||||
, Effects.map IncreaseButtonAction fx
|
||||
)
|
||||
|
||||
ResetButtonAction action' ->
|
||||
let
|
||||
(submodel, fx) =
|
||||
Button.update action' model.resetButtonModel
|
||||
model' =
|
||||
case action' of
|
||||
Button.Click ->
|
||||
reset model
|
||||
_ ->
|
||||
model
|
||||
in
|
||||
( { model' | resetButtonModel = submodel }
|
||||
, Effects.map ResetButtonAction fx
|
||||
)
|
||||
|
||||
|
||||
-- VIEW
|
||||
|
||||
|
||||
view : Signal.Address Action -> Model -> Html
|
||||
view addr model =
|
||||
div
|
||||
[ style
|
||||
[ ("margin", "auto")
|
||||
, ("padding-left", "5%")
|
||||
, ("padding-right", "5%")
|
||||
]
|
||||
]
|
||||
[ text ("Current count: " ++ toString model.count )
|
||||
, Button.flat
|
||||
(Signal.forwardTo addr IncreaseButtonAction)
|
||||
model.increaseButtonModel
|
||||
[]
|
||||
[ text "Increase" ]
|
||||
, Button.flat
|
||||
(Signal.forwardTo addr ResetButtonAction)
|
||||
model.resetButtonModel
|
||||
[]
|
||||
[ text "Reset" ]
|
||||
]
|
||||
|> Material.Scheme.top
|
||||
|
||||
|
||||
{- The remainder of this file is Elm/StartApp boilerplate.
|
||||
-}
|
||||
|
||||
|
||||
-- SETUP
|
||||
|
||||
|
||||
init : (Model, Effects.Effects Action)
|
||||
init = (model, Effects.none)
|
||||
|
||||
|
||||
inputs : List (Signal.Signal Action)
|
||||
inputs =
|
||||
[
|
||||
]
|
||||
|
||||
|
||||
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 Never ())
|
||||
port tasks =
|
||||
app.tasks
|
||||
158
examples/Component.elm
Normal file
158
examples/Component.elm
Normal file
|
|
@ -0,0 +1,158 @@
|
|||
import StartApp
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (href, class, style)
|
||||
import Effects exposing (Effects, Never)
|
||||
import Task exposing (Task)
|
||||
|
||||
import Material
|
||||
import Material.Scheme
|
||||
import Material.Button as Button
|
||||
|
||||
|
||||
-- MODEL
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ count : Int
|
||||
, mdl : Material.Model Action
|
||||
-- Boilerplate: mdl is the Model store for any and all MDL components you need.
|
||||
}
|
||||
|
||||
|
||||
model : Model
|
||||
model =
|
||||
{ count = 0
|
||||
, mdl = Material.model
|
||||
-- Boilerplate: Always use this initial MDL model store.
|
||||
}
|
||||
|
||||
|
||||
-- ACTION, UPDATE
|
||||
|
||||
|
||||
type Action
|
||||
= Increase
|
||||
| Reset
|
||||
| MDL (Material.Action Action)
|
||||
-- Boilerplate: Action for MDL actions (ripple animations etc.).
|
||||
|
||||
|
||||
update : Action -> Model -> (Model, Effects Action)
|
||||
update action model =
|
||||
case Debug.log "" action of
|
||||
Increase ->
|
||||
( { model | count = model.count + 1 }
|
||||
, Effects.none
|
||||
)
|
||||
|
||||
Reset ->
|
||||
( { model | count = 0 }
|
||||
, Effects.none
|
||||
)
|
||||
|
||||
{- Boilerplate: MDL action handler. It should always look like this, except
|
||||
you can of course choose to put its saved model someplace other than
|
||||
model.mdl.
|
||||
-}
|
||||
MDL action' ->
|
||||
let (mdl', fx) =
|
||||
Material.update MDL action' model.mdl
|
||||
in
|
||||
( { model | mdl = mdl' } , fx )
|
||||
|
||||
|
||||
-- VIEW
|
||||
|
||||
|
||||
type alias Mdl = Material.Model Action
|
||||
|
||||
|
||||
{- We construct the instances of the Button component that we need, one
|
||||
for the increase button, one for the reset button. First, the increase
|
||||
button. The arguments are:
|
||||
|
||||
- An instance id (the `0`). Every component that uses the same model collection
|
||||
(model.mdl in this file) must have a distinct instance id.
|
||||
- An Action creator (`MDL`), lifting MDL actions to your Action type.
|
||||
- A button view (`flat`).
|
||||
- An initial model (`(Button.model True)`---a button with a ripple animation.
|
||||
- A list of observations you want to make of the button (final argument).
|
||||
In this case, we hook up Click events of the button to the `Increase` action
|
||||
defined above.
|
||||
-}
|
||||
increase : Button.Instance Mdl Action
|
||||
increase =
|
||||
Button.instance 0 MDL Button.flat (Button.model True)
|
||||
[ Button.fwdClick Increase ]
|
||||
|
||||
|
||||
{- Next, the reset button. This one has id 1, does not ripple, and forwards its
|
||||
click event to our Reset action.
|
||||
-}
|
||||
reset : Button.Instance Mdl Action
|
||||
reset =
|
||||
Button.instance 1 MDL Button.flat (Button.model False)
|
||||
[ Button.fwdClick Reset ]
|
||||
|
||||
|
||||
{- Notice that we did not have to add increase and reset separately to model.mdl,
|
||||
and we did not have to add to our update actions to handle their internal events.
|
||||
-}
|
||||
|
||||
|
||||
view : Signal.Address Action -> Model -> Html
|
||||
view addr model =
|
||||
div
|
||||
[ style
|
||||
[ ("margin", "auto")
|
||||
, ("padding-left", "5%")
|
||||
, ("padding-right", "5%")
|
||||
]
|
||||
]
|
||||
[ text ("Current count: " ++ toString model.count )
|
||||
, increase.view addr model.mdl [] [ text "Increase" ]
|
||||
, reset.view addr model.mdl [] [ text "Reset" ]
|
||||
-- Note that we use the .view function of our component instances to
|
||||
-- actually render the component.
|
||||
]
|
||||
|> Material.Scheme.top
|
||||
|
||||
|
||||
{- The remainder of this file is Elm/StartApp boilerplate.
|
||||
-}
|
||||
|
||||
|
||||
-- SETUP
|
||||
|
||||
|
||||
init : (Model, Effects.Effects Action)
|
||||
init = (model, Effects.none)
|
||||
|
||||
|
||||
inputs : List (Signal.Signal Action)
|
||||
inputs =
|
||||
[
|
||||
]
|
||||
|
||||
|
||||
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 Never ())
|
||||
port tasks =
|
||||
app.tasks
|
||||
|
|
@ -1,6 +1,7 @@
|
|||
module Main (..) where
|
||||
import StartApp
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (href, class, style)
|
||||
import Html.Attributes exposing (href, class, style, key)
|
||||
import Signal exposing (Signal)
|
||||
import Effects exposing (..)
|
||||
import Task
|
||||
|
|
@ -8,20 +9,57 @@ import Signal
|
|||
import Task exposing (Task)
|
||||
import Array exposing (Array)
|
||||
|
||||
import Material.Color as Color
|
||||
import Material.Layout as Layout exposing (defaultLayoutModel)
|
||||
import Hop
|
||||
import Hop.Types
|
||||
import Hop.Navigate exposing (navigateTo)
|
||||
import Hop.Matchers exposing (match1)
|
||||
|
||||
import Material exposing (lift, lift')
|
||||
import Material.Color as Color
|
||||
import Material.Layout
|
||||
import Material.Layout as Layout exposing (defaultLayoutModel)
|
||||
import Material.Helpers exposing (lift, lift')
|
||||
import Material.Style as Style
|
||||
import Material
|
||||
import Material.Scheme as Scheme
|
||||
|
||||
import Demo.Buttons
|
||||
import Demo.Grid
|
||||
import Demo.Textfields
|
||||
import Demo.Snackbar
|
||||
import Demo.Badges
|
||||
import Demo.Elevation
|
||||
|
||||
--import Demo.Template
|
||||
|
||||
|
||||
-- ROUTING
|
||||
|
||||
|
||||
type Route
|
||||
= Tab Int
|
||||
| E404
|
||||
|
||||
|
||||
type alias Routing =
|
||||
( Route, Hop.Types.Location )
|
||||
|
||||
route0 : Routing
|
||||
route0 =
|
||||
( Tab 0, Hop.Types.newLocation )
|
||||
|
||||
|
||||
router : Hop.Types.Router Route
|
||||
router =
|
||||
Hop.new
|
||||
{ notFound = E404
|
||||
, matchers =
|
||||
( match1 (Tab 0) "/"
|
||||
:: (tabs |> List.indexedMap (\idx (_, path, _) ->
|
||||
match1 (Tab idx) ("/" ++ path))
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
-- MODEL
|
||||
|
||||
|
||||
|
|
@ -36,6 +74,7 @@ layoutModel =
|
|||
|
||||
type alias Model =
|
||||
{ layout : Layout.Model
|
||||
, routing : Routing
|
||||
, buttons : Demo.Buttons.Model
|
||||
, textfields : Demo.Textfields.Model
|
||||
, snackbar : Demo.Snackbar.Model
|
||||
|
|
@ -46,39 +85,79 @@ type alias Model =
|
|||
model : Model
|
||||
model =
|
||||
{ layout = layoutModel
|
||||
, routing = route0
|
||||
, buttons = Demo.Buttons.model
|
||||
, textfields = Demo.Textfields.model
|
||||
, snackbar = Demo.Snackbar.model
|
||||
--, template = Demo.Template.model
|
||||
--, template = Demo.Template.model
|
||||
}
|
||||
|
||||
|
||||
|
||||
-- ACTION, UPDATE
|
||||
|
||||
|
||||
type Action
|
||||
= LayoutAction Layout.Action
|
||||
-- Hop
|
||||
= ApplyRoute ( Route, Hop.Types.Location )
|
||||
| HopAction ()
|
||||
-- Tabs
|
||||
| LayoutAction Layout.Action
|
||||
| ButtonsAction Demo.Buttons.Action
|
||||
| TextfieldAction Demo.Textfields.Action
|
||||
| SnackbarAction Demo.Snackbar.Action
|
||||
--| TemplateAction Demo.Template.Action
|
||||
--| TemplateAction Demo.Template.Action
|
||||
|
||||
|
||||
update : Action -> Model -> (Model, Effects.Effects Action)
|
||||
nth : Int -> List a -> Maybe a
|
||||
nth k xs =
|
||||
List.drop k xs |> List.head
|
||||
|
||||
|
||||
update : Action -> Model -> ( Model, Effects Action )
|
||||
update action model =
|
||||
case Debug.log "Action: " action of
|
||||
LayoutAction a -> lift .layout (\m x->{m|layout =x}) LayoutAction Layout.update a model
|
||||
case action of
|
||||
LayoutAction a ->
|
||||
let
|
||||
( lifted, layoutFx ) =
|
||||
lift .layout (\m x -> { m | layout = x }) LayoutAction Layout.update a model
|
||||
routeFx =
|
||||
case a of
|
||||
Layout.SwitchTab k ->
|
||||
nth k tabs
|
||||
|> Maybe.map (\(_, path, _) -> Effects.map HopAction (navigateTo path))
|
||||
|> Maybe.withDefault Effects.none
|
||||
_ ->
|
||||
Effects.none
|
||||
in
|
||||
( lifted, Effects.batch [ layoutFx, routeFx ] )
|
||||
|
||||
ApplyRoute route ->
|
||||
( { model
|
||||
| routing = route
|
||||
, layout = setTab model.layout (fst route)
|
||||
}
|
||||
, Effects.none
|
||||
)
|
||||
|
||||
HopAction _ ->
|
||||
( model, Effects.none )
|
||||
|
||||
ButtonsAction a -> lift .buttons (\m x->{m|buttons =x}) ButtonsAction Demo.Buttons.update a model
|
||||
TextfieldAction a -> lift' .textfields (\m x->{m|textfields=x}) Demo.Textfields.update a model
|
||||
|
||||
TextfieldAction a -> lift .textfields (\m x->{m|textfields=x}) TextfieldAction Demo.Textfields.update a model
|
||||
|
||||
SnackbarAction a -> lift .snackbar (\m x->{m|snackbar =x}) SnackbarAction Demo.Snackbar.update a model
|
||||
|
||||
--TemplateAction a -> lift .template (\m x->{m|template =x}) TemplateAction Demo.Template.update a model
|
||||
|
||||
|
||||
|
||||
-- VIEW
|
||||
|
||||
|
||||
type alias Addr = Signal.Address Action
|
||||
|
||||
type alias Addr =
|
||||
Signal.Address Action
|
||||
|
||||
|
||||
drawer : List Html
|
||||
|
|
@ -86,11 +165,11 @@ drawer =
|
|||
[ Layout.title "Example drawer"
|
||||
, Layout.navigation
|
||||
[ Layout.link
|
||||
[ href "https://www.getmdl.io/components/index.html" ]
|
||||
[ text "MDL" ]
|
||||
[ href "https://github.com/debois/elm-mdl" ]
|
||||
[ text "github" ]
|
||||
, Layout.link
|
||||
[ href "https://www.google.com/design/spec/material-design/introduction.html"]
|
||||
[ text "Material Design"]
|
||||
[ href "http://package.elm-lang.org/packages/debois/elm-mdl/latest/" ]
|
||||
[ text "elm-package" ]
|
||||
]
|
||||
]
|
||||
|
||||
|
|
@ -112,31 +191,50 @@ header =
|
|||
]
|
||||
|
||||
|
||||
tabs : List (String, Addr -> Model -> List Html)
|
||||
tabs : List (String, String, Addr -> Model -> Html)
|
||||
tabs =
|
||||
[ ("Snackbar", \addr model ->
|
||||
[Demo.Snackbar.view (Signal.forwardTo addr SnackbarAction) model.snackbar])
|
||||
, ("Textfields", \addr model ->
|
||||
[Demo.Textfields.view (Signal.forwardTo addr TextfieldAction) model.textfields])
|
||||
, ("Buttons", \addr model ->
|
||||
[Demo.Buttons.view (Signal.forwardTo addr ButtonsAction) model.buttons])
|
||||
, ("Grid", \addr model -> Demo.Grid.view)
|
||||
, ("Badges", \addr model -> Demo.Badges.view )
|
||||
[ ("Buttons", "buttons", \addr model ->
|
||||
Demo.Buttons.view (Signal.forwardTo addr ButtonsAction) model.buttons)
|
||||
, ("Badges", "badges", \addr model -> Demo.Badges.view )
|
||||
, ("Elevation", "elevation", \addr model -> Demo.Elevation.view )
|
||||
, ("Grid", "grid", \addr model -> Demo.Grid.view)
|
||||
, ("Snackbar", "snackbar", \addr model ->
|
||||
Demo.Snackbar.view (Signal.forwardTo addr SnackbarAction) model.snackbar)
|
||||
, ("Textfields", "textfields", \addr model ->
|
||||
Demo.Textfields.view (Signal.forwardTo addr TextfieldAction) model.textfields)
|
||||
{-
|
||||
, ("Template", \addr model ->
|
||||
[Demo.Template.view (Signal.forwardTo addr TemplateAction) model.template])
|
||||
-}
|
||||
]
|
||||
|
||||
tabViews : Array (Addr -> Model -> List Html)
|
||||
tabViews = List.map snd tabs |> Array.fromList
|
||||
|
||||
e404 : Addr -> Model -> Html
|
||||
e404 _ _ =
|
||||
div
|
||||
[
|
||||
]
|
||||
[ Style.styled Html.h1
|
||||
[ Style.cs "mdl-typography--display-4"
|
||||
, Color.background Color.primary
|
||||
]
|
||||
[]
|
||||
[ text "404" ]
|
||||
]
|
||||
|
||||
|
||||
tabViews : Array (Addr -> Model -> Html)
|
||||
tabViews = List.map (\(_,_,v) -> v) tabs |> Array.fromList
|
||||
|
||||
|
||||
tabTitles : List Html
|
||||
tabTitles = List.map (fst >> text) tabs
|
||||
tabTitles =
|
||||
List.map (\(x,_,_) -> text x) tabs
|
||||
|
||||
|
||||
stylesheet : Html
|
||||
stylesheet = Style.stylesheet """
|
||||
stylesheet =
|
||||
Style.stylesheet """
|
||||
blockquote:before { content: none; }
|
||||
blockquote:after { content: none; }
|
||||
blockquote {
|
||||
|
|
@ -150,65 +248,83 @@ stylesheet = Style.stylesheet """
|
|||
*/
|
||||
}
|
||||
p, blockquote {
|
||||
max-width: 33em;
|
||||
font-size: 13px;
|
||||
max-width: 40em;
|
||||
}
|
||||
|
||||
h1, h2 {
|
||||
/* TODO. Need typography module with kerning. */
|
||||
margin-left: -3px;
|
||||
}
|
||||
"""
|
||||
|
||||
|
||||
setTab : Layout.Model -> Route -> Layout.Model
|
||||
setTab layout route =
|
||||
let
|
||||
idx =
|
||||
case route of
|
||||
Tab k -> k
|
||||
E404 -> -1
|
||||
in
|
||||
{ layout | selectedTab = idx }
|
||||
|
||||
|
||||
view : Signal.Address Action -> Model -> Html
|
||||
view addr model =
|
||||
let top =
|
||||
div
|
||||
[ style
|
||||
[ ("margin", "auto")
|
||||
, ("padding-left", "5%")
|
||||
, ("padding-right", "5%")
|
||||
let
|
||||
top =
|
||||
div
|
||||
[ style
|
||||
[ ( "margin", "auto" )
|
||||
, ( "padding-left", "8%" )
|
||||
, ( "padding-right", "8%" )
|
||||
]
|
||||
]
|
||||
((Array.get model.layout.selectedTab tabViews
|
||||
|> Maybe.withDefault (\addr model ->
|
||||
[div [] [text "This can't happen."]]
|
||||
)
|
||||
) addr model)
|
||||
|
||||
, key <| toString (fst model.routing)
|
||||
]
|
||||
[ (Array.get model.layout.selectedTab tabViews
|
||||
|> Maybe.withDefault e404)
|
||||
addr
|
||||
model
|
||||
]
|
||||
in
|
||||
Layout.view (Signal.forwardTo addr LayoutAction) model.layout
|
||||
{ header = header
|
||||
, drawer = drawer
|
||||
, tabs = tabTitles
|
||||
, main = [ top ]
|
||||
, main = [ stylesheet, top ]
|
||||
}
|
||||
{- The following line is not needed when you manually set up
|
||||
your html, as done with page.html. Removing it will then
|
||||
fix the flicker you see on load.
|
||||
-}
|
||||
|> Material.topWithScheme Color.Teal Color.Red
|
||||
|> Scheme.topWithScheme Color.Teal Color.Red
|
||||
|
||||
|
||||
init : (Model, Effects.Effects Action)
|
||||
init = (model, Effects.none)
|
||||
init : ( Model, Effects.Effects Action )
|
||||
init =
|
||||
( model, Effects.none )
|
||||
|
||||
|
||||
inputs : List (Signal.Signal Action)
|
||||
inputs =
|
||||
[ Layout.setupSignals LayoutAction
|
||||
, Signal.map ApplyRoute router.signal
|
||||
]
|
||||
|
||||
|
||||
app : StartApp.App Model
|
||||
app =
|
||||
StartApp.start
|
||||
{ init = init
|
||||
, view = view
|
||||
, update = update
|
||||
, inputs = inputs
|
||||
}
|
||||
StartApp.start
|
||||
{ init = init
|
||||
, view = view
|
||||
, update = update
|
||||
, inputs = inputs
|
||||
}
|
||||
|
||||
|
||||
main : Signal Html
|
||||
main =
|
||||
app.html
|
||||
app.html
|
||||
|
||||
|
||||
-- PORTS
|
||||
|
|
@ -216,4 +332,9 @@ main =
|
|||
|
||||
port tasks : Signal (Task.Task Never ())
|
||||
port tasks =
|
||||
app.tasks
|
||||
app.tasks
|
||||
|
||||
|
||||
port routeRunTask : Task () ()
|
||||
port routeRunTask =
|
||||
router.run
|
||||
|
|
|
|||
|
|
@ -2,34 +2,86 @@ module Demo.Badges (..) where
|
|||
|
||||
import Html exposing (..)
|
||||
import Material.Badge as Badge
|
||||
import Material.Style exposing (..)
|
||||
import Material.Style as Style exposing (styled)
|
||||
import Material.Icon as Icon
|
||||
import Material.Grid exposing (..)
|
||||
|
||||
import Demo.Page as Page
|
||||
|
||||
|
||||
-- VIEW
|
||||
|
||||
|
||||
view : List Html
|
||||
c : List Html -> Cell
|
||||
c = cell [ size All 4 ]
|
||||
|
||||
view : Html
|
||||
view =
|
||||
[ div
|
||||
[]
|
||||
[ p [] []
|
||||
, styled span [ Badge.withBadge "2" ] [] [ text "Span with badge" ]
|
||||
, p [] []
|
||||
, styled span [ Badge.withBadge "22", Badge.noBackground ] [] [ text "Span with no background badge" ]
|
||||
, p [] []
|
||||
, styled span [ Badge.withBadge "33", Badge.overlap ] [] [ text "Span with badge overlap" ]
|
||||
, p [] []
|
||||
, styled span [ Badge.withBadge "99", Badge.overlap, Badge.noBackground ] [] [ text "Span with badge overlap and no background" ]
|
||||
, p [] []
|
||||
, styled span [ Badge.withBadge "♥" ] [] [ text "Span with HTML symbol - Black heart suit" ]
|
||||
, p [] []
|
||||
, styled span [ Badge.withBadge "→" ] [] [ text "Span with HTML symbol - Rightwards arrow" ]
|
||||
, p [] []
|
||||
, styled span [ Badge.withBadge "Δ" ] [] [ text "Span with HTML symbol - Delta" ]
|
||||
, p [] []
|
||||
, span [] [ text "Icon with badge" ]
|
||||
, Icon.view "face" [ Icon.size24, Badge.withBadge "33", Badge.overlap ] []
|
||||
, Icon.view "face" [ Icon.size48, Badge.withBadge "33", Badge.overlap ] []
|
||||
[ grid
|
||||
[]
|
||||
[ c [Style.span [ Badge.withBadge "2" ] [text "Badge"] ]
|
||||
, c [Style.span
|
||||
[ Badge.withBadge "22", Badge.noBackground ]
|
||||
[ text "No background" ]
|
||||
]
|
||||
, c [Style.span
|
||||
[ Badge.withBadge "33", Badge.overlap ]
|
||||
[ text "Overlap" ]
|
||||
]
|
||||
, c [Style.span
|
||||
[ Badge.withBadge "99", Badge.overlap, Badge.noBackground ]
|
||||
[ text "Overlap, no background" ]
|
||||
]
|
||||
, c [Style.span
|
||||
[ Badge.withBadge "♥" ]
|
||||
[ text "Symbol" ]
|
||||
]
|
||||
, c [ Icon.view "flight_takeoff" [ Icon.size24, Badge.withBadge "33", Badge.overlap ] [] ]
|
||||
]
|
||||
]
|
||||
|> Page.body "Badges" srcUrl intro references
|
||||
|
||||
|
||||
|
||||
intro : Html
|
||||
intro =
|
||||
Page.fromMDL "http://www.getmdl.io/components/#badges-section" """
|
||||
> The Material Design Lite (MDL) badge component is an onscreen notification
|
||||
> element. A badge consists of a small circle, typically containing a number or
|
||||
> other characters, that appears in proximity to another object. A badge can be
|
||||
> both a notifier that there are additional items associated with an object and
|
||||
> an indicator of how many items there are.
|
||||
>
|
||||
> You can use a badge to unobtrusively draw the user's attention to items they
|
||||
> might not otherwise notice, or to emphasize that items may need their
|
||||
> attention. For example:
|
||||
>
|
||||
> - A "New messages" notification might be followed by a badge containing the
|
||||
> number of unread messages.
|
||||
> - A "You have unpurchased items in your shopping cart" reminder might include
|
||||
> a badge showing the number of items in the cart.
|
||||
> - A "Join the discussion!" button might have an accompanying badge indicating the
|
||||
> number of users currently participating in the discussion.
|
||||
>
|
||||
> A badge is almost
|
||||
> always positioned near a link so that the user has a convenient way to access
|
||||
> the additional information indicated by the badge. However, depending on the
|
||||
> intent, the badge itself may or may not be part of the link.
|
||||
>
|
||||
> Badges are a new feature in user interfaces, and provide users with a visual clue to help them discover additional relevant content. Their design and use is therefore an important factor in the overall user experience.
|
||||
>
|
||||
"""
|
||||
|
||||
|
||||
srcUrl : String
|
||||
srcUrl =
|
||||
"https://github.com/debois/elm-mdl/blob/master/examples/Demo/Badges.elm"
|
||||
|
||||
|
||||
references : List (String, String)
|
||||
references =
|
||||
[ Page.package "http://package.elm-lang.org/packages/debois/elm-mdl/latest/Material-Badge"
|
||||
--, Page.mds "https://www.google.com/design/spec/components/buttons.html"
|
||||
, Page.mdl "https://www.getmdl.io/components/#badges-section"
|
||||
]
|
||||
|
||||
|
|
|
|||
|
|
@ -10,15 +10,19 @@ import Material.Grid as Grid
|
|||
import Material.Icon as Icon
|
||||
import Material.Style exposing (Style)
|
||||
|
||||
import Demo.Page as Page
|
||||
|
||||
|
||||
-- MODEL
|
||||
|
||||
|
||||
type alias Index = (Int, Int)
|
||||
|
||||
|
||||
type alias View =
|
||||
Signal.Address Button.Action -> Button.Model -> List Style -> List Html -> Html
|
||||
|
||||
|
||||
type alias View' =
|
||||
Signal.Address Button.Action -> Button.Model -> Html
|
||||
|
||||
|
|
@ -69,7 +73,8 @@ model =
|
|||
-- ACTION, UPDATE
|
||||
|
||||
|
||||
type Action = Action Index Button.Action
|
||||
type Action
|
||||
= Action Index Button.Action
|
||||
|
||||
|
||||
type alias Model =
|
||||
|
|
@ -79,20 +84,23 @@ type alias 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)
|
||||
update action model =
|
||||
case action of
|
||||
Action idx action ->
|
||||
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
|
||||
|
||||
|
||||
|
||||
view : Signal.Address Action -> Model -> Html
|
||||
view addr model =
|
||||
buttons |> List.concatMap (\row ->
|
||||
|
|
@ -125,4 +133,39 @@ view addr model =
|
|||
]
|
||||
)
|
||||
)
|
||||
|> Grid.grid []
|
||||
|> Grid.grid []
|
||||
|> flip (::) []
|
||||
|> Page.body "Buttons" srcUrl intro references
|
||||
|
||||
intro : Html
|
||||
intro =
|
||||
Page.fromMDL "https://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.
|
||||
|
||||
"""
|
||||
|
||||
srcUrl : String
|
||||
srcUrl =
|
||||
"https://github.com/debois/elm-mdl/blob/master/examples/Demo/Buttons.elm"
|
||||
|
||||
references : List (String, String)
|
||||
references =
|
||||
[ Page.package "http://package.elm-lang.org/packages/debois/elm-mdl/latest/Material-Button"
|
||||
, Page.mds "https://www.google.com/design/spec/components/buttons.html"
|
||||
, Page.mdl "https://www.getmdl.io/components/#buttons-section"
|
||||
]
|
||||
|
||||
|
|
|
|||
85
examples/Demo/Elevation.elm
Normal file
85
examples/Demo/Elevation.elm
Normal file
|
|
@ -0,0 +1,85 @@
|
|||
module Demo.Elevation where
|
||||
|
||||
import Html exposing (..)
|
||||
|
||||
import Material.Style as Style exposing (cs, css)
|
||||
import Material.Elevation as Elevation
|
||||
|
||||
import Demo.Page as Page
|
||||
|
||||
|
||||
-- VIEW
|
||||
|
||||
|
||||
elevate : Int -> Html
|
||||
elevate k =
|
||||
Style.div
|
||||
[ css "height" "96px"
|
||||
, css "width" "128px"
|
||||
, css "margin" "40px"
|
||||
, css "display" "inline-flex"
|
||||
, css "flex-flow" "row wrap"
|
||||
, css "justify-content" "center"
|
||||
, css "align-items" "center"
|
||||
, Elevation.shadow k
|
||||
]
|
||||
[ Style.div
|
||||
[ cs ".mdl-typography--title-color-contrast"
|
||||
-- TODO. Typography!
|
||||
]
|
||||
[ text <| toString k ]
|
||||
]
|
||||
|
||||
|
||||
|
||||
|
||||
view : Html
|
||||
view =
|
||||
0 :: Elevation.validElevations
|
||||
|> List.map elevate
|
||||
|> Page.body "Elevation" srcUrl intro references
|
||||
|
||||
|
||||
|
||||
intro : Html
|
||||
intro =
|
||||
Page.fromMDL "https://github.com/google/material-design-lite/blob/master/src/shadow/README.md" """
|
||||
> The Material Design Lite (MDL) shadow is not a component in the same sense as
|
||||
> an MDL card, menu, or textbox; it is a visual effect that can be assigned to a
|
||||
> user interface element. The effect simulates a three-dimensional positioning of
|
||||
> the element, as though it is slightly raised above the surface it rests upon —
|
||||
> a positive z-axis value, in user interface terms. The shadow starts at the
|
||||
> edges of the element and gradually fades outward, providing a realistic 3-D
|
||||
> effect.
|
||||
>
|
||||
> Shadows are a convenient and intuitive means of distinguishing an element from
|
||||
> its surroundings. A shadow can draw the user's eye to an object and emphasize
|
||||
> the object's importance, uniqueness, or immediacy.
|
||||
>
|
||||
> Shadows are a well-established feature in user interfaces, and provide users
|
||||
> with a visual clue to an object's intended use or value. Their design and use
|
||||
> is an important factor in the overall user experience.)
|
||||
|
||||
The [Material Design Specification](https://www.google.com/design/spec/what-is-material/elevation-shadows.html#elevation-shadows-elevation-android-)
|
||||
pre-defines appropriate elevation for most UI elements; you need to manually
|
||||
assign shadows only to your own elements.
|
||||
|
||||
You are encouraged to visit the
|
||||
[Material Design specification](https://www.google.com/design/spec/what-is-material/elevation-shadows.html)
|
||||
for details about appropriate use of shadows.
|
||||
"""
|
||||
|
||||
|
||||
srcUrl : String
|
||||
srcUrl =
|
||||
"https://github.com/debois/elm-mdl/blob/master/examples/Demo/Elevation.elm"
|
||||
|
||||
|
||||
references : List (String, String)
|
||||
references =
|
||||
[ Page.package "http://package.elm-lang.org/packages/debois/elm-mdl/latest/Material-Elevation"
|
||||
, Page.mds "https://www.google.com/design/spec/what-is-material/elevation-shadows.html"
|
||||
, Page.mdl "https://github.com/google/material-design-lite/blob/master/src/shadow/README.md"
|
||||
]
|
||||
|
||||
|
||||
|
|
@ -1,14 +1,19 @@
|
|||
module Demo.Grid where
|
||||
|
||||
|
||||
import Html exposing (..)
|
||||
import Array
|
||||
|
||||
import Material.Grid exposing (..)
|
||||
import Material.Style exposing (Style, css)
|
||||
import Material.Color as Color
|
||||
|
||||
import Markdown
|
||||
import Demo.Page as Page
|
||||
|
||||
import Html exposing (..)
|
||||
|
||||
-- Cell styling
|
||||
|
||||
|
||||
style : Int -> List Style
|
||||
style h =
|
||||
[ css "text-sizing" "border-box"
|
||||
|
|
@ -19,44 +24,61 @@ style h =
|
|||
, css "color" "white"
|
||||
]
|
||||
|
||||
|
||||
-- Cell variants
|
||||
|
||||
|
||||
democell : Int -> List Style -> List Html -> Cell
|
||||
democell k styling =
|
||||
cell <| List.concat [style k, styling]
|
||||
|
||||
|
||||
small : List Style -> List Html -> Cell
|
||||
small = democell 50
|
||||
|
||||
|
||||
std : List Style -> List Html -> Cell
|
||||
std = democell 200
|
||||
|
||||
|
||||
-- Grid
|
||||
|
||||
view : List Html
|
||||
|
||||
color : Int -> Style
|
||||
color k =
|
||||
Array.get ((k + 7) % Array.length Color.palette) Color.palette
|
||||
|> Maybe.withDefault Color.Teal
|
||||
|> flip Color.color Color.S500
|
||||
|> Color.background
|
||||
|
||||
|
||||
view : Html
|
||||
view =
|
||||
[ [1..12]
|
||||
|> List.map (\i -> small [size All 1] [text "1"])
|
||||
[ p []
|
||||
[ text """Resize your browser-window and observe the effect on the Grid
|
||||
below. Note in particular what happens to the top and bottom rows."""
|
||||
]
|
||||
, [1..12 ]
|
||||
|> List.map (\i -> small [size All 1, color i] [text "1"])
|
||||
|> grid []
|
||||
, [1 .. 3]
|
||||
|> List.map (\i -> std [size All 4] [text <| "4"])
|
||||
|> List.map (\i -> std [size All 4, color i] [text <| "4"])
|
||||
|> grid []
|
||||
, [ std [size All 6] [text "6"]
|
||||
, std [size All 4] [text "4"]
|
||||
, std [size All 2] [text "2"]
|
||||
, [ std [size All 6, color 16] [text "6"]
|
||||
, std [size All 4, color 17] [text "4"]
|
||||
, std [size All 2, color 18] [text "2"]
|
||||
] |> grid []
|
||||
, [ std [size All 6, size Tablet 8] [text "6 (8 tablet)"]
|
||||
, std [size All 4, size Tablet 6] [text "4 (6 tablet)"]
|
||||
, std [size All 2, size Phone 4] [text "2 (4 phone)"]
|
||||
, [ std [size All 6, size Tablet 8, color 19] [text "6 (8 tablet)"]
|
||||
, std [size All 4, size Tablet 6, color 20] [text "4 (6 tablet)"]
|
||||
, std [size All 2, size Phone 4, color 21] [text "2 (4 phone)"]
|
||||
] |> grid []
|
||||
]
|
||||
|> Page.body "Grid" srcUrl intro references
|
||||
|
||||
|
||||
intro : Html
|
||||
intro = """
|
||||
From the
|
||||
[Material Design Lite documentation](http://www.getmdl.io/components/#layout-section/grid):
|
||||
|
||||
intro =
|
||||
Page.fromMDL "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
|
||||
|
|
@ -72,16 +94,15 @@ From the
|
|||
> - 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.
|
||||
"""
|
||||
|
||||
#### See also
|
||||
|
||||
- [Demo source code](https://github.com/debois/elm-mdl/blob/master/examples/Demo/Grid.elm)
|
||||
- [elm-mdl package documentation](http://package.elm-lang.org/packages/debois/elm-mdl/latest/Material-Grid)
|
||||
- [Material Design Specification](https://www.google.com/design/spec/layout/responsive-ui.html#responsive-ui-grid)
|
||||
- [Material Design Lite documentation](http://www.getmdl.io/components/#layout-section/grid)
|
||||
|
||||
#### Demo
|
||||
|
||||
""" |> Markdown.toHtml
|
||||
|
||||
srcUrl : String
|
||||
srcUrl =
|
||||
"https://github.com/debois/elm-mdl/blob/master/examples/Demo/Grid.elm"
|
||||
|
||||
references : List (String, String)
|
||||
references =
|
||||
[ Page.package "http://package.elm-lang.org/packages/debois/elm-mdl/latest/Material-Grid"
|
||||
, Page.mds "https://www.google.com/design/spec/layout/responsive-ui.html#responsive-ui-grid"
|
||||
, Page.mdl "http://www.getmdl.io/components/#layout-section/grid"
|
||||
]
|
||||
|
|
|
|||
148
examples/Demo/Page.elm
Normal file
148
examples/Demo/Page.elm
Normal file
|
|
@ -0,0 +1,148 @@
|
|||
module Demo.Page
|
||||
( demo, package, mds, mdl
|
||||
, fromMDL, fromMDS
|
||||
, body
|
||||
)
|
||||
where
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (href, class)
|
||||
import Markdown
|
||||
|
||||
import Material.Grid exposing (..)
|
||||
import Material.Style as Style exposing (styled, cs, css, attribute)
|
||||
import Material.Button as Button
|
||||
import Material.Color as Color
|
||||
import Material.Icon as Icon
|
||||
|
||||
|
||||
-- REFERENCES
|
||||
|
||||
|
||||
demo : String -> (String, String)
|
||||
demo url =
|
||||
( "Demo source", url )
|
||||
|
||||
|
||||
package : String -> (String, String)
|
||||
package url =
|
||||
( "Package documentation", url )
|
||||
|
||||
|
||||
mds : String -> (String, String)
|
||||
mds url =
|
||||
( "Material Design Specification", url )
|
||||
|
||||
|
||||
mdl : String -> (String, String)
|
||||
mdl url =
|
||||
( "Material Design Lite documentation", url )
|
||||
|
||||
|
||||
references : List (String, String) -> List Html
|
||||
references links =
|
||||
[ text "References"
|
||||
, ul []
|
||||
( links |> List.map (\(str, url) ->
|
||||
li [] [ a [ href url ] [ text str ] ]
|
||||
)
|
||||
)
|
||||
]
|
||||
|
||||
|
||||
-- DOCUMENTATION QUOTES
|
||||
|
||||
|
||||
from : String -> String -> String -> Html
|
||||
from title url body =
|
||||
div []
|
||||
[ text "From the "
|
||||
, a [ href url ] [ text title ]
|
||||
, text ":"
|
||||
, Markdown.toHtml body
|
||||
]
|
||||
|
||||
|
||||
fromMDL : String -> String -> Html
|
||||
fromMDL =
|
||||
from "Material Design Lite documentation"
|
||||
|
||||
|
||||
fromMDS : String -> String -> Html
|
||||
fromMDS =
|
||||
from "Material Design Specification"
|
||||
|
||||
|
||||
-- TITLES
|
||||
|
||||
|
||||
title : String -> Html
|
||||
title t =
|
||||
Style.styled Html.h1
|
||||
[ Color.text Color.primary
|
||||
--, cs "mdl-typography--display-4"
|
||||
-- TODO. Typography module
|
||||
]
|
||||
[]
|
||||
[ text t ]
|
||||
|
||||
|
||||
demoTitle : Html
|
||||
demoTitle =
|
||||
Style.styled Html.h2
|
||||
[ Color.text Color.primary
|
||||
]
|
||||
[]
|
||||
[ text "Example" ]
|
||||
|
||||
-- VIEW SOURCE BUTTON
|
||||
|
||||
|
||||
addr : Signal.Address Button.Action
|
||||
addr = (Signal.mailbox Button.Click).address
|
||||
|
||||
|
||||
fab : String -> Html
|
||||
fab url =
|
||||
Button.fab addr (Button.model False)
|
||||
[ css "position" "fixed"
|
||||
, css "right" "48px"
|
||||
, css "top" "72px"
|
||||
, css "z-index" "100"
|
||||
, Button.colored
|
||||
--, attribute (href srcUrl)
|
||||
, attribute (Html.Attributes.attribute "onclick" ("alert('foo!');")) --("window.location.href = '" ++ srcUrl ++ "';") )
|
||||
]
|
||||
[ Icon.i "link" ]
|
||||
|
||||
|
||||
-- BODY
|
||||
|
||||
|
||||
body : String -> String -> Html -> List (String, String) -> List Html -> Html
|
||||
body t srcUrl contents links demo =
|
||||
div []
|
||||
[ title t
|
||||
, grid [ noSpacing ]
|
||||
[ cell [ size All 6, size Phone 4 ] [ contents ]
|
||||
, cell
|
||||
[ size All 5, offset Desktop 1, size Phone 4, align Top
|
||||
, css "position" "relative"
|
||||
]
|
||||
( references <| ("Demo source", srcUrl) :: links )
|
||||
]
|
||||
--, fab srcUrl
|
||||
-- TODO: buttons can't be links (yet)
|
||||
-- TODO: FAB placement.
|
||||
, demoTitle
|
||||
, Style.div
|
||||
[ css "margin-bottom" "48px"
|
||||
--, css "margin-top" "48px"
|
||||
-- , Elevation.shadow 2
|
||||
]
|
||||
demo
|
||||
]
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -4,36 +4,49 @@ import Effects exposing (Effects, none)
|
|||
import Html exposing (..)
|
||||
import Html.Attributes exposing (class, style, key)
|
||||
import Array exposing (Array)
|
||||
import Time exposing (Time, millisecond)
|
||||
|
||||
import Markdown
|
||||
|
||||
import Material.Helpers exposing (map1st, map2nd, delay)
|
||||
import Material.Color as Color
|
||||
import Material.Style exposing (styled, cs)
|
||||
import Material.Style exposing (styled, cs, css)
|
||||
import Material.Snackbar as Snackbar
|
||||
import Material.Button as Button exposing (Action(..))
|
||||
import Material.Grid exposing (..)
|
||||
import Material exposing (lift, lift')
|
||||
import Material.Elevation as Elevation
|
||||
import Material
|
||||
|
||||
import Demo.Page as Page
|
||||
|
||||
|
||||
-- MODEL
|
||||
|
||||
|
||||
type alias Mdl =
|
||||
Material.Model Action
|
||||
|
||||
|
||||
type Square'
|
||||
= Appearing
|
||||
| Idle
|
||||
| Disappearing
|
||||
|
||||
|
||||
type alias Square =
|
||||
(Int, Square')
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ count : Int
|
||||
, clicked : List Int
|
||||
, snackbar : Snackbar.Model Action
|
||||
, toastButton : Button.Model
|
||||
, snackbarButton : Button.Model
|
||||
, squares : List Square
|
||||
, mdl : Mdl
|
||||
}
|
||||
|
||||
|
||||
model : Model
|
||||
model =
|
||||
{ count = 0
|
||||
, clicked = []
|
||||
, snackbar = Snackbar.model
|
||||
, toastButton = Button.model True
|
||||
, snackbarButton = Button.model True
|
||||
, squares = []
|
||||
, mdl = Material.model
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -41,138 +54,220 @@ model =
|
|||
|
||||
|
||||
type Action
|
||||
= Undo Int
|
||||
-- Components
|
||||
| SnackbarAction (Snackbar.Action Action)
|
||||
| ToastButtonAction Button.Action
|
||||
| SnackbarButtonAction Button.Action
|
||||
= AddSnackbar
|
||||
| AddToast
|
||||
| Appear Int
|
||||
| Disappear Int
|
||||
| Gone Int
|
||||
| MDL (Material.Action Action)
|
||||
|
||||
|
||||
snackbar : Int -> Snackbar.Contents Action
|
||||
snackbar k =
|
||||
Snackbar.snackbar
|
||||
("Snackbar message #" ++ toString k)
|
||||
"UNDO"
|
||||
(Undo k)
|
||||
add : Model -> (Int -> Snackbar.Contents Action) -> (Model, Effects Action)
|
||||
add model f =
|
||||
let
|
||||
(mdl', fx) =
|
||||
Snackbar.add (f model.count) snackbar model.mdl
|
||||
model' =
|
||||
{ model
|
||||
| mdl = mdl'
|
||||
, count = model.count + 1
|
||||
, squares = (model.count, Appearing) :: model.squares
|
||||
}
|
||||
in
|
||||
( model'
|
||||
, Effects.batch
|
||||
[ Effects.tick (always (Appear model.count))
|
||||
, fx
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
toast : Int -> Snackbar.Contents Action
|
||||
toast k =
|
||||
Snackbar.toast
|
||||
<| "Toast message #" ++ toString k
|
||||
|
||||
|
||||
add : (Int -> Snackbar.Contents Action) -> Model -> (Model, Effects Action)
|
||||
add f model =
|
||||
let
|
||||
(snackbar', effects) =
|
||||
Snackbar.update (Snackbar.Add (f model.count)) model.snackbar
|
||||
in
|
||||
({ model
|
||||
| snackbar = snackbar'
|
||||
, count = model.count + 1
|
||||
, clicked = model.count :: model.clicked
|
||||
}
|
||||
, Effects.map SnackbarAction effects)
|
||||
mapSquare : Int -> (Square' -> Square') -> Model -> Model
|
||||
mapSquare k f model =
|
||||
{ model
|
||||
| squares =
|
||||
List.map
|
||||
( \((k', sq) as s) -> if k /= k' then s else (k', f sq) )
|
||||
model.squares
|
||||
}
|
||||
|
||||
|
||||
|
||||
update : Action -> Model -> (Model, Effects Action)
|
||||
update action model =
|
||||
case action of
|
||||
SnackbarButtonAction Click ->
|
||||
add snackbar model
|
||||
AddSnackbar ->
|
||||
add model
|
||||
<| \k -> Snackbar.snackbar ("Snackbar message #" ++ toString k) "UNDO" (Disappear k)
|
||||
|
||||
ToastButtonAction Click ->
|
||||
add toast model
|
||||
AddToast ->
|
||||
add model
|
||||
<| \k -> Snackbar.toast <| "Toast message #" ++ toString k
|
||||
|
||||
Undo k ->
|
||||
Appear k ->
|
||||
( model |> mapSquare k (always Idle)
|
||||
, none
|
||||
)
|
||||
|
||||
Disappear k ->
|
||||
( model |> mapSquare k (always Disappearing)
|
||||
, delay transitionLength (Gone k)
|
||||
)
|
||||
|
||||
Gone k ->
|
||||
({ model
|
||||
| clicked = List.filter ((/=) k) model.clicked
|
||||
| squares = List.filter (fst >> (/=) k) model.squares
|
||||
}
|
||||
, none)
|
||||
|
||||
SnackbarAction (Snackbar.Action action')
|
||||
-> update action' model
|
||||
MDL action' ->
|
||||
Material.update MDL action' model.mdl
|
||||
|> map1st (\m -> { model | mdl = m })
|
||||
|
||||
SnackbarAction action' -> lift .snackbar (\m x -> {m|snackbar =x}) SnackbarAction Snackbar.update action' model
|
||||
ToastButtonAction action' -> lift .toastButton (\m x -> {m|toastButton =x}) ToastButtonAction Button.update action' model
|
||||
SnackbarButtonAction action' -> lift .snackbarButton (\m x -> {m|snackbarButton=x}) SnackbarButtonAction Button.update action' model
|
||||
|
||||
|
||||
-- VIEW
|
||||
|
||||
|
||||
clickView : Model -> Int -> Html
|
||||
clickView model k =
|
||||
addSnackbarButton : Button.Instance Mdl Action
|
||||
addSnackbarButton =
|
||||
Button.instance 0 MDL
|
||||
Button.raised (Button.model True)
|
||||
[ Button.fwdClick AddSnackbar ]
|
||||
|
||||
|
||||
addToastButton : Button.Instance Mdl Action
|
||||
addToastButton =
|
||||
Button.instance 1 MDL
|
||||
Button.raised (Button.model True)
|
||||
[ Button.fwdClick AddToast ]
|
||||
|
||||
|
||||
-- TODO: Bad name
|
||||
snackbar : Snackbar.Instance Mdl Action
|
||||
snackbar =
|
||||
Snackbar.instance MDL Snackbar.model
|
||||
|
||||
|
||||
boxHeight : String
|
||||
boxHeight = "48px"
|
||||
|
||||
|
||||
boxWidth : String
|
||||
boxWidth = "64px"
|
||||
|
||||
|
||||
transitionLength : Time
|
||||
transitionLength = 150 * millisecond
|
||||
|
||||
|
||||
transitions : (String, String)
|
||||
transitions =
|
||||
("transition"
|
||||
, "box-shadow 333ms ease-in-out 0s, "
|
||||
++ "width " ++ toString transitionLength ++ "ms, "
|
||||
++ "height " ++ toString transitionLength ++ "ms"
|
||||
)
|
||||
|
||||
|
||||
clickView : Model -> Square -> Html
|
||||
clickView model (k, square) =
|
||||
let
|
||||
color =
|
||||
Array.get ((k + 4) % Array.length Color.palette) Color.palette
|
||||
|> Maybe.withDefault Color.Teal
|
||||
|> flip Color.color Color.S500
|
||||
|
||||
selected =
|
||||
(k == model.snackbar.seq - 1) &&
|
||||
(Snackbar.isActive model.snackbar /= Nothing)
|
||||
selected' =
|
||||
Snackbar.activeAction (snackbar.get model.mdl) == Just (Disappear k)
|
||||
|
||||
(width, height, margin, selected) =
|
||||
case square of
|
||||
Idle ->
|
||||
(boxWidth, boxHeight, "16px 16px", selected')
|
||||
_ ->
|
||||
("0", "0", "16px 0", False)
|
||||
in
|
||||
styled div
|
||||
[ Color.background color
|
||||
, Color.text Color.primaryContrast
|
||||
-- TODO. Should have shadow styles someplace.
|
||||
, cs <| "mdl-shadow--" ++ if selected then "8dp" else "2dp"
|
||||
]
|
||||
[ style
|
||||
[ ("margin-right", "3ex")
|
||||
, ("margin-bottom", "3ex")
|
||||
, ("padding", "1.5ex")
|
||||
, ("width", "4ex")
|
||||
, ("border-radius", "2px")
|
||||
div
|
||||
[ style
|
||||
[ ("height", boxHeight)
|
||||
, ("width", width)
|
||||
, ("position", "relative")
|
||||
, ("display", "inline-block")
|
||||
, ("text-align", "center")
|
||||
, ("transition", "box-shadow 333ms ease-in-out 0s")
|
||||
, ("margin", margin)
|
||||
, ("transition",
|
||||
"width " ++ toString transitionLength ++ "ms ease-in-out 0s, "
|
||||
++ "margin " ++ toString transitionLength ++ "ms ease-in-out 0s"
|
||||
)
|
||||
, ("z-index", "0")
|
||||
]
|
||||
, key (toString k)
|
||||
, key <| toString k
|
||||
]
|
||||
[ text <| toString k ]
|
||||
[ styled div
|
||||
[ Color.background color
|
||||
, Color.text Color.primaryContrast
|
||||
, Elevation.shadow (if selected then 8 else 2)
|
||||
]
|
||||
[ style
|
||||
[ ("display", "inline-flex")
|
||||
, ("align-items", "center")
|
||||
, ("justify-content", "center")
|
||||
, ("height", height)
|
||||
, ("width", width)
|
||||
, ("border-radius", "2px")
|
||||
, transitions
|
||||
, ("overflow", "hidden")
|
||||
, ("box-sizing", "border-box")
|
||||
, ("flex", "0 0 auto")
|
||||
, ("position", "absolute")
|
||||
, ("bottom", "0")
|
||||
, ("left", "0")
|
||||
]
|
||||
]
|
||||
[ div [] [ text <| toString k ] ]
|
||||
]
|
||||
|
||||
|
||||
|
||||
view : Signal.Address Action -> Model -> Html
|
||||
view addr model =
|
||||
div []
|
||||
[ h1 [ class "mdl-typography--display-4-color-contrast" ] [ text "Snackbars & Toasts" ]
|
||||
, intro
|
||||
, grid []
|
||||
-- TODO. Buttons should be centered. Desperately need to be able
|
||||
-- to add css/classes to top-level element of components (div
|
||||
-- in grid, button in button, div in textfield etc.)
|
||||
[ cell [ size All 2, size Phone 2, align Top ]
|
||||
[ Button.raised
|
||||
(Signal.forwardTo addr ToastButtonAction)
|
||||
model.toastButton
|
||||
[]
|
||||
Page.body "Snackbar & Toast" srcUrl intro references
|
||||
[ p []
|
||||
[ text """Click the buttons below to activate the snackbar. Note that
|
||||
multiple activations are automatically queued."""
|
||||
]
|
||||
, grid [ ] --css "margin-top" "32px" ]
|
||||
[ cell
|
||||
[ size All 2, size Phone 2, align Top ]
|
||||
[ addToastButton.view addr model.mdl
|
||||
[ Button.colored
|
||||
, css "margin" "16px"
|
||||
]
|
||||
[ text "Toast" ]
|
||||
]
|
||||
, cell [ size All 2, size Phone 2, align Top ]
|
||||
[ Button.raised
|
||||
(Signal.forwardTo addr SnackbarButtonAction)
|
||||
model.snackbarButton
|
||||
[]
|
||||
, cell
|
||||
[ size All 2, size Phone 2, align Top ]
|
||||
[ addSnackbarButton.view addr model.mdl
|
||||
[ Button.colored
|
||||
, css "margin" "16px"
|
||||
]
|
||||
[ text "Snackbar" ]
|
||||
]
|
||||
, cell
|
||||
[ size Desktop 7, size Tablet 3, size Phone 12, align Top ]
|
||||
(model.clicked |> List.reverse |> List.map (clickView model))
|
||||
[ size Desktop 7, offset Desktop 1
|
||||
, size Tablet 3, offset Tablet 1
|
||||
, size Phone 4
|
||||
, align Top
|
||||
]
|
||||
(model.squares |> List.reverse |> List.map (clickView model))
|
||||
]
|
||||
, Snackbar.view (Signal.forwardTo addr SnackbarAction) model.snackbar
|
||||
, snackbar.view addr model.mdl
|
||||
]
|
||||
|
||||
|
||||
intro : Html
|
||||
intro = """
|
||||
From the
|
||||
[Material Design Lite documentation](https://www.getmdl.io/components/index.html#snackbar-section).
|
||||
|
||||
intro =
|
||||
Page.fromMDL "https://www.getmdl.io/components/index.html#snackbar-section" """
|
||||
> The Material Design Lite (MDL) __snackbar__ component is a container used to
|
||||
> notify a user of an operation's status. It displays at the bottom of the
|
||||
> screen. A snackbar may contain an action button to execute a command for the
|
||||
|
|
@ -180,15 +275,19 @@ From the
|
|||
> example. Actions should not be to close the snackbar. By not providing an
|
||||
> action, the snackbar becomes a __toast__ component.
|
||||
|
||||
#### See also
|
||||
|
||||
- [Demo source code](https://github.com/debois/elm-mdl/blob/master/examples/Demo/Snackbar.elm)
|
||||
- [elm-mdl package documentation](http://package.elm-lang.org/packages/debois/elm-mdl/latest/Material-Snackbar)
|
||||
- [Material Design Specification](https://www.google.com/design/spec/components/snackbars-toasts.html)
|
||||
- [Material Design Lite documentation](https://www.getmdl.io/components/index.html#snackbar-section)
|
||||
|
||||
#### Demo
|
||||
|
||||
""" |> Markdown.toHtml
|
||||
"""
|
||||
|
||||
|
||||
srcUrl : String
|
||||
srcUrl =
|
||||
"https://github.com/debois/elm-mdl/blob/master/examples/Demo/Snackbar.elm"
|
||||
|
||||
|
||||
references : List (String, String)
|
||||
references =
|
||||
[ Page.package "http://package.elm-lang.org/packages/debois/elm-mdl/latest/Material-Snackbar"
|
||||
, Page.mds "https://www.google.com/design/spec/components/snackbars-toasts.html"
|
||||
, Page.mdl "https://www.getmdl.io/components/index.html#snackbar-section"
|
||||
]
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,52 +1,211 @@
|
|||
module Demo.Textfields where
|
||||
|
||||
import Array exposing (Array)
|
||||
import Html exposing (Html)
|
||||
import Effects exposing (Effects)
|
||||
import Regex
|
||||
|
||||
import Material.Textfield as Textfield
|
||||
import Material.Grid as Grid exposing (..)
|
||||
import Material.Helpers exposing (map1st)
|
||||
import Material
|
||||
|
||||
import Demo.Page as Page
|
||||
|
||||
|
||||
type alias Model = Array Textfield.Model
|
||||
-- MODEL
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ mdl : Material.Model Action
|
||||
, rx : (String, Regex.Regex)
|
||||
}
|
||||
|
||||
|
||||
rx0 : String
|
||||
rx0 =
|
||||
"[0-9]*"
|
||||
|
||||
|
||||
setRegex : String -> (String, Regex.Regex)
|
||||
setRegex str =
|
||||
(str, Regex.regex str)
|
||||
|
||||
|
||||
model : Model
|
||||
model =
|
||||
let t0 = Textfield.model in
|
||||
[ t0
|
||||
, { t0 | label = Just { text = "Labelled", float = False } }
|
||||
, { t0 | label = Just { text = "Floating label", float = True }}
|
||||
, { t0
|
||||
model =
|
||||
{ mdl = Material.model
|
||||
, rx = setRegex rx0
|
||||
}
|
||||
|
||||
|
||||
-- ACTION, UPDATE
|
||||
|
||||
|
||||
type Action
|
||||
= MDL (Material.Action Action)
|
||||
| Upd0 String
|
||||
| Upd4 String
|
||||
|
||||
|
||||
transferToDisabled : String -> Mdl -> Mdl
|
||||
transferToDisabled str =
|
||||
field3.map (\m ->
|
||||
{ m
|
||||
| value =
|
||||
if str == "" then
|
||||
""
|
||||
else
|
||||
"\"" ++ str ++ "\" (still disabled, though)"
|
||||
})
|
||||
|
||||
|
||||
{- Check that rx matches all of str.
|
||||
-}
|
||||
match : String -> Regex.Regex -> Bool
|
||||
match str rx =
|
||||
Regex.find Regex.All rx str
|
||||
|> List.any (.match >> (==) str)
|
||||
|
||||
|
||||
checkRegex : String -> (String, Regex.Regex) -> Mdl -> Mdl
|
||||
checkRegex str (rx', rx) mdl =
|
||||
let
|
||||
value4 = field4.get mdl |> .value
|
||||
in
|
||||
mdl |> field4.map (\m -> { m | error =
|
||||
if match value4 rx then
|
||||
Nothing
|
||||
else
|
||||
"Doesn't match regex ' " ++ rx' ++ "'" |> Just
|
||||
})
|
||||
|
||||
|
||||
|
||||
update : Action -> Model -> (Model, Effects Action)
|
||||
update action model =
|
||||
case action of
|
||||
MDL action' ->
|
||||
Material.update MDL action' model.mdl
|
||||
|> map1st (\mdl' -> { model | mdl = mdl' })
|
||||
|
||||
Upd0 str ->
|
||||
( { model | mdl = transferToDisabled str model.mdl }
|
||||
, Effects.none
|
||||
)
|
||||
|
||||
Upd4 str ->
|
||||
( { model | mdl = checkRegex str model.rx model.mdl }
|
||||
, Effects.none
|
||||
)
|
||||
|
||||
|
||||
-- VIEW
|
||||
|
||||
|
||||
m0 : Textfield.Model
|
||||
m0 =
|
||||
Textfield.model
|
||||
|
||||
|
||||
type alias Mdl =
|
||||
Material.Model Action
|
||||
|
||||
|
||||
field0 : Textfield.Instance Mdl Action
|
||||
field0 =
|
||||
Textfield.instance 0 MDL m0
|
||||
[ Textfield.fwdInput Upd0
|
||||
]
|
||||
|
||||
|
||||
field1 : Textfield.Instance Mdl Action
|
||||
field1 =
|
||||
Textfield.instance 1 MDL
|
||||
{ m0 | label = Just { text = "Labelled", float = False } }
|
||||
[]
|
||||
|
||||
|
||||
field2 : Textfield.Instance Mdl Action
|
||||
field2 =
|
||||
Textfield.instance 2 MDL
|
||||
{ m0 | label = Just { text = "Floating label", float = True } }
|
||||
[]
|
||||
|
||||
|
||||
field3 : Textfield.Instance Mdl Action
|
||||
field3 =
|
||||
Textfield.instance 3 MDL
|
||||
{ m0
|
||||
| label = Just { text = "Disabled", float = False }
|
||||
, isDisabled = True
|
||||
}
|
||||
, { t0
|
||||
| label = Just { text = "With error and value", float = False }
|
||||
, error = Just "The input is wrong!"
|
||||
, value = "Incorrect input"
|
||||
}
|
||||
]
|
||||
|> Array.fromList
|
||||
[]
|
||||
|
||||
|
||||
type Action =
|
||||
Field Int Textfield.Action
|
||||
|
||||
|
||||
update : Action -> Model -> Model
|
||||
update (Field k action) fields =
|
||||
Array.get k fields
|
||||
|> Maybe.map (Textfield.update action)
|
||||
|> Maybe.map (\field' -> Array.set k field' fields)
|
||||
|> Maybe.withDefault fields
|
||||
field4 : Textfield.Instance Mdl Action
|
||||
field4 =
|
||||
Textfield.instance 4 MDL
|
||||
{ m0 | label = Just { text = "With error checking", float = False } }
|
||||
[ Textfield.fwdInput Upd4 ]
|
||||
|
||||
|
||||
view : Signal.Address Action -> Model -> Html
|
||||
view addr model =
|
||||
model
|
||||
|> Array.indexedMap (\k field ->
|
||||
Textfield.view (Signal.forwardTo addr (Field k)) field
|
||||
)
|
||||
|> Array.toList
|
||||
|> List.map (\x -> cell [size All 3] [x])
|
||||
[ field0
|
||||
, field1
|
||||
, field2
|
||||
, field3
|
||||
, field4
|
||||
]
|
||||
|> List.map (\c ->
|
||||
cell
|
||||
[size All 4, offset Desktop 1]
|
||||
[c.view addr model.mdl]
|
||||
)
|
||||
|> List.intersperse (cell [size All 1] [])
|
||||
|> grid []
|
||||
|> flip (::) []
|
||||
|> (::) (Html.text "Try entering text into some of the textfields below.")
|
||||
|> Page.body "Textfields" srcUrl intro references
|
||||
|
||||
|
||||
intro : Html
|
||||
intro =
|
||||
Page.fromMDL "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.
|
||||
|
||||
"""
|
||||
|
||||
srcUrl : String
|
||||
srcUrl =
|
||||
"https://github.com/debois/elm-mdl/blob/master/examples/Demo/Textfields.elm"
|
||||
|
||||
|
||||
references : List (String, String)
|
||||
references =
|
||||
[ Page.package "http://package.elm-lang.org/packages/debois/elm-mdl/latest/Material-Textfield"
|
||||
, Page.mds "https://www.google.com/design/spec/components/text-fields.html"
|
||||
, Page.mdl "https://www.getmdl.io/components/#textfields-section"
|
||||
]
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
243
src/Material.elm
243
src/Material.elm
|
|
@ -1,126 +1,187 @@
|
|||
module Material
|
||||
( topWithScheme, top
|
||||
, Updater', Updater, lift, lift'
|
||||
) where
|
||||
module Material
|
||||
( Model, model
|
||||
, Action, update
|
||||
)
|
||||
where
|
||||
|
||||
{-| Material Design component library for Elm based on Google's
|
||||
{-|
|
||||
|
||||
Material Design component library for Elm based on Google's
|
||||
[Material Design Lite](https://www.getmdl.io/).
|
||||
|
||||
This module contains only initial CSS setup and convenience function for alleviating
|
||||
the pain of the missing component architecture in Elm.
|
||||
Click
|
||||
[here](https://debois.github.io/elm-mdl/)
|
||||
for a live demo.
|
||||
|
||||
# Loading CSS
|
||||
@docs topWithScheme, top
|
||||
# Component model
|
||||
|
||||
# Component convienience
|
||||
@docs Updater', Updater, lift', lift
|
||||
-}
|
||||
The component model of the library is simply the Elm Architecture (TEA), i.e.,
|
||||
each component has types `Model` and `Action`, and values `view` and `update`. A
|
||||
minimal example using this library in plain TEA can be found
|
||||
[here](https://github.com/debois/elm-mdl/blob/master/examples/Component-TEA.elm).
|
||||
|
||||
Using more than a few component in plain TEA is unwieldy because of the large
|
||||
amount of boilerplate one has to write. This library provides the "component
|
||||
support" for getting rid of most of that boilerplate. A minimal example using
|
||||
component support is
|
||||
[here](http://github.com/debois/elm-mdl/blob/master/examples/Component.elm).
|
||||
|
||||
import String
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Effects exposing (..)
|
||||
It is important to note that component support lives __within__ TEA;
|
||||
it is not an alternative architecture.
|
||||
|
||||
import Material.Color exposing (Palette(..), Color)
|
||||
# Getting started
|
||||
|
||||
The easiest way to get started is to start with one of the minimal examples above.
|
||||
We recommend going with the library's
|
||||
[component support](http://github.com/debois/elm-mdl/blob/master/examples/Component.elm)
|
||||
rather than working directly in plain Elm Architecture.
|
||||
|
||||
scheme : Palette -> Palette -> String
|
||||
scheme primary accent =
|
||||
[ "https://code.getmdl.io/1.1.2/" ++ Material.Color.scheme primary accent
|
||||
, "https://fonts.googleapis.com/icon?family=Material+Icons"
|
||||
, "https://fonts.googleapis.com/css?family=Roboto:400,300,500|Roboto+Mono|Roboto+Condensed:400,700&subset=latin,latin-ext"
|
||||
]
|
||||
|> List.map (\url -> "@import url(" ++ url ++ ");")
|
||||
|> String.join "\n"
|
||||
# Component Support
|
||||
|
||||
This module contains only convenience functions for working with nested
|
||||
components in the Elm architecture. A minimal example using this library
|
||||
with component support can be found
|
||||
[here](http://github.com/debois/elm-mdl/blob/master/examples/Component.elm).
|
||||
We encourage you to use the library in this fashion.
|
||||
|
||||
All examples in this subsection is from the
|
||||
[above minimal example](http://github.com/debois/elm-mdl/blob/master/examples/Component.elm)
|
||||
|
||||
{-| Top-level container for Material components. This will force loading of
|
||||
Material Design Lite CSS files Any component you use must be contained
|
||||
in this container, OR you must manually add something like the following to
|
||||
your .html file:
|
||||
Here is how you use component support in general. First, boilerplate.
|
||||
|
||||
1. Include `Material`:
|
||||
|
||||
<!-- 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.3/material.min.css" />
|
||||
|
||||
Supply primary and accent colors as parameters. Refer to the
|
||||
Material Design Lite [Custom CSS theme builder](https://www.getmdl.io/customize/index.html)
|
||||
to preview combinations.
|
||||
2. Add a model container Material components to your model:
|
||||
|
||||
Please be aware that Grey, Blue Grey, and Brown cannot be secondary colors. If
|
||||
you choose them as such anyway, you will get the default theme.
|
||||
type alias Model =
|
||||
{ ...
|
||||
, mdl : Material.Model
|
||||
}
|
||||
|
||||
Using this top-level container is not recommended, as most browsers will load
|
||||
css concurrently with rendering the initial page, which will produce a flicker
|
||||
on page load. The container is included only to provide an option to get started
|
||||
quickly and for use with elm-reactor.
|
||||
model : Model =
|
||||
{ ...
|
||||
, mdl = Material.model
|
||||
}
|
||||
|
||||
3. Add an action for Material components.
|
||||
|
||||
type Action =
|
||||
...
|
||||
| MDL (Material.Action Action)
|
||||
|
||||
4. Handle that action in your update function as follows:
|
||||
|
||||
update action model =
|
||||
case action of
|
||||
...
|
||||
MDL action' ->
|
||||
let (mdl', fx) =
|
||||
Material.update MDL action' model.mdl
|
||||
in
|
||||
( { model | mdl = mdl' } , fx )
|
||||
|
||||
Next, make the component instances you need. Do this in the View section of your
|
||||
source file. Let's say you need a textfield for name entry, and you'd like to
|
||||
be notifed whenever the field changes value through your own NameChanged action:
|
||||
|
||||
import Material.Textfield as Textfield
|
||||
|
||||
...
|
||||
|
||||
type Action =
|
||||
...
|
||||
| NameChanged String
|
||||
|
||||
...
|
||||
|
||||
update action model =
|
||||
case action of
|
||||
...
|
||||
NameChanged name ->
|
||||
-- Do whatever you need to do.
|
||||
|
||||
...
|
||||
|
||||
nameInput : Textfield.Instance Material.Model Action
|
||||
nameInput =
|
||||
Textfield.instance 2 MDL Textfield.model
|
||||
[ Textfield.fwdInput NameChanged
|
||||
]
|
||||
|
||||
view addr model =
|
||||
...
|
||||
nameInput.view addr model.mdl
|
||||
|
||||
|
||||
The win relative to using plain Elm Architecture is that adding a component
|
||||
neither requires you to update your model, your Actions, nor your update function.
|
||||
(As in the above example, you will frequently have to update the latter two anyway,
|
||||
but now it's not boilerplate, its "business logic".)
|
||||
|
||||
|
||||
## Optimising for size
|
||||
|
||||
Using this module will force all elm-mdl components to be built and included in
|
||||
your application. If this is unacceptable, you can custom-build a version of this
|
||||
module that uses only the components you need. To do so, you need to re-implement
|
||||
the present module, modifying the values `model` and `Model` by commenting out the
|
||||
components you are not using. The module source can be found
|
||||
[here](https://github.com/debois/elm-mdl/blob/master/src/Material.elm).
|
||||
|
||||
You do not need to re-build the entire elm-mdl library; simply copy the
|
||||
source of this module, give it a new name, modify as it as indicated above,
|
||||
then use your modified module rather than this one.
|
||||
|
||||
@docs Model, model, Action, update
|
||||
-}
|
||||
topWithScheme: Palette -> Palette -> Html -> Html
|
||||
topWithScheme primary accent content =
|
||||
div [] <|
|
||||
{- Trick from Peter Damoc to load CSS outside of <head>.
|
||||
https://github.com/pdamoc/elm-mdl/blob/master/src/Mdl.elm#L63
|
||||
-}
|
||||
[ node "style"
|
||||
[ type' "text/css"]
|
||||
[ Html.text <| scheme primary accent]
|
||||
, content
|
||||
]
|
||||
|
||||
import Dict
|
||||
import Effects exposing (Effects)
|
||||
|
||||
import Material.Button as Button
|
||||
import Material.Textfield as Textfield
|
||||
import Material.Snackbar as Snackbar
|
||||
import Material.Component as Component exposing (Indexed)
|
||||
|
||||
|
||||
{-| Top-level container with default color scheme.
|
||||
{-| Model encompassing all Material components. Since some components store
|
||||
user actions in their model (notably Snackbar), the model is generic in the
|
||||
type of such "observations".
|
||||
-}
|
||||
top : Html -> Html
|
||||
top content =
|
||||
-- Force default color-scheme by picking an invalid combination.
|
||||
topWithScheme Grey Grey content
|
||||
type alias Model obs =
|
||||
{ button : Indexed Button.Model
|
||||
, textfield : Indexed Textfield.Model
|
||||
, snackbar : Maybe (Snackbar.Model obs)
|
||||
}
|
||||
|
||||
|
||||
|
||||
{-| TODO.
|
||||
{-| Initial model.
|
||||
-}
|
||||
type alias Updater' action model =
|
||||
action -> model -> model
|
||||
model : Model obs
|
||||
model =
|
||||
{ button = Dict.empty
|
||||
, textfield = Dict.empty
|
||||
, snackbar = Nothing
|
||||
}
|
||||
|
||||
|
||||
{-| TODO.
|
||||
{-| Action encompassing actions of all Material components.
|
||||
-}
|
||||
type alias Updater action model =
|
||||
action -> model -> (model, Effects action)
|
||||
|
||||
type alias ComponentModel model components =
|
||||
{ model | components : components }
|
||||
type alias Action obs =
|
||||
Component.Action (Model obs) obs
|
||||
|
||||
|
||||
{-| TODO.
|
||||
{-| Update function for the above Action.
|
||||
-}
|
||||
lift' :
|
||||
(model -> submodel) -> -- get
|
||||
(model -> submodel -> model) -> -- set
|
||||
Updater' subaction submodel -> -- update
|
||||
subaction -> -- action
|
||||
model -> -- model
|
||||
(model, Effects action)
|
||||
lift' get set update action model =
|
||||
(set model (update action (get model)), Effects.none)
|
||||
|
||||
|
||||
{-| TODO.
|
||||
-}
|
||||
lift :
|
||||
(model -> submodel) -> -- get
|
||||
(model -> submodel -> model) -> -- set
|
||||
(subaction -> action) -> -- fwd
|
||||
Updater subaction submodel -> -- update
|
||||
subaction -> -- action
|
||||
model -> -- model
|
||||
(model, Effects action)
|
||||
lift get set fwd update action model =
|
||||
let
|
||||
(submodel', e) = update action (get model)
|
||||
in
|
||||
(set model submodel', Effects.map fwd e)
|
||||
update :
|
||||
(Action obs -> obs)
|
||||
-> Action obs
|
||||
-> Model obs
|
||||
-> (Model obs, Effects obs)
|
||||
update =
|
||||
Component.update
|
||||
|
|
|
|||
|
|
@ -30,7 +30,8 @@ module Material.Badge
|
|||
@docs withBadge, noBackground, overlap
|
||||
-}
|
||||
|
||||
import Material.Style exposing (Style, cs, attrib, multiple)
|
||||
import Html.Attributes
|
||||
import Material.Style exposing (Style, cs, attribute, multiple)
|
||||
|
||||
|
||||
{-| Optional style for Badge. No background for badge
|
||||
|
|
@ -55,4 +56,7 @@ overlap =
|
|||
-}
|
||||
withBadge : String -> Style
|
||||
withBadge databadge =
|
||||
multiple [cs "mdl-badge", attrib "data-badge" databadge]
|
||||
multiple
|
||||
[ cs "mdl-badge"
|
||||
, attribute (Html.Attributes.attribute "data-badge" databadge)
|
||||
]
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
module Material.Button
|
||||
( Model, model, Action(Click), update
|
||||
, flat, raised, fab, minifab, icon
|
||||
, Button, colored, primary, accent
|
||||
, colored, primary, accent
|
||||
, View, State, Instance, instance, fwdClick
|
||||
) where
|
||||
|
||||
{-| From the [Material Design Lite documentation](http://www.getmdl.io/components/#buttons-section):
|
||||
|
|
@ -25,11 +26,11 @@ module Material.Button
|
|||
See also the
|
||||
[Material Design Specification]([https://www.google.com/design/spec/components/buttons.html).
|
||||
|
||||
# Component
|
||||
@docs Model, model, Action, update
|
||||
# Elm architecture
|
||||
@docs Model, model, Action, update, View
|
||||
|
||||
# Style
|
||||
@docs Button, colored, primary, accent
|
||||
@docs colored, primary, accent
|
||||
|
||||
# View
|
||||
Refer to the
|
||||
|
|
@ -38,6 +39,9 @@ for details about what type of buttons are appropriate for which situations.
|
|||
|
||||
@docs flat, raised, fab, minifab, icon
|
||||
|
||||
# Component
|
||||
@docs State, Instance, instance, fwdClick
|
||||
|
||||
-}
|
||||
|
||||
import Html exposing (..)
|
||||
|
|
@ -49,6 +53,7 @@ import Signal exposing (Address, forwardTo)
|
|||
import Material.Helpers as Helpers
|
||||
import Material.Style exposing (Style, cs, cs', styled)
|
||||
import Material.Ripple as Ripple
|
||||
import Material.Component as Component exposing (Indexed)
|
||||
|
||||
{-| MDL button.
|
||||
-}
|
||||
|
|
@ -105,24 +110,20 @@ update action model =
|
|||
-- VIEW
|
||||
|
||||
|
||||
{-| Type tag for button styles.
|
||||
-}
|
||||
type Button = X
|
||||
|
||||
|
||||
{-| Color button with primary or accent color depending on button type.
|
||||
{-| Color button with primary or accent color depending on button type.
|
||||
-}
|
||||
colored : Style
|
||||
colored =
|
||||
colored =
|
||||
cs "mdl-button--colored"
|
||||
|
||||
|
||||
{-| Color button with primary color.
|
||||
-}
|
||||
primary : Style
|
||||
primary =
|
||||
primary =
|
||||
cs "mdl-button--primary"
|
||||
|
||||
|
||||
{-| Color button with accent color.
|
||||
-}
|
||||
accent : Style
|
||||
|
|
@ -130,8 +131,6 @@ accent =
|
|||
cs "mdl-button--accent"
|
||||
|
||||
|
||||
{-| Component view.
|
||||
-}
|
||||
view : String -> Address Action -> Model -> List Style -> List Html -> Html
|
||||
view kind addr model styling html =
|
||||
styled button
|
||||
|
|
@ -143,19 +142,26 @@ view kind addr model styling html =
|
|||
)
|
||||
[ Helpers.blurOn "mouseup"
|
||||
, Helpers.blurOn "mouseleave"
|
||||
, onClick addr Click
|
||||
, Html.Events.onClick addr Click
|
||||
]
|
||||
(case model of
|
||||
S (Just ripple) ->
|
||||
Ripple.view
|
||||
(forwardTo addr Ripple)
|
||||
[ class "mdl-button__ripple-container"
|
||||
, Helpers.blurOn "mouseup" ]
|
||||
, Helpers.blurOn "mouseup"
|
||||
]
|
||||
ripple
|
||||
:: html
|
||||
_ -> html)
|
||||
|
||||
|
||||
{-| Type of button views.
|
||||
-}
|
||||
type alias View =
|
||||
Address Action -> Model -> List Style -> List Html -> Html
|
||||
|
||||
|
||||
{-| From the
|
||||
[Material Design Specification](https://www.google.com/design/spec/components/buttons.html#buttons-flat-buttons):
|
||||
|
||||
|
|
@ -176,7 +182,7 @@ Example use (uncolored flat button, assuming properly setup model):
|
|||
flatButton = Button.flat addr model Button.Plain [text "Click me!"]
|
||||
|
||||
-}
|
||||
flat : Address Action -> Model -> List Style -> List Html -> Html
|
||||
flat : View
|
||||
flat = view ""
|
||||
|
||||
|
||||
|
|
@ -197,7 +203,7 @@ Example use (colored raised button, assuming properly setup model):
|
|||
raisedButton = Button.raised addr model Button.Colored [text "Click me!"]
|
||||
|
||||
-}
|
||||
raised : Address Action -> Model -> List Style -> List Html -> Html
|
||||
raised : View
|
||||
raised = view "mdl-button--raised"
|
||||
|
||||
|
||||
|
|
@ -223,13 +229,13 @@ Example use (colored with a '+' icon):
|
|||
fabButton : Html
|
||||
fabButton = fab addr model Colored [Icon.i "add"]
|
||||
-}
|
||||
fab : Address Action -> Model -> List Style -> List Html -> Html
|
||||
fab : View
|
||||
fab = view "mdl-button--fab"
|
||||
|
||||
|
||||
{-| Mini-sized variant of a Floating Action Button; refer to `fab`.
|
||||
-}
|
||||
minifab : Address Action -> Model -> List Style -> List Html -> Html
|
||||
minifab : View
|
||||
minifab = view "mdl-button--mini-fab"
|
||||
|
||||
|
||||
|
|
@ -245,5 +251,56 @@ Example use (no color, displaying a '+' icon):
|
|||
iconButton : Html
|
||||
iconButton = icon addr model Plain [Icon.i "add"]
|
||||
-}
|
||||
icon : Address Action -> Model -> List Style -> List Html -> Html
|
||||
icon : View
|
||||
icon = view "mdl-button--icon"
|
||||
|
||||
|
||||
|
||||
-- COMPONENT
|
||||
|
||||
|
||||
{-|
|
||||
-}
|
||||
type alias State s =
|
||||
{ s | button : Indexed Model }
|
||||
|
||||
|
||||
type alias Observer obs =
|
||||
Component.Observer Action obs
|
||||
|
||||
|
||||
{-|
|
||||
-}
|
||||
type alias Instance state obs =
|
||||
Component.Instance
|
||||
Model
|
||||
state
|
||||
Action
|
||||
obs
|
||||
(List Style -> List Html -> Html)
|
||||
|
||||
|
||||
{-| Component instance.
|
||||
-}
|
||||
instance :
|
||||
Int
|
||||
-> (Component.Action (State state) obs -> obs)
|
||||
-> (Address Action -> Model -> List Style -> List Html -> Html)
|
||||
-> Model
|
||||
-> List (Observer obs)
|
||||
-> Instance (State state) obs
|
||||
|
||||
instance id lift view model0 observers =
|
||||
Component.instance
|
||||
view update .button (\x y -> {y | button = x}) id lift model0 observers
|
||||
|
||||
|
||||
{-| Lift the button Click action to your own action. E.g.,
|
||||
-}
|
||||
fwdClick : obs -> (Observer obs)
|
||||
fwdClick obs action =
|
||||
case action of
|
||||
Click -> Just obs
|
||||
_ -> Nothing
|
||||
|
||||
|
||||
|
|
|
|||
351
src/Material/Component.elm
Normal file
351
src/Material/Component.elm
Normal file
|
|
@ -0,0 +1,351 @@
|
|||
module Material.Component
|
||||
( embed, embedIndexed, Embedding, Observer
|
||||
, Indexed
|
||||
, Instance, instance, instance1
|
||||
, update
|
||||
, Action
|
||||
) where
|
||||
|
||||
{-|
|
||||
|
||||
The Elm Architecture is conceptually very nice, but it forces us to write large
|
||||
amounts of boilerplate whenever we need to use a "component". We must:
|
||||
|
||||
1. Retain the state of the component in our Model
|
||||
2. Add the components actions to our Action
|
||||
3. Dispatch those actions in our update
|
||||
|
||||
None of these things have anything to do with what we want from the component,
|
||||
namely rendering it in our View function, and potentially reacting to some
|
||||
(but not all) of its actions---e.g., we want to react to a Click of a button,
|
||||
but we don't care when it updates its animation state.
|
||||
|
||||
This module provides an extensible mechanism for collecting arbitrary
|
||||
(differently-typed) Elm Architecture components into a single component with
|
||||
a single Action type and update function. The module is used internally to
|
||||
produce `instance` functions; if you are using elm-mdl (and are not interested in
|
||||
optimising for compiled program size or writing your own components), you
|
||||
should ignore this module and look instead at `Material`.
|
||||
|
||||
|
||||
# Embeddings
|
||||
@docs Indexed, Embedding, embed, embedIndexed
|
||||
|
||||
# Instance construction
|
||||
@docs Action, Instance, Observer, instance, instance1
|
||||
|
||||
# Instance consumption
|
||||
@docs update
|
||||
|
||||
-}
|
||||
|
||||
import Effects exposing (Effects)
|
||||
import Task
|
||||
import Dict exposing (Dict)
|
||||
|
||||
import Material.Helpers exposing (map1, map2, map1st, map2nd, Update, Update')
|
||||
|
||||
|
||||
|
||||
-- TYPES
|
||||
|
||||
|
||||
|
||||
{-| Standard EA view function type.
|
||||
-}
|
||||
type alias View model action a =
|
||||
Signal.Address action -> model -> a
|
||||
|
||||
|
||||
|
||||
-- EMBEDDING MODELS
|
||||
|
||||
|
||||
|
||||
{-| Indexed families of things.
|
||||
-}
|
||||
type alias Indexed a =
|
||||
Dict Int a
|
||||
|
||||
|
||||
{-| An __embedding__ of an Elm Architecture component is a variant in which
|
||||
view and update functions know how to extract and update their model
|
||||
from a larger master model.
|
||||
-}
|
||||
type alias Embedding model container action a =
|
||||
{ view : View container action a
|
||||
, update : Update container action
|
||||
, getModel : container -> model
|
||||
, setModel : model -> container -> container
|
||||
}
|
||||
|
||||
|
||||
{-| Embed a component. Third and fourth arguments are a getter (extract the
|
||||
local model from the container) and a setter (update local model in the
|
||||
container).
|
||||
|
||||
It is instructive to compare the types of the view and update function in
|
||||
the input and output:
|
||||
|
||||
{- Input -} {- Output -}
|
||||
View model action a View container action a
|
||||
Update model action Update container action
|
||||
|
||||
-}
|
||||
embed :
|
||||
View model action a -> -- Given a view function,
|
||||
Update model action -> -- an update function
|
||||
(container -> model) -> -- a getter
|
||||
(model -> container -> container) -> -- a setter
|
||||
Embedding model container action a -- produce an Embedding.
|
||||
|
||||
embed view update get set =
|
||||
{ view =
|
||||
\addr model -> view addr (get model)
|
||||
, update =
|
||||
\action model ->
|
||||
update action (get model)
|
||||
|> map1st (flip set model)
|
||||
, getModel = get
|
||||
, setModel = set
|
||||
}
|
||||
|
||||
|
||||
{-| We are interested in particular embeddings where components of the same
|
||||
type all have their state living inside a shared `Dict`; the individual
|
||||
component has a key used to look up its own state.
|
||||
-}
|
||||
embedIndexed :
|
||||
View model action a -> -- Given a view function,
|
||||
Update model action -> -- an update function
|
||||
(container -> Indexed model) -> -- a getter
|
||||
(Indexed model -> container -> container) -> -- a setter
|
||||
model -> -- an initial model for this instance
|
||||
Int -> -- an instance id (*)
|
||||
Embedding model container action a -- ... produce a Component.
|
||||
|
||||
embedIndexed view update get set model0 id =
|
||||
let
|
||||
get' model =
|
||||
Dict.get id (get model) |> Maybe.withDefault model0
|
||||
|
||||
set' submodel model =
|
||||
set (Dict.insert id submodel (get model)) model
|
||||
in
|
||||
embed view update get' set'
|
||||
|
||||
|
||||
|
||||
-- LIFTING ACTIONS
|
||||
|
||||
|
||||
|
||||
{-| Similarly to how embeddings enable collecting models of different type
|
||||
in a single model container, we need to collect actions in a single "master
|
||||
action" type. Obviously, actions need to be eventually executed by running
|
||||
the corresponding update function. To avoid this master action type explicitly
|
||||
representing the Action/update pairs of elm-mdl components, we represent an
|
||||
action of an individual component as a partially applied update function; that
|
||||
is, a function `container -> container`. E.g., the `Click` action of Button is
|
||||
conceptually represented as:
|
||||
|
||||
embeddedButton : Embedding Button.Model container action ...
|
||||
embeddedButton =
|
||||
embedIndexed
|
||||
Button.view Button.update .button {\m x -> {m|button=x} Button.model 0
|
||||
|
||||
clickAction : container -> container
|
||||
clickAction = embeddedButton.update Button.click
|
||||
|
||||
When all Material components are embedded in the same `container` model, we
|
||||
then have a uniform update mechanism.
|
||||
|
||||
We lost the ability to inspect the action when we did this, though. To be
|
||||
able to react to some actions of a component, we add to our `container ->
|
||||
container` type for actions a potential __observation__ of type `obs`.
|
||||
In practice, this observation type `obs` will be the Action of the TEA
|
||||
component __hosting__ MDL components.
|
||||
|
||||
Altogether, accounting also for effects, we arrive at the following type.
|
||||
-}
|
||||
type Action container obs =
|
||||
A (container -> (container, Effects (Action container obs), Maybe obs))
|
||||
|
||||
|
||||
{-| Type of observers, i.e., functions that take an actual action of the
|
||||
underlying TEA component to an observation. E.g., Button has an Observer for
|
||||
its `Click` action.
|
||||
-}
|
||||
type alias Observer action obs =
|
||||
action -> Maybe obs
|
||||
|
||||
|
||||
{-| Generic update function for Action.
|
||||
-}
|
||||
update :
|
||||
(Action container obs -> obs) ->
|
||||
Update' container (Action container obs) obs
|
||||
|
||||
update fwd (A f) container =
|
||||
let
|
||||
(container', fx, obs) =
|
||||
f container
|
||||
|> map2 (Effects.map fwd)
|
||||
in
|
||||
case obs of
|
||||
Nothing ->
|
||||
(container', fx)
|
||||
|
||||
Just x ->
|
||||
(container', Effects.batch [ fx, Effects.task (Task.succeed x) ])
|
||||
|
||||
|
||||
|
||||
|
||||
-- INSTANCES
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
{-| Type of component instances. A component instance contains a view,
|
||||
get/set/map for the inner model, and a forwarder lifting component
|
||||
actions to observations.
|
||||
-}
|
||||
type alias Instance model container action obs a =
|
||||
{ view : View container obs a
|
||||
, get : container -> model
|
||||
, set : model -> container -> container
|
||||
, map : (model -> model) -> container -> container
|
||||
, fwd : action -> obs
|
||||
}
|
||||
|
||||
|
||||
{- TEA update function variant where running the function
|
||||
produces not just a new model and an effect, but also an
|
||||
observation.
|
||||
-}
|
||||
type alias Step model action obs =
|
||||
action -> model -> (model, Effects action, Maybe obs)
|
||||
|
||||
|
||||
{- Partially apply a step function to an action, producing a generic Action.
|
||||
-}
|
||||
pack : (Step model action obs) -> action -> Action model obs
|
||||
pack update action =
|
||||
A (update action >> map2 (Effects.map (pack update)))
|
||||
|
||||
|
||||
{- Convert an update function to a step function by applying a
|
||||
function that converts the action input to the update function into
|
||||
an observation.
|
||||
-}
|
||||
observe : Observer action obs -> Update model action -> Step model action obs
|
||||
observe f update action =
|
||||
update action >> (\(model', effects) -> (model', effects, f action))
|
||||
|
||||
|
||||
{- Return the first non-Nothing value in the list, or Nothing if no such
|
||||
exists.
|
||||
-}
|
||||
pick : (a -> Maybe b) -> List a -> Maybe b
|
||||
pick f xs =
|
||||
case xs of
|
||||
[] -> Nothing
|
||||
x :: xs' ->
|
||||
case f x of
|
||||
Nothing -> pick f xs'
|
||||
x -> x
|
||||
|
||||
|
||||
{- Promote a list of Observers to a single Observer by picking, for a given
|
||||
action, the first one that succeeds.
|
||||
-}
|
||||
connect : List (Observer action obs) -> Observer action obs
|
||||
connect observers subaction =
|
||||
pick ((|>) subaction) observers
|
||||
|
||||
|
||||
{-| Given a lifting function, a list of observers and an embedding, construct an
|
||||
Instance.
|
||||
-}
|
||||
instance'
|
||||
: (Action container obs -> obs)
|
||||
-> List (Observer action obs)
|
||||
-> Embedding model container action a
|
||||
-> Instance model container action obs a
|
||||
instance' lift observers embedding =
|
||||
let
|
||||
fwd =
|
||||
pack (observe (connect observers) embedding.update) >> lift
|
||||
get =
|
||||
embedding.getModel
|
||||
set =
|
||||
embedding.setModel
|
||||
in
|
||||
{ view =
|
||||
\addr ->
|
||||
embedding.view (Signal.forwardTo addr fwd)
|
||||
, get = get
|
||||
, set = set
|
||||
, map = \f model -> set (f (get model)) model
|
||||
, fwd = fwd
|
||||
}
|
||||
|
||||
|
||||
|
||||
{-| It is helpful to see parameter names:
|
||||
|
||||
instance view update get set id lift model0 observers =
|
||||
...
|
||||
|
||||
Convert a regular Elm Architecture component (`view`, `update`) to a component
|
||||
which knows how to access its model inside a generic container model (`get`,
|
||||
`set`), and which dispatches generic `Action` updates, lifted to the consumers
|
||||
action type `obs` (`lift`). You can react to actions in custom way by providing
|
||||
observers (`observers`). You must also provide an initial model (`model0`) and an
|
||||
identifier for the instance (`id`). The identifier must be unique for all
|
||||
instances of the same type stored in the same model (overapproximating rule of
|
||||
thumb: if they are in the same file, they need distinct ids.)
|
||||
|
||||
Its instructive to compare the types of the input and output views:
|
||||
|
||||
{- Input -} {- Output -}
|
||||
View model action a View container obs a
|
||||
|
||||
That is, this function fully converts a view from its own `model` and `action`
|
||||
to the master `container` model and `observation` action.
|
||||
-}
|
||||
instance
|
||||
: View model action a
|
||||
-> Update model action
|
||||
-> (container -> Indexed model)
|
||||
-> (Indexed model -> container -> container)
|
||||
-> Int
|
||||
-> (Action container obs -> obs)
|
||||
-> model
|
||||
-> List (Observer action obs)
|
||||
-> Instance model container action obs a
|
||||
|
||||
instance view update get set id lift model0 observers =
|
||||
embedIndexed view update get set model0 id
|
||||
|> instance' lift observers
|
||||
|
||||
|
||||
{-| Variant of `instance` for components that are naturally singletons
|
||||
(e.g., snackbar, layout).
|
||||
-}
|
||||
instance1
|
||||
: View model action a
|
||||
-> Update model action
|
||||
-> (container -> Maybe model)
|
||||
-> (Maybe model -> container -> container)
|
||||
-> (Action container obs -> obs)
|
||||
-> model
|
||||
-> List (Observer action obs)
|
||||
-> Instance model container action obs a
|
||||
|
||||
instance1 view update get set lift model0 observers =
|
||||
embed view update (get >> Maybe.withDefault model0) (Just >> set)
|
||||
|> instance' lift observers
|
||||
73
src/Material/Elevation.elm
Normal file
73
src/Material/Elevation.elm
Normal file
|
|
@ -0,0 +1,73 @@
|
|||
module Material.Elevation
|
||||
( shadow
|
||||
, validElevations
|
||||
, transition
|
||||
) where
|
||||
|
||||
|
||||
{-| From the [Material Design Lite documentation](https://github.com/google/material-design-lite/blob/master/src/shadow/README.md)
|
||||
|
||||
> The Material Design Lite (MDL) shadow is not a component in the same sense as
|
||||
> an MDL card, menu, or textbox; it is a visual effect that can be assigned to a
|
||||
> user interface element. The effect simulates a three-dimensional positioning of
|
||||
> the element, as though it is slightly raised above the surface it rests upon —
|
||||
> a positive z-axis value, in user interface terms. The shadow starts at the
|
||||
> edges of the element and gradually fades outward, providing a realistic 3-D
|
||||
> effect.
|
||||
>
|
||||
> Shadows are a convenient and intuitive means of distinguishing an element from
|
||||
> its surroundings. A shadow can draw the user's eye to an object and emphasize
|
||||
> the object's importance, uniqueness, or immediacy.
|
||||
>
|
||||
> Shadows are a well-established feature in user interfaces, and provide users
|
||||
> with a visual clue to an object's intended use or value. Their design and use
|
||||
> is an important factor in the overall user experience.)
|
||||
|
||||
The [Material Design Specification](https://www.google.com/design/spec/what-is-material/elevation-shadows.html#elevation-shadows-elevation-android-)
|
||||
pre-defines appropriate elevation for most UI elements; you need to manually
|
||||
assign shadows only to your own elements.
|
||||
|
||||
You are encouraged to visit the
|
||||
[Material Design specification](https://www.google.com/design/spec/what-is-material/elevation-shadows.html)
|
||||
for details about appropriate use of shadows.
|
||||
|
||||
|
||||
# Component
|
||||
@docs shadow, validElevations, transition
|
||||
|
||||
-}
|
||||
|
||||
import Material.Style exposing (..)
|
||||
|
||||
|
||||
{-| Indicate the elevation of an element by giving it a shadow.
|
||||
The `z` argument indicates intended elevation; valid values
|
||||
are 2, 3, 4, 6, 8, 16, 24. Invalid values produce no shadow.
|
||||
|
||||
(The specification uses only the values 1-6, 8, 9, 12, 16, 24 for standard UI
|
||||
elements; MDL sources define all values 0-24, but omits most from production css.)
|
||||
-}
|
||||
shadow : Int -> Style
|
||||
shadow z =
|
||||
cs ("mdl-shadow--" ++ toString z ++ "dp")
|
||||
|
||||
|
||||
{-| Programmatically accessible valid elevations for `shadow`.
|
||||
-}
|
||||
validElevations : List Int
|
||||
validElevations =
|
||||
[ 2, 3, 4, 6, 8, 16, 24 ]
|
||||
|
||||
|
||||
{-| Add a CSS-transition to changes in elevation. Supply a transition
|
||||
duration in milliseconds as argument.
|
||||
|
||||
NB! This style dictated by neither MDL nor the Material Design
|
||||
Specification.
|
||||
-}
|
||||
transition : String -> Style
|
||||
transition duration =
|
||||
css "transition" ("box-shadow " ++ toString duration ++ "ms ease-in-out 0s")
|
||||
|
||||
|
||||
|
||||
|
|
@ -3,23 +3,14 @@ module Material.Helpers where
|
|||
import Html
|
||||
import Html.Attributes
|
||||
import Effects exposing (Effects)
|
||||
import Time exposing (Time)
|
||||
import Task
|
||||
|
||||
filter : (a -> List b -> c) -> a -> List (Maybe b) -> c
|
||||
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
|
||||
|
||||
|
||||
effect : Effects b -> a -> (a, Effects b)
|
||||
effect e x = (x, e)
|
||||
|
||||
|
|
@ -43,3 +34,69 @@ clip lower upper k = Basics.max lower (Basics.min k upper)
|
|||
blurOn : String -> Html.Attribute
|
||||
blurOn evt =
|
||||
Html.Attributes.attribute ("on" ++ evt) <| "this.blur()"
|
||||
|
||||
|
||||
-- TUPLES
|
||||
|
||||
|
||||
map1 : (a -> a') -> (a, b, c) -> (a', b, c)
|
||||
map1 f (x,y,z) = (f x, y, z)
|
||||
|
||||
|
||||
map2 : (b -> b') -> (a, b, c) -> (a, b', c)
|
||||
map2 f (x,y,z) = (x, f y, z)
|
||||
|
||||
|
||||
map1st : (a -> c) -> (a,b) -> (c,b)
|
||||
map1st f (x,y) = (f x, y)
|
||||
|
||||
|
||||
map2nd : (b -> c) -> (a,b) -> (a,c)
|
||||
map2nd f (x,y) = (x, f y)
|
||||
|
||||
|
||||
{- Variant of EA update function type, where effects may be
|
||||
lifted to a different type.
|
||||
-}
|
||||
type alias Update' model action action' =
|
||||
action -> model -> (model, Effects action')
|
||||
|
||||
|
||||
{-| Standard EA update function type.
|
||||
-}
|
||||
type alias Update model action =
|
||||
Update' model action action
|
||||
|
||||
|
||||
lift' :
|
||||
(model -> submodel) -> -- get
|
||||
(model -> submodel -> model) -> -- set
|
||||
(subaction -> submodel -> submodel) ->
|
||||
subaction -> -- action
|
||||
model -> -- model
|
||||
(model, Effects action)
|
||||
lift' get set update action model =
|
||||
(set model (update action (get model)), Effects.none)
|
||||
|
||||
lift :
|
||||
(model -> submodel) -> -- get
|
||||
(model -> submodel -> model) -> -- set
|
||||
(subaction -> action) -> -- fwd
|
||||
Update submodel subaction -> -- update
|
||||
subaction -> -- action
|
||||
model -> -- model
|
||||
(model, Effects action)
|
||||
lift get set fwd update action model =
|
||||
let
|
||||
(submodel', e) = update action (get model)
|
||||
in
|
||||
(set model submodel', Effects.map fwd e)
|
||||
|
||||
|
||||
delay : Time -> a -> Effects a
|
||||
delay t x =
|
||||
Task.sleep t
|
||||
|> (flip Task.andThen) (always (Task.succeed x))
|
||||
|> Effects.task
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -352,7 +352,7 @@ tabsView addr model tabs =
|
|||
, ("is-casting-shadow", model.mode == Standard)
|
||||
]
|
||||
]
|
||||
(tabs |> mapWithIndex (\tabIndex tab ->
|
||||
(tabs |> List.indexedMap (\tabIndex tab ->
|
||||
filter a
|
||||
[ classList
|
||||
[ ("mdl-layout__tab", True)
|
||||
|
|
|
|||
84
src/Material/Scheme.elm
Normal file
84
src/Material/Scheme.elm
Normal file
|
|
@ -0,0 +1,84 @@
|
|||
module Material.Scheme
|
||||
( topWithScheme, top
|
||||
) where
|
||||
|
||||
{-|
|
||||
The elm-mdl library depends on Google's MDL CSS implementation, and your
|
||||
application must load this CSS in order for elm-mdl to function correctly.
|
||||
There are two ways to accomplish this:
|
||||
|
||||
1. Load CSS from HTML by adding suitable `<link ...>` directives to the
|
||||
HTML-file containing your app, or
|
||||
2. Load CSS from Elm (by inserting `style` elements into the DOM).
|
||||
|
||||
|
||||
# Load CSS from HTML
|
||||
|
||||
To load CSS manually, add the following to your
|
||||
<!-- 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.3/material.min.css" />
|
||||
|
||||
# Loading CSS from Elm
|
||||
|
||||
@docs topWithScheme, top
|
||||
-}
|
||||
|
||||
|
||||
import String
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
|
||||
import Material.Color exposing (Palette(..), Color)
|
||||
|
||||
|
||||
scheme : Palette -> Palette -> String
|
||||
scheme primary accent =
|
||||
[ "https://code.getmdl.io/1.1.3/" ++ Material.Color.scheme primary accent
|
||||
, "https://fonts.googleapis.com/icon?family=Material+Icons"
|
||||
, "https://fonts.googleapis.com/css?family=Roboto:400,300,500|Roboto+Mono|Roboto+Condensed:400,700&subset=latin,latin-ext"
|
||||
]
|
||||
|> List.map (\url -> "@import url(" ++ url ++ ");")
|
||||
|> String.join "\n"
|
||||
|
||||
|
||||
{-| Top-level container for Material components. This will force loading of
|
||||
Material Design Lite CSS files by inserting an appropriate `style` element.
|
||||
|
||||
Supply primary and accent colors as parameters. Refer to the Material Design
|
||||
Lite [Custom CSS theme builder](https://www.getmdl.io/customize/index.html)
|
||||
to preview combinations. Please be aware that Grey, Blue Grey, and Brown
|
||||
cannot be secondary colors. If you choose them as such anyway, you will get the
|
||||
default theme.
|
||||
|
||||
**NB!** Using this top-level container is not recommended, as most browsers
|
||||
will load CSS requested from `style` elements concurrently with rendering the
|
||||
initial page, which will produce a flicker on page load. The container is
|
||||
included only to provide an option to get started quickly and for use with
|
||||
elm-reactor.
|
||||
|
||||
TODO: Usage example
|
||||
-}
|
||||
topWithScheme: Palette -> Palette -> Html -> Html
|
||||
topWithScheme primary accent content =
|
||||
div [] <|
|
||||
{- Trick from Peter Damoc to load CSS outside of <head>.
|
||||
https://github.com/pdamoc/elm-mdl/blob/master/src/Mdl.elm#L63
|
||||
-}
|
||||
[ node "style"
|
||||
[ type' "text/css"]
|
||||
[ Html.text <| scheme primary accent]
|
||||
, content
|
||||
]
|
||||
|
||||
|
||||
{-| Top-level container with default color scheme. See `topWithScheme` above.
|
||||
-}
|
||||
top : Html -> Html
|
||||
top content =
|
||||
-- Force default color-scheme by picking an invalid combination.
|
||||
topWithScheme Grey Grey content
|
||||
|
||||
|
||||
|
||||
83
src/Material/Shadow.elm
Normal file
83
src/Material/Shadow.elm
Normal file
|
|
@ -0,0 +1,83 @@
|
|||
module Material.Elevation
|
||||
( shadow
|
||||
, transition
|
||||
) where
|
||||
|
||||
|
||||
{-| From the [Material Design Lite documentation](https://github.com/google/material-design-lite/blob/master/src/shadow/README.md)
|
||||
|
||||
> The Material Design Lite (MDL) shadow is not a component in the same sense as
|
||||
> an MDL card, menu, or textbox; it is a visual effect that can be assigned to a
|
||||
> user interface element. The effect simulates a three-dimensional positioning of
|
||||
> the element, as though it is slightly raised above the surface it rests upon —
|
||||
> a positive z-axis value, in user interface terms. The shadow starts at the
|
||||
> edges of the element and gradually fades outward, providing a realistic 3-D
|
||||
> effect.
|
||||
>
|
||||
> Shadows are a convenient and intuitive means of distinguishing an element from
|
||||
> its surroundings. A shadow can draw the user's eye to an object and emphasize
|
||||
> the object's importance, uniqueness, or immediacy.
|
||||
>
|
||||
> Shadows are a well-established feature in user interfaces, and provide users
|
||||
> with a visual clue to an object's intended use or value. Their design and use
|
||||
> is an important factor in the overall user experience.)
|
||||
|
||||
See also the
|
||||
[Material Design specification](https://www.google.com/design/spec/what-is-material/elevation-shadows.html)
|
||||
.
|
||||
|
||||
# Component
|
||||
@docs shadow, transition
|
||||
|
||||
# View
|
||||
@docs view
|
||||
|
||||
-}
|
||||
|
||||
|
||||
import Effects exposing (Effects, none)
|
||||
import Html exposing (..)
|
||||
|
||||
|
||||
-- MODEL
|
||||
|
||||
|
||||
{-| Component model.
|
||||
-}
|
||||
type alias Model =
|
||||
{
|
||||
}
|
||||
|
||||
|
||||
{-| Default component model constructor.
|
||||
-}
|
||||
model : Model
|
||||
model =
|
||||
{
|
||||
}
|
||||
|
||||
|
||||
-- ACTION, UPDATE
|
||||
|
||||
|
||||
{-| Component action.
|
||||
-}
|
||||
type Action
|
||||
= MyAction
|
||||
|
||||
|
||||
{-| Component update.
|
||||
-}
|
||||
update : Action -> Model -> (Model, Effects Action)
|
||||
update action model =
|
||||
(model, none)
|
||||
|
||||
|
||||
-- VIEW
|
||||
|
||||
|
||||
{-| Component view.
|
||||
-}
|
||||
view : Signal.Address Action -> Model -> Html
|
||||
view addr model =
|
||||
div [] [ h1 [] [ text "TEMPLATE" ] ]
|
||||
|
|
@ -1,7 +1,8 @@
|
|||
module Material.Snackbar
|
||||
( Contents, Model, model, toast, snackbar, isActive
|
||||
( Contents, Model, model, toast, snackbar, isActive, activeAction
|
||||
, Action(Add, Action), update
|
||||
, view
|
||||
, Instance, instance, add
|
||||
) where
|
||||
|
||||
{-| TODO
|
||||
|
|
@ -24,7 +25,8 @@ import Task
|
|||
import Time exposing (Time)
|
||||
import Maybe exposing (andThen)
|
||||
|
||||
import Material.Helpers exposing (mapFx, addFx)
|
||||
import Material.Component as Component exposing (Indexed)
|
||||
import Material.Helpers exposing (mapFx, addFx, delay)
|
||||
|
||||
|
||||
-- MODEL
|
||||
|
|
@ -44,7 +46,7 @@ type alias Contents a =
|
|||
-}
|
||||
type alias Model a =
|
||||
{ queue : List (Contents a)
|
||||
, state : State a
|
||||
, state : State' a
|
||||
, seq : Int
|
||||
}
|
||||
|
||||
|
|
@ -84,7 +86,9 @@ snackbar message actionMessage action =
|
|||
, fade = 250
|
||||
}
|
||||
|
||||
|
||||
{-| TODO
|
||||
(Bad name)
|
||||
-}
|
||||
isActive : Model a -> Maybe (Contents a)
|
||||
isActive model =
|
||||
|
|
@ -96,6 +100,15 @@ isActive model =
|
|||
Nothing
|
||||
|
||||
|
||||
{-| TODO
|
||||
-}
|
||||
activeAction : Model a -> Maybe a
|
||||
activeAction model =
|
||||
isActive model
|
||||
|> flip Maybe.andThen .action
|
||||
|> Maybe.map snd
|
||||
|
||||
|
||||
contentsOf : Model a -> Maybe (Contents a)
|
||||
contentsOf model =
|
||||
case model.state of
|
||||
|
|
@ -107,7 +120,7 @@ contentsOf model =
|
|||
-- SNACKBAR STATE MACHINE
|
||||
|
||||
|
||||
type State a
|
||||
type State' a
|
||||
= Inert
|
||||
| Active (Contents a)
|
||||
| Fading (Contents a)
|
||||
|
|
@ -118,13 +131,6 @@ type Transition
|
|||
| Click
|
||||
|
||||
|
||||
delay : Time -> a -> Effects a
|
||||
delay t x =
|
||||
Task.sleep t
|
||||
|> (flip Task.andThen) (\_ -> Task.succeed x)
|
||||
|> Effects.task
|
||||
|
||||
|
||||
move : Transition -> Model a -> (Model a, Effects Transition)
|
||||
move transition model =
|
||||
case (model.state, transition) of
|
||||
|
|
@ -270,3 +276,61 @@ view addr model =
|
|||
)
|
||||
buttonBody
|
||||
]
|
||||
|
||||
|
||||
-- COMPONENT
|
||||
|
||||
|
||||
{-|
|
||||
-}
|
||||
type alias State s obs =
|
||||
{ s | snackbar : Maybe (Model obs) }
|
||||
|
||||
|
||||
{-|
|
||||
-}
|
||||
type alias Instance state obs =
|
||||
Component.Instance (Model obs) state (Action obs) obs Html
|
||||
|
||||
|
||||
{-|
|
||||
-}
|
||||
type alias Observer obs =
|
||||
Component.Observer (Action obs) obs
|
||||
|
||||
|
||||
actionObserver : Observer ons
|
||||
actionObserver action =
|
||||
case action of
|
||||
Action action' ->
|
||||
Just action'
|
||||
|
||||
_ ->
|
||||
Nothing
|
||||
|
||||
|
||||
{-| Component instance.
|
||||
-}
|
||||
instance
|
||||
: (Component.Action (State state obs) obs -> obs)
|
||||
-> (Model obs)
|
||||
-> Instance (State state obs) obs
|
||||
|
||||
instance lift model0 =
|
||||
Component.instance1
|
||||
view update .snackbar (\x y -> {y | snackbar = x}) lift model0 [ actionObserver ]
|
||||
|
||||
{-|
|
||||
TODO
|
||||
-}
|
||||
add :
|
||||
Contents obs
|
||||
-> Instance (State state obs) obs
|
||||
-> (State state obs)
|
||||
-> (State state obs, Effects obs)
|
||||
add contents inst model =
|
||||
let
|
||||
(sb, fx) =
|
||||
update (Add contents) (inst.get model)
|
||||
in
|
||||
(inst.set sb model, Effects.map inst.fwd fx)
|
||||
|
|
|
|||
|
|
@ -1,8 +1,7 @@
|
|||
module Material.Style
|
||||
( Style
|
||||
, styled
|
||||
, cs, cs', css, css', attrib, multiple
|
||||
, stylesheet
|
||||
, cs, cs', css, css', attribute, multiple
|
||||
, styled, div, span, stylesheet
|
||||
) where
|
||||
|
||||
|
||||
|
|
@ -17,10 +16,10 @@ add to or remove from the contents of an already constructed class Attribute.)
|
|||
@docs Style
|
||||
|
||||
# Constructors
|
||||
@docs cs, cs', css, css', attrib, multiple
|
||||
@docs cs, cs', css, css', attribute, multiple
|
||||
|
||||
# Application
|
||||
@docs styled
|
||||
@docs styled, div, span
|
||||
|
||||
# Convenience
|
||||
@docs stylesheet
|
||||
|
|
@ -41,45 +40,33 @@ import Html.Attributes
|
|||
type Style
|
||||
= Class String
|
||||
| CSS (String, String)
|
||||
| Attr (String, String)
|
||||
| Attr Html.Attribute
|
||||
| Multiple (List Style)
|
||||
| NOP
|
||||
|
||||
multipleOf : Style -> Maybe (List Style)
|
||||
multipleOf style =
|
||||
case style of
|
||||
Multiple multiple -> Just multiple
|
||||
_ -> Nothing
|
||||
|
||||
type alias Summary =
|
||||
{ attrs : List Attribute
|
||||
, classes : List String
|
||||
, css : List (String, String)
|
||||
}
|
||||
|
||||
|
||||
attrOf : Style -> Maybe (String, String)
|
||||
attrOf style =
|
||||
case style of
|
||||
Attr attrib -> Just attrib
|
||||
_ -> Nothing
|
||||
|
||||
cssOf : Style -> Maybe (String, String)
|
||||
cssOf style =
|
||||
case style of
|
||||
CSS css -> Just css
|
||||
_ -> Nothing
|
||||
collect1 : Style -> Summary -> Summary
|
||||
collect1 style ({ classes, css, attrs } as acc) =
|
||||
case style of
|
||||
Class x -> { acc | classes = x :: classes }
|
||||
CSS x -> { acc | css = x :: css }
|
||||
Attr x -> { acc | attrs = x :: attrs }
|
||||
Multiple styles -> List.foldl collect1 acc styles
|
||||
NOP -> acc
|
||||
|
||||
|
||||
classOf : Style -> Maybe String
|
||||
classOf style =
|
||||
case style of
|
||||
Class c -> Just c
|
||||
_ -> Nothing
|
||||
collect : List Style -> Summary
|
||||
collect =
|
||||
List.foldl collect1 { classes=[], css=[], attrs=[] }
|
||||
|
||||
|
||||
flatten : Style -> List Style -> List Style
|
||||
flatten style styles =
|
||||
case style of
|
||||
Multiple styles' ->
|
||||
List.foldl flatten styles' styles
|
||||
style ->
|
||||
style :: styles
|
||||
|
||||
{-| Handle the common case of setting attributes of a standard Html node
|
||||
from a List Style. Use like this:
|
||||
|
||||
|
|
@ -96,19 +83,41 @@ Note that if you do specify `style`, `class`, or `classList` attributes in
|
|||
(*), they will be discarded.
|
||||
-}
|
||||
styled : (List Attribute -> a) -> List Style -> List Attribute -> a
|
||||
styled ctor styles attrs =
|
||||
styled ctor styles attrs' =
|
||||
let
|
||||
flatStyles = List.foldl flatten [] styles
|
||||
styleAttrs = (List.filterMap attrOf flatStyles)
|
||||
|> List.map (\attrib -> Html.Attributes.attribute (fst attrib) ( snd attrib))
|
||||
{ classes, css, attrs } = collect styles
|
||||
in
|
||||
ctor
|
||||
( Html.Attributes.style (List.filterMap cssOf flatStyles)
|
||||
:: Html.Attributes.class (String.join " " (List.filterMap classOf flatStyles))
|
||||
:: List.append attrs styleAttrs
|
||||
)
|
||||
ctor
|
||||
( Html.Attributes.style css
|
||||
:: Html.Attributes.class (String.join " " classes)
|
||||
:: List.append attrs attrs'
|
||||
)
|
||||
|
||||
|
||||
{-| Handle the ultra-common case of setting attributes of a div element.
|
||||
Use like this:
|
||||
|
||||
myDiv : Html
|
||||
myDiv =
|
||||
Style.div
|
||||
[ Color.background Color.primary
|
||||
, Color.text Color.accentContrast
|
||||
]
|
||||
[ text "I'm in color!" ]
|
||||
|
||||
-}
|
||||
div : List Style -> List Html -> Html
|
||||
div styles elems =
|
||||
styled Html.div styles [] elems
|
||||
|
||||
|
||||
{-| Convenience function for the reasonably common case of setting attributes
|
||||
of a span element. See also `div`.
|
||||
-}
|
||||
span : List Style -> List Html -> Html
|
||||
span styles elems =
|
||||
styled Html.span styles [] elems
|
||||
|
||||
|
||||
{-| Add a HTML class to a component. (Name chosen to avoid clashing with
|
||||
Html.Attributes.class.)
|
||||
|
|
@ -130,11 +139,13 @@ css : String -> String -> Style
|
|||
css key value =
|
||||
CSS (key, value)
|
||||
|
||||
|
||||
{-| Add a custom attribute
|
||||
-}
|
||||
attrib : String -> String -> Style
|
||||
attrib key value =
|
||||
Attr (key, value)
|
||||
attribute : Html.Attribute -> Style
|
||||
attribute attr =
|
||||
Attr attr
|
||||
|
||||
|
||||
{-| Add a custom attribute
|
||||
-}
|
||||
|
|
@ -142,6 +153,7 @@ multiple : List Style -> Style
|
|||
multiple styles =
|
||||
Multiple (styles)
|
||||
|
||||
|
||||
{-| Conditionally add a CSS style to a component
|
||||
-}
|
||||
css' : String -> String -> Bool -> Style
|
||||
|
|
|
|||
|
|
@ -26,15 +26,22 @@ This implementation provides only single-line.
|
|||
# Configuration
|
||||
@docs Kind, Label
|
||||
|
||||
# Component
|
||||
# Elm Architecture
|
||||
@docs Action, Model, model, update, view
|
||||
|
||||
# Component
|
||||
@docs State, Instance
|
||||
@docs instance, fwdInput, fwdBlur, fwdFocus
|
||||
|
||||
-}
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (..)
|
||||
import Effects
|
||||
|
||||
import Material.Helpers exposing (filter)
|
||||
import Material.Component as Component exposing (Indexed)
|
||||
|
||||
|
||||
-- MODEL
|
||||
|
|
@ -131,6 +138,7 @@ 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
|
||||
labelText = model.label |> Maybe.map .text
|
||||
in
|
||||
filter div
|
||||
[ classList
|
||||
|
|
@ -155,8 +163,71 @@ view addr model =
|
|||
, 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])
|
||||
, Just <| label
|
||||
[class "mdl-textfield__label"]
|
||||
(case labelText of
|
||||
Just str -> [ text str ]
|
||||
Nothing -> [])
|
||||
, model.error |> Maybe.map (\e ->
|
||||
span [class "mdl-textfield__error"] [text e])
|
||||
]
|
||||
|
||||
|
||||
|
||||
-- COMPONENT
|
||||
|
||||
|
||||
{-|
|
||||
-}
|
||||
type alias State state =
|
||||
{ state | textfield : Indexed Model }
|
||||
|
||||
|
||||
{-|
|
||||
-}
|
||||
type alias Instance state obs =
|
||||
Component.Instance Model state Action obs Html
|
||||
|
||||
|
||||
{-| Component constructor. See module `Material`.
|
||||
-}
|
||||
instance :
|
||||
Int
|
||||
-> (Component.Action (State state) obs -> obs)
|
||||
-> Model
|
||||
-> List (Component.Observer Action obs)
|
||||
-> Instance (State state) obs
|
||||
|
||||
instance =
|
||||
let
|
||||
update' action model = (update action model, Effects.none)
|
||||
in
|
||||
Component.instance view update' .textfield (\x y -> {y | textfield = x})
|
||||
|
||||
|
||||
{-| Lift the button Click action to your own action. E.g.,
|
||||
-}
|
||||
fwdInput : (String -> obs) -> Action -> Maybe obs
|
||||
fwdInput f action =
|
||||
case action of
|
||||
Input str -> Just (f str)
|
||||
_ -> Nothing
|
||||
|
||||
|
||||
{-| Lift the Blur action to your own action.
|
||||
-}
|
||||
fwdBlur : obs -> Action -> Maybe obs
|
||||
fwdBlur o action =
|
||||
case action of
|
||||
Blur -> Just o
|
||||
_ -> Nothing
|
||||
|
||||
|
||||
{-| Lift the Focus action to your own action.
|
||||
-}
|
||||
fwdFocus : obs -> Action -> Maybe obs
|
||||
fwdFocus o action =
|
||||
case action of
|
||||
Focus -> Just o
|
||||
_ -> Nothing
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue