From 0952b248dc3d37a910f5ecba4b16cd94e64c450a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B8ren=20Debois?= Date: Sat, 26 Mar 2016 12:16:40 +0100 Subject: [PATCH 01/21] Update README.md --- README.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/README.md b/README.md index 231e2da..5024fd3 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,7 @@ # Material Design Components in Elm +[![Build Status](https://travis-ci.org/debois/elm-mdl.svg?branch=master)](https://travis-ci.org/debois/elm-mdl) + Port of Google's [Material Design Lite](https://www.getmdl.io/) CSS/JS implementation of the From 56fa46c26b9c113e50678323ec8ab854b2bc5eb9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B8ren=20Debois?= Date: Sat, 26 Mar 2016 14:39:11 +0100 Subject: [PATCH 02/21] Undo Travis test --- examples/Demo.elm | 2 -- 1 file changed, 2 deletions(-) diff --git a/examples/Demo.elm b/examples/Demo.elm index b3ad5a3..15443dc 100644 --- a/examples/Demo.elm +++ b/examples/Demo.elm @@ -22,8 +22,6 @@ import Demo.Badges -- MODEL -x = 0 + "foo" - layoutModel : Layout.Model layoutModel = From 8ca132ae4d7ae127cda972049b02ed0ee7c9d6a3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B8ren=20Debois?= Date: Wed, 30 Mar 2016 08:13:49 +0200 Subject: [PATCH 03/21] Refactored collect --- src/Material/Style.elm | 99 ++++++++++++++++++++++-------------------- 1 file changed, 52 insertions(+), 47 deletions(-) diff --git a/src/Material/Style.elm b/src/Material/Style.elm index a2d0ead..d7e54d3 100644 --- a/src/Material/Style.elm +++ b/src/Material/Style.elm @@ -1,8 +1,7 @@ module Material.Style ( Style - , styled - , cs, cs', css, css', attrib, multiple - , stylesheet + , cs, cs', css, css', attribute, multiple + , styled, div', 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' # 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,34 @@ 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, +with no custom attributes. Name chosen to avoid conflicts with Html.div. 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 + {-| Add a HTML class to a component. (Name chosen to avoid clashing with Html.Attributes.class.) @@ -130,11 +132,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 +146,7 @@ multiple : List Style -> Style multiple styles = Multiple (styles) + {-| Conditionally add a CSS style to a component -} css' : String -> String -> Bool -> Style From 2ca589a7ef9ea179c5fe3dfea65779d6f45a8bb5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B8ren=20Debois?= Date: Wed, 30 Mar 2016 09:19:18 +0200 Subject: [PATCH 04/21] Added elevation (shadow) styles --- Makefile | 6 ++-- examples/Demo/Grid.elm | 37 +++++++++++++++++++++- examples/Demo/Snackbar.elm | 38 +++++++++++------------ src/Material/Badge.elm | 8 +++-- src/Material/Elevation.elm | 63 ++++++++++++++++++++++++++++++++++++++ 5 files changed, 127 insertions(+), 25 deletions(-) create mode 100644 src/Material/Elevation.elm diff --git a/Makefile b/Makefile index 6e6aa98..be82290 100644 --- a/Makefile +++ b/Makefile @@ -11,14 +11,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 diff --git a/examples/Demo/Grid.elm b/examples/Demo/Grid.elm index 3a92e8e..49ccfb4 100644 --- a/examples/Demo/Grid.elm +++ b/examples/Demo/Grid.elm @@ -4,6 +4,7 @@ import Material.Grid exposing (..) import Material.Style exposing (Style, css) import Html exposing (..) +import Markdown -- Cell styling @@ -33,7 +34,8 @@ std = democell 200 view : List Html view = - [ [1..12] + [ intro + , [1..12] |> List.map (\i -> small [size All 1] [text "1"]) |> grid [] , [1 .. 3] @@ -50,3 +52,36 @@ view = ] +intro : Html +intro = """ +From the +[Material Design Lite documentation](http://www.getmdl.io/components/#layout-section/grid): + +> The Material Design Lite (MDL) grid component is a simplified method for laying +> out content for multiple screen sizes. It reduces the usual coding burden +> required to correctly display blocks of content in a variety of display +> conditions. +> +> The MDL grid is defined and enclosed by a container element. A grid has 12 +> columns in the desktop screen size, 8 in the tablet size, and 4 in the phone +> size, each size having predefined margins and gutters. Cells are laid out +> sequentially in a row, in the order they are defined, with some exceptions: +> +> - If a cell doesn't fit in the row in one of the screen sizes, it flows +> into the following line. +> - If a cell has a specified column size equal to or larger than the number +> of columns for the current screen size, it takes up the entirety of its +> row. + +#### 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 + + diff --git a/examples/Demo/Snackbar.elm b/examples/Demo/Snackbar.elm index 6df85e6..8929bb5 100644 --- a/examples/Demo/Snackbar.elm +++ b/examples/Demo/Snackbar.elm @@ -5,15 +5,16 @@ import Html exposing (..) import Html.Attributes exposing (class, style, key) import Array exposing (Array) -import Markdown - import Material.Color as Color import Material.Style exposing (styled, cs) import Material.Snackbar as Snackbar import Material.Button as Button exposing (Action(..)) import Material.Grid exposing (..) +import Material.Elevation as Elevation import Material exposing (lift, lift') +import Demo.Page as Page + -- MODEL @@ -119,7 +120,7 @@ clickView model k = [ Color.background color , Color.text Color.primaryContrast -- TODO. Should have shadow styles someplace. - , cs <| "mdl-shadow--" ++ if selected then "8dp" else "2dp" + , Elevation.shadow (if selected then 8 else 2) ] [ style [ ("margin-right", "3ex") @@ -139,10 +140,8 @@ clickView model k = view : Signal.Address Action -> Model -> Html view addr model = - div [] - [ h1 [ class "mdl-typography--display-4-color-contrast" ] [ text "Snackbars & Toasts" ] - , intro - , grid [] + Page.view srcUrl "Snackbar & Toast" [ intro ] references + [ 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.) @@ -169,10 +168,8 @@ view addr model = 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 +177,18 @@ 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) +srcUrl : String +srcUrl = + "https://github.com/debois/elm-mdl/blob/master/examples/Demo/Snackbar.elm" -#### Demo - -""" |> Markdown.toHtml +references : List (String, String) +references = + [ Page.demo srcUrl + , 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" + ] diff --git a/src/Material/Badge.elm b/src/Material/Badge.elm index 6e7b569..1e2e9f9 100644 --- a/src/Material/Badge.elm +++ b/src/Material/Badge.elm @@ -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) + ] diff --git a/src/Material/Elevation.elm b/src/Material/Elevation.elm new file mode 100644 index 0000000..464fd81 --- /dev/null +++ b/src/Material/Elevation.elm @@ -0,0 +1,63 @@ +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.) + +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, 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 0--24. The specification uses only the values +1-6, 8, 9, 12, 16, 24 for standard UI elements. +-} +shadow : Int -> Style +shadow z = + cs ("mdl-shadow--" ++ toString z ++ "dp") + + +{-| 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") + + + From cfa48e874c1159d34728e5a8b98ab19c39c4f4d2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B8ren=20Debois?= Date: Thu, 31 Mar 2016 08:14:13 +0200 Subject: [PATCH 05/21] Draft component model. --- src/Material/Component.elm | 126 +++++++++++++++++++++++++++++++++++++ 1 file changed, 126 insertions(+) create mode 100644 src/Material/Component.elm diff --git a/src/Material/Component.elm b/src/Material/Component.elm new file mode 100644 index 0000000..978da8e --- /dev/null +++ b/src/Material/Component.elm @@ -0,0 +1,126 @@ +module Material.Component where + +import Effects exposing (Effects) +import Html exposing (Html) +import Dict exposing (Dict) + +import Material.Button as Button +import Material.Style exposing (Style) +import Material.Textfield as Textfield + +type Action model = + A (model -> (model, Effects (Action model))) + +type alias Updater model action = + action -> model -> (model, Effects action) + + +update : Updater State (Action State) +update (A f) model = + f model + + + +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) + + +pack : Updater model action -> action -> Action model +pack update action = + A ( \m -> map2nd (Effects.map (pack update)) (update action m) ) + + +type alias View model action a = + Signal.Address action -> model -> a + + +type alias Component model action a = + { view : View model action a + , update : Updater model action + } + + +type alias States a = + Dict Int a + + +type alias State = + { button : States Button.Model + , textfield : States Textfield.Model + } + + +state0 : State +state0 = + { button = Dict.empty + , textfield = Dict.empty + } + + +buttonComponent : Component Button.Model Button.Action (List Style -> List Html -> Html) +buttonComponent = + { view = Button.raised + , update = Button.update + } + +textfieldComponent : Component Textfield.Model Textfield.Action Html +textfieldComponent = + { view = Textfield.view + , update = \action model -> (Textfield.update action model, Effects.none) + } + + +embed : + Component submodel action a -> -- Given a "Component submodel ..." + (model -> States submodel) -> -- a getter + (States submodel -> model -> model) -> -- a setter + Int -> -- an id for this instance + submodel -> -- an initial model for this instance + Component model action a -- ... produce a "Component model ..." + +embed component get set id model0 = + let + get' model = + Dict.get id (get model) |> Maybe.withDefault model0 + + set' submodel model = + set (Dict.insert id submodel (get model)) model + + view addr model = + component.view addr (get' model) + + update action model = + component.update action (get' model) + |> map1st (flip set' model) + in + { view = view + , update = update + } + + +instance : ((Action State) -> action) -> Component State a b -> View State action b +instance f component addr state = + component.view + (Signal.forwardTo addr (pack component.update >> f)) + state + +{- +f id = + + embed buttonComponent .button (\x y -> { y | button = x}) id (Button.model True) +-} + +buttonInstance : ((Action State) -> action) -> Int -> View State action (List Style -> List Html -> Html) +buttonInstance f id = + embed buttonComponent .button (\x y -> { y | button = x}) id (Button.model True) + |> instance f + + +textfieldInstance f id = + embed textfieldComponent .textfield (\x y -> { y | textfield = x}) id (Textfield.model) + |> instance f + From 0dfaaf2001adcd9c430c1a661fc1796353857532 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B8ren=20Debois?= Date: Thu, 31 Mar 2016 09:20:10 +0200 Subject: [PATCH 06/21] tm --- src/Material/Component.elm | 73 +++++++++++++++++++++++++++++--------- 1 file changed, 56 insertions(+), 17 deletions(-) diff --git a/src/Material/Component.elm b/src/Material/Component.elm index 978da8e..694d550 100644 --- a/src/Material/Component.elm +++ b/src/Material/Component.elm @@ -8,17 +8,6 @@ import Material.Button as Button import Material.Style exposing (Style) import Material.Textfield as Textfield -type Action model = - A (model -> (model, Effects (Action model))) - -type alias Updater model action = - action -> model -> (model, Effects action) - - -update : Updater State (Action State) -update (A f) model = - f model - map1st : (a -> c) -> (a,b) -> (c,b) @@ -29,6 +18,20 @@ map2nd : (b -> c) -> (a,b) -> (a,c) map2nd f (x,y) = (x, f y) + +type alias Updater model action = + action -> model -> (model, Effects action) + + +type Action model = + A (model -> (model, Effects (Action model))) + + +update : Updater State (Action State) +update (A f) model = + f model + + pack : Updater model action -> action -> Action model pack update action = A ( \m -> map2nd (Effects.map (pack update)) (update action m) ) @@ -78,11 +81,11 @@ embed : Component submodel action a -> -- Given a "Component submodel ..." (model -> States submodel) -> -- a getter (States submodel -> model -> model) -> -- a setter - Int -> -- an id for this instance submodel -> -- an initial model for this instance + Int -> -- an id for this instance Component model action a -- ... produce a "Component model ..." -embed component get set id model0 = +embed component get set model0 id = let get' model = Dict.get id (get model) |> Maybe.withDefault model0 @@ -102,6 +105,19 @@ embed component get set id model0 = } +type alias Updater' model action action' = + action -> model -> (model, Effects action, action') + +{- +observe : (action -> action') -> Updater model action -> Updater' model action action' +observe f update action model = + let + (model', effects) = update action model + in + (model', effects, f action) +-} + + instance : ((Action State) -> action) -> Component State a b -> View State action b instance f component addr state = component.view @@ -114,13 +130,36 @@ f id = embed buttonComponent .button (\x y -> { y | button = x}) id (Button.model True) -} +type alias Ctor model model' action a = + model -> Int -> Component model' action a + + +type alias ButtonStates a = + { a | button : States Button.Model } + + +mkButton : Ctor (Button.Model) (ButtonStates model') Button.Action (List Style -> List Html -> Html) + {- + : Button.Model + -> Int + -> Component + { b | button : States Button.Model } + Button.Action + (List Style -> List Html -> Html) + -} + +mkButton model0 = + embed buttonComponent .button (\x y -> {y | button = x}) model0 + + + buttonInstance : ((Action State) -> action) -> Int -> View State action (List Style -> List Html -> Html) buttonInstance f id = - embed buttonComponent .button (\x y -> { y | button = x}) id (Button.model True) - |> instance f + instance f (mkButton (Button.model True) id) +mkTextfield model0 = + embed textfieldComponent .textfield (\x y -> { y | textfield = x}) model0 textfieldInstance f id = - embed textfieldComponent .textfield (\x y -> { y | textfield = x}) id (Textfield.model) - |> instance f + instance f (mkTextfield Textfield.model id) From be98c3d0e0fd01dad80b1fc15e7944aeec8392ba Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B8ren=20Debois?= Date: Thu, 31 Mar 2016 21:15:50 +0200 Subject: [PATCH 07/21] Draft observers --- src/Material/Component.elm | 231 ++++++++++++++++++++++++------------- 1 file changed, 148 insertions(+), 83 deletions(-) diff --git a/src/Material/Component.elm b/src/Material/Component.elm index 694d550..3d3661b 100644 --- a/src/Material/Component.elm +++ b/src/Material/Component.elm @@ -9,6 +9,13 @@ import Material.Style exposing (Style) import Material.Textfield as Textfield +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) @@ -18,42 +25,21 @@ map2nd : (b -> c) -> (a,b) -> (a,c) map2nd f (x,y) = (x, f y) - -type alias Updater model action = - action -> model -> (model, Effects action) +type alias Update' model action action' = + action -> model -> (model, Effects action') -type Action model = - A (model -> (model, Effects (Action model))) - - -update : Updater State (Action State) -update (A f) model = - f model +type alias Update model action = + Update' model action action -pack : Updater model action -> action -> Action model -pack update action = - A ( \m -> map2nd (Effects.map (pack update)) (update action m) ) - - -type alias View model action a = - Signal.Address action -> model -> a - - -type alias Component model action a = - { view : View model action a - , update : Updater model action - } - - -type alias States a = - Dict Int a +type alias Step model action action' = + action -> model -> (model, Effects action, action') type alias State = - { button : States Button.Model - , textfield : States Textfield.Model + { button : Indexed Button.Model + , textfield : Indexed Textfield.Model } @@ -64,6 +50,54 @@ state0 = } +type Action model obs = + A (model -> (model, Effects (Action model obs), obs)) + + +type alias Model model state = + { model | componentState : state } + + +update : + (Action state (Maybe action) -> action) -> + Update (Model model state) action -> + Update' (Model model state) (Action state (Maybe action)) action + +update fwd update' (A f) model = + let + (model', fx, obs) = + f model.componentState + |> map1 (\state' -> { model | componentState = state' }) + |> map2 (Effects.map fwd) + in + case obs of + Nothing -> + (model', fx) + + Just x -> + update' x model' + |> map2nd (\fx' -> Effects.batch [ fx, fx' ]) + + +pack : (Step model action obs) -> action -> Action model obs +pack update action = + A (update action >> map2 (Effects.map (pack update))) +-- CAUTION. Potential crash from update/update name clash. + + +type alias View model action a = + Signal.Address action -> model -> a + + +type alias Component model action a = + { view : View model action a + , update : Update model action + } + + +type alias Indexed a = + Dict Int a + buttonComponent : Component Button.Model Button.Action (List Style -> List Html -> Html) buttonComponent = { view = Button.raised @@ -77,89 +111,120 @@ textfieldComponent = } -embed : +type alias Widget submodel model action obs a = + { view : View model action a + , update : Update model action + , observe : action -> Maybe obs + , getModel : model -> submodel + , setModel : submodel -> model -> model + } + + +widget : Component submodel action a -> -- Given a "Component submodel ..." - (model -> States submodel) -> -- a getter - (States submodel -> model -> model) -> -- a setter + (model -> Indexed submodel) -> -- a getter + (Indexed submodel -> model -> model) -> -- a setter submodel -> -- an initial model for this instance Int -> -- an id for this instance - Component model action a -- ... produce a "Component model ..." + Widget submodel model action obs a -- ... produce a "Widget ..." -embed component get set model0 id = +widget component 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 - - view addr model = - component.view addr (get' model) - - update action model = - component.update action (get' model) - |> map1st (flip set' model) in - { view = view - , update = update + { view = + \addr model -> component.view addr (get' model) + + , update = + \action model -> + component.update action (get' model) + |> map1st (flip set' model) + + , getModel = get' + , setModel = set' + , observe = \_ -> Nothing } -type alias Updater' model action action' = - action -> model -> (model, Effects action, action') -{- -observe : (action -> action') -> Updater model action -> Updater' model action action' -observe f update action model = - let - (model', effects) = update action model - in - (model', effects, f action) --} +observe : (action -> obs) -> Update model action -> Step model action obs +observe f update action = + update action >> (\(model', effects) -> (model', effects, f action)) -instance : ((Action State) -> action) -> Component State a b -> View State action b -instance f component addr state = - component.view - (Signal.forwardTo addr (pack component.update >> f)) - state +type alias Instance submodel model action a = + { view : View model action a + , getModel : model -> submodel + , setModel : submodel -> model -> model + } -{- -f id = - embed buttonComponent .button (\x y -> { y | button = x}) id (Button.model True) --} +instance : + (Action model (Maybe action) -> action) -> + Widget submodel model subaction action a -> + Instance submodel model action a +instance lift widget = + { view = + \addr -> + widget.view (Signal.forwardTo addr (pack (observe widget.observe widget.update) >> lift)) + , getModel = + widget.getModel + , setModel = + widget.setModel + } -type alias Ctor model model' action a = - model -> Int -> Component model' action a +instance' : + (Action model (Maybe action) -> action) -> + Widget submodel model subaction action a -> + View model action a +instance' lift widget = (instance lift widget).view + type alias ButtonStates a = - { a | button : States Button.Model } + { a | button : Indexed Button.Model } + +--buttonWidget : Button.Model -> Int -> Widget Button.Model (ButtonStates m) Button.Action (Maybe obs) (List Style -> List Html -> Html) +buttonWidget model = + widget buttonComponent .button (\x y -> {y | button = x}) model + +type Test = State' (Action State (Maybe Test)) -mkButton : Ctor (Button.Model) (ButtonStates model') Button.Action (List Style -> List Html -> Html) - {- - : Button.Model - -> Int - -> Component - { b | button : States Button.Model } - Button.Action - (List Style -> List Html -> Html) - -} +addObserver widget f = + { widget + | observe = + \action -> + case f action of + Nothing -> widget.observe action + x -> x + } + -mkButton model0 = - embed buttonComponent .button (\x y -> {y | button = x}) model0 + +onClick f widget = + (\action -> + case action of + Button.Click -> + Just f + _ -> + Nothing) + |> addObserver widget -buttonInstance : ((Action State) -> action) -> Int -> View State action (List Style -> List Html -> Html) -buttonInstance f id = - instance f (mkButton (Button.model True) id) -mkTextfield model0 = - embed textfieldComponent .textfield (\x y -> { y | textfield = x}) model0 -textfieldInstance f id = - instance f (mkTextfield Textfield.model id) +type alias TextfieldStates a = + { a | textfield : Indexed Textfield.Model } + + + +--textfieldWidget : Textfield.Model -> Int -> Widget Textfield.Model (TextfieldStates model) Textfield.Action (Maybe obs) Html +textfieldWidget model = + widget textfieldComponent .textfield (\x y -> { y | textfield = x}) model From a5d96c22586d30e0285076c5cc3f0f82837ae60d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B8ren=20Debois?= Date: Thu, 31 Mar 2016 21:58:30 +0200 Subject: [PATCH 08/21] Functional component model --- examples/Demo/Badges.elm | 2 +- examples/Demo/Buttons.elm | 56 ++++++++++++++++++++++++++++++-------- examples/Demo/Snackbar.elm | 10 ++++--- src/Material/Button.elm | 30 +++++++++++--------- src/Material/Component.elm | 45 +++++++++++++++++------------- src/Material/Style.elm | 11 ++++---- 6 files changed, 100 insertions(+), 54 deletions(-) diff --git a/examples/Demo/Badges.elm b/examples/Demo/Badges.elm index 7989f17..cca89ca 100644 --- a/examples/Demo/Badges.elm +++ b/examples/Demo/Badges.elm @@ -2,7 +2,7 @@ module Demo.Badges (..) where import Html exposing (..) import Material.Badge as Badge -import Material.Style exposing (..) +import Material.Style exposing (styled) import Material.Icon as Icon diff --git a/examples/Demo/Buttons.elm b/examples/Demo/Buttons.elm index eedced0..723107c 100644 --- a/examples/Demo/Buttons.elm +++ b/examples/Demo/Buttons.elm @@ -10,6 +10,9 @@ import Material.Grid as Grid import Material.Icon as Icon import Material.Style exposing (Style) +import Material.Textfield as Textfield +import Material.Component exposing (..) + -- MODEL @@ -63,35 +66,56 @@ model = buttons |> List.concatMap (List.map <| \(idx, (ripple, _, _)) -> (idx, Button.model ripple)) |> Dict.fromList + , componentState = state0 } -- ACTION, UPDATE -type Action = Action Index Button.Action +type Action + = Action Index Button.Action + | State' (Material.Component.Action Material.Component.State (Maybe Action)) + | Click + type alias Model = { clicked : String , buttons : Dict.Dict Index Button.Model + , componentState : State + -- TODO: Exposed Action should not be parametric. } 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) + + State' action' -> + Material.Component.update State' update action' model + + Click -> + ( tf.map (\m -> { m | value = "You clicked!" }) model, Effects.none ) + + + + -- VIEW +tf = instance State' (textfieldWidget Textfield.model 4) + view : Signal.Address Action -> Model -> Html view addr model = @@ -125,4 +149,14 @@ view addr model = ] ) ) - |> Grid.grid [] + |> (\contents -> + div [] + [ instance' State' (buttonWidget (Button.model True) 1 |> onClick Click) addr model [] [ text "Click me (1)" ] + , instance' State' (buttonWidget (Button.model False) 2) addr model [] [ text "Click me (2)" ] + , instance' State' (textfieldWidget Textfield.model 3) addr model + , tf.view addr model + , Grid.grid [] contents + ] + ) + +--i = instance' State' (buttonWidget (Button.model True) 1) -- addr model.componentState [] [ text "Click me (1)" ] diff --git a/examples/Demo/Snackbar.elm b/examples/Demo/Snackbar.elm index 8929bb5..61597a1 100644 --- a/examples/Demo/Snackbar.elm +++ b/examples/Demo/Snackbar.elm @@ -140,7 +140,7 @@ clickView model k = view : Signal.Address Action -> Model -> Html view addr model = - Page.view srcUrl "Snackbar & Toast" [ intro ] references + Page.body "Snackbar & Toast" srcUrl intro references [ grid [] -- TODO. Buttons should be centered. Desperately need to be able -- to add css/classes to top-level element of components (div @@ -152,7 +152,8 @@ view addr model = [] [ text "Toast" ] ] - , cell [ size All 2, size Phone 2, align Top ] + , cell + [ size All 2, size Phone 2, align Top ] [ Button.raised (Signal.forwardTo addr SnackbarButtonAction) model.snackbarButton @@ -179,14 +180,15 @@ intro = """ + srcUrl : String srcUrl = "https://github.com/debois/elm-mdl/blob/master/examples/Demo/Snackbar.elm" + references : List (String, String) references = - [ Page.demo srcUrl - , Page.package "http://package.elm-lang.org/packages/debois/elm-mdl/latest/Material-Snackbar" + [ 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" ] diff --git a/src/Material/Button.elm b/src/Material/Button.elm index dc1731c..e86c021 100644 --- a/src/Material/Button.elm +++ b/src/Material/Button.elm @@ -1,7 +1,7 @@ module Material.Button ( Model, model, Action(Click), update , flat, raised, fab, minifab, icon - , Button, colored, primary, accent + , colored, primary, accent ) where {-| From the [Material Design Lite documentation](http://www.getmdl.io/components/#buttons-section): @@ -29,7 +29,7 @@ See also the @docs Model, model, Action, update # Style -@docs Button, colored, primary, accent +@docs colored, primary, accent # View Refer to the @@ -105,24 +105,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 +126,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 @@ -150,12 +144,21 @@ view kind addr model styling html = Ripple.view (forwardTo addr Ripple) [ class "mdl-button__ripple-container" - , Helpers.blurOn "mouseup" ] + , Helpers.blurOn "mouseup" + ] ripple :: html _ -> html) +-- Fake address (for link buttons). + + +addr : Signal.Address Action +addr = (Signal.mailbox Click).address + + + {-| From the [Material Design Specification](https://www.google.com/design/spec/components/buttons.html#buttons-flat-buttons): @@ -247,3 +250,4 @@ Example use (no color, displaying a '+' icon): -} icon : Address Action -> Model -> List Style -> List Html -> Html icon = view "mdl-button--icon" + diff --git a/src/Material/Component.elm b/src/Material/Component.elm index 3d3661b..722e2ce 100644 --- a/src/Material/Component.elm +++ b/src/Material/Component.elm @@ -158,37 +158,46 @@ observe f update action = type alias Instance submodel model action a = { view : View model action a - , getModel : model -> submodel - , setModel : submodel -> model -> model + , get : model -> submodel + , set : submodel -> model -> model + , map : (submodel -> submodel) -> model -> model } instance : (Action model (Maybe action) -> action) -> Widget submodel model subaction action a -> - Instance submodel model action a + Instance submodel (Model master model) action a instance lift widget = - { view = - \addr -> - widget.view (Signal.forwardTo addr (pack (observe widget.observe widget.update) >> lift)) - , getModel = - widget.getModel - , setModel = - widget.setModel - } + let + get model = + widget.getModel model.componentState + + set x model = + { model | componentState = widget.setModel x model.componentState } + + in + { view = + \addr model -> + widget.view (Signal.forwardTo addr (pack (observe widget.observe widget.update) >> lift)) model.componentState + , get = get + , set = set + , map = \f model -> set (f (get model)) model + } + + instance' : (Action model (Maybe action) -> action) -> Widget submodel model subaction action a -> - View model action a - + View (Model m model) action a instance' lift widget = (instance lift widget).view type alias ButtonStates a = { a | button : Indexed Button.Model } ---buttonWidget : Button.Model -> Int -> Widget Button.Model (ButtonStates m) Button.Action (Maybe obs) (List Style -> List Html -> Html) +buttonWidget : Button.Model -> Int -> Widget Button.Model (ButtonStates m) Button.Action (Maybe obs) (List Style -> List Html -> Html) buttonWidget model = widget buttonComponent .button (\x y -> {y | button = x}) model @@ -209,10 +218,8 @@ addObserver widget f = onClick f widget = (\action -> case action of - Button.Click -> - Just f - _ -> - Nothing) + Button.Click -> Just f + _ -> Nothing) |> addObserver widget @@ -224,7 +231,7 @@ type alias TextfieldStates a = ---textfieldWidget : Textfield.Model -> Int -> Widget Textfield.Model (TextfieldStates model) Textfield.Action (Maybe obs) Html +textfieldWidget : Textfield.Model -> Int -> Widget Textfield.Model (TextfieldStates model) Textfield.Action (Maybe obs) Html textfieldWidget model = widget textfieldComponent .textfield (\x y -> { y | textfield = x}) model diff --git a/src/Material/Style.elm b/src/Material/Style.elm index d7e54d3..92f91ac 100644 --- a/src/Material/Style.elm +++ b/src/Material/Style.elm @@ -1,7 +1,7 @@ module Material.Style ( Style , cs, cs', css, css', attribute, multiple - , styled, div', stylesheet + , styled, div, stylesheet ) where @@ -19,7 +19,7 @@ add to or remove from the contents of an already constructed class Attribute.) @docs cs, cs', css, css', attribute, multiple # Application -@docs styled, div' +@docs styled, div # Convenience @docs stylesheet @@ -95,8 +95,7 @@ styled ctor styles attrs' = {-| Handle the ultra-common case of setting attributes of a div element, -with no custom attributes. Name chosen to avoid conflicts with Html.div. Use -like this: +with no custom attributes. Use like this: myDiv : Html myDiv = @@ -107,8 +106,8 @@ like this: [ text "I'm in color!" ] -} -div' : List Style -> List Html -> Html -div' styles elems = +div : List Style -> List Html -> Html +div styles elems = styled Html.div styles [] elems From 73256c80db62c74ebec9a7eb45c205d374c8578e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B8ren=20Debois?= Date: Thu, 31 Mar 2016 23:32:20 +0200 Subject: [PATCH 09/21] Added component features to textfield and button (needs better docs, though). --- examples/Demo/Buttons.elm | 38 ++++--- src/Material/Button.elm | 70 +++++++++--- src/Material/Component.elm | 226 +++++++++++++++++++++---------------- src/Material/Helpers.elm | 32 ++++-- src/Material/Layout.elm | 2 +- src/Material/Textfield.elm | 46 +++++++- 6 files changed, 275 insertions(+), 139 deletions(-) diff --git a/examples/Demo/Buttons.elm b/examples/Demo/Buttons.elm index 723107c..b22f788 100644 --- a/examples/Demo/Buttons.elm +++ b/examples/Demo/Buttons.elm @@ -11,7 +11,8 @@ import Material.Icon as Icon import Material.Style exposing (Style) import Material.Textfield as Textfield -import Material.Component exposing (..) +import Material.Component as Component +import Material.Component.All as Setup -- MODEL @@ -19,9 +20,11 @@ import Material.Component exposing (..) 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 @@ -66,7 +69,7 @@ model = buttons |> List.concatMap (List.map <| \(idx, (ripple, _, _)) -> (idx, Button.model ripple)) |> Dict.fromList - , componentState = state0 + , componentState = Setup.state } @@ -75,16 +78,15 @@ model = type Action = Action Index Button.Action - | State' (Material.Component.Action Material.Component.State (Maybe Action)) + | State (Setup.Action Action) | Click - + | Input String type alias Model = { clicked : String , buttons : Dict.Dict Index Button.Model - , componentState : State - -- TODO: Exposed Action should not be parametric. + , componentState : Setup.State } @@ -101,20 +103,28 @@ update action model = ) |> Maybe.withDefault (model, Effects.none) - State' action' -> - Material.Component.update State' update action' model + State action' -> + Component.update State update action' model Click -> ( tf.map (\m -> { m | value = "You clicked!" }) model, Effects.none ) + Input str -> + ( tf.map (\m -> { m | value = "You wrote '" ++ str ++ "' in the other guy."}) model + , Effects.none + ) - +instance = Component.instance State +instance' = Component.instance' State + + +tf = instance <| Textfield.component Textfield.model 4 + -- VIEW -tf = instance State' (textfieldWidget Textfield.model 4) view : Signal.Address Action -> Model -> Html @@ -151,12 +161,12 @@ view addr model = ) |> (\contents -> div [] - [ instance' State' (buttonWidget (Button.model True) 1 |> onClick Click) addr model [] [ text "Click me (1)" ] - , instance' State' (buttonWidget (Button.model False) 2) addr model [] [ text "Click me (2)" ] - , instance' State' (textfieldWidget Textfield.model 3) addr model + [ instance' (Button.component Button.flat (Button.model True) 1 |> onClick Click) addr model [] [ text "Click me (1)" ] + , instance' (Button.component Button.raised (Button.model False) 2) addr model [] [ text "Click me (2)" ] + , instance' (Textfield.component Textfield.model 3 |> Textfield.onInput Input) addr model , tf.view addr model , Grid.grid [] contents ] ) ---i = instance' State' (buttonWidget (Button.model True) 1) -- addr model.componentState [] [ text "Click me (1)" ] +--i = instance' State (buttonWidget (Button.model True) 1) -- addr model.componentState [] [ text "Click me (1)" ] diff --git a/src/Material/Button.elm b/src/Material/Button.elm index e86c021..bab699d 100644 --- a/src/Material/Button.elm +++ b/src/Material/Button.elm @@ -2,6 +2,7 @@ module Material.Button ( Model, model, Action(Click), update , flat, raised, fab, minifab, icon , colored, primary, accent + , View, component, Component, onClick ) where {-| From the [Material Design Lite documentation](http://www.getmdl.io/components/#buttons-section): @@ -25,8 +26,8 @@ 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 colored, primary, accent @@ -38,6 +39,9 @@ for details about what type of buttons are appropriate for which situations. @docs flat, raised, fab, minifab, icon +# Component +@docs Component, component, onClick + -} 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 (Component, Indexed) {-| MDL button. -} @@ -137,7 +142,7 @@ 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) -> @@ -151,12 +156,10 @@ view kind addr model styling html = _ -> html) --- Fake address (for link buttons). - - -addr : Signal.Address Action -addr = (Signal.mailbox Click).address - +{-| Type of button views. +-} +type alias View = + Address Action -> Model -> List Style -> List Html -> Html {-| From the @@ -179,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 "" @@ -200,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" @@ -226,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" @@ -248,6 +251,45 @@ 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 + + +{-| Button component type. +-} +type alias Component state obs = + Component.Component + Model + { state | button : Indexed Model } + Action + obs + (List Style -> List Html -> Html) + + +{-| Component constructor. Provide the view function your button should +have as the first argument, e.g., + + button = Button.component Button.minifab (Button.model True) 0 + +-} +component : View -> Model -> Int -> Component state action +component view = + Component.setup view update .button (\x y -> {y | button = x}) + + +{-| Lift the button Click action to your own action. E.g., +-} +onClick : obs -> Component state obs -> Component state obs +onClick o component = + (\action -> + case action of + Click -> Just o + _ -> Nothing) + |> Component.addObserver component + + + diff --git a/src/Material/Component.elm b/src/Material/Component.elm index 722e2ce..8f90a0e 100644 --- a/src/Material/Component.elm +++ b/src/Material/Component.elm @@ -1,63 +1,82 @@ -module Material.Component where +module Material.Component + ( Component, setup, addObserver + , Instance, instance, instance' + , update + , Indexed + , View, Update, Action + ) where + +{-| + +# Types + +## Elm architecture types +@docs View, Update, Action + +## Component types +@docs Component, Instance + +## Helpers +@docs Indexed + +# For component consumers +@docs instance, instance' +@docs update + +# For component authors +@docs component, addObserver +-} import Effects exposing (Effects) -import Html exposing (Html) import Dict exposing (Dict) -import Material.Button as Button -import Material.Style exposing (Style) -import Material.Textfield as Textfield + +import Material.Helpers exposing (map1, map2, map1st, map2nd) -map1 : (a -> a') -> (a, b, c) -> (a', b, c) -map1 f (x,y,z) = (f x, y, z) +-- TYPES -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) +{-| Indexed families of things. +-} +type alias Indexed a = + Dict Int a +{- 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 -type alias Step model action action' = - action -> model -> (model, Effects action, action') - - -type alias State = - { button : Indexed Button.Model - , textfield : Indexed Textfield.Model - } - - -state0 : State -state0 = - { button = Dict.empty - , textfield = Dict.empty - } +{-| Standard EA view function type. +-} +type alias View model action a = + Signal.Address action -> model -> a +{-| Generic component action. +-} type Action model obs = A (model -> (model, Effects (Action model obs), obs)) +{-| Generic model. +-} type alias Model model state = { model | componentState : state } +-- FOR CONSUMERS + + update : (Action state (Maybe action) -> action) -> Update (Model model state) action -> @@ -79,39 +98,13 @@ update fwd update' (A f) model = |> map2nd (\fx' -> Effects.batch [ fx, fx' ]) -pack : (Step model action obs) -> action -> Action model obs -pack update action = - A (update action >> map2 (Effects.map (pack update))) --- CAUTION. Potential crash from update/update name clash. + +-- COMPONENT -type alias View model action a = - Signal.Address action -> model -> a - - -type alias Component model action a = - { view : View model action a - , update : Update model action - } - - -type alias Indexed a = - Dict Int a - -buttonComponent : Component Button.Model Button.Action (List Style -> List Html -> Html) -buttonComponent = - { view = Button.raised - , update = Button.update - } - -textfieldComponent : Component Textfield.Model Textfield.Action Html -textfieldComponent = - { view = Textfield.view - , update = \action model -> (Textfield.update action model, Effects.none) - } - - -type alias Widget submodel model action obs a = +{-| Component type. +-} +type alias Component submodel model action obs a = { view : View model action a , update : Update model action , observe : action -> Maybe obs @@ -120,15 +113,30 @@ type alias Widget submodel model action obs a = } -widget : - Component submodel action a -> -- Given a "Component submodel ..." +{-| Component constructor. You must supply + +1. A view function +2. An update function +3. A getter +4. A setter + +This will produce a function which needs only + +5. An initial model, and +6. an id + +to fit with the `instance` function. +-} +setup : + View submodel action a -> -- Given a view function, + Update submodel action -> -- an update function (model -> Indexed submodel) -> -- a getter (Indexed submodel -> model -> model) -> -- a setter submodel -> -- an initial model for this instance - Int -> -- an id for this instance - Widget submodel model action obs a -- ... produce a "Widget ..." + Int -> -- an instance id (*) + Component submodel model action obs a -- ... produce a Component. -widget component get set model0 id = +setup view update get set model0 id = let get' model = Dict.get id (get model) |> Maybe.withDefault model0 @@ -137,13 +145,11 @@ widget component get set model0 id = set (Dict.insert id submodel (get model)) model in { view = - \addr model -> component.view addr (get' model) - + \addr model -> view addr (get' model) , update = \action model -> - component.update action (get' model) + update action (get' model) |> map1st (flip set' model) - , getModel = get' , setModel = set' , observe = \_ -> Nothing @@ -151,11 +157,27 @@ widget component get set model0 id = +{- EA 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, obs) + + +{- 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 : (action -> obs) -> Update model action -> Step model action obs observe f update action = update action >> (\(model', effects) -> (model', effects, f action)) +{-| Type of component instances. A component instance contains a view, +and get/set/map for, well, getting, setting, and mapping the component +model. +-} type alias Instance submodel model action a = { view : View model action a , get : model -> submodel @@ -164,9 +186,22 @@ type alias Instance submodel model action a = } +{- Partially apply a step (update + observation) 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))) + + +{-| Instantiate a component. You must supply: + +1. A function embedding `Action` into your actions. +2. A component +-} instance : (Action model (Maybe action) -> action) -> - Widget submodel model subaction action a -> + Component submodel model subaction action a -> Instance submodel (Model master model) action a instance lift widget = let @@ -176,55 +211,48 @@ instance lift widget = set x model = { model | componentState = widget.setModel x model.componentState } + fwd = + pack (observe widget.observe widget.update) >> lift in { view = \addr model -> - widget.view (Signal.forwardTo addr (pack (observe widget.observe widget.update) >> lift)) model.componentState + widget.view (Signal.forwardTo addr fwd) model.componentState , get = get , set = set , map = \f model -> set (f (get model)) model } - +{-| Convenience function for instantiating components whose models +you never need to read or write. (E.g,. Snackbar in Toast form.) +-} instance' : (Action model (Maybe action) -> action) -> - Widget submodel model subaction action a -> + Component submodel model subaction action a -> View (Model m model) action a + instance' lift widget = (instance lift widget).view -type alias ButtonStates a = - { a | button : Indexed Button.Model } - -buttonWidget : Button.Model -> Int -> Widget Button.Model (ButtonStates m) Button.Action (Maybe obs) (List Style -> List Html -> Html) -buttonWidget model = - widget buttonComponent .button (\x y -> {y | button = x}) model - -type Test = State' (Action State (Maybe Test)) - - -addObserver widget f = - { widget +{-| Add an observer to a component. +-} +addObserver + : { c | observe : a -> Maybe b } + -> (a -> Maybe b) + -> { c | observe : a -> Maybe b } +addObserver component f = + { component | observe = \action -> case f action of - Nothing -> widget.observe action + Nothing -> component.observe action x -> x } -onClick f widget = - (\action -> - case action of - Button.Click -> Just f - _ -> Nothing) - |> addObserver widget - - - +{- type alias TextfieldStates a = { a | textfield : Indexed Textfield.Model } @@ -235,3 +263,5 @@ textfieldWidget : Textfield.Model -> Int -> Widget Textfield.Model (TextfieldSta textfieldWidget model = widget textfieldComponent .textfield (\x y -> { y | textfield = x}) model +-} + diff --git a/src/Material/Helpers.elm b/src/Material/Helpers.elm index ebc552c..da6b11a 100644 --- a/src/Material/Helpers.elm +++ b/src/Material/Helpers.elm @@ -9,17 +9,6 @@ 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 +32,24 @@ 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) + + diff --git a/src/Material/Layout.elm b/src/Material/Layout.elm index 97dac5d..1d1f3a2 100644 --- a/src/Material/Layout.elm +++ b/src/Material/Layout.elm @@ -279,7 +279,7 @@ tabsView addr model tabs = , ("mds-js-ripple-effect--ignore-events", model.rippleTabs) ] ] - (tabs |> mapWithIndex (\tabIndex tab -> + (tabs |> List.indexedMap (\tabIndex tab -> filter a [ classList [ ("mdl-layout__tab", True) diff --git a/src/Material/Textfield.elm b/src/Material/Textfield.elm index 975fa0b..a2ccb26 100644 --- a/src/Material/Textfield.elm +++ b/src/Material/Textfield.elm @@ -26,15 +26,21 @@ This implementation provides only single-line. # Configuration @docs Kind, Label -# Component +# Elm Architecture @docs Action, Model, model, update, view + +# Component +@docs component, Component, onInput + -} 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 @@ -160,3 +166,41 @@ view addr model = , model.error |> Maybe.map (\e -> span [class "mdl-textfield__error"] [text e]) ] + + + +-- COMPONENT + + +{-| Textfield component type. +-} +type alias Component state obs = + Component.Component + Model + { state | textfield : Indexed Model } + Action + obs + Html + + +{-| Component constructor. +-} +component : Model -> Int -> Component state action +component = + let + update' action model = (update action model, Effects.none) + in + Component.setup view update' .textfield (\x y -> {y | textfield = x}) + + +{-| Lift the button Click action to your own action. E.g., +-} +onInput : (String -> obs) -> Component state obs -> Component state obs +onInput f component = + (\action -> + case action of + Input str -> Just (f str) + _ -> Nothing) + |> Component.addObserver component + + From edf172bd611e87effcde58e8d5a8247003b857ae Mon Sep 17 00:00:00 2001 From: Victor Vrantchan Date: Mon, 4 Apr 2016 21:22:05 -0400 Subject: [PATCH 10/21] add sporto/hop package --- elm-package.json | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/elm-package.json b/elm-package.json index cdc296f..74622c7 100644 --- a/elm-package.json +++ b/elm-package.json @@ -9,7 +9,7 @@ ], "exposed-modules": [ "Material", - "Material.Style", + "Material.Style", "Material.Color", "Material.Icon", "Material.Button", @@ -23,7 +23,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" -} +} \ No newline at end of file From 72384a5e33705c998b884339fe5640fb8282abc1 Mon Sep 17 00:00:00 2001 From: Victor Vrantchan Date: Tue, 5 Apr 2016 00:26:22 -0400 Subject: [PATCH 11/21] add routing to Demo example --- examples/Demo.elm | 296 +++++++++++++++++++++++++++++++------------ examples/Routing.elm | 90 +++++++++++++ 2 files changed, 308 insertions(+), 78 deletions(-) create mode 100644 examples/Routing.elm diff --git a/examples/Demo.elm b/examples/Demo.elm index 15443dc..3f61f82 100644 --- a/examples/Demo.elm +++ b/examples/Demo.elm @@ -1,3 +1,5 @@ +module Main (..) where + import StartApp import Html exposing (..) import Html.Attributes exposing (href, class, style) @@ -7,48 +9,56 @@ import Task import Signal import Task exposing (Task) import Array exposing (Array) - +import Routing +import Hop +import Hop.Navigate exposing (navigateTo) import Material.Color as Color +import Material.Layout import Material.Layout as Layout exposing (defaultLayoutModel) import Material exposing (lift, lift') import Material.Style as Style - import Demo.Buttons import Demo.Grid import Demo.Textfields import Demo.Snackbar import Demo.Badges ---import Demo.Template + +--import Demo.Template -- MODEL layoutModel : Layout.Model layoutModel = { defaultLayoutModel - | state = Layout.initState (List.length tabs) + | state = Layout.initState (List.length tabs) } type alias Model = { layout : Layout.Model + , routing : Routing.Model , buttons : Demo.Buttons.Model , textfields : Demo.Textfields.Model - , snackbar : Demo.Snackbar.Model - --, template : Demo.Template.Model + , snackbar : + Demo.Snackbar.Model + --, template : Demo.Template.Model } model : Model model = { layout = layoutModel + , routing = Routing.initialModel , buttons = Demo.Buttons.model , textfields = Demo.Textfields.model - , snackbar = Demo.Snackbar.model - --, template = Demo.Template.model + , snackbar = + Demo.Snackbar.model + --, template = Demo.Template.model } + -- ACTION, UPDATE @@ -57,37 +67,106 @@ type Action | ButtonsAction Demo.Buttons.Action | TextfieldAction Demo.Textfields.Action | SnackbarAction Demo.Snackbar.Action - --| TemplateAction Demo.Template.Action + | RoutingAction Routing.Action + | HopAction () -update : Action -> Model -> (Model, Effects.Effects Action) + +--| TemplateAction Demo.Template.Action + + +changeTab : Layout.Action -> Effects Action +changeTab action = + let + navTo path = + Effects.map HopAction (navigateTo path) + in + case action of + Layout.SwitchTab n -> + case n of + 0 -> + navTo "/snackbar" + + 1 -> + navTo "/textfields" + + 2 -> + navTo "/buttons" + + 3 -> + navTo "/grid" + + 4 -> + navTo "/badges" + + _ -> + navTo "/404" + + _ -> + Effects.none + + +update : Action -> Model -> ( Model, Effects.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 - 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 - 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 + LayoutAction a -> + let + ( lifted, layoutFx ) = + lift .layout (\m x -> { m | layout = x }) LayoutAction Layout.update a model + + routeFx = + changeTab a + + fx = + Effects.batch [ layoutFx, routeFx ] + in + ( lifted, fx ) + + 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 + + SnackbarAction a -> + lift .snackbar (\m x -> { m | snackbar = x }) SnackbarAction Demo.Snackbar.update a model + + RoutingAction a -> + let + ( routing', fx ) = + Routing.update a model.routing + + model' = + { model | routing = routing' } + in + ( model' + , Effects.map RoutingAction fx + ) + + HopAction _ -> + ( model, Effects.none ) + +--TemplateAction a -> lift .template (\m x->{m|template =x}) TemplateAction Demo.Template.update a model -- VIEW -type alias Addr = Signal.Address Action - +type alias Addr = + Signal.Address Action drawer : List Html drawer = [ Layout.title "Example drawer" , Layout.navigation - [ Layout.link - [href "https://github.com/debois/elm-mdl"] - [text "github"] - , Layout.link - [href "http://package.elm-lang.org/packages/debois/elm-mdl/latest/"] - [text "elm-package"] - ] + [ Layout.link + [ href "https://github.com/debois/elm-mdl" ] + [ text "github" ] + , Layout.link + [ href "http://package.elm-lang.org/packages/debois/elm-mdl/latest/" ] + [ text "elm-package" ] + ] ] @@ -96,41 +175,52 @@ header = [ Layout.title "elm-mdl" , Layout.spacer , Layout.navigation - [ Layout.link - [ href "https://www.getmdl.io/components/index.html" ] - [ text "MDL" ] - , Layout.link - [ href "https://www.google.com/design/spec/material-design/introduction.html"] - [ text "Material Design"] - ] + [ Layout.link + [ href "https://www.getmdl.io/components/index.html" ] + [ text "MDL" ] + , Layout.link + [ href "https://www.google.com/design/spec/material-design/introduction.html" ] + [ text "Material Design" ] + ] ] -tabs : List (String, Addr -> Model -> List Html) +tabs : List ( String, Addr -> Model -> List 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 ) - {- - , ("Template", \addr model -> - [Demo.Template.view (Signal.forwardTo addr TemplateAction) model.template]) - -} + [ ( "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 ) + {- + , ("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 +tabViews = + List.map snd tabs |> Array.fromList tabTitles : List Html -tabTitles = List.map (fst >> text) tabs +tabTitles = + List.map (fst >> text) tabs + stylesheet : Html -stylesheet = Style.stylesheet """ +stylesheet = + Style.stylesheet """ blockquote:before { content: none; } blockquote:after { content: none; } blockquote { @@ -143,66 +233,111 @@ stylesheet = Style.stylesheet """ inline css. */ } - p, blockquote { + p, blockquote { max-width: 33em; font-size: 13px; } """ - view : Signal.Address Action -> Model -> Html view addr model = - let top = - div - [ style - [ ("margin", "auto") - , ("padding-left", "5%") - , ("padding-right", "5%") - ] - ] - ((Array.get model.layout.selectedTab tabViews - |> Maybe.withDefault (\addr model -> - [div [] [text "This can't happen."]] - ) - ) addr model) + routingView addr model + +routingView : Signal.Address Action -> Model -> Html +routingView addr model = + case (Debug.log "Route " model.routing.route) of + Routing.Home -> + let + model' = + { model | layout = setTab model.layout 0 } + in + appView addr model' + + Routing.TabRoute tabNumber -> + let + model' = + { model | layout = setTab model.layout tabNumber } + in + appView addr model' + + Routing.NotFoundRoute -> + div [] [ h2 [] [ text "Not found" ] ] + + +setTab layout tabNumber = + { layout | selectedTab = tabNumber } + + +appView : Signal.Address Action -> Model -> Html +appView addr model = + let + top = + div + [ style + [ ( "margin", "auto" ) + , ( "padding-left", "5%" ) + , ( "padding-right", "5%" ) + ] + ] + ((Array.get model.layout.selectedTab tabViews + |> Maybe.withDefault + (\addr model -> + [ div [] [ text "This can't happen." ] ] + ) + ) + addr + model + ) in - Layout.view (Signal.forwardTo addr LayoutAction) model.layout + Layout.view + (Signal.forwardTo addr LayoutAction) + model.layout { header = Just header , drawer = Just drawer , tabs = Just tabTitles , 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 + {- 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 -init : (Model, Effects.Effects Action) -init = (model, Effects.none) +routerSignal : Signal Action +routerSignal = + Signal.map RoutingAction Routing.signal + + +init : ( Model, Effects.Effects Action ) +init = + ( model, Effects.none ) inputs : List (Signal.Signal Action) inputs = [ Layout.setupSizeChangeSignal LayoutAction + , routerSignal ] 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 @@ -210,4 +345,9 @@ main = port tasks : Signal (Task.Task Never ()) port tasks = - app.tasks + app.tasks + + +port routeRunTask : Task () () +port routeRunTask = + Routing.run diff --git a/examples/Routing.elm b/examples/Routing.elm new file mode 100644 index 0000000..32815f7 --- /dev/null +++ b/examples/Routing.elm @@ -0,0 +1,90 @@ +module Routing (..) where + +import Task exposing (Task) +import Effects exposing (Effects, Never) +import Hop +import Hop.Types exposing (Location, PathMatcher, Router, newLocation) +import Hop.Navigate exposing (navigateTo) +import Hop.Matchers exposing (match1, match2, match3, str) + + +type Route + = Home + | TabRoute Int + | NotFoundRoute + + +type alias Model = + { location : Location + , route : Route + } + + +initialModel : Model +initialModel = + { location = newLocation + , route = Home + } + + +type Action + = HopAction () + | ApplyRoute ( Route, Location ) + | NavigateTo String + + +update : Action -> Model -> ( Model, Effects Action ) +update action model = + case action of + NavigateTo path -> + ( model, Effects.map HopAction (navigateTo path) ) + + ApplyRoute ( route, location ) -> + ( { model + | route = route + , location = location + } + , Effects.none + ) + + HopAction () -> + ( model, Effects.none ) + + +indexMatcher : PathMatcher Route +indexMatcher = + match1 Home "/" + + +tabMatcher : String -> Int -> PathMatcher Route +tabMatcher tabName tabNumber = + match1 (TabRoute tabNumber) ("/" ++ tabName) + + +matchers : List (PathMatcher Route) +matchers = + [ indexMatcher + , (tabMatcher "snackbar" 0) + , (tabMatcher "textfields" 1) + , (tabMatcher "buttons" 2) + , (tabMatcher "grid" 3) + , (tabMatcher "badges" 4) + ] + + +router : Router Route +router = + Hop.new + { matchers = matchers + , notFound = NotFoundRoute + } + + +run : Task () () +run = + router.run + + +signal : Signal Action +signal = + Signal.map ApplyRoute router.signal From 84d3234f0469043f513f96716e07e5b4b2f0c889 Mon Sep 17 00:00:00 2001 From: Victor Vrantchan Date: Tue, 5 Apr 2016 13:03:36 -0400 Subject: [PATCH 12/21] address PR comments --- examples/Demo.elm | 31 +++++-------------------------- 1 file changed, 5 insertions(+), 26 deletions(-) diff --git a/examples/Demo.elm b/examples/Demo.elm index 3f61f82..4239f93 100644 --- a/examples/Demo.elm +++ b/examples/Demo.elm @@ -132,16 +132,7 @@ update action model = lift .snackbar (\m x -> { m | snackbar = x }) SnackbarAction Demo.Snackbar.update a model RoutingAction a -> - let - ( routing', fx ) = - Routing.update a model.routing - - model' = - { model | routing = routing' } - in - ( model' - , Effects.map RoutingAction fx - ) + lift .routing (\m x -> { m | routing = x }) RoutingAction Routing.update a model HopAction _ -> ( model, Effects.none ) @@ -249,23 +240,16 @@ routingView : Signal.Address Action -> Model -> Html routingView addr model = case (Debug.log "Route " model.routing.route) of Routing.Home -> - let - model' = - { model | layout = setTab model.layout 0 } - in - appView addr model' + appView addr { model | layout = setTab model.layout 0 } Routing.TabRoute tabNumber -> - let - model' = - { model | layout = setTab model.layout tabNumber } - in - appView addr model' + appView addr { model | layout = setTab model.layout tabNumber } Routing.NotFoundRoute -> div [] [ h2 [] [ text "Not found" ] ] +setTab : Layout.Model -> Int -> Layout.Model setTab layout tabNumber = { layout | selectedTab = tabNumber } @@ -307,11 +291,6 @@ appView addr model = Material.topWithScheme Color.Teal Color.Red -routerSignal : Signal Action -routerSignal = - Signal.map RoutingAction Routing.signal - - init : ( Model, Effects.Effects Action ) init = ( model, Effects.none ) @@ -320,7 +299,7 @@ init = inputs : List (Signal.Signal Action) inputs = [ Layout.setupSizeChangeSignal LayoutAction - , routerSignal + , Signal.map RoutingAction Routing.signal ] From aaf58fa37c9f4fa50627e22bf92406670b7bd814 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B8ren=20Debois?= Date: Wed, 6 Apr 2016 15:28:37 +0200 Subject: [PATCH 13/21] Experimental component model --- Makefile | 3 + examples/Component-EA.elm | 145 +++++++++++++++ examples/Component.elm | 159 +++++++++++++++++ src/Material.elm | 265 ++++++++++++++++----------- src/Material/Button.elm | 59 +++--- src/Material/Component.elm | 357 ++++++++++++++++++++----------------- src/Material/Scheme.elm | 84 +++++++++ src/Material/Textfield.elm | 61 +++++-- 8 files changed, 819 insertions(+), 314 deletions(-) create mode 100644 examples/Component-EA.elm create mode 100644 examples/Component.elm create mode 100644 src/Material/Scheme.elm diff --git a/Makefile b/Makefile index be82290..5d2cb48 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,8 @@ PAGES=../elm-mdl-gh-pages +comp: + elm-make examples/Component.elm --warn --output elm.js + elm.js: elm-make examples/Demo.elm --warn --output elm.js diff --git a/examples/Component-EA.elm b/examples/Component-EA.elm new file mode 100644 index 0000000..284966a --- /dev/null +++ b/examples/Component-EA.elm @@ -0,0 +1,145 @@ +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.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 diff --git a/examples/Component.elm b/examples/Component.elm new file mode 100644 index 0000000..93f2756 --- /dev/null +++ b/examples/Component.elm @@ -0,0 +1,159 @@ +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 + -- Boilerplate: Model store for any and all MDL components you need. + } + + + +model : Model +model = + { count = 0 + , mdl = Material.model + -- Always use this initial MDL component model store. + } + + +-- ACTION, UPDATE + + +type Action + = Increase + | Reset + | MDL (Material.Action Action) + -- Boilerplate: Action for MDL actions (ripple animations etc.). + -- It should always look like this. + + +update : Action -> Model -> (Model, Effects.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 + + +{- 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 Material.Model 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 Material.Model 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 diff --git a/src/Material.elm b/src/Material.elm index fb34d4f..5978df4 100644 --- a/src/Material.elm +++ b/src/Material.elm @@ -1,127 +1,178 @@ -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, e.g., +each component has Model, Action, view, and update. A minimal example using +this library in plain Elm Architecture can be found +[here](https://github.com/debois/elm-mdl/blob/master/examples/Component-EA.elm). + +Nesting large amounts of components in the Elm Architecture is somewhat +unwieldy because of the large amount of boilerplate one has to write. This +library includes "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). + +It is important to note that component support lives __within__ the Elm +architecture; it is not an alternative architecture. + +# 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 rather than working +directly in plain Elm Architecture. + +# This module + +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) + +Here is how you use component support in general. First, boilerplate. + + 1. Include `Material`: + `import Material` + + 2. Add a model container Material components to your model: + + type alias Model = + { ... + , mdl : Material.Model + } + + 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`. 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 itMatendicated above, then use +your modified module rather than this one. + +@docs Model, model, Action, update -} +import Dict +import Effects exposing (Effects) -import String -import Html exposing (..) -import Html.Attributes exposing (..) -import Effects exposing (..) - -import Material.Color exposing (Palette(..), Color) +import Material.Button as Button +import Material.Textfield as Textfield +import Material.Component as Component exposing (Indexed) - -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" - - - -{-| 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: - - - - - - -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. - -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 encompassing all Material components. -} -topWithScheme: Palette -> Palette -> Html -> Html -topWithScheme primary accent content = - div [] <| - {- Trick from Peter Damoc to load CSS outside of . - https://github.com/pdamoc/elm-mdl/blob/master/src/Mdl.elm#L63 - -} - [ node "style" - [ type' "text/css"] - [ Html.text <| scheme primary accent] - , content - ] +type alias Model = + { button : Indexed Button.Model + , textfield : Indexed Textfield.Model + } -{-| Top-level container with default color scheme. +{-| Initial model. -} -top : Html -> Html -top content = - -- Force default color-scheme by picking an invalid combination. - topWithScheme Grey Grey content +model : Model +model = + { button = Dict.empty + , textfield = Dict.empty + } - -{-| TODO. +{-| Action encompassing actions of all Material components. -} -type alias Updater' action model = - action -> model -> model +type alias Action action = + Component.Action Model action -{-| TODO. +{-| Update function for the above Action. -} -type alias Updater action model = - action -> model -> (model, Effects action) - -type alias ComponentModel model components = - { model | components : components } - - -{-| TODO. --} -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 action -> action) + -> (Action action) + -> Model + -> (Model, Effects action) +update = + Component.update diff --git a/src/Material/Button.elm b/src/Material/Button.elm index bab699d..9e6bc67 100644 --- a/src/Material/Button.elm +++ b/src/Material/Button.elm @@ -2,7 +2,7 @@ module Material.Button ( Model, model, Action(Click), update , flat, raised, fab, minifab, icon , colored, primary, accent - , View, component, Component, onClick + , View, State, Instance, instance, fwdClick ) where {-| From the [Material Design Lite documentation](http://www.getmdl.io/components/#buttons-section): @@ -40,7 +40,7 @@ for details about what type of buttons are appropriate for which situations. @docs flat, raised, fab, minifab, icon # Component -@docs Component, component, onClick +@docs State, Instance, instance, fwdClick -} @@ -53,7 +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 (Component, Indexed) +import Material.Component as Component exposing (Indexed) {-| MDL button. -} @@ -259,37 +259,46 @@ icon = view "mdl-button--icon" -- COMPONENT -{-| Button component type. +{-| -} -type alias Component state obs = - Component.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 | button : Indexed Model } - Action - obs + state + obs (List Style -> List Html -> Html) -{-| Component constructor. Provide the view function your button should -have as the first argument, e.g., +{-| Ydrk. -} +instance : + Int + -> (Component.Action (State state) obs -> obs) + -> (Address Action -> Model -> List Style -> List Html -> Html) + -> Model + -> List (Observer obs) + -> Instance (State state) obs - button = Button.component Button.minifab (Button.model True) 0 - --} -component : View -> Model -> Int -> Component state action -component view = - Component.setup view update .button (\x y -> {y | button = x}) +instance id lift view model0 observers = + Component.setup view update .button (\x y -> {y | button = x}) model0 id + |> Component.instance lift observers {-| Lift the button Click action to your own action. E.g., -} -onClick : obs -> Component state obs -> Component state obs -onClick o component = - (\action -> - case action of - Click -> Just o - _ -> Nothing) - |> Component.addObserver component - +fwdClick : obs -> (Observer obs) +fwdClick obs action = + case action of + Click -> Just obs + _ -> Nothing diff --git a/src/Material/Component.elm b/src/Material/Component.elm index 8f90a0e..843c472 100644 --- a/src/Material/Component.elm +++ b/src/Material/Component.elm @@ -1,48 +1,53 @@ module Material.Component - ( Component, setup, addObserver - , Instance, instance, instance' - , update + ( Embedding, Observer , Indexed - , View, Update, Action + , Instance, instance + , update + , Action ) where -{-| +{-| -# Types +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: -## Elm architecture types -@docs View, Update, Action + 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 -## Component types -@docs Component, Instance +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. -## Helpers -@docs Indexed +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), you should ignore this module and look +instead at `Material`. -# For component consumers -@docs instance, instance' +# Component types +@docs Indexed, Embedding, Observer, Instance + +# Instance construction +@docs instance + +# Instance consumption @docs update -# For component authors -@docs component, addObserver -} import Effects exposing (Effects) import Dict exposing (Dict) - import Material.Helpers exposing (map1, map2, map1st, map2nd) -- TYPES -{-| Indexed families of things. --} -type alias Indexed a = - Dict Int a - - {- Variant of EA update function type, where effects may be lifted to a different type. -} @@ -62,81 +67,64 @@ type alias View model action a = Signal.Address action -> model -> a -{-| Generic component action. + +{-| Indexed families of things. -} -type Action model obs = - A (model -> (model, Effects (Action model obs), obs)) - +type alias Indexed a = + Dict Int a -{-| Generic model. + +{-| 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 container model. -} -type alias Model model state = - { model | componentState : state } - - --- FOR CONSUMERS - - -update : - (Action state (Maybe action) -> action) -> - Update (Model model state) action -> - Update' (Model model state) (Action state (Maybe action)) action - -update fwd update' (A f) model = - let - (model', fx, obs) = - f model.componentState - |> map1 (\state' -> { model | componentState = state' }) - |> map2 (Effects.map fwd) - in - case obs of - Nothing -> - (model', fx) - - Just x -> - update' x model' - |> map2nd (\fx' -> Effects.batch [ fx, fx' ]) - - - --- COMPONENT - - -{-| Component type. --} -type alias Component submodel model action obs a = - { view : View model action a - , update : Update model action - , observe : action -> Maybe obs - , getModel : model -> submodel - , setModel : submodel -> model -> model +type alias Embedding model container action a = + { view : View container action a + , update : Update container action + , getModel : container -> model + , setModel : model -> container -> container } -{-| Component constructor. You must supply - -1. A view function -2. An update function -3. A getter -4. A setter - -This will produce a function which needs only - -5. An initial model, and -6. an id - -to fit with the `instance` function. +{-| 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). -} -setup : - View submodel action a -> -- Given a view function, - Update submodel action -> -- an update function - (model -> Indexed submodel) -> -- a getter - (Indexed submodel -> model -> model) -> -- a setter - submodel -> -- an initial model for this instance - Int -> -- an instance id (*) - Component submodel model action obs a -- ... produce a Component. +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. -setup view update get set model0 id = +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 an id used for looking up its own state. Its the responsibility of the user +to make +sure that ids are unique. +-} +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 @@ -144,34 +132,51 @@ setup view update get set model0 id = set' submodel model = set (Dict.insert id submodel (get model)) model in - { view = - \addr model -> view addr (get' model) - , update = - \action model -> - update action (get' model) - |> map1st (flip set' model) - , getModel = get' - , setModel = set' - , observe = \_ -> Nothing - } + embed view update get' set' + +{-| We need a generic Action which encompasses x +-} +type Action model obs = + A (model -> (model, Effects (Action model obs), Maybe obs)) + + +-- FOR CONSUMERS + + +{-| Generic update function for Action. +-} +update : + (Action state action -> action) -> + Update' state (Action state action) action + +update fwd (A f) state = + let + (state', fx, obs) = + f state + |> map2 (Effects.map fwd) + in + case obs of + Nothing -> + (state', fx) + + Just x -> + (state', Effects.batch [ fx, Effects.tick (always x) ]) + + + +-- INSTANCES + + {- EA 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, obs) - - -{- 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 : (action -> obs) -> Update model action -> Step model action obs -observe f update action = - update action >> (\(model', effects) -> (model', effects, f action)) + action -> model -> (model, Effects action, Maybe obs) + {-| Type of component instances. A component instance contains a view, @@ -186,7 +191,7 @@ type alias Instance submodel model action a = } -{- Partially apply a step (update + observation) function to an action, +{- Partially apply a step function to an action, producing a generic Action. -} pack : (Step model action obs) -> action -> Action model obs @@ -194,74 +199,94 @@ pack update action = A (update action >> map2 (Effects.map (pack update))) -{-| Instantiate a component. You must supply: - -1. A function embedding `Action` into your actions. -2. A component +{-| Type of observers. -} -instance : - (Action model (Maybe action) -> action) -> - Component submodel model subaction action a -> - Instance submodel (Model master model) action a -instance lift widget = +type alias Observer action obs = + action -> Maybe obs + + +{- 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 + + +connect : List (Observer subaction action) -> Observer subaction action +connect observers subaction = + pick ((|>) subaction) observers + + + +{-| Given a lifting function, a list of observers and an embedding, construct an +Instance. Notice that the Instance forgets the type parameter `subaction`. +-} +instance' : + (Action model action -> action) -> + List (Observer subaction action) -> + Embedding submodel model subaction a -> + Instance submodel model action a +instance' lift observers embedding = let - get model = - widget.getModel model.componentState - - set x model = - { model | componentState = widget.setModel x model.componentState } - fwd = - pack (observe widget.observe widget.update) >> lift + pack (observe (connect observers) embedding.update) >> lift + get = + embedding.getModel + set = + embedding.setModel in { view = - \addr model -> - widget.view (Signal.forwardTo addr fwd) model.componentState + \addr -> + embedding.view (Signal.forwardTo addr fwd) , get = get , set = set , map = \f model -> set (f (get model)) model } -{-| Convenience function for instantiating components whose models -you never need to read or write. (E.g,. Snackbar in Toast form.) +{-| 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 state in a generic container model (get, set), +and which dispatches generic Action updates, lifted to the consumers action +type (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 (rule of thumb: if they are in the same +file, they need distinct ids.) -} -instance' : - (Action model (Maybe action) -> action) -> - Component submodel model subaction action a -> - View (Model m model) action a +instance + : View model action a + -> Update model action + -> (container -> Indexed model) + -> (Indexed model -> container -> container) + -> Int + -> (Action container observation -> observation) + -> model + -> List (Observer action observation) + -> Instance model container observation a -instance' lift widget = (instance lift widget).view - - -{-| Add an observer to a component. --} -addObserver - : { c | observe : a -> Maybe b } - -> (a -> Maybe b) - -> { c | observe : a -> Maybe b } -addObserver component f = - { component - | observe = - \action -> - case f action of - Nothing -> component.observe action - x -> x - } - +instance view update get set id lift model0 observers = + embedIndexed view update get set model0 id + |> instance' lift observers -{- - -type alias TextfieldStates a = - { a | textfield : Indexed Textfield.Model } - - - -textfieldWidget : Textfield.Model -> Int -> Widget Textfield.Model (TextfieldStates model) Textfield.Action (Maybe obs) Html -textfieldWidget model = - widget textfieldComponent .textfield (\x y -> { y | textfield = x}) model - --} - diff --git a/src/Material/Scheme.elm b/src/Material/Scheme.elm new file mode 100644 index 0000000..a33365d --- /dev/null +++ b/src/Material/Scheme.elm @@ -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 `` 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 + + + + + +# 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.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" + + +{-| 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 . + 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 + + + diff --git a/src/Material/Textfield.elm b/src/Material/Textfield.elm index a2ccb26..a2134a7 100644 --- a/src/Material/Textfield.elm +++ b/src/Material/Textfield.elm @@ -30,7 +30,8 @@ This implementation provides only single-line. @docs Action, Model, model, update, view # Component -@docs component, Component, onInput +@docs State, Instance +@docs instance, fwdInput, fwdBlur, fwdFocus -} @@ -172,35 +173,63 @@ view addr model = -- COMPONENT -{-| Textfield component type. +{-| -} -type alias Component state obs = - Component.Component +type alias State state = + { state | textfield : Indexed Model } + + +{-| +-} +type alias Instance state obs = + Component.Instance Model - { state | textfield : Indexed Model } - Action + state obs Html {-| Component constructor. -} -component : Model -> Int -> Component state action -component = +instance : + Int + -> (Component.Action (State state) obs -> obs) + -> Model + -> List (Component.Observer Action obs) + -> Instance (State state) obs + + +instance id lift model0 observers = let update' action model = (update action model, Effects.none) in - Component.setup view update' .textfield (\x y -> {y | textfield = x}) + Component.setup view update' .textfield (\x y -> {y | textfield = x}) model0 id + |> Component.instance lift observers {-| Lift the button Click action to your own action. E.g., -} -onInput : (String -> obs) -> Component state obs -> Component state obs -onInput f component = - (\action -> - case action of - Input str -> Just (f str) - _ -> Nothing) - |> Component.addObserver component +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 + From f994c82d509508770b54b1ba0572aca7634436ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B8ren=20Debois?= Date: Wed, 6 Apr 2016 20:16:54 +0200 Subject: [PATCH 14/21] Missing files. (snackbar still broken). --- Makefile | 2 +- elm-package.json | 3 +- examples/Component.elm | 10 +-- examples/Demo.elm | 5 +- examples/Demo/Buttons.elm | 33 +-------- examples/Demo/Elevation.elm | 101 ++++++++++++++++++++++++++ examples/Demo/Page.elm | 140 ++++++++++++++++++++++++++++++++++++ examples/Demo/Snackbar.elm | 98 +++++++++++++------------ src/Material.elm | 15 ++-- src/Material/Button.elm | 7 +- src/Material/Component.elm | 37 ++++------ src/Material/Helpers.elm | 36 ++++++++++ src/Material/Shadow.elm | 83 +++++++++++++++++++++ src/Material/Snackbar.elm | 70 +++++++++++++++++- src/Material/Textfield.elm | 14 ++-- 15 files changed, 524 insertions(+), 130 deletions(-) create mode 100644 examples/Demo/Elevation.elm create mode 100644 examples/Demo/Page.elm create mode 100644 src/Material/Shadow.elm diff --git a/Makefile b/Makefile index 5d2cb48..2f8e86f 100644 --- a/Makefile +++ b/Makefile @@ -3,7 +3,7 @@ PAGES=../elm-mdl-gh-pages comp: elm-make examples/Component.elm --warn --output elm.js -elm.js: +demo: elm-make examples/Demo.elm --warn --output elm.js wip-pages : diff --git a/elm-package.json b/elm-package.json index cdc296f..f9fde46 100644 --- a/elm-package.json +++ b/elm-package.json @@ -15,7 +15,8 @@ "Material.Button", "Material.Textfield", "Material.Layout", - "Material.Grid" + "Material.Grid", + "Material.Component" ], "dependencies": { "debois/elm-dom": "1.0.0 <= v < 2.0.0", diff --git a/examples/Component.elm b/examples/Component.elm index 93f2756..5a1624c 100644 --- a/examples/Component.elm +++ b/examples/Component.elm @@ -14,7 +14,7 @@ import Material.Button as Button type alias Model = { count : Int - , mdl : Material.Model + , mdl : Material.Model Action -- Boilerplate: Model store for any and all MDL components you need. } @@ -23,7 +23,7 @@ type alias Model = model : Model model = { count = 0 - , mdl = Material.model + , mdl = Material.model -- Always use this initial MDL component model store. } @@ -66,6 +66,8 @@ update action model = -- 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: @@ -79,7 +81,7 @@ button. The arguments are: In this case, we hook up Click events of the button to the `Increase` action defined above. -} -increase : Button.Instance Material.Model Action +increase : Button.Instance Mdl Action increase = Button.instance 0 MDL Button.flat (Button.model True) @@ -89,7 +91,7 @@ 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 Material.Model Action +reset : Button.Instance Mdl Action reset = Button.instance 1 MDL Button.flat (Button.model False) diff --git a/examples/Demo.elm b/examples/Demo.elm index 15443dc..2628786 100644 --- a/examples/Demo.elm +++ b/examples/Demo.elm @@ -10,8 +10,9 @@ import Array exposing (Array) import Material.Color as Color import Material.Layout as Layout exposing (defaultLayoutModel) -import Material exposing (lift, lift') +import Material.Helpers exposing (lift, lift') import Material.Style as Style +import Material.Scheme as Scheme import Demo.Buttons import Demo.Grid @@ -178,7 +179,7 @@ view addr model = 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) diff --git a/examples/Demo/Buttons.elm b/examples/Demo/Buttons.elm index b22f788..67a8b41 100644 --- a/examples/Demo/Buttons.elm +++ b/examples/Demo/Buttons.elm @@ -11,8 +11,6 @@ import Material.Icon as Icon import Material.Style exposing (Style) import Material.Textfield as Textfield -import Material.Component as Component -import Material.Component.All as Setup -- MODEL @@ -69,7 +67,6 @@ model = buttons |> List.concatMap (List.map <| \(idx, (ripple, _, _)) -> (idx, Button.model ripple)) |> Dict.fromList - , componentState = Setup.state } @@ -78,15 +75,11 @@ model = type Action = Action Index Button.Action - | State (Setup.Action Action) - | Click - | Input String type alias Model = { clicked : String , buttons : Dict.Dict Index Button.Model - , componentState : Setup.State } @@ -103,25 +96,6 @@ update action model = ) |> Maybe.withDefault (model, Effects.none) - State action' -> - Component.update State update action' model - - Click -> - ( tf.map (\m -> { m | value = "You clicked!" }) model, Effects.none ) - - Input str -> - ( tf.map (\m -> { m | value = "You wrote '" ++ str ++ "' in the other guy."}) model - , Effects.none - ) - - -instance = Component.instance State -instance' = Component.instance' State - - -tf = instance <| Textfield.component Textfield.model 4 - - -- VIEW @@ -161,12 +135,7 @@ view addr model = ) |> (\contents -> div [] - [ instance' (Button.component Button.flat (Button.model True) 1 |> onClick Click) addr model [] [ text "Click me (1)" ] - , instance' (Button.component Button.raised (Button.model False) 2) addr model [] [ text "Click me (2)" ] - , instance' (Textfield.component Textfield.model 3 |> Textfield.onInput Input) addr model - , tf.view addr model - , Grid.grid [] contents + [ Grid.grid [] contents ] ) ---i = instance' State (buttonWidget (Button.model True) 1) -- addr model.componentState [] [ text "Click me (1)" ] diff --git a/examples/Demo/Elevation.elm b/examples/Demo/Elevation.elm new file mode 100644 index 0000000..c5d9d59 --- /dev/null +++ b/examples/Demo/Elevation.elm @@ -0,0 +1,101 @@ +module Demo.Elevation where + +import Effects exposing (Effects, none) +import Html exposing (..) + +import Markdown + +import Material.Template as Template +import Material exposing (lift, lift') + + +-- MODEL + + +type alias Model = + { template : Template.Model + } + + +model : Model +model = + { template = Template.model + } + + +-- ACTION, UPDATE + + +type Action + = TemplateAction Template.Action + + +update : Action -> Model -> (Model, Effects Action) +update action model = + case action of + TemplateAction action' -> lift .template (\m x -> {m|template=x}) TemplateAction Template.update action' model + + +-- VIEW + + + +view : Signal.Address Action -> Model -> Html +view addr model = + div [] + [ intro + , Template.view (Signal.forwardTo addr TemplateAction) model.template + ] + + + +intro : Html +intro = """ + + +{-| 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. + +# TEMPLATE + +From the +[Material Design Lite documentation](https://www.getmdl.io/components/index.html#TEMPLATE-section). + +> ... + +#### See also + + - [Demo source code](https://github.com/debois/elm-mdl/blob/master/examples/Demo/TEMPLATE.elm) + - [elm-mdl package documentation](http://package.elm-lang.org/packages/debois/elm-mdl/latest/Material-TEMPLATE) + - [Material Design Specification](https://www.google.com/design/spec/components/TEMPLATE.html) + - [Material Design Lite documentation](https://www.getmdl.io/components/index.html#TEMPLATE) + +#### Demo + +""" |> Markdown.toHtml + + + diff --git a/examples/Demo/Page.elm b/examples/Demo/Page.elm new file mode 100644 index 0000000..faa7b45 --- /dev/null +++ b/examples/Demo/Page.elm @@ -0,0 +1,140 @@ +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.div + [ Color.text Color.primary + , cs "mdl-typography--display-4" + -- TODO. Typography module + ] + [ text t ] + + +demoTitle : Html +demoTitle = + Style.div + [ Color.text Color.primary + , cs "mdl-typography--display-1" + -- TODO. Typography module + ] + [ text "Demo" ] + + + +-- 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" "72px" + , css "bottom" "72px" + , 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 [] + [ cell [ size All 6, size Phone 4 ] [ contents ] + , cell + [ size All 5, offset Desktop 1, size Phone 4, align Top ] + ( references <| ("Demo source", srcUrl) :: links ) + ] + :: fab srcUrl + :: demoTitle + :: demo + ) + + + + diff --git a/examples/Demo/Snackbar.elm b/examples/Demo/Snackbar.elm index 61597a1..95ad351 100644 --- a/examples/Demo/Snackbar.elm +++ b/examples/Demo/Snackbar.elm @@ -5,13 +5,14 @@ import Html exposing (..) import Html.Attributes exposing (class, style, key) import Array exposing (Array) +import Material.Helpers exposing (map1st, map2nd) import Material.Color as Color import Material.Style exposing (styled, cs) import Material.Snackbar as Snackbar import Material.Button as Button exposing (Action(..)) import Material.Grid exposing (..) import Material.Elevation as Elevation -import Material exposing (lift, lift') +import Material import Demo.Page as Page @@ -19,12 +20,13 @@ import Demo.Page as Page -- MODEL +type alias Mdl = Material.Model Action + + type alias Model = { count : Int , clicked : List Int - , snackbar : Snackbar.Model Action - , toastButton : Button.Model - , snackbarButton : Button.Model + , mdl : Mdl } @@ -32,9 +34,7 @@ model : Model model = { count = 0 , clicked = [] - , snackbar = Snackbar.model - , toastButton = Button.model True - , snackbarButton = Button.model True + , mdl = Material.model } @@ -43,10 +43,9 @@ model = type Action = Undo Int - -- Components - | SnackbarAction (Snackbar.Action Action) - | ToastButtonAction Button.Action - | SnackbarButtonAction Button.Action + | AddSnackbar + | AddToast + | MDL (Material.Action Action) snackbar : Int -> Snackbar.Contents Action @@ -65,26 +64,26 @@ toast 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) - + let + (mdl', fx) = + Snackbar.add (f model.count) snackbarComponent model.mdl + model' = + { model + | mdl = mdl' + , count = model.count + 1 + , clicked = model.count :: model.clicked + } + in + (model', fx) update : Action -> Model -> (Model, Effects Action) update action model = case action of - SnackbarButtonAction Click -> + AddSnackbar -> add snackbar model - ToastButtonAction Click -> + AddToast -> add toast model Undo k -> @@ -93,17 +92,33 @@ update action model = } , none) - SnackbarAction (Snackbar.Action action') - -> update action' model - - 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 - + MDL action' -> + Material.update MDL action' model.mdl + |> map1st (\m -> { model | mdl = m }) -- VIEW +addSnackbar : Button.Instance Mdl Action +addSnackbar = + Button.instance 0 MDL + Button.raised (Button.model True) + [ Button.fwdClick AddSnackbar ] + + +addToast : Button.Instance Mdl Action +addToast = + Button.instance 1 MDL + Button.raised (Button.model True) + [ Button.fwdClick AddToast ] + + +snackbarComponent : Snackbar.Instance Mdl Action +snackbarComponent = + Snackbar.instance 2 MDL Snackbar.model [] + + + clickView : Model -> Int -> Html clickView model k = let @@ -112,9 +127,12 @@ clickView model k = |> Maybe.withDefault Color.Teal |> flip Color.color Color.S500 + sbmodel = + snackbarComponent.get model.mdl + selected = - (k == model.snackbar.seq - 1) && - (Snackbar.isActive model.snackbar /= Nothing) + (k == sbmodel.seq - 1) && + (Snackbar.isActive sbmodel /= Nothing) in styled div [ Color.background color @@ -146,25 +164,17 @@ view addr model = -- 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 - [] - [ text "Toast" ] + [ addToast.view addr model.mdl [] [ text "Toast" ] ] , cell [ size All 2, size Phone 2, align Top ] - [ Button.raised - (Signal.forwardTo addr SnackbarButtonAction) - model.snackbarButton - [] - [ text "Snackbar" ] + [ addSnackbar.view addr model.mdl [] [ text "Snackbar" ] ] , cell [ size Desktop 7, size Tablet 3, size Phone 12, align Top ] (model.clicked |> List.reverse |> List.map (clickView model)) ] - , Snackbar.view (Signal.forwardTo addr SnackbarAction) model.snackbar + , snackbarComponent.view addr model.mdl ] diff --git a/src/Material.elm b/src/Material.elm index 5978df4..82a8ae1 100644 --- a/src/Material.elm +++ b/src/Material.elm @@ -141,38 +141,41 @@ 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) {-| Model encompassing all Material components. -} -type alias Model = +type alias Model a = { button : Indexed Button.Model , textfield : Indexed Textfield.Model + , snackbar : Indexed (Snackbar.Model a) } {-| Initial model. -} -model : Model +model : Model a model = { button = Dict.empty , textfield = Dict.empty + , snackbar = Dict.empty } {-| Action encompassing actions of all Material components. -} type alias Action action = - Component.Action Model action + Component.Action (Model action) action {-| Update function for the above Action. -} update : (Action action -> action) - -> (Action action) - -> Model - -> (Model, Effects action) + -> Action action + -> Model action + -> (Model action, Effects action) update = Component.update diff --git a/src/Material/Button.elm b/src/Material/Button.elm index 9e6bc67..9771593 100644 --- a/src/Material/Button.elm +++ b/src/Material/Button.elm @@ -279,7 +279,8 @@ type alias Instance state obs = (List Style -> List Html -> Html) -{-| Ydrk. -} +{-| Component instance. +-} instance : Int -> (Component.Action (State state) obs -> obs) @@ -289,8 +290,8 @@ instance : -> Instance (State state) obs instance id lift view model0 observers = - Component.setup view update .button (\x y -> {y | button = x}) model0 id - |> Component.instance lift 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., diff --git a/src/Material/Component.elm b/src/Material/Component.elm index 843c472..99a7407 100644 --- a/src/Material/Component.elm +++ b/src/Material/Component.elm @@ -35,38 +35,27 @@ instead at `Material`. @docs instance # Instance consumption -@docs update +@docs update, Action -} import Effects exposing (Effects) import Dict exposing (Dict) -import Material.Helpers exposing (map1, map2, map1st, map2nd) +import Material.Helpers exposing (map1, map2, map1st, map2nd, Update, Update') -- TYPES -{- 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 - - {-| Standard EA view function type. -} type alias View model action a = Signal.Address action -> model -> a +-- EMBEDDING MODELS + {-| Indexed families of things. -} @@ -136,14 +125,13 @@ embedIndexed view update get set model0 id = +-- LIFTING ACTIONS -{-| We need a generic Action which encompasses x + +{-| Generic MDL Action. -} type Action model obs = A (model -> (model, Effects (Action model obs), Maybe obs)) - - --- FOR CONSUMERS {-| Generic update function for Action. @@ -183,11 +171,12 @@ type alias Step model action obs = and get/set/map for, well, getting, setting, and mapping the component model. -} -type alias Instance submodel model action a = +type alias Instance submodel model subaction action a = { view : View model action a , get : model -> submodel , set : submodel -> model -> model , map : (submodel -> submodel) -> model -> model + , fwd : subaction -> action } @@ -240,7 +229,7 @@ instance' : (Action model action -> action) -> List (Observer subaction action) -> Embedding submodel model subaction a -> - Instance submodel model action a + Instance submodel model subaction action a instance' lift observers embedding = let fwd = @@ -256,6 +245,7 @@ instance' lift observers embedding = , get = get , set = set , map = \f model -> set (f (get model)) model + , fwd = fwd } @@ -282,11 +272,8 @@ instance -> (Action container observation -> observation) -> model -> List (Observer action observation) - -> Instance model container observation a + -> Instance model container action observation a instance view update get set id lift model0 observers = embedIndexed view update get set model0 id |> instance' lift observers - - - diff --git a/src/Material/Helpers.elm b/src/Material/Helpers.elm index da6b11a..772741f 100644 --- a/src/Material/Helpers.elm +++ b/src/Material/Helpers.elm @@ -53,3 +53,39 @@ 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) diff --git a/src/Material/Shadow.elm b/src/Material/Shadow.elm new file mode 100644 index 0000000..4c5e150 --- /dev/null +++ b/src/Material/Shadow.elm @@ -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" ] ] diff --git a/src/Material/Snackbar.elm b/src/Material/Snackbar.elm index d90563d..0925f31 100644 --- a/src/Material/Snackbar.elm +++ b/src/Material/Snackbar.elm @@ -2,6 +2,7 @@ module Material.Snackbar ( Contents, Model, model, toast, snackbar, isActive , Action(Add, Action), update , view + , Instance, instance, add ) where {-| TODO @@ -24,6 +25,7 @@ import Task import Time exposing (Time) import Maybe exposing (andThen) +import Material.Component as Component exposing (Indexed) import Material.Helpers exposing (mapFx, addFx) @@ -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,6 +86,7 @@ snackbar message actionMessage action = , fade = 250 } + {-| TODO -} isActive : Model a -> Maybe (Contents a) @@ -107,7 +110,7 @@ contentsOf model = -- SNACKBAR STATE MACHINE -type State a +type State' a = Inert | Active (Contents a) | Fading (Contents a) @@ -270,3 +273,66 @@ view addr model = ) buttonBody ] + + +-- COMPONENT + + +{-| +-} +type alias State s obs = + { s | snackbar : Indexed (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 + + +{-| Component instance. +-} +instance : + Int + -> (Component.Action (State state obs) obs -> obs) + -> (Model obs) + -> List (Observer obs) + -> Instance (State state obs) obs + +instance id lift model0 observers = + Component.instance + view update .snackbar (\x y -> {y | snackbar = x}) id lift model0 observers + + +{-| + 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) + +{-| 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 + +-} + diff --git a/src/Material/Textfield.elm b/src/Material/Textfield.elm index a2134a7..d9c4554 100644 --- a/src/Material/Textfield.elm +++ b/src/Material/Textfield.elm @@ -182,14 +182,10 @@ type alias State state = {-| -} type alias Instance state obs = - Component.Instance - Model - state - obs - Html + Component.Instance Model state obs Html -{-| Component constructor. +{-| Component constructor. See module `Material`. -} instance : Int @@ -198,13 +194,11 @@ instance : -> List (Component.Observer Action obs) -> Instance (State state) obs - -instance id lift model0 observers = +instance = let update' action model = (update action model, Effects.none) in - Component.setup view update' .textfield (\x y -> {y | textfield = x}) model0 id - |> Component.instance lift observers + Component.instance view update' .textfield (\x y -> {y | textfield = x}) {-| Lift the button Click action to your own action. E.g., From 7a918ed60c8db117057896d473a6f2d7c8be80e0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B8ren=20Debois?= Date: Wed, 6 Apr 2016 21:49:02 +0200 Subject: [PATCH 15/21] Misc --- examples/Demo/Buttons.elm | 1 - examples/Demo/Snackbar.elm | 2 +- src/Material/Button.elm | 1 + src/Material/Snackbar.elm | 27 +++++++++++++-------------- src/Material/Textfield.elm | 2 +- 5 files changed, 16 insertions(+), 17 deletions(-) diff --git a/examples/Demo/Buttons.elm b/examples/Demo/Buttons.elm index 67a8b41..ad21be9 100644 --- a/examples/Demo/Buttons.elm +++ b/examples/Demo/Buttons.elm @@ -10,7 +10,6 @@ import Material.Grid as Grid import Material.Icon as Icon import Material.Style exposing (Style) -import Material.Textfield as Textfield -- MODEL diff --git a/examples/Demo/Snackbar.elm b/examples/Demo/Snackbar.elm index 95ad351..fc73a9f 100644 --- a/examples/Demo/Snackbar.elm +++ b/examples/Demo/Snackbar.elm @@ -115,7 +115,7 @@ addToast = snackbarComponent : Snackbar.Instance Mdl Action snackbarComponent = - Snackbar.instance 2 MDL Snackbar.model [] + Snackbar.instance 2 MDL Snackbar.model diff --git a/src/Material/Button.elm b/src/Material/Button.elm index 9771593..25f1553 100644 --- a/src/Material/Button.elm +++ b/src/Material/Button.elm @@ -275,6 +275,7 @@ type alias Instance state obs = Component.Instance Model state + Action obs (List Style -> List Html -> Html) diff --git a/src/Material/Snackbar.elm b/src/Material/Snackbar.elm index 0925f31..0a1eba3 100644 --- a/src/Material/Snackbar.elm +++ b/src/Material/Snackbar.elm @@ -296,18 +296,28 @@ 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 : Int -> (Component.Action (State state obs) obs -> obs) -> (Model obs) - -> List (Observer obs) -> Instance (State state obs) obs -instance id lift model0 observers = +instance id lift model0 = Component.instance - view update .snackbar (\x y -> {y | snackbar = x}) id lift model0 observers + view update .snackbar (\x y -> {y | snackbar = x}) id lift model0 [ actionObserver ] {-| @@ -325,14 +335,3 @@ add contents inst model = in (inst.set sb model, Effects.map inst.fwd fx) -{-| 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 - --} - diff --git a/src/Material/Textfield.elm b/src/Material/Textfield.elm index d9c4554..f3382ea 100644 --- a/src/Material/Textfield.elm +++ b/src/Material/Textfield.elm @@ -182,7 +182,7 @@ type alias State state = {-| -} type alias Instance state obs = - Component.Instance Model state obs Html + Component.Instance Model state Action obs Html {-| Component constructor. See module `Material`. From dfda38d0c16ccf90fb00a65ad8ebb9d9dab6d8fa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B8ren=20Debois?= Date: Wed, 6 Apr 2016 22:05:04 +0200 Subject: [PATCH 16/21] Added small demos to .travis.yml --- .travis.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.travis.yml b/.travis.yml index d7bb1e5..d8b2d34 100644 --- a/.travis.yml +++ b/.travis.yml @@ -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 + From 1fdcc78ba723360599ab69fab443f565fc2ea78d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B8ren=20Debois?= Date: Thu, 7 Apr 2016 09:52:11 +0200 Subject: [PATCH 17/21] Functional component model. --- .../{Component-EA.elm => Component-TEA.elm} | 0 examples/Component.elm | 11 +- examples/Demo/Snackbar.elm | 45 ++-- src/Material.elm | 147 ++++++------ src/Material/Component.elm | 222 ++++++++++++------ src/Material/Snackbar.elm | 16 +- 6 files changed, 249 insertions(+), 192 deletions(-) rename examples/{Component-EA.elm => Component-TEA.elm} (100%) diff --git a/examples/Component-EA.elm b/examples/Component-TEA.elm similarity index 100% rename from examples/Component-EA.elm rename to examples/Component-TEA.elm diff --git a/examples/Component.elm b/examples/Component.elm index 5a1624c..d648048 100644 --- a/examples/Component.elm +++ b/examples/Component.elm @@ -15,7 +15,7 @@ import Material.Button as Button type alias Model = { count : Int , mdl : Material.Model Action - -- Boilerplate: Model store for any and all MDL components you need. + -- Boilerplate: mdl is the Model store for any and all MDL components you need. } @@ -24,7 +24,7 @@ model : Model model = { count = 0 , mdl = Material.model - -- Always use this initial MDL component model store. + -- Boilerplate: Always use this initial MDL model store. } @@ -36,7 +36,6 @@ type Action | Reset | MDL (Material.Action Action) -- Boilerplate: Action for MDL actions (ripple animations etc.). - -- It should always look like this. update : Action -> Model -> (Model, Effects.Effects Action) @@ -83,8 +82,7 @@ button. The arguments are: -} increase : Button.Instance Mdl Action increase = - Button.instance 0 MDL - Button.flat (Button.model True) + Button.instance 0 MDL Button.flat (Button.model True) [ Button.fwdClick Increase ] @@ -93,8 +91,7 @@ click event to our Reset action. -} reset : Button.Instance Mdl Action reset = - Button.instance 1 MDL - Button.flat (Button.model False) + Button.instance 1 MDL Button.flat (Button.model False) [ Button.fwdClick Reset ] diff --git a/examples/Demo/Snackbar.elm b/examples/Demo/Snackbar.elm index fc73a9f..3c3c2ca 100644 --- a/examples/Demo/Snackbar.elm +++ b/examples/Demo/Snackbar.elm @@ -20,7 +20,8 @@ import Demo.Page as Page -- MODEL -type alias Mdl = Material.Model Action +type alias Mdl = + Material.Model Action type alias Model = @@ -48,22 +49,8 @@ type Action | MDL (Material.Action Action) -snackbar : Int -> Snackbar.Contents Action -snackbar k = - Snackbar.snackbar - ("Snackbar message #" ++ toString k) - "UNDO" - (Undo k) - - -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 = +add : Model -> (Int -> Snackbar.Contents Action) -> (Model, Effects Action) +add model f = let (mdl', fx) = Snackbar.add (f model.count) snackbarComponent model.mdl @@ -81,10 +68,12 @@ update : Action -> Model -> (Model, Effects Action) update action model = case action of AddSnackbar -> - add snackbar model + add model + <| \k -> Snackbar.snackbar ("Snackbar message #" ++ toString k) "UNDO" (Undo k) - AddToast -> - add toast model + AddToast -> + add model + <| \k -> Snackbar.toast <| "Toast message #" ++ toString k Undo k -> ({ model @@ -96,18 +85,19 @@ update action model = Material.update MDL action' model.mdl |> map1st (\m -> { model | mdl = m }) + -- VIEW -addSnackbar : Button.Instance Mdl Action -addSnackbar = +addSnackbarButton : Button.Instance Mdl Action +addSnackbarButton = Button.instance 0 MDL Button.raised (Button.model True) [ Button.fwdClick AddSnackbar ] -addToast : Button.Instance Mdl Action -addToast = +addToastButton : Button.Instance Mdl Action +addToastButton = Button.instance 1 MDL Button.raised (Button.model True) [ Button.fwdClick AddToast ] @@ -115,8 +105,7 @@ addToast = snackbarComponent : Snackbar.Instance Mdl Action snackbarComponent = - Snackbar.instance 2 MDL Snackbar.model - + Snackbar.instance MDL Snackbar.model clickView : Model -> Int -> Html @@ -164,11 +153,11 @@ view addr model = -- 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 ] - [ addToast.view addr model.mdl [] [ text "Toast" ] + [ addToastButton.view addr model.mdl [] [ text "Toast" ] ] , cell [ size All 2, size Phone 2, align Top ] - [ addSnackbar.view addr model.mdl [] [ text "Snackbar" ] + [ addSnackbarButton.view addr model.mdl [] [ text "Snackbar" ] ] , cell [ size Desktop 7, size Tablet 3, size Phone 12, align Top ] diff --git a/src/Material.elm b/src/Material.elm index 82a8ae1..388c4c8 100644 --- a/src/Material.elm +++ b/src/Material.elm @@ -15,27 +15,28 @@ for a live demo. # Component model -The component model of the library is simply the Elm Architecture, e.g., -each component has Model, Action, view, and update. A minimal example using -this library in plain Elm Architecture can be found -[here](https://github.com/debois/elm-mdl/blob/master/examples/Component-EA.elm). +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). -Nesting large amounts of components in the Elm Architecture is somewhat -unwieldy because of the large amount of boilerplate one has to write. This -library includes "component support", for getting rid of most of that -boilerplate. A minimal example using component support is +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). -It is important to note that component support lives __within__ the Elm -architecture; it is not an alternative architecture. +It is important to note that component support lives __within__ TEA; +it is not an alternative architecture. # 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 rather than working -directly in plain Elm Architecture. +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. -# This module +# Component Support This module contains only convenience functions for working with nested components in the Elm architecture. A minimal example using this library @@ -49,69 +50,69 @@ All examples in this subsection is from the Here is how you use component support in general. First, boilerplate. 1. Include `Material`: - `import Material` + + `import Material` 2. Add a model container Material components to your model: - type alias Model = - { ... - , mdl : Material.Model - } + type alias Model = + { ... + , mdl : Material.Model + } - model : Model = - { ... - , mdl = Material.model - } + model : Model = + { ... + , mdl = Material.model + } 3. Add an action for Material components. - type Action = - ... - | MDL (Material.Action Action) + 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 ) - + 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 + import Material.Textfield as Textfield - ... - - type Action = - ... - | NameChanged String - - ... - - update action model = - case action of ... - NameChanged name -> - -- Do whatever you need to do. - ... + type Action = + ... + | NameChanged String - nameInput : Textfield.Instance Material.Model Action - nameInput = - Textfield.instance 2 MDL Textfield.model - [ Textfield.fwdInput NameChanged ] + ... - - view addr model = - ... - nameInput.view addr model.mdl + 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 @@ -125,13 +126,13 @@ but now it's not boilerplate, its "business logic".) 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`. The module source -can be found - [here](https://github.com/debois/elm-mdl/blob/master/src/Material.elm). +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 itMatendicated above, then use -your modified module rather than this one. +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 -} @@ -145,37 +146,39 @@ import Material.Snackbar as Snackbar import Material.Component as Component exposing (Indexed) -{-| Model encompassing all Material components. +{-| 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". -} -type alias Model a = +type alias Model obs = { button : Indexed Button.Model , textfield : Indexed Textfield.Model - , snackbar : Indexed (Snackbar.Model a) + , snackbar : Maybe (Snackbar.Model obs) } {-| Initial model. -} -model : Model a +model : Model obs model = { button = Dict.empty , textfield = Dict.empty - , snackbar = Dict.empty + , snackbar = Nothing } {-| Action encompassing actions of all Material components. -} -type alias Action action = - Component.Action (Model action) action +type alias Action obs = + Component.Action (Model obs) obs {-| Update function for the above Action. -} update : - (Action action -> action) - -> Action action - -> Model action - -> (Model action, Effects action) + (Action obs -> obs) + -> Action obs + -> Model obs + -> (Model obs, Effects obs) update = Component.update diff --git a/src/Material/Component.elm b/src/Material/Component.elm index 99a7407..ab9e1df 100644 --- a/src/Material/Component.elm +++ b/src/Material/Component.elm @@ -1,16 +1,15 @@ module Material.Component - ( Embedding, Observer + ( embed, embedIndexed, Embedding, Observer , Indexed - , Instance, instance + , 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: +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 @@ -26,37 +25,43 @@ This module provides an extensible mechanism for collecting arbitrary 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), you should ignore this module and look -instead at `Material`. +instead at `Material`. -# Component types -@docs Indexed, Embedding, Observer, Instance + +# Embeddings +@docs Indexed, Embedding, embed, embedIndexed # Instance construction -@docs instance +@docs Action, Instance, Observer, instance, instance1 # Instance consumption -@docs update, Action +@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 = @@ -65,9 +70,9 @@ type alias Indexed 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 container model. +from a larger master model. -} -type alias Embedding model container action a = +type alias Embedding model container action a = { view : View container action a , update : Update container action , getModel : container -> model @@ -78,6 +83,14 @@ type alias Embedding model container action a = {-| 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, @@ -98,11 +111,9 @@ embed view update get 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 an id used for looking up its own state. Its the responsibility of the user -to make -sure that ids are unique. +{-| 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, @@ -128,37 +139,90 @@ embedIndexed view update get set model0 id = -- LIFTING ACTIONS -{-| Generic MDL Action. + +{-| 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 model obs = - A (model -> (model, Effects (Action model obs), Maybe obs)) +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 state action -> action) -> - Update' state (Action state action) action + (Action container obs -> obs) -> + Update' container (Action container obs) obs -update fwd (A f) state = +update fwd (A f) container = let - (state', fx, obs) = - f state + (container', fx, obs) = + f container |> map2 (Effects.map fwd) in case obs of Nothing -> - (state', fx) + (container', fx) Just x -> - (state', Effects.batch [ fx, Effects.tick (always x) ]) + (container', Effects.batch [ fx, Effects.task (Task.succeed x) ]) + -- INSTANCES -{- EA update function variant where running the function + + + + +{-| 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. -} @@ -166,34 +230,13 @@ type alias Step model action obs = action -> model -> (model, Effects action, Maybe obs) - -{-| Type of component instances. A component instance contains a view, -and get/set/map for, well, getting, setting, and mapping the component -model. --} -type alias Instance submodel model subaction action a = - { view : View model action a - , get : model -> submodel - , set : submodel -> model -> model - , map : (submodel -> submodel) -> model -> model - , fwd : subaction -> action - } - - -{- Partially apply a step function to an action, -producing a generic Action. +{- 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))) -{-| Type of observers. --} -type alias Observer action obs = - action -> Maybe obs - - {- Convert an update function to a step function by applying a function that converts the action input to the update function into an observation. @@ -216,20 +259,22 @@ pick f xs = x -> x -connect : List (Observer subaction action) -> Observer subaction action +{- 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. Notice that the Instance forgets the type parameter `subaction`. +Instance. -} -instance' : - (Action model action -> action) -> - List (Observer subaction action) -> - Embedding submodel model subaction a -> - Instance submodel model subaction action a +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 = @@ -249,31 +294,58 @@ instance' lift observers embedding = } + {-| 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 state in a generic container model (get, set), -and which dispatches generic Action updates, lifted to the consumers action -type (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 (rule of thumb: if they are in the same -file, they need distinct ids.) +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 observation -> observation) - -> model - -> List (Observer action observation) - -> Instance model container action observation a + : 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 diff --git a/src/Material/Snackbar.elm b/src/Material/Snackbar.elm index 0a1eba3..6afa30d 100644 --- a/src/Material/Snackbar.elm +++ b/src/Material/Snackbar.elm @@ -281,7 +281,7 @@ view addr model = {-| -} type alias State s obs = - { s | snackbar : Indexed (Model obs) } + { s | snackbar : Maybe (Model obs) } {-| @@ -306,19 +306,16 @@ actionObserver action = Nothing - {-| Component instance. -} -instance : - Int - -> (Component.Action (State state obs) obs -> obs) +instance + : (Component.Action (State state obs) obs -> obs) -> (Model obs) -> Instance (State state obs) obs -instance id lift model0 = - Component.instance - view update .snackbar (\x y -> {y | snackbar = x}) id lift model0 [ actionObserver ] - +instance lift model0 = + Component.instance1 + view update .snackbar (\x y -> {y | snackbar = x}) lift model0 [ actionObserver ] {-| TODO @@ -334,4 +331,3 @@ add contents inst model = update (Add contents) (inst.get model) in (inst.set sb model, Effects.map inst.fwd fx) - From 02ac83a9f710b4dcfef065b28e97c2575a791f45 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B8ren=20Debois?= Date: Fri, 8 Apr 2016 15:51:45 +0200 Subject: [PATCH 18/21] Components --- examples/Component-TEA.elm | 3 +- examples/Demo.elm | 4 +- examples/Demo/Buttons.elm | 41 ++++++- examples/Demo/Grid.elm | 63 ++++++---- examples/Demo/Page.elm | 43 ++++--- examples/Demo/Snackbar.elm | 188 +++++++++++++++++++++-------- examples/Demo/Textfields.elm | 227 ++++++++++++++++++++++++++++++----- src/Material/Helpers.elm | 11 ++ src/Material/Snackbar.elm | 21 ++-- src/Material/Textfield.elm | 12 +- 10 files changed, 470 insertions(+), 143 deletions(-) diff --git a/examples/Component-TEA.elm b/examples/Component-TEA.elm index 284966a..b7e4f18 100644 --- a/examples/Component-TEA.elm +++ b/examples/Component-TEA.elm @@ -44,7 +44,8 @@ reset model = { model | count = 0 } -update : Action -> Model -> (Model, Effects.Effects Action) + +update : Action -> Model -> (Model, Effects Action) update action model = case Debug.log "" action of IncreaseButtonAction action' -> diff --git a/examples/Demo.elm b/examples/Demo.elm index 2628786..b87a100 100644 --- a/examples/Demo.elm +++ b/examples/Demo.elm @@ -66,7 +66,7 @@ update action model = case Debug.log "Action: " action of LayoutAction a -> lift .layout (\m x->{m|layout =x}) LayoutAction Layout.update a model 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 @@ -115,7 +115,7 @@ tabs = [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) + , ("Grid", \addr model -> [ Demo.Grid.view ]) , ("Badges", \addr model -> Demo.Badges.view ) {- , ("Template", \addr model -> diff --git a/examples/Demo/Buttons.elm b/examples/Demo/Buttons.elm index ad21be9..2c5a292 100644 --- a/examples/Demo/Buttons.elm +++ b/examples/Demo/Buttons.elm @@ -10,6 +10,7 @@ import Material.Grid as Grid import Material.Icon as Icon import Material.Style exposing (Style) +import Demo.Page as Page -- MODEL @@ -132,9 +133,39 @@ view addr model = ] ) ) - |> (\contents -> - div [] - [ Grid.grid [] contents - ] - ) + |> 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 `