Functional component model

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
 
 

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)" ]

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

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

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
 

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