diff --git a/demo/Demo.elm b/demo/Demo.elm index 28fcb25..4985fa3 100644 --- a/demo/Demo.elm +++ b/demo/Demo.elm @@ -18,6 +18,7 @@ import Material.Scheme as Scheme import Material.Icon as Icon import Material.Typography as Typography import Material.Menu as Menu +import Material.Toggles as Toggles import Demo.Buttons import Demo.Menus import Demo.Tables @@ -66,6 +67,7 @@ type alias Model = , chips : Demo.Chips.Model , selectedTab : Int , transparentHeader : Bool + , logMessages : Bool } @@ -93,6 +95,7 @@ model = , chips = Demo.Chips.model , selectedTab = 0 , transparentHeader = False + , logMessages = False } @@ -119,10 +122,11 @@ type Msg | TypographyMsg Demo.Typography.Msg | CardsMsg Demo.Cards.Msg | ListsMsg Demo.Lists.Msg - | ToggleHeader | DialogMsg Demo.Dialog.Msg | ElevationMsg Demo.Elevation.Msg | ChipMsg Demo.Chips.Msg + | ToggleHeader + | ToggleLog nth : Int -> List a -> Maybe a @@ -132,75 +136,81 @@ nth k xs = update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = - case Debug.log "Message" msg of - SelectTab k -> - ( { model | selectedTab = k }, Cmd.none ) + let + log msg = + if model.logMessages then Debug.log "Msg" else identity + in + case log "Msg" msg of + SelectTab k -> + ( { model | selectedTab = k }, Cmd.none ) - ToggleHeader -> - ( { model | transparentHeader = not model.transparentHeader }, Cmd.none ) + ToggleHeader -> + ( { model | transparentHeader = not model.transparentHeader }, Cmd.none ) + ToggleLog -> + ( { model | logMessages = not model.logMessages }, Cmd.none ) - Mdl msg -> - Material.update Mdl msg model + Mdl msg -> + Material.update Mdl msg model - ButtonsMsg a -> - lift .buttons (\m x -> { m | buttons = x }) ButtonsMsg Demo.Buttons.update a model + ButtonsMsg a -> + lift .buttons (\m x -> { m | buttons = x }) ButtonsMsg Demo.Buttons.update a model - BadgesMsg a -> - lift .badges (\m x -> { m | badges = x }) BadgesMsg Demo.Badges.update a model + BadgesMsg a -> + lift .badges (\m x -> { m | badges = x }) BadgesMsg Demo.Badges.update a model - LayoutMsg a -> - lift .layout (\m x -> { m | layout = x }) LayoutMsg Demo.Layout.update a model + LayoutMsg a -> + lift .layout (\m x -> { m | layout = x }) LayoutMsg Demo.Layout.update a model - MenusMsg a -> - lift .menus (\m x -> { m | menus = x }) MenusMsg Demo.Menus.update a model + MenusMsg a -> + lift .menus (\m x -> { m | menus = x }) MenusMsg Demo.Menus.update a model - TextfieldMsg m -> - Demo.Textfields.update m model.textfields - |> Maybe.map (map1st (\x -> { model | textfields = x })) - |> Maybe.withDefault ( model, Cmd.none ) - |> map2nd (Cmd.map TextfieldMsg) + TextfieldMsg m -> + Demo.Textfields.update m model.textfields + |> Maybe.map (map1st (\x -> { model | textfields = x })) + |> Maybe.withDefault ( model, Cmd.none ) + |> map2nd (Cmd.map TextfieldMsg) - SnackbarMsg a -> - lift .snackbar (\m x -> { m | snackbar = x }) SnackbarMsg Demo.Snackbar.update a model + SnackbarMsg a -> + lift .snackbar (\m x -> { m | snackbar = x }) SnackbarMsg Demo.Snackbar.update a model - TogglesMsg a -> - lift .toggles (\m x -> { m | toggles = x }) TogglesMsg Demo.Toggles.update a model + TogglesMsg a -> + lift .toggles (\m x -> { m | toggles = x }) TogglesMsg Demo.Toggles.update a model - TablesMsg a -> - lift .tables (\m x -> { m | tables = x }) TablesMsg Demo.Tables.update a model + TablesMsg a -> + lift .tables (\m x -> { m | tables = x }) TablesMsg Demo.Tables.update a model - LoadingMsg a -> - lift .loading (\m x -> { m | loading = x }) LoadingMsg Demo.Loading.update a model + LoadingMsg a -> + lift .loading (\m x -> { m | loading = x }) LoadingMsg Demo.Loading.update a model - FooterMsg a -> - lift .footers (\m x -> { m | footers = x }) FooterMsg Demo.Footer.update a model + FooterMsg a -> + lift .footers (\m x -> { m | footers = x }) FooterMsg Demo.Footer.update a model - SliderMsg a -> - lift .slider (\m x -> { m | slider = x }) SliderMsg Demo.Slider.update a model + SliderMsg a -> + lift .slider (\m x -> { m | slider = x }) SliderMsg Demo.Slider.update a model - TooltipMsg a -> - lift .tooltip (\m x -> { m | tooltip = x }) TooltipMsg Demo.Tooltip.update a model + TooltipMsg a -> + lift .tooltip (\m x -> { m | tooltip = x }) TooltipMsg Demo.Tooltip.update a model - TabMsg a -> - lift .tabs (\m x -> { m | tabs = x }) TabMsg Demo.Tabs.update a model + TabMsg a -> + lift .tabs (\m x -> { m | tabs = x }) TabMsg Demo.Tabs.update a model - TypographyMsg a -> - lift .typography (\m x -> { m | typography = x }) TypographyMsg Demo.Typography.update a model + TypographyMsg a -> + lift .typography (\m x -> { m | typography = x }) TypographyMsg Demo.Typography.update a model - CardsMsg a -> - lift .cards (\m x -> { m | cards = x }) CardsMsg Demo.Cards.update a model + CardsMsg a -> + lift .cards (\m x -> { m | cards = x }) CardsMsg Demo.Cards.update a model - ListsMsg a -> - lift .lists (\m x -> { m | lists = x }) ListsMsg Demo.Lists.update a model + ListsMsg a -> + lift .lists (\m x -> { m | lists = x }) ListsMsg Demo.Lists.update a model - DialogMsg a -> - lift .dialog (\m x -> { m | dialog = x }) DialogMsg Demo.Dialog.update a model + DialogMsg a -> + lift .dialog (\m x -> { m | dialog = x }) DialogMsg Demo.Dialog.update a model - ElevationMsg a -> - lift .elevation (\m x -> { m | elevation = x }) ElevationMsg Demo.Elevation.update a model + ElevationMsg a -> + lift .elevation (\m x -> { m | elevation = x }) ElevationMsg Demo.Elevation.update a model - ChipMsg a -> - lift .chips (\m x -> { m | chips = x }) ChipMsg Demo.Chips.update a model + ChipMsg a -> + lift .chips (\m x -> { m | chips = x }) ChipMsg Demo.Chips.update a model @@ -264,9 +274,9 @@ e404 _ = ] -drawer : List (Html Msg) -drawer = - [ Layout.title [] [ text "Example drawer" ] +drawer : Model -> List (Html Msg) +drawer model = + [ Layout.title [] [ text "elm-mdl" ] , Layout.navigation [] [ Layout.link @@ -280,6 +290,31 @@ drawer = , Options.onClick (Layout.toggleDrawer Mdl) ] [ text "Card component" ] + , Layout.link + [ css "display" "inline-flex" + , css "flex-wrap" "wrap" + , css "justify-content" "space-between" + , css "align-items" "center" + , Options.onToggle ToggleLog + , Options.onClick ToggleLog + ] + [ text "Log messages" + , Toggles.checkbox Mdl [0] model.mdl + [ Toggles.ripple + , Toggles.value model.logMessages + , css "width" "32px" + ] + [] + , if model.logMessages then + Options.div + [ Typography.caption + , css "width" "100%" + ] + [ text "Open your Javascript console to observe MDL messages" ] + + else + text "" + ] ] ] @@ -353,7 +388,7 @@ view_ model = { header = header model , drawer = if model.layout.withDrawer then - drawer + drawer model else [] , tabs = diff --git a/demo/Demo/Layout.elm b/demo/Demo/Layout.elm index 7cf7ed0..5084ff0 100644 --- a/demo/Demo/Layout.elm +++ b/demo/Demo/Layout.elm @@ -68,31 +68,61 @@ model = type Msg - = Update (Model -> Model) - | Mdl (Material.Msg Msg) + = Mdl (Material.Msg Msg) | ScrollToTop | Nop + | SetPrimaryColor Color.Hue + | SetAccentColor Color.Hue + | ToggleHeader + | ToggleDrawer + | ToggleTabs + | ToggleFixedHeader + | ToggleFixedDrawer + | ToggleFixedTabs + | SetHeader HeaderType update : Msg -> Model -> ( Model, Cmd Msg ) update action model = case action of - Update f -> - ( f model, Cmd.none ) - Mdl msg_ -> Material.update Mdl msg_ model ScrollToTop -> - ( model, Task.attempt (always Nop) <| Dom.Scroll.toTop Layout.mainId) + model ! [ Task.attempt (always Nop) <| Dom.Scroll.toTop Layout.mainId ] Nop -> - ( model, Cmd.none ) + model ! [] + SetPrimaryColor hue -> + fixColors { model | primary = hue } ! [] -{- Make sure we didn't pick the same primary and accent colour. -} + SetAccentColor hue -> + { model | accent = hue } ! [] + + ToggleHeader -> + { model | withHeader = not model.withHeader } ! [] + + ToggleDrawer -> + { model | withDrawer = not model.withDrawer } ! [] + + ToggleTabs -> + { model | withTabs = not model.withTabs } ! [] + ToggleFixedHeader -> + { model | fixedHeader = not model.fixedHeader } ! [] + ToggleFixedDrawer -> + { model | fixedDrawer = not model.fixedDrawer } ! [] + + ToggleFixedTabs -> + { model | fixedTabs = not model.fixedTabs } ! [] + + SetHeader h -> + { model | header = h } ! [] + + +{- Make sure we didn't pick the same primary and accent colour. -} fixColors : Model -> Model fixColors model = if model.primary == model.accent then @@ -131,9 +161,9 @@ picker : -> Maybe Color.Hue -> Color.Shade -> Color.Hue - -> (Color.Hue -> Model -> Model) + -> (Color.Hue -> Msg) -> Html Msg -picker hues disabled shade current f = +picker hues disabled shade current msg = hues |> Array.toList |> List.map @@ -151,7 +181,7 @@ picker hues disabled shade current f = , css "cursor" "pointer" |> when (disabled /= Just hue) ] (if Just hue /= disabled then - [ Html.Events.onClick (f hue >> fixColors |> Update) ] + [ Html.Events.onClick (msg hue) ] else [] ) @@ -184,21 +214,21 @@ view model = , Toggles.switch Mdl [ 8 ] model.mdl - [ Options.onToggle (Update <| \m -> { m | withHeader = not m.withHeader }) + [ Options.onToggle ToggleHeader , Toggles.value model.withHeader ] [ text "With header" ] , Toggles.switch Mdl [ 9 ] model.mdl - [ Options.onToggle (Update <| \m -> { m | withDrawer = not m.withDrawer }) + [ Options.onToggle ToggleDrawer , Toggles.value model.withDrawer ] [ text "With drawer" ] , Toggles.switch Mdl [ 10 ] model.mdl - [ Options.onToggle (Update <| \m -> { m | withTabs = not m.withTabs }) + [ Options.onToggle ToggleTabs , Toggles.value model.withTabs ] [ text "With tabs" ] @@ -208,7 +238,7 @@ view model = , Toggles.switch Mdl [ 0 ] model.mdl - [ Options.onToggle (Update <| \m -> { m | fixedHeader = not m.fixedHeader }) + [ Options.onToggle ToggleFixedHeader , Toggles.value model.fixedHeader ] [ text "Fixed header" ] @@ -217,7 +247,7 @@ view model = , Toggles.switch Mdl [ 1 ] model.mdl - [ Options.onToggle (Update <| \m -> { m | fixedDrawer = not m.fixedDrawer }) + [ Options.onToggle ToggleFixedDrawer , Toggles.value model.fixedDrawer ] [ text "Fixed drawer" ] @@ -226,7 +256,7 @@ view model = , Toggles.switch Mdl [ 2 ] model.mdl - [ Options.onToggle (Update <| \m -> { m | fixedTabs = not m.fixedTabs }) + [ Options.onToggle ToggleFixedTabs , Toggles.value model.fixedTabs ] [ text "Fixed tabs" ] @@ -241,7 +271,7 @@ view model = model.mdl [ Toggles.group "kind" , Toggles.value <| model.header == Standard - , Options.onToggle (Update <| \m -> { m | header = Standard }) + , Options.onToggle (SetHeader Standard) ] [ text "Standard" ] , Toggles.radio Mdl @@ -249,7 +279,7 @@ view model = model.mdl [ Toggles.group "kind" , Toggles.value <| model.header == Seamed - , Options.onToggle (Update <| \m -> { m | header = Seamed }) + , Options.onToggle (SetHeader Seamed) ] [ text "Seamed" ] , Toggles.radio Mdl @@ -257,7 +287,7 @@ view model = model.mdl [ Toggles.group "kind" , Toggles.value <| model.header == Scrolling - , Options.onToggle (Update <| \m -> { m | header = Scrolling }) + , Options.onToggle (SetHeader Scrolling) ] [ text "Scrolling" ] , Toggles.radio Mdl @@ -265,7 +295,7 @@ view model = model.mdl [ Toggles.group "kind" , Toggles.value <| model.header == (Waterfall True) - , Options.onToggle (Update <| \m -> { m | header = (Waterfall True) }) + , Options.onToggle (SetHeader <| Waterfall True) ] [ text "Waterfall (top)" ] , Toggles.radio Mdl @@ -273,7 +303,7 @@ view model = model.mdl [ Toggles.group "kind" , Toggles.value <| model.header == (Waterfall False) - , Options.onToggle (Update <| \m -> { m | header = (Waterfall False) }) + , Options.onToggle (SetHeader <| Waterfall False) ] [ text "Waterfall (bottom)" ] ] @@ -358,14 +388,14 @@ view model = [ Grid.cell [ Grid.size Grid.All 4 ] [ h5 [] [ text "Primary colour" ] - , picker Color.hues Nothing Color.S500 model.primary (\hue m -> { m | primary = hue }) + , picker Color.hues Nothing Color.S500 model.primary SetPrimaryColor ] , Grid.cell [ Grid.size Grid.All 4 , Grid.offset Grid.Desktop 2 ] [ h5 [] [ text "Accent colour" ] - , picker Color.accentHues (Just model.primary) Color.A200 model.accent (\hue m -> { m | accent = hue }) + , picker Color.accentHues (Just model.primary) Color.A200 model.accent SetAccentColor ] , Grid.cell [ Grid.size Grid.All 4 diff --git a/src/Material.elm b/src/Material.elm index a8401cc..428e881 100644 --- a/src/Material.elm +++ b/src/Material.elm @@ -5,6 +5,7 @@ module Material , Msg , Container , update + , update_ , subscriptions , init ) @@ -163,7 +164,7 @@ module as a starting point ## Shorthands -@docs Model, model, Msg, Container, update, subscriptions, init +@docs Model, model, Msg, Container, update, update_, subscriptions, init -} import Dict @@ -238,37 +239,40 @@ your own Msg type. -} update : (Msg m -> m) -> Msg m -> Container c -> ( Container c, Cmd m ) update lift msg container = - let - store = - .mdl container - in - (case msg of - ButtonMsg idx msg -> - Button.react lift msg idx store + update_ lift msg (.mdl container) + |> map1st (Maybe.map (\mdl -> { container | mdl = mdl })) + |> map1st (Maybe.withDefault container) - TextfieldMsg idx msg -> - Textfield.react lift msg idx store - MenuMsg idx msg -> - Menu.react (MenuMsg idx >> lift) msg idx store +{-| Variant update function that explicitly signals whether model needs update. +If it is not clear to you that you need this, you do not :) +-} +update_ : (Msg m -> m) -> Msg m -> Model -> ( Maybe Model, Cmd m ) +update_ lift msg store = + case msg of + ButtonMsg idx msg -> + Button.react lift msg idx store - LayoutMsg msg -> - Layout.react (LayoutMsg >> lift) msg store + TextfieldMsg idx msg -> + Textfield.react lift msg idx store - TogglesMsg idx msg -> - Toggles.react lift msg idx store + MenuMsg idx msg -> + Menu.react (MenuMsg idx >> lift) msg idx store - TooltipMsg idx msg -> - Tooltip.react lift msg idx store + LayoutMsg msg -> + Layout.react (LayoutMsg >> lift) msg store - TabsMsg idx msg -> - Tabs.react lift msg idx store + TogglesMsg idx msg -> + Toggles.react lift msg idx store - Dispatch msgs -> - (Nothing, Dispatch.forward msgs) - ) - |> map1st (Maybe.map (\mdl -> { container | mdl = mdl })) - |> map1st (Maybe.withDefault container) + TooltipMsg idx msg -> + Tooltip.react lift msg idx store + + TabsMsg idx msg -> + Tabs.react lift msg idx store + + Dispatch msgs -> + (Nothing, Dispatch.forward msgs) {-| Subscriptions and initialisation of elm-mdl. Some components requires