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] 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 +