diff --git a/demo/Demo.elm b/demo/Demo.elm index 9708472..28fcb25 100644 --- a/demo/Demo.elm +++ b/demo/Demo.elm @@ -1,3 +1,4 @@ +module Main exposing (..) import Html exposing (..) import Html.Attributes exposing (href, class, style) @@ -6,10 +7,8 @@ import Platform.Cmd exposing (..) import Array exposing (Array) import Dict exposing (Dict) import String - import Navigation import RouteUrl as Routing - import Material import Material.Color as Color import Material.Layout as Layout @@ -19,7 +18,6 @@ import Material.Scheme as Scheme import Material.Icon as Icon import Material.Typography as Typography import Material.Menu as Menu - import Demo.Buttons import Demo.Menus import Demo.Tables @@ -45,58 +43,57 @@ import Demo.Chips -- MODEL - type alias Model = - { mdl : Material.Model - , buttons : Demo.Buttons.Model - , badges : Demo.Badges.Model - , layout : Demo.Layout.Model - , menus : Demo.Menus.Model - , textfields : Demo.Textfields.Model - , toggles : Demo.Toggles.Model - , snackbar : Demo.Snackbar.Model - , tables : Demo.Tables.Model - , loading : Demo.Loading.Model - , footers : Demo.Footer.Model - , tooltip : Demo.Tooltip.Model - , tabs : Demo.Tabs.Model - , slider : Demo.Slider.Model - , typography : Demo.Typography.Model - , cards : Demo.Cards.Model - , lists : Demo.Lists.Model - , dialog : Demo.Dialog.Model - , elevation : Demo.Elevation.Model - , chips : Demo.Chips.Model - , selectedTab : Int - , transparentHeader : Bool - } + { mdl : Material.Model + , buttons : Demo.Buttons.Model + , badges : Demo.Badges.Model + , layout : Demo.Layout.Model + , menus : Demo.Menus.Model + , textfields : Demo.Textfields.Model + , toggles : Demo.Toggles.Model + , snackbar : Demo.Snackbar.Model + , tables : Demo.Tables.Model + , loading : Demo.Loading.Model + , footers : Demo.Footer.Model + , tooltip : Demo.Tooltip.Model + , tabs : Demo.Tabs.Model + , slider : Demo.Slider.Model + , typography : Demo.Typography.Model + , cards : Demo.Cards.Model + , lists : Demo.Lists.Model + , dialog : Demo.Dialog.Model + , elevation : Demo.Elevation.Model + , chips : Demo.Chips.Model + , selectedTab : Int + , transparentHeader : Bool + } model : Model model = - { mdl = Material.model - , buttons = Demo.Buttons.model - , badges = Demo.Badges.model - , layout = Demo.Layout.model - , menus = Demo.Menus.model - , textfields = Demo.Textfields.model - , toggles = Demo.Toggles.model - , snackbar = Demo.Snackbar.model - , tables = Demo.Tables.model - , loading = Demo.Loading.model - , footers = Demo.Footer.model - , tooltip = Demo.Tooltip.model - , tabs = Demo.Tabs.model - , slider = Demo.Slider.model - , typography = Demo.Typography.model - , cards = Demo.Cards.model - , lists = Demo.Lists.model - , dialog = Demo.Dialog.model - , elevation = Demo.Elevation.model - , chips = Demo.Chips.model - , selectedTab = 0 - , transparentHeader = False - } + { mdl = Material.model + , buttons = Demo.Buttons.model + , badges = Demo.Badges.model + , layout = Demo.Layout.model + , menus = Demo.Menus.model + , textfields = Demo.Textfields.model + , toggles = Demo.Toggles.model + , snackbar = Demo.Snackbar.model + , tables = Demo.Tables.model + , loading = Demo.Loading.model + , footers = Demo.Footer.model + , tooltip = Demo.Tooltip.model + , tabs = Demo.Tabs.model + , slider = Demo.Slider.model + , typography = Demo.Typography.model + , cards = Demo.Cards.model + , lists = Demo.Lists.model + , dialog = Demo.Dialog.model + , elevation = Demo.Elevation.model + , chips = Demo.Chips.model + , selectedTab = 0 + , transparentHeader = False + } @@ -104,273 +101,332 @@ model = type Msg - = SelectTab Int - | Mdl (Material.Msg Msg) - | BadgesMsg Demo.Badges.Msg - | ButtonsMsg Demo.Buttons.Msg - | LayoutMsg Demo.Layout.Msg - | MenusMsg Demo.Menus.Msg - | TextfieldMsg Demo.Textfields.Msg - | SnackbarMsg Demo.Snackbar.Msg - | TogglesMsg Demo.Toggles.Msg - | TablesMsg Demo.Tables.Msg - | LoadingMsg Demo.Loading.Msg - | FooterMsg Demo.Footer.Msg - | TooltipMsg Demo.Tooltip.Msg - | TabMsg Demo.Tabs.Msg - | SliderMsg Demo.Slider.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 + = SelectTab Int + | Mdl (Material.Msg Msg) + | BadgesMsg Demo.Badges.Msg + | ButtonsMsg Demo.Buttons.Msg + | LayoutMsg Demo.Layout.Msg + | MenusMsg Demo.Menus.Msg + | TextfieldMsg Demo.Textfields.Msg + | SnackbarMsg Demo.Snackbar.Msg + | TogglesMsg Demo.Toggles.Msg + | TablesMsg Demo.Tables.Msg + | LoadingMsg Demo.Loading.Msg + | FooterMsg Demo.Footer.Msg + | TooltipMsg Demo.Tooltip.Msg + | TabMsg Demo.Tabs.Msg + | SliderMsg Demo.Slider.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 nth : Int -> List a -> Maybe a nth k xs = - List.drop k xs |> List.head + List.drop k xs |> List.head update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = - case Debug.log "Message" msg of - SelectTab k -> - ( { model | selectedTab = k } , Cmd.none ) - - ToggleHeader -> - ( { model | transparentHeader = not model.transparentHeader }, Cmd.none) - - Mdl msg -> - Material.update Mdl msg 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - 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 - ChipMsg a -> lift .chips (\m x->{m|chips=x}) ChipMsg Demo.Chips.update a model + case Debug.log "Message" msg of + SelectTab k -> + ( { model | selectedTab = k }, Cmd.none ) + + ToggleHeader -> + ( { model | transparentHeader = not model.transparentHeader }, Cmd.none ) + + Mdl msg -> + Material.update Mdl msg 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + ChipMsg a -> + lift .chips (\m x -> { m | chips = x }) ChipMsg Demo.Chips.update a model + -- VIEW -tabs : List (String, String, Model -> Html Msg) +tabs : List ( String, String, Model -> Html Msg ) tabs = - [ ("Buttons", "buttons", .buttons >> Demo.Buttons.view >> Html.map ButtonsMsg) - , ("Badges", "badges", .badges >> Demo.Badges.view >> Html.map BadgesMsg) - , ("Cards", "cards", .cards >> Demo.Cards.view >> Html.map CardsMsg) - , ("Chips", "chips", .chips >> Demo.Chips.view >> Html.map ChipMsg) - , ("Dialog", "dialog", .dialog >> Demo.Dialog.view >> Html.map DialogMsg) - , ("Elevation", "elevation", .elevation >> Demo.Elevation.view >> Html.map ElevationMsg) - , ("Footers", "footers", .footers >> Demo.Footer.view >> Html.map FooterMsg) - , ("Grid", "grid", \_ -> Demo.Grid.view) - , ("Layout", "layout", .layout >> Demo.Layout.view >> Html.map LayoutMsg) - , ("Lists", "lists", .lists >> Demo.Lists.view >> Html.map ListsMsg) - , ("Loading", "loading", .loading >> Demo.Loading.view >> Html.map LoadingMsg) - , ("Menus", "menus", .menus >> Demo.Menus.view >> Html.map MenusMsg) - , ("Sliders", "sliders", .slider >> Demo.Slider.view >> Html.map SliderMsg) - , ("Snackbar", "snackbar", .snackbar >> Demo.Snackbar.view >> Html.map SnackbarMsg) - , ("Tables", "tables", .tables >> Demo.Tables.view >> Html.map TablesMsg) - , ("Tabs", "tabs", .tabs >> Demo.Tabs.view >> Html.map TabMsg) - , ("Textfields", "textfields", .textfields >> Demo.Textfields.view >> Html.map TextfieldMsg) - , ("Toggles", "toggles", .toggles >> Demo.Toggles.view >> Html.map TogglesMsg) - , ("Tooltips", "tooltips", .tooltip >> Demo.Tooltip.view >> Html.map TooltipMsg) - , ("Typography", "typography", .typography >> Demo.Typography.view >> Html.map TypographyMsg) - ] + [ ( "Buttons", "buttons", .buttons >> Demo.Buttons.view >> Html.map ButtonsMsg ) + , ( "Badges", "badges", .badges >> Demo.Badges.view >> Html.map BadgesMsg ) + , ( "Cards", "cards", .cards >> Demo.Cards.view >> Html.map CardsMsg ) + , ( "Chips", "chips", .chips >> Demo.Chips.view >> Html.map ChipMsg ) + , ( "Dialog", "dialog", .dialog >> Demo.Dialog.view >> Html.map DialogMsg ) + , ( "Elevation", "elevation", .elevation >> Demo.Elevation.view >> Html.map ElevationMsg ) + , ( "Footers", "footers", .footers >> Demo.Footer.view >> Html.map FooterMsg ) + , ( "Grid", "grid", \_ -> Demo.Grid.view ) + , ( "Layout", "layout", .layout >> Demo.Layout.view >> Html.map LayoutMsg ) + , ( "Lists", "lists", .lists >> Demo.Lists.view >> Html.map ListsMsg ) + , ( "Loading", "loading", .loading >> Demo.Loading.view >> Html.map LoadingMsg ) + , ( "Menus", "menus", .menus >> Demo.Menus.view >> Html.map MenusMsg ) + , ( "Sliders", "sliders", .slider >> Demo.Slider.view >> Html.map SliderMsg ) + , ( "Snackbar", "snackbar", .snackbar >> Demo.Snackbar.view >> Html.map SnackbarMsg ) + , ( "Tables", "tables", .tables >> Demo.Tables.view >> Html.map TablesMsg ) + , ( "Tabs", "tabs", .tabs >> Demo.Tabs.view >> Html.map TabMsg ) + , ( "Textfields", "textfields", .textfields >> Demo.Textfields.view >> Html.map TextfieldMsg ) + , ( "Toggles", "toggles", .toggles >> Demo.Toggles.view >> Html.map TogglesMsg ) + , ( "Tooltips", "tooltips", .tooltip >> Demo.Tooltip.view >> Html.map TooltipMsg ) + , ( "Typography", "typography", .typography >> Demo.Typography.view >> Html.map TypographyMsg ) + ] tabTitles : List (Html a) tabTitles = - List.map (\(x,_,_) -> text x) tabs + List.map (\( x, _, _ ) -> text x) tabs tabViews : Array (Model -> Html Msg) -tabViews = List.map (\(_,_,v) -> v) tabs |> Array.fromList +tabViews = + List.map (\( _, _, v ) -> v) tabs |> Array.fromList tabUrls : Array String tabUrls = - List.map (\(_,x,_) -> x) tabs |> Array.fromList + List.map (\( _, x, _ ) -> x) tabs |> Array.fromList urlTabs : Dict String Int urlTabs = - List.indexedMap (\idx (_,x,_) -> (x, idx)) tabs |> Dict.fromList + List.indexedMap (\idx ( _, x, _ ) -> ( x, idx )) tabs |> Dict.fromList e404 : Model -> Html Msg e404 _ = - div - [ - ] - [ Options.styled Html.h1 - [ Options.cs "mdl-typography--display-4" - , Typography.center + div + [] + [ Options.styled Html.h1 + [ Options.cs "mdl-typography--display-4" + , Typography.center + ] + [ text "404" ] ] - [ text "404" ] - ] - drawer : List (Html Msg) drawer = - [ Layout.title [] [ text "Example drawer" ] - , Layout.navigation - [] - [ Layout.link - [ Layout.href "https://github.com/debois/elm-mdl" ] - [ text "github" ] - , Layout.link - [ Layout.href "http://package.elm-lang.org/packages/debois/elm-mdl/latest/" ] - [ text "elm-package" ] - , Layout.link - [ Layout.href "#cards" - , Options.onClick (Layout.toggleDrawer Mdl) + [ Layout.title [] [ text "Example drawer" ] + , Layout.navigation + [] + [ Layout.link + [ Layout.href "https://github.com/debois/elm-mdl" ] + [ text "github" ] + , Layout.link + [ Layout.href "http://package.elm-lang.org/packages/debois/elm-mdl/latest/" ] + [ text "elm-package" ] + , Layout.link + [ Layout.href "#cards" + , Options.onClick (Layout.toggleDrawer Mdl) + ] + [ text "Card component" ] ] - [ text "Card component" ] ] - ] header : Model -> List (Html Msg) header model = - if model.layout.withHeader then - [ Layout.row - [ if model.transparentHeader then css "height" "192px" else Options.nop - , css "transition" "height 333ms ease-in-out 0s" - ] - [ Layout.title [] [ text "elm-mdl" ] - , Layout.spacer - , Layout.navigation [] - [ Layout.link - [ Options.onClick ToggleHeader] - [ Icon.i "photo" ] - , Layout.link - [ Layout.href "https://github.com/debois/elm-mdl"] - [ span [] [text "github"] ] - , Layout.link - [ Layout.href "http://package.elm-lang.org/packages/debois/elm-mdl/latest/" ] - [ text "elm-package" ] + if model.layout.withHeader then + [ Layout.row + [ if model.transparentHeader then + css "height" "192px" + else + Options.nop + , css "transition" "height 333ms ease-in-out 0s" + ] + [ Layout.title [] [ text "elm-mdl" ] + , Layout.spacer + , Layout.navigation [] + [ Layout.link + [ Options.onClick ToggleHeader ] + [ Icon.i "photo" ] + , Layout.link + [ Layout.href "https://github.com/debois/elm-mdl" ] + [ span [] [ text "github" ] ] + , Layout.link + [ Layout.href "http://package.elm-lang.org/packages/debois/elm-mdl/latest/" ] + [ text "elm-package" ] + ] ] ] - ] - else - [] + else + [] view : Model -> Html Msg -view = Html.Lazy.lazy view_ +view = + Html.Lazy.lazy view_ view_ : Model -> Html Msg view_ model = - let - top = - (Array.get model.selectedTab tabViews |> Maybe.withDefault e404) model - in - Layout.render Mdl model.mdl - [ Layout.selectedTab model.selectedTab - , Layout.onSelectTab SelectTab - , Layout.fixedHeader |> when model.layout.fixedHeader - , Layout.fixedDrawer |> when model.layout.fixedDrawer - , Layout.fixedTabs |> when model.layout.fixedTabs - , (case model.layout.header of - Demo.Layout.Waterfall x -> Layout.waterfall x - Demo.Layout.Seamed -> Layout.seamed - Demo.Layout.Standard -> Options.nop - Demo.Layout.Scrolling -> Layout.scrolling) - |> when model.layout.withHeader - , if model.transparentHeader then Layout.transparentHeader else Options.nop - ] - { header = header model - , drawer = if model.layout.withDrawer then drawer else [] - , tabs = - if model.layout.withTabs then - (tabTitles, [ Color.background (Color.color model.layout.primary Color.S400) ]) - else - ([], []) - , main = [ stylesheet, top ] - } - {- ** Begin - - The following lines are not necessary when you manually set up - your html, as done with page.html. Removing it will then - fix the flicker you see on load. - -} - |> (\contents -> - div [] - [ Scheme.topWithScheme model.layout.primary model.layout.accent contents - - , Html.node "script" - [ Html.Attributes.attribute "src" "https://cdn.polyfill.io/v2/polyfill.js?features=Event.focusin" ] - [] - , Html.node "script" - [ Html.Attributes.attribute "src" "assets/highlight/highlight.pack.js" ] - [] - , case nth model.selectedTab tabs of - Just ( "Dialog", _, _ ) -> - Html.map DialogMsg (Demo.Dialog.element model.dialog) - {- Because of limitations on browsers that have non-native (polyfilled) - elements, our dialog element /may/ have to sit up here. However, - running in elm-reactor will never load the polyfill, so we render the - dialog (wrongly if there is no polyfill) only when the Dialog tab is - active. - -} - _ -> - div [] [] - ] - ) - {- ** End -} - - + let + top = + (Array.get model.selectedTab tabViews |> Maybe.withDefault e404) model + in + Layout.render Mdl + model.mdl + [ Layout.selectedTab model.selectedTab + , Layout.onSelectTab SelectTab + , Layout.fixedHeader |> when model.layout.fixedHeader + , Layout.fixedDrawer |> when model.layout.fixedDrawer + , Layout.fixedTabs |> when model.layout.fixedTabs + , (case model.layout.header of + Demo.Layout.Waterfall x -> + Layout.waterfall x + + Demo.Layout.Seamed -> + Layout.seamed + + Demo.Layout.Standard -> + Options.nop + + Demo.Layout.Scrolling -> + Layout.scrolling + ) + |> when model.layout.withHeader + , if model.transparentHeader then + Layout.transparentHeader + else + Options.nop + ] + { header = header model + , drawer = + if model.layout.withDrawer then + drawer + else + [] + , tabs = + if model.layout.withTabs then + ( tabTitles, [ Color.background (Color.color model.layout.primary Color.S400) ] ) + else + ( [], [] ) + , main = [ stylesheet, top ] + } + {- ** Begin + + The following lines are not necessary when you manually set up + your html, as done with page.html. Removing it will then + fix the flicker you see on load. + -} + |> + (\contents -> + div [] + [ Scheme.topWithScheme model.layout.primary model.layout.accent contents + , Html.node "script" + [ Html.Attributes.attribute "src" "https://cdn.polyfill.io/v2/polyfill.js?features=Event.focusin" ] + [] + , Html.node "script" + [ Html.Attributes.attribute "src" "assets/highlight/highlight.pack.js" ] + [] + , case nth model.selectedTab tabs of + Just ( "Dialog", _, _ ) -> + Html.map DialogMsg (Demo.Dialog.element model.dialog) + + {- Because of limitations on browsers that have non-native (polyfilled) + elements, our dialog element /may/ have to sit up here. However, + running in elm-reactor will never load the polyfill, so we render the + dialog (wrongly if there is no polyfill) only when the Dialog tab is + active. + -} + _ -> + div [] [] + ] + ) + + + +{- ** End -} -- ROUTING urlOf : Model -> String urlOf model = - "#" ++ (Array.get model.selectedTab tabUrls |> Maybe.withDefault "") + "#" ++ (Array.get model.selectedTab tabUrls |> Maybe.withDefault "") delta2url : Model -> Model -> Maybe Routing.UrlChange delta2url model1 model2 = - if model1.selectedTab /= model2.selectedTab then - { entry = Routing.NewEntry - , url = urlOf model2 - } |> Just - else - Nothing + if model1.selectedTab /= model2.selectedTab then + { entry = Routing.NewEntry + , url = urlOf model2 + } + |> Just + else + Nothing location2messages : Navigation.Location -> List Msg location2messages location = - [ case String.dropLeft 1 location.hash of - "" -> - SelectTab 0 - - x -> - Dict.get x urlTabs - |> Maybe.withDefault -1 - |> SelectTab - ] + [ case String.dropLeft 1 location.hash of + "" -> + SelectTab 0 + + x -> + Dict.get x urlTabs + |> Maybe.withDefault -1 + |> SelectTab + ] @@ -379,29 +435,32 @@ location2messages location = main : Routing.RouteUrlProgram Never Model Msg main = - Routing.program - { delta2url = delta2url - , location2messages = location2messages - , init = - ( { model - | mdl = Layout.setTabsWidth 2124 model.mdl - {- elm gives us no way to measure the actual width of tabs. We - hardwire it. If you add a tab, remember to update this. Find the - new value using: - - document.getElementsByClassName("mdl-layout__tab-bar")[0].scrollWidth - -} - } - , Material.init Mdl - ) - , view = view - , subscriptions = \model -> - Sub.batch - [ Sub.map MenusMsg (Menu.subs Demo.Menus.Mdl model.menus.mdl) - , Material.subscriptions Mdl model - ] - , update = update - } + Routing.program + { delta2url = delta2url + , location2messages = location2messages + , init = + ( { model + | mdl = + Layout.setTabsWidth 2124 model.mdl + {- elm gives us no way to measure the actual width of tabs. We + hardwire it. If you add a tab, remember to update this. Find the + new value using: + + document.getElementsByClassName("mdl-layout__tab-bar")[0].scrollWidth + -} + } + , Material.init Mdl + ) + , view = view + , subscriptions = + \model -> + Sub.batch + [ Sub.map MenusMsg (Menu.subs Demo.Menus.Mdl model.menus.mdl) + , Material.subscriptions Mdl model + ] + , update = update + } + -- CSS @@ -409,7 +468,7 @@ main = stylesheet : Html a stylesheet = - Options.stylesheet """ + Options.stylesheet """ /* The following line is better done in html. We keep it here for compatibility with elm-reactor. */ diff --git a/demo/Demo/Badges.elm b/demo/Demo/Badges.elm index 96f7ce6..3aeeb43 100644 --- a/demo/Demo/Badges.elm +++ b/demo/Demo/Badges.elm @@ -2,8 +2,6 @@ module Demo.Badges exposing (..) import Html exposing (..) import Platform.Cmd exposing (Cmd) - - import Material.Badge as Badge import Material.Options as Options exposing (styled) import Material.Icon as Icon @@ -12,234 +10,258 @@ import Material.Helpers as Helpers import Material.Button as Button import Material.Options exposing (css) import Material - import Demo.Code as Code import Demo.Page as Page -type Msg - = Increase - | Decrease - | SetCode String - | CodeBox Code.Msg - | Mdl (Material.Msg Msg) - - -type alias Model = - { unread : Int - , mdl : Material.Model - , code : Maybe String - , codebox : Code.Model - } - - -model : Model -model = - { unread = 1 - , mdl = Material.model - , code = Nothing - , codebox = Code.model - } - - -update : Msg -> Model -> (Model, Cmd Msg) -update action model = - case action of - Mdl msg_ -> - Material.update Mdl msg_ model - - Decrease -> - ( { model | unread = model.unread - 1 } - , List.range 0 7 - |> List.map toFloat - |> List.map (\i -> Helpers.delay (2 ^ i * 20 + 750) Increase) - |> Cmd.batch - ) - - Increase -> - ( { model | unread = model.unread + 1 } - , Cmd.none - ) - - SetCode code -> - Code.update (Code.Set code) model.codebox - |> Helpers.map1st (\codebox -> { model | codebox = codebox }) - |> Helpers.map2nd (Cmd.map CodeBox) - - CodeBox msg_ -> - Code.update msg_ model.codebox - |> Helpers.map1st (\codebox -> { model | codebox = codebox }) - |> Helpers.map2nd (Cmd.map CodeBox) +type Msg + = Increase + | Decrease + | SetCode String + | CodeBox Code.Msg + | Mdl (Material.Msg Msg) + + +type alias Model = + { unread : Int + , mdl : Material.Model + , code : Maybe String + , codebox : Code.Model + } + + +model : Model +model = + { unread = 1 + , mdl = Material.model + , code = Nothing + , codebox = Code.model + } + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update action model = + case action of + Mdl msg_ -> + Material.update Mdl msg_ model + + Decrease -> + ( { model | unread = model.unread - 1 } + , List.range 0 7 + |> List.map toFloat + |> List.map (\i -> Helpers.delay (2 ^ i * 20 + 750) Increase) + |> Cmd.batch + ) + + Increase -> + ( { model | unread = model.unread + 1 } + , Cmd.none + ) + + SetCode code -> + Code.update (Code.Set code) model.codebox + |> Helpers.map1st (\codebox -> { model | codebox = codebox }) + |> Helpers.map2nd (Cmd.map CodeBox) + + CodeBox msg_ -> + Code.update msg_ model.codebox + |> Helpers.map1st (\codebox -> { model | codebox = codebox }) + |> Helpers.map2nd (Cmd.map CodeBox) + + -- VIEW onHover : a -> Options.Style a -onHover = - Options.onMouseOver +onHover = + Options.onMouseOver c : List (Html Msg) -> Cell Msg -c = cell [ size All 4 ] +c = + cell [ size All 4 ] view : Model -> Html Msg view model = - let - demo2 = - [ p [] - [ text "Typical use of a badge in, say, in an e-mail client:" ] - , grid [] - [ c [ Options.div - [ css "width" "10em", css "display" "inline-block" ] - [ Options.styled span - [ if model.unread /= 0 then Badge.add (toString model.unread) else Options.nop + let + demo2 = + [ p [] + [ text "Typical use of a badge in, say, in an e-mail client:" ] + , grid [] + [ c + [ Options.div + [ css "width" "10em", css "display" "inline-block" ] + [ Options.styled span + [ if model.unread /= 0 then + Badge.add (toString model.unread) + else + Options.nop + ] + [ text "Unread" ] + ] + , Button.render Mdl + [ 0 ] + model.mdl + [ Options.onClick Decrease + , Button.raised + , Button.ripple + , Button.colored + ] + [ text "Mark as read" ] ] - [ text "Unread" ] - ] - , Button.render Mdl [0] model.mdl - [ Options.onClick Decrease - , Button.raised - , Button.ripple - , Button.colored - ] - [ text "Mark as read" ] - ] - ] - ] - demo1 = - [ p [] - [ text "Below are all possible combinations of badges. Hover to show source excerpt." ] - , grid - [] - [ c [ let c1 = """ - Options.span - [ Badge.add "3" ] + ] + ] + + demo1 = + [ p [] + [ text "Below are all possible combinations of badges. Hover to show source excerpt." ] + , grid + [] + [ c + [ let + c1 = + """ + Options.span + [ Badge.add "3" ] [ text "Badge" ]""" - in - Options.span - [ Badge.add "3" - , onHover <| SetCode c1 - ] - [ text "Badge" ] - ] - , c [ let c2 = """ + in + Options.span + [ Badge.add "3" + , onHover <| SetCode c1 + ] + [ text "Badge" ] + ] + , c + [ let + c2 = + """ Options.span [ Badge.add "♥" ] [ text "Symbol" ]""" - in - Options.span - [ Badge.add "♥" - , onHover <| SetCode c2 + in + Options.span + [ Badge.add "♥" + , onHover <| SetCode c2 + ] + [ text "Symbol" ] ] - [ text "Symbol" ] - - ] - , c [ let c3 = """ + , c + [ let + c3 = + """ Icon.view "shopping_cart" [ Icon.size24 , Badge.add "33" ]""" - in - Options.styled span - [ onHover <| SetCode c3 ] - [ Icon.view "shopping_cart" - [ Icon.size24 - , Badge.add "33" - ] + in + Options.styled span + [ onHover <| SetCode c3 ] + [ Icon.view "shopping_cart" + [ Icon.size24 + , Badge.add "33" + ] + ] ] - ] - , c [ let c4 = """ - Options.span + , c + [ let + c4 = + """ + Options.span [ Badge.add "5" - , Badge.noBackground - ] + , Badge.noBackground + ] [ text "No background" ]""" - in - Options.span - [ Badge.add "5" - , Badge.noBackground - , onHover <| SetCode c4 - ] - [ text "No background" ] - ] - , c [ let c5 = """ - Options.span + in + Options.span + [ Badge.add "5" + , Badge.noBackground + , onHover <| SetCode c4 + ] + [ text "No background" ] + ] + , c + [ let + c5 = + """ + Options.span [ Badge.add "8" - , Badge.overlap - ] + , Badge.overlap + ] [ text "Overlap" ]""" - in - Options.span - [ Badge.add "8" - , Badge.overlap - , onHover <| SetCode c5 - ] - [ text "Overlap" ] - ] - , c [ let c6 = """ + in + Options.span + [ Badge.add "8" + , Badge.overlap + , onHover <| SetCode c5 + ] + [ text "Overlap" ] + ] + , c + [ let + c6 = + """ Options.span [ Badge.add "13" - , Badge.overlap - , Badge.noBackground - ] + , Badge.overlap + , Badge.noBackground + ] [ text "Overlap, no background" ]""" - in - Options.span - [ Badge.add "13" - , Badge.overlap - , Badge.noBackground - , onHover <| SetCode c6 - ] - [ text "Overlap, no background" ] - ] - ] - , Code.view model.codebox [ Options.css "margin" "20px 0" ] - ] - in - Page.body1_ "Badges" srcUrl intro references demo1 demo2 - + in + Options.span + [ Badge.add "13" + , Badge.overlap + , Badge.noBackground + , onHover <| SetCode c6 + ] + [ text "Overlap, no background" ] + ] + ] + , Code.view model.codebox [ Options.css "margin" "20px 0" ] + ] + in + Page.body1_ "Badges" srcUrl intro references demo1 demo2 intro : Html a intro = - Page.fromMDL "http://www.getmdl.io/components/#badges-section" """ + Page.fromMDL "http://www.getmdl.io/components/#badges-section" """ > The Material Design Lite (MDL) badge component is an onscreen notification > element. A badge consists of a small circle, typically containing a number or > other characters, that appears in proximity to another object. A badge can be > both a notifier that there are additional items associated with an object and > an indicator of how many items there are. -> +> > You can use a badge to unobtrusively draw the user's attention to items they > might not otherwise notice, or to emphasize that items may need their > attention. For example: -> +> > - A "New messages" notification might be followed by a badge containing the -> number of unread messages. +> number of unread messages. > - A "You have unpurchased items in your shopping cart" reminder might include > a badge showing the number of items in the cart. > - A "Join the discussion!" button might have an accompanying badge indicating the -> number of users currently participating in the discussion. -> +> number of users currently participating in the discussion. +> > A badge is almost > always positioned near a link so that the user has a convenient way to access > the additional information indicated by the badge. However, depending on the > intent, the badge itself may or may not be part of the link. -> +> > Badges are a new feature in user interfaces, and provide users with a visual clue to help them discover additional relevant content. Their design and use is therefore an important factor in the overall user experience. -> +> """ srcUrl : String -srcUrl = - "https://github.com/debois/elm-mdl/blob/master/demo/Demo/Badges.elm" - +srcUrl = + "https://github.com/debois/elm-mdl/blob/master/demo/Demo/Badges.elm" -references : List (String, String) -references = - [ Page.package "http://package.elm-lang.org/packages/debois/elm-mdl/latest/Material-Badge" - --, Page.mds "https://www.google.com/design/spec/components/buttons.html" - , Page.mdl "https://www.getmdl.io/components/#badges-section" - ] +references : List ( String, String ) +references = + [ Page.package "http://package.elm-lang.org/packages/debois/elm-mdl/latest/Material-Badge" + --, Page.mds "https://www.google.com/design/spec/components/buttons.html" + , Page.mdl "https://www.getmdl.io/components/#badges-section" + ] diff --git a/demo/Demo/Buttons.elm b/demo/Demo/Buttons.elm index 44123aa..3631373 100644 --- a/demo/Demo/Buttons.elm +++ b/demo/Demo/Buttons.elm @@ -4,14 +4,12 @@ import Html exposing (..) import Html.Attributes exposing (..) import Platform.Cmd exposing (Cmd) import String - import Material.Button as Button exposing (..) import Material.Grid as Grid import Material.Icon as Icon import Material.Options as Options exposing (Style) import Material.Helpers exposing (map1st, map2nd) import Material - import Demo.Code as Code import Demo.Page as Page @@ -19,237 +17,328 @@ import Demo.Page as Page -- MODEL -type alias Index = - List Int +type alias Index = + List Int -type Misc - = Default | Ripple | Disabled +type Misc + = Default + | Ripple + | Disabled -type Color - = Plain | Colored +type Color + = Plain + | Colored -type Kind - = Flat | Raised | FAB | MiniFAB | Icon +type Kind + = Flat + | Raised + | FAB + | MiniFAB + | Icon -type alias Model = - { last : Maybe (Kind, Color, Misc) - , mdl : Material.Model - , code : Code.Model - } +type alias Model = + { last : Maybe ( Kind, Color, Misc ) + , mdl : Material.Model + , code : Code.Model + } model : Model -model = - { last = Nothing - , mdl = Material.model - , code = Code.model - } +model = + { last = Nothing + , mdl = Material.model + , code = Code.model + } + -- ACTION/UPDATE -type Msg - = Click (Kind, Color, Misc) - | Mdl (Material.Msg Msg) - | Code Code.Msg +type Msg + = Click ( Kind, Color, Misc ) + | Mdl (Material.Msg Msg) + | Code Code.Msg -update : Msg -> Model -> (Model, Cmd Msg) -update action model = - case action of - Mdl msg_ -> - Material.update Mdl msg_ model +update : Msg -> Model -> ( Model, Cmd Msg ) +update action model = + case action of + Mdl msg_ -> + Material.update Mdl msg_ model - Code msg_ -> - Code.update msg_ model.code - |> map1st (\code_ -> { model | code = code_ }) - |> map2nd (Cmd.map Code) + Code msg_ -> + Code.update msg_ model.code + |> map1st (\code_ -> { model | code = code_ }) + |> map2nd (Cmd.map Code) + + Click last -> + let + ( code_, fx ) = + Code.update (Code.Set (program last)) model.code + in + ( { model + | last = Just last + , code = code_ + } + , Cmd.map Code fx + ) - Click last -> - let - (code_, fx) = - Code.update (Code.Set (program last)) model.code - in - ( { model - | last = Just last - , code = code_ - } - , Cmd.map Code fx - ) -- VIEW miscs : List Misc -miscs = - [ Default, Ripple, Disabled ] +miscs = + [ Default, Ripple, Disabled ] colors : List Color -colors = - [ Plain, Colored ] +colors = + [ Plain, Colored ] kinds : List Kind -kinds = - [ Flat, Raised, FAB, MiniFAB, Icon ] - - -describe : (Kind, Color, Misc) -> String -describe (kind, color, misc) = - [ case kind of - Flat -> "flat" - Raised -> "raised" - FAB -> "fab" - MiniFAB -> "mini-fab" - Icon -> "icon" - , case color of - Plain -> "plain" - Colored -> "colored" - , case misc of - Ripple -> "w/ripple" - Disabled -> "disabled" - Default -> "" - ] - |> List.filter ((/=) "") - |> String.join " " - - -program : (Kind, Color, Misc) -> String -program (kind, color, misc) = - let - options = - [ case kind of - Flat -> "" - Raised -> "raised" - FAB -> "fab" - MiniFAB -> "minifab" - Icon -> "icon" - , case color of - Plain -> "" - Colored -> "colored" - , case misc of - Ripple -> "ripple" - Disabled -> "disabled" - Default -> "" - , "onClick MyClickMsg" - ] - |> List.filter ((/=) "") - |> List.map ((++) "Button.") - |> String.join "\n , " - contents = - case kind of - Flat -> "text \"Flat button\"" - Raised -> "text \"Raised button\"" - FAB -> "Icon.i \"add\"" - MiniFAB -> "Icon.i \"zoom_in\"" - Icon -> "Icon.i \"flight_land\"" - in - """Button.render Mdl [0] model.mdl +kinds = + [ Flat, Raised, FAB, MiniFAB, Icon ] + + +describe : ( Kind, Color, Misc ) -> String +describe ( kind, color, misc ) = + [ case kind of + Flat -> + "flat" + + Raised -> + "raised" + + FAB -> + "fab" + + MiniFAB -> + "mini-fab" + + Icon -> + "icon" + , case color of + Plain -> + "plain" + + Colored -> + "colored" + , case misc of + Ripple -> + "w/ripple" + + Disabled -> + "disabled" + + Default -> + "" + ] + |> List.filter ((/=) "") + |> String.join " " + + +program : ( Kind, Color, Misc ) -> String +program ( kind, color, misc ) = + let + options = + [ case kind of + Flat -> + "" + + Raised -> + "raised" + + FAB -> + "fab" + + MiniFAB -> + "minifab" + + Icon -> + "icon" + , case color of + Plain -> + "" + + Colored -> + "colored" + , case misc of + Ripple -> + "ripple" + + Disabled -> + "disabled" + + Default -> + "" + , "onClick MyClickMsg" + ] + |> List.filter ((/=) "") + |> List.map ((++) "Button.") + |> String.join "\n , " + + contents = + case kind of + Flat -> + "text \"Flat button\"" + + Raised -> + "text \"Raised button\"" + + FAB -> + "Icon.i \"add\"" + + MiniFAB -> + "Icon.i \"zoom_in\"" + + Icon -> + "Icon.i \"flight_land\"" + in + """Button.render Mdl [0] model.mdl [ """ ++ options ++ """ ] [ """ ++ contents ++ "]" indexedConcat : (Int -> a -> List b) -> List a -> List b -indexedConcat f xs = - List.indexedMap f xs - |> List.concat +indexedConcat f xs = + List.indexedMap f xs + |> List.concat viewButtons : Model -> List (Grid.Cell Msg) viewButtons model = - kinds |> indexedConcat (\idx0 kind -> - colors |> indexedConcat (\idx1 color -> - miscs |> List.indexedMap (\idx2 misc -> - Grid.cell - [ Grid.size Grid.All 2] - [ div - [ style - [ ("text-align", "center") - , ("margin-top", ".6em") - , ("margin-bottom", ".6em") - ] - ] - [ Button.render Mdl [idx0, idx1, idx2] model.mdl - [ case kind of - Flat -> Button.flat - Raised -> Button.raised - FAB -> Button.fab - MiniFAB -> Button.minifab - Icon -> Button.icon - , case color of - Plain -> Button.plain - Colored -> Button.colored - , case misc of - Disabled -> Button.disabled - Ripple -> Button.ripple - Default -> Options.nop - , Options.onClick (Click (kind, color, misc)) - ] - [ case kind of - Flat -> text "Flat button" - Raised -> text "Raised button" - FAB -> Icon.i "add" - MiniFAB -> Icon.i "zoom_in" - Icon -> Icon.i "flight_land" - ] - , div - [ style - [ ("font-size", "9pt") - , ("margin-top", ".6em") - ] - ] - [ text <| describe (kind, color, misc) ] - ] - ] - ))) + kinds + |> indexedConcat + (\idx0 kind -> + colors + |> indexedConcat + (\idx1 color -> + miscs + |> List.indexedMap + (\idx2 misc -> + Grid.cell + [ Grid.size Grid.All 2 ] + [ div + [ style + [ ( "text-align", "center" ) + , ( "margin-top", ".6em" ) + , ( "margin-bottom", ".6em" ) + ] + ] + [ Button.render Mdl + [ idx0, idx1, idx2 ] + model.mdl + [ case kind of + Flat -> + Button.flat + + Raised -> + Button.raised + + FAB -> + Button.fab + + MiniFAB -> + Button.minifab + + Icon -> + Button.icon + , case color of + Plain -> + Button.plain + + Colored -> + Button.colored + , case misc of + Disabled -> + Button.disabled + + Ripple -> + Button.ripple + + Default -> + Options.nop + , Options.onClick (Click ( kind, color, misc )) + ] + [ case kind of + Flat -> + text "Flat button" + + Raised -> + text "Raised button" + + FAB -> + Icon.i "add" + + MiniFAB -> + Icon.i "zoom_in" + + Icon -> + Icon.i "flight_land" + ] + , div + [ style + [ ( "font-size", "9pt" ) + , ( "margin-top", ".6em" ) + ] + ] + [ text <| describe ( kind, color, misc ) ] + ] + ] + ) + ) + ) view : Model -> Html Msg -view model = - Page.body1_ "Buttons" srcUrl intro references - [ p [] - [ text """Various combinations of colors and button styles can be seen +view model = + Page.body1_ "Buttons" + srcUrl + intro + references + [ p [] + [ text """Various combinations of colors and button styles can be seen below. Most buttons have animations; try clicking. Code for the last clicked button appears below the buttons.""" + ] + , Grid.grid [] (viewButtons model) + , p [] + [ model.last + |> Maybe.map describe + |> Maybe.map (\str -> "Code for '" ++ str ++ "':") + |> Maybe.withDefault "Click a button to see the corresponding code." + |> text + , Code.view model.code [ Options.css "margin" "20px" ] + ] ] - , Grid.grid [] (viewButtons model) - , p [] - [ model.last - |> Maybe.map describe - |> Maybe.map (\str -> "Code for '" ++ str ++ "':") - |> Maybe.withDefault "Click a button to see the corresponding code." - |> text - , Code.view model.code [ Options.css "margin" "20px" ] - ] - ] - [ h4 [ id "link-buttons" ] - [ text "Link buttons" - ] - - , p [] - [ text """ + [ h4 [ id "link-buttons" ] + [ text "Link buttons" + ] + , p [] + [ text """ To make a button act like a link, supply the option `Button.link ""`. The example below opens the Grid tab of this demo.""" - ] - - , Button.render Mdl [9, 0, 0, 1] model.mdl - [ Button.ripple - , Button.colored - , Button.raised - , Button.link "#grid" - ] - [ text "Link" ] - - , Code.code [ Options.css "margin" "20px 0" ] - """ + ] + , Button.render Mdl + [ 9, 0, 0, 1 ] + model.mdl + [ Button.ripple + , Button.colored + , Button.raised + , Button.link "#grid" + ] + [ text "Link" ] + , Code.code [ Options.css "margin" "20px 0" ] + """ Button.render Mdl [9, 0, 0, 1] model.mdl [ Button.ripple , Button.colored @@ -258,24 +347,26 @@ view model = ] [ text "Link" ] """ - , p [] - [ text """ - Buttons with the `link` property function as HTML `a` elements. + , p [] + [ text """ + Buttons with the `link` property function as HTML `a` elements. You can supply the usual attributes, e.g, `target`. The example below opens the link in a new tab or window, depending on the - browser. + browser. """ - ] - , Button.render Mdl [9, 0, 0, 2] model.mdl - [ Button.ripple - , Button.colored - , Button.raised - , Button.link "#grid" - , Options.attribute <| Html.Attributes.target "_blank" - ] - [ text "Open in new tab" ] - , Code.code [ Options.css "margin" "20px 0" ] - """ + ] + , Button.render Mdl + [ 9, 0, 0, 2 ] + model.mdl + [ Button.ripple + , Button.colored + , Button.raised + , Button.link "#grid" + , Options.attribute <| Html.Attributes.target "_blank" + ] + [ text "Open in new tab" ] + , Code.code [ Options.css "margin" "20px 0" ] + """ Button.render Mdl [9, 0, 0, 2] model.mdl [ Button.ripple , Button.colored @@ -285,12 +376,12 @@ view model = ] [ text "Ripple and target" ] """ - ] + ] intro : Html a intro = - Page.fromMDL "https://www.getmdl.io/components/#buttons-section" """ + Page.fromMDL "https://www.getmdl.io/components/#buttons-section" """ > The Material Design Lite (MDL) button component is an enhanced version of the > standard HTML `