diff --git a/examples/Demo/Snackbar.elm b/examples/Demo/Snackbar.elm new file mode 100644 index 0000000..4a8f146 --- /dev/null +++ b/examples/Demo/Snackbar.elm @@ -0,0 +1,232 @@ +module Demo.Snackbar where + +import Effects exposing (Effects, none) +import Html exposing (..) +import Html.Attributes exposing (class, style, key) +import Array exposing (Array) +import String + +import Markdown + +import Material.Snackbar as Snackbar +import Material.Button as Button exposing (Action(..)) +import Material.Grid exposing (..) +import Material exposing (lift, lift') + + +-- MODEL + + +type alias Model = + { count : Int + , clicked : List Int + , snackbar : Snackbar.Model Action + , toastButton : Button.Model + , snackbarButton : Button.Model + } + + +model : Model +model = + { count = 0 + , clicked = [] + , snackbar = Snackbar.model + , toastButton = Button.model True + , snackbarButton = Button.model True + } + + +-- ACTION, UPDATE + + +type Action + = Undo Int + -- Components + | SnackbarAction (Snackbar.Action Action) + | ToastButtonAction Button.Action + | SnackbarButtonAction Button.Action + + +snackbar : Int -> Snackbar.Contents Action +snackbar k = + Snackbar.snackbar + ("Snackbar message #" ++ toString k) + "UNDO" + (Undo k) + + +toast : Int -> Snackbar.Contents Action +toast k = + Snackbar.toast + <| "Toast message #" ++ toString k + + +add : (Int -> Snackbar.Contents Action) -> Model -> (Model, Effects Action) +add f model = + let + (snackbar', effects) = + Snackbar.update (Snackbar.Add (f model.count)) model.snackbar + in + ({ model + | snackbar = snackbar' + , count = model.count + 1 + , clicked = model.count :: model.clicked + } + , Effects.map SnackbarAction effects) + + + +update : Action -> Model -> (Model, Effects Action) +update action model = + case action of + SnackbarButtonAction Click -> + add snackbar model + + ToastButtonAction Click -> + add toast model + + Undo k -> + ({ model + | clicked = List.filter ((/=) k) model.clicked + } + , none) + + SnackbarAction (Snackbar.Action action') + -> update action' model + + SnackbarAction action' -> lift .snackbar (\m x -> {m|snackbar =x}) SnackbarAction Snackbar.update action' model + ToastButtonAction action' -> lift .toastButton (\m x -> {m|toastButton =x}) ToastButtonAction Button.update action' model + SnackbarButtonAction action' -> lift .snackbarButton (\m x -> {m|snackbarButton=x}) SnackbarButtonAction Button.update action' model + + +-- VIEW + + +-- This should be supported by the library somehow. +colors : Array String +colors = + [ "indigo" + , "blue" + , "light-blue" + , "cyan" + , "teal" + , "green" + , "light-green" + , "lime" + , "yellow" + , "amber" + , "orange" + , "brown" + , "blue-grey" + , "grey" + , "deep-orange" + , "red" + , "pink" + , "purple" + , "deep-purple" + ] |> Array.fromList + + +clickView : Int -> Html +clickView k = + let + color = + Array.get ((k + 4) % Array.length colors) colors + |> Maybe.withDefault "blue" + in + div + [ [ "mdl-color--" ++ color + , "mdl-color-text--primary-contrast" + , "mdl-shadow--8dp" + ] |> String.join " " |> class + , style + [ ("margin-right", "3ex") + , ("margin-bottom", "3ex") + , ("padding", "1.5ex") + , ("width", "4ex") + , ("border-radius", "2px") + , ("display", "inline-block") + , ("text-align", "center") + ] + , key (toString k) + ] + [ text <| toString k ] + + +view : Signal.Address Action -> Model -> Html +view addr model = + div [] + [ intro + , grid + -- TODO. Buttons should be centered. Desperately need to be able + -- to add css/classes to top-level element of components (div + -- in grid, button in button, div in textfield etc.) + [ cell [ size All 2, size Phone 2, align Top ] + [ Button.raised + (Signal.forwardTo addr ToastButtonAction) + model.toastButton Button.Plain + [ text "Toast" ] + ] + , cell [ size All 2, size Phone 2, align Top ] + [ Button.raised + (Signal.forwardTo addr SnackbarButtonAction) + model.snackbarButton + Button.Plain + [ text "Snackbar" ] + ] + , cell + [ size Desktop 7, size Tablet 3, size Phone 12, align Top ] + (model.clicked |> List.reverse |> List.map clickView) + ] + , Snackbar.view (Signal.forwardTo addr SnackbarAction) model.snackbar + ] + + +introStyle : String +introStyle = """ + blockquote:before { content: none; } + blockquote:after { content: none; } + blockquote { + border-left-style: solid; + border-width: 3px; + padding-left: 1.3ex; + border-color: rgb(255,82,82); + /* TODO: Really need a way to specify "secondary color" in + inline css. + */ + } +""" + + +introBody : Html +introBody = """ +# Snackbars & toasts + +From the +[Material Design Lite documentation](https://www.getmdl.io/components/index.html#snackbar-section). + +> The Material Design Lite (MDL) __snackbar__ component is a container used to +> notify a user of an operation's status. It displays at the bottom of the +> screen. A snackbar may contain an action button to execute a command for the +> user. Actions should undo the committed action or retry it if it failed for +> example. Actions should not be to close the snackbar. By not providing an +> action, the snackbar becomes a __toast__ component. + +#### See also + + - [Demo source code](https://github.com/debois/elm-mdl/blob/master/examples/Demo/Snackbar.elm) + - [elm-mdl package documentation](http://package.elm-lang.org/packages/debois/elm-mdl/1.0.1/Material-Snackbar) + - [Material Design Specification](https://www.google.com/design/spec/components/snackbars-toasts.html) + - [Material Design Lite documentation](https://www.getmdl.io/components/index.html#snackbar-section). + +#### Demo + +""" |> Markdown.toHtml + + +intro : Html +intro = + div [] + [ node "style" [] [ text introStyle ] + , introBody + ] diff --git a/page.html b/page.html index a4b43f4..b87c533 100644 --- a/page.html +++ b/page.html @@ -9,7 +9,7 @@ - + diff --git a/src/Material/Color.elm b/src/Material/Color.elm new file mode 100644 index 0000000..cae7f03 --- /dev/null +++ b/src/Material/Color.elm @@ -0,0 +1,71 @@ +module Material.Color + ( Color(..) + , cssName + ) where + +{-| Fixed Material Design Lite color palette. + +@docs Color(..) + +# Internals + +These are used internally in the Material package and is likely not useful +to you. + +@docs cssName : Color -> String +-} + + +{-| Color palette. +-} +type Color + = Indigo + | Blue + | LightBlue + | Cyan + | Teal + | Green + | LightGreen + | Lime + | Yellow + | Amber + | Orange + | Brown + | BlueGrey + | Grey + | DeepOrange + | Red + | Pink + | Purple + | DeepPurple + -- Not actual colors + | Primary + | Accent + + +{-| MDL CSS name of given color. +-} +cssName : Color -> String +cssName color = + case color of + Indigo -> "indigo" + Blue -> "blue" + LightBlue -> "light-blue" + Cyan -> "cyan" + Teal -> "teal" + Green -> "green" + LightGreen -> "light-green" + Lime -> "lime" + Yellow -> "yellow" + Amber -> "amber" + Orange -> "orange" + Brown -> "brown" + BlueGrey -> "blue-grey" + Grey -> "grey" + DeepOrange -> "deep-orange" + Red -> "red" + Pink -> "pink" + Purple -> "purple" + DeepPurple -> "deep-purple" + Primary -> "primary" + Accent -> "accent" diff --git a/src/Material/Snackbar.elm b/src/Material/Snackbar.elm new file mode 100644 index 0000000..689d72e --- /dev/null +++ b/src/Material/Snackbar.elm @@ -0,0 +1,261 @@ +module Material.Snackbar + ( Contents, Model, model, toast, snackbar + , Action(Add, Action), update + , view + ) where + +{-| TODO + +# Model +@ docs Contents, Model, model, toast, snackbar + +# Action, Update +@docs Action, update + +# View +@docs view +-} + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (onClick) +import Effects exposing (Effects, none) +import Task +import Time exposing (Time) +import Maybe exposing (andThen) + +import Material.Helpers exposing (mapFx, addFx) + + +-- MODEL + + +{-| TODO +-} +type alias Contents a = + { message : String + , action : Maybe (String, a) + , timeout : Time + , fade : Time + } + + +{-| TODO +-} +type alias Model a = + { queue : List (Contents a) + , state : State a + , seq : Int + } + + +{-| TODO +-} +model : Model a +model = + { queue = [] + , state = Inert + , seq = 0 + } + + + + +{-| Generate default toast with given message. +Timeout is 2750ms, fade 250ms. +-} +toast : String -> Contents a +toast message = + { message = message + , action = Nothing + , timeout = 2750 + , fade = 250 + } + + +{-| Generate default snackbar with given message, +action-label, and action. Timeout is 2750ms, fade 250ms. +-} +snackbar : String -> String -> a -> Contents a +snackbar message actionMessage action = + { message = message + , action = Just (actionMessage, action) + , timeout = 2750 + , fade = 250 + } + + +-- SNACKBAR STATE MACHINE + + +type State a + = Inert + | Active (Contents a) + | Fading (Contents a) + + +type Transition + = Timeout + | Click + + +delay : Time -> a -> Effects a +delay t x = + Task.sleep t + |> (flip Task.andThen) (\_ -> Task.succeed x) + |> Effects.task + + +move : Transition -> Model a -> (Model a, Effects Transition) +move transition model = + case (model.state, transition) of + (Inert, Timeout) -> + tryDequeue model + + (Active contents, _) -> + ( { model | state = Fading contents } + , delay contents.fade Timeout + ) + + (Fading contents, Timeout) -> + ( { model | state = Inert} + , Effects.tick (\_ -> Timeout) + ) + + _ -> + (model, none) + + +-- NOTIFICATION QUEUE + + +enqueue : Contents a -> Model a -> Model a +enqueue contents model = + { model + | queue = List.append model.queue [contents] + } + + +tryDequeue : Model a -> (Model a, Effects Transition) +tryDequeue model = + case (model.state, model.queue) of + (Inert, c :: cs) -> + ( { model + | state = Active c + , queue = cs + , seq = model.seq + 1 + } + , delay c.timeout Timeout + ) + + _ -> + (model, none) + + +-- ACTIONS, UPDATE + + +{-| TODO +-} +type Action a + = Add (Contents a) + | Action a + | Move Int Transition + + +forwardClick : Transition -> Model a -> (Model a, Effects (Action a)) -> (Model a, Effects (Action a)) +forwardClick transition model = + case (transition, model.state) of + (Click, Active contents) -> + contents.action + |> Maybe.map (snd >> Action >> Task.succeed >> Effects.task >> addFx) + |> Maybe.withDefault (\x -> x) + + _ -> + \x -> x + + +liftTransition : (Model a, Effects Transition) -> (Model a, Effects (Action a)) +liftTransition (model, effect) = + (model, Effects.map (Move model.seq) effect) + + +{-| TODO +-} +update : Action a -> Model a -> (Model a, Effects (Action a)) +update action model = + case action of + Action _ -> + (model, none) + + Add contents -> + enqueue contents model + |> tryDequeue + |> liftTransition + + Move seq transition -> + if seq == model.seq then + move transition model + |> liftTransition + |> forwardClick transition model + else + (model, none) + + +-- VIEW + + +contentsOf : Model a -> Maybe (Contents a) +contentsOf model = + case model.state of + Inert -> Nothing + Active contents -> Just contents + Fading contents -> Just contents + + +view : Signal.Address (Action a) -> Model a -> Html +view addr model = + let + active = + model.queue /= [] + + textBody = + contentsOf model + |> Maybe.map (\c -> [ text c.message ]) + |> Maybe.withDefault [] + + (buttonBody, buttonHandler) = + contentsOf model + |> (flip Maybe.andThen .action) + |> Maybe.map (\(msg, action') -> + ([ text msg ], + [ onClick addr (Move model.seq Click) ]) + ) + |> Maybe.withDefault ([], []) + + isActive = + case model.state of + Inert -> False + Active _ -> True + Fading _ -> False + in + div + [ classList + [ ("mdl-js-snackbar", True) + , ("mdl-snackbar", True) + , ("mdl-snackbar--active", isActive) + ] + -- , ariaHidden "true" + ] + [ div + [ class "mdl-snackbar__text" + ] + textBody + , button + ( class "mdl-snackbar__action" + :: type' "button" + -- :: ariaHidden "true" + :: buttonHandler + ) + buttonBody + ]