Experimental component model

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
 

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

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

src/Material.elm

@@ -1,127 +1,178 @@
 module Material 
-  ( topWithScheme, top
+  ( Model, model
-  , Updater', Updater, lift, lift'
+  , Action, update
-  ) where
+  )
+  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
+Click 
-the pain of the missing component architecture in Elm. 
+[here](https://debois.github.io/elm-mdl/)
+for a live demo. 
 
-# Loading CSS
+# Component model 
-@docs topWithScheme, top
 
-# Component convienience
+The component model of the library is simply the Elm Architecture, e.g., 
-@docs Updater', Updater, lift', lift
+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 Material.Button as Button
-import Html exposing (..)
+import Material.Textfield as Textfield
-import Html.Attributes exposing (..)
+import Material.Component as Component exposing (Indexed)
-import Effects exposing (..)
-
-import Material.Color exposing (Palette(..), Color)
 
 
-
+{-| Model encompassing all Material components. 
-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:
-
-    <!-- MDL -->
-    <link href='https://fonts.googleapis.com/css?family=Roboto:400,300,500|Roboto+Mono|Roboto+Condensed:400,700&subset=latin,latin-ext' rel='stylesheet' type='text/css'>
-    <link rel="stylesheet" href="https://fonts.googleapis.com/icon?family=Material+Icons">
-    <link rel="stylesheet" href="https://code.getmdl.io/1.1.2/material.min.css" />
-
-Supply primary and accent colors as parameters. Refer to the
-Material Design Lite [Custom CSS theme builder](https://www.getmdl.io/customize/index.html)
-to preview combinations.
-
-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.
-
 -}
-topWithScheme: Palette -> Palette -> Html -> Html
+type alias Model = 
-topWithScheme primary accent content =
+  { button : Indexed Button.Model
-  div [] <|
+  , textfield : Indexed Textfield.Model
-  {- Trick from Peter Damoc to load CSS outside of <head>.
+  }
-     https://github.com/pdamoc/elm-mdl/blob/master/src/Mdl.elm#L63
-   -}
-  [ node "style"
-    [ type' "text/css"]
-    [ Html.text <| scheme primary accent]
-  , content
-  ]
 
 
-{-| Top-level container with default color scheme.
+{-| Initial model.
 -}
-top : Html -> Html
+model : Model
-top content =
+model = 
-  -- Force default color-scheme by picking an invalid combination.
+  { button = Dict.empty
-  topWithScheme Grey Grey content
+  , textfield = Dict.empty
+  }
 
 
-
+{-| Action encompassing actions of all Material components. 
-{-| TODO.
 -}
-type alias Updater' action model =
+type alias Action action = 
-  action -> model -> model
+  Component.Action Model action
 
 
-{-| TODO.
+{-| Update function for the above Action. 
 -}
-type alias Updater action model =
+update : 
-  action -> model -> (model, Effects action)
+  (Action action -> action) 
-
+  -> (Action action) 
-type alias ComponentModel model components =
+  -> Model 
-  { model | components : components }
+  -> (Model, Effects action)
-
+update = 
-
+  Component.update
-{-| 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)

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 = 
+type alias State s =
-  Component.Component 
+  { s | button : Indexed Model }
+
+
+type alias Observer obs = 
+  Component.Observer Action obs
+
+
+{-|
+-}
+type alias Instance state obs =
+  Component.Instance 
     Model
-    { state | button : Indexed Model }
+    state
-    Action 
     obs 
     (List Style -> List Html -> Html)
 
 
-{-| Component constructor. Provide the view function your button should
+{-| Ydrk. -}
-have as the first argument, e.g., 
+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
+instance id lift view model0 observers = 
-
+  Component.setup view update .button (\x y -> {y | button = x}) model0 id
--}
+    |> Component.instance lift observers
-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
+fwdClick : obs -> (Observer obs)
-onClick o component  = 
+fwdClick obs action = 
-  (\action -> 
+  case action of 
-    case action of 
+    Click -> Just obs
-      Click -> Just o
+    _ -> Nothing 
-      _ -> Nothing)
-  |> Component.addObserver component 
-
 
 

src/Material/Component.elm

@@ -1,48 +1,53 @@
 module Material.Component 
-  ( Component, setup, addObserver
+  ( Embedding, Observer
-  , Instance, instance, instance'
-  , update
   , 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
+  1. Retain the state of the component in our Model 
-@docs View, Update, Action 
+  2. Add the components actions to our Action 
+  3. Dispatch those actions in our update
 
-## Component types
+None of these things have anything to do with what we want from the component, 
-@docs Component, Instance
+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
+This module provides an extensible mechanism for collecting arbitrary
-@docs Indexed
+(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
+# Component types
-@docs instance, instance'
+@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 = 
+type alias Indexed a = 
-  A (model -> (model, Effects (Action model obs), obs))
+  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  = 
+type alias Embedding model container  action a = 
-  { model | componentState : state }
+  { view : View container action a
-
+  , update : Update container action 
-
+  , getModel : container -> model
--- FOR CONSUMERS
+  , setModel : model -> container -> container
-
-
-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
   }
  
 
-{-| Component constructor. You must supply 
+{-| 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 
-1. A view function 
+container). 
-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 : 
+embed : 
-  View submodel action a ->                 -- Given a view function, 
+  View model action a ->               -- Given a view function, 
-  Update submodel action ->                 -- an update function 
+  Update model action ->               -- an update function 
-  (model -> Indexed submodel) ->            -- a getter 
+  (container -> model) ->              -- a getter 
-  (Indexed submodel -> model -> model) ->   -- a setter
+  (model -> container -> container) -> -- a setter
-  submodel ->                               -- an initial model for this instance
+  Embedding model container action a   -- produce an Embedding. 
-  Int ->                                    -- an instance id (*)
-  Component submodel model action obs a     -- ... produce a Component.
 
-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,35 +132,52 @@ setup view update get set model0 id =
     set' submodel model = 
       set (Dict.insert id submodel (get model)) model 
   in 
-    { view = 
+      embed view update get' set' 
-        \addr model -> view addr (get' model)
-    , update = 
-        \action model -> 
-          update action (get' model)
-            |> map1st (flip set' model)
-    , getModel = get'
-    , setModel = set'
-    , observe = \_ -> Nothing
-    }
 
 
 
+
+{-| 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)
+  action -> model -> (model, Effects 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 : (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
@@ -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: 
+{-| Type of observers.
-
-1. A function embedding `Action` into your actions. 
-2. A component
 -}
-instance : 
+type alias Observer action obs = 
-  (Action model (Maybe action) -> action) -> 
+  action -> Maybe obs
-  Component submodel model subaction action a -> 
+
-  Instance submodel (Model master model) action a
+
-instance lift widget = 
+{- 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 -> 
+        \addr -> 
-          widget.view (Signal.forwardTo addr fwd) model.componentState
+          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
+{-| It is helpful to see parameter names: 
-you never need to read or write. (E.g,. Snackbar in Toast form.)
+
+    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' : 
+instance
-  (Action model (Maybe action) -> action) -> 
+    : View model action a
-  Component submodel model subaction action a -> 
+    -> Update model action
-  View (Model m model) action a
+    -> (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
+instance view update get set id lift model0 observers = 
-      
+  embedIndexed view update get set model0 id 
-
+    |> instance' lift observers
-{-| 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
-  }
 
 
 
-
-{-
-
-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
-
--}
-

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 `<link ...>` directives to the
+HTML-file containing your app, or 
+2. Load CSS from Elm (by inserting `style` elements into the DOM).
+
+
+# Load CSS from HTML 
+
+To load CSS manually, add the following to your 
+    <!-- MDL -->
+    <link href='https://fonts.googleapis.com/css?family=Roboto:400,300,500|Roboto+Mono|Roboto+Condensed:400,700&subset=latin,latin-ext' rel='stylesheet' type='text/css'>
+    <link rel="stylesheet" href="https://fonts.googleapis.com/icon?family=Material+Icons">
+    <link rel="stylesheet" href="https://code.getmdl.io/1.1.2/material.min.css" />
+
+# Loading CSS from Elm 
+
+@docs topWithScheme, top
+-}
+
+
+import String
+import Html exposing (..)
+import Html.Attributes exposing (..)
+
+import Material.Color exposing (Palette(..), Color)
+
+
+scheme : Palette -> Palette -> String
+scheme primary accent =
+  [ "https://code.getmdl.io/1.1.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 <head>.
+     https://github.com/pdamoc/elm-mdl/blob/master/src/Mdl.elm#L63
+   -}
+  [ node "style"
+    [ type' "text/css"]
+    [ Html.text <| scheme primary accent]
+  , content
+  ]
+
+
+{-| Top-level container with default color scheme. See `topWithScheme` above.
+-}
+top : Html -> Html
+top content =
+  -- Force default color-scheme by picking an invalid combination.
+  topWithScheme Grey Grey content
+
+
+

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 = 
+type alias State state = 
-  Component.Component 
+  { state | textfield : Indexed Model }
+
+
+{-| 
+-}
+type alias Instance state obs = 
+  Component.Instance
     Model
-    { state | textfield : Indexed Model }
+    state
-    Action 
     obs
     Html
 
 
 {-| Component constructor. 
 -}
-component : Model -> Int -> Component state action
+instance : 
-component = 
+  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
+fwdInput : (String -> obs) -> Action -> Maybe obs
-onInput f component  = 
+fwdInput f action =
-  (\action -> 
+  case action of 
-    case action of 
+    Input str -> Just (f str)
-      Input str -> Just (f str)
+    _ -> Nothing
-      _ -> Nothing)
-  |> Component.addObserver component 
 
 
+{-| 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 
+