diff --git a/Makefile b/Makefile index 8488124..b7b0c95 100644 --- a/Makefile +++ b/Makefile @@ -6,6 +6,9 @@ comp: demo: (cd demo; elm-make Demo.elm --warn --output ../elm.js) +docs: + elm-make --docs=docs.json + wip-pages : elm-make examples/Demo.elm --output $(PAGES)/wip.js (cd $(PAGES); git commit -am "Update."; git push origin gh-pages) diff --git a/demo/Demo.elm b/demo/Demo.elm index ad6e9eb..55aa0db 100644 --- a/demo/Demo.elm +++ b/demo/Demo.elm @@ -116,7 +116,7 @@ nth k xs = update : Action -> Model -> ( Model, Effects Action ) update action model = - case action of + case Debug.log "Action" action of LayoutAction a -> let ( lifted, layoutFx ) = @@ -203,7 +203,7 @@ tabs = , ("Textfields", "textfields", \addr model -> Demo.Textfields.view (Signal.forwardTo addr TextfieldAction) model.textfields) {- - , ("Template", \addr model -> + , ("Template", "tempate", \addr model -> [Demo.Template.view (Signal.forwardTo addr TemplateAction) model.template]) -} ] diff --git a/demo/Demo/Snackbar.elm b/demo/Demo/Snackbar.elm index b1ab490..fd643ed 100644 --- a/demo/Demo/Snackbar.elm +++ b/demo/Demo/Snackbar.elm @@ -22,11 +22,13 @@ import Demo.Page as Page type alias Mdl = - Material.Model Action + Material.Model type Square' = Appearing + | Waiting + | Active | Idle | Disappearing @@ -38,6 +40,7 @@ type alias Square = type alias Model = { count : Int , squares : List Square + , snackbar : Snackbar.Model Int , mdl : Mdl } @@ -46,6 +49,7 @@ model : Model model = { count = 0 , squares = [] + , snackbar = Snackbar.model , mdl = Material.model } @@ -57,19 +61,20 @@ type Action = AddSnackbar | AddToast | Appear Int - | Disappear Int | Gone Int + | Snackbar (Snackbar.Action Int) | MDL (Material.Action Action) -add : Model -> (Int -> Snackbar.Contents Action) -> (Model, Effects Action) -add model f = +add : (Int -> Snackbar.Contents Int) -> Model -> (Model, Effects Action) +add f model = let - (mdl', fx) = - Snackbar.add (f model.count) snackbar model.mdl + (snackbar', fx) = + Snackbar.add (f model.count) model.snackbar + |> map2nd (Effects.map Snackbar) model' = { model - | mdl = mdl' + | snackbar = snackbar' , count = model.count + 1 , squares = (model.count, Appearing) :: model.squares } @@ -92,24 +97,31 @@ mapSquare k f model = } - update : Action -> Model -> (Model, Effects Action) update action model = case action of AddSnackbar -> - add model - <| \k -> Snackbar.snackbar ("Snackbar message #" ++ toString k) "UNDO" (Disappear k) + add (\k -> Snackbar.snackbar k ("Snackbar message #" ++ toString k) "UNDO") model AddToast -> - add model - <| \k -> Snackbar.toast <| "Toast message #" ++ toString k + add (\k -> Snackbar.toast k <| "Toast message #" ++ toString k) model Appear k -> + ( model |> mapSquare k (\sq -> if sq == Appearing then Waiting else sq) + , none + ) + + Snackbar (Snackbar.Begin k) -> + ( model |> mapSquare k (always Active) + , none + ) + + Snackbar (Snackbar.End k) -> ( model |> mapSquare k (always Idle) , none ) - Disappear k -> + Snackbar (Snackbar.Click k) -> ( model |> mapSquare k (always Disappearing) , delay transitionLength (Gone k) ) @@ -120,6 +132,11 @@ update action model = } , none) + Snackbar action' -> + Snackbar.update action' model.snackbar + |> map1st (\s -> { model | snackbar = s }) + |> map2nd (Effects.map Snackbar) + MDL action' -> Material.update MDL action' model.mdl |> map1st (\m -> { model | mdl = m }) @@ -143,12 +160,6 @@ addToastButton = [ Button.fwdClick AddToast ] --- TODO: Bad name -snackbar : Snackbar.Instance Mdl Action -snackbar = - Snackbar.instance MDL Snackbar.model - - boxHeight : String boxHeight = "48px" @@ -166,27 +177,38 @@ transitions = ("transition" , "box-shadow 333ms ease-in-out 0s, " ++ "width " ++ toString transitionLength ++ "ms, " - ++ "height " ++ toString transitionLength ++ "ms" + ++ "height " ++ toString transitionLength ++ "ms, " + ++ "background-color " ++ toString transitionLength ++ "ms" ) clickView : Model -> Square -> Html clickView model (k, square) = let - color = + palette = Array.get ((k + 4) % Array.length Color.palette) Color.palette |> Maybe.withDefault Color.Teal - |> flip Color.color Color.S500 + + shade = + case square of + Idle -> + Color.S100 + + _ -> + Color.S500 + + color = + Color.color palette shade selected' = - Snackbar.activeAction (snackbar.get model.mdl) == Just (Disappear k) + square == Active (width, height, margin, selected) = - case square of - Idle -> - (boxWidth, boxHeight, "16px 16px", selected') - _ -> - ("0", "0", "16px 0", False) + if square == Appearing || square == Disappearing then + ("0", "0", "16px 0", False) + else + (boxWidth, boxHeight, "16px 16px", selected') + in div [ style @@ -236,7 +258,7 @@ view addr model = [ text """Click the buttons below to activate the snackbar. Note that multiple activations are automatically queued.""" ] - , grid [ ] --css "margin-top" "32px" ] + , grid [ ] [ cell [ size All 2, size Phone 2, align Top ] [ addToastButton.view addr model.mdl @@ -261,7 +283,7 @@ view addr model = ] (model.squares |> List.reverse |> List.map (clickView model)) ] - , snackbar.view addr model.mdl + , Snackbar.view (Signal.forwardTo addr Snackbar) model.snackbar ] diff --git a/demo/Demo/Textfields.elm b/demo/Demo/Textfields.elm index 46a54dc..da0dfa5 100644 --- a/demo/Demo/Textfields.elm +++ b/demo/Demo/Textfields.elm @@ -16,7 +16,7 @@ import Demo.Page as Page type alias Model = - { mdl : Material.Model Action + { mdl : Material.Model , rx : (String, Regex.Regex) } @@ -108,7 +108,7 @@ m0 = type alias Mdl = - Material.Model Action + Material.Model field0 : Textfield.Instance Mdl Action diff --git a/src/Material.elm b/src/Material.elm index 73e056b..217f88b 100644 --- a/src/Material.elm +++ b/src/Material.elm @@ -36,6 +36,10 @@ We recommend going with the library's [component support](http://github.com/debois/elm-mdl/blob/master/examples/Component.elm) rather than working directly in plain Elm Architecture. +# TODO + +Using TEA, Style. + # Component Support This module contains only convenience functions for working with nested @@ -153,16 +157,16 @@ import Material.Component as Component exposing (Indexed) user actions in their model (notably Snackbar), the model is generic in the type of such "observations". -} -type alias Model obs = +type alias Model = { button : Indexed Button.Model , textfield : Indexed Textfield.Model - , snackbar : Maybe (Snackbar.Model obs) + , snackbar : Maybe (Snackbar.Model Int) } {-| Initial model. -} -model : Model obs +model : Model model = { button = Dict.empty , textfield = Dict.empty @@ -173,7 +177,7 @@ model = {-| Action encompassing actions of all Material components. -} type alias Action obs = - Component.Action (Model obs) obs + Component.Action Model obs {-| Update function for the above Action. @@ -181,7 +185,7 @@ type alias Action obs = update : (Action obs -> obs) -> Action obs - -> Model obs - -> (Model obs, Effects obs) + -> Model + -> (Model, Effects obs) update = Component.update diff --git a/src/Material/Snackbar.elm b/src/Material/Snackbar.elm index 95bd42e..acbf2b2 100644 --- a/src/Material/Snackbar.elm +++ b/src/Material/Snackbar.elm @@ -1,23 +1,26 @@ module Material.Snackbar - ( Contents, Model, model, toast, snackbar, isActive, activeAction - , Action(Add, Action), update + ( Contents, Model, add, model, toast, snackbar + , Action(Begin, End, Click), update , view - , Instance, instance, add ) where -{-| TODO +{-| Material Design "Snackbar" component. -# Model -@docs Contents, Model, model, toast, snackbar, isActive, activeAction +For live demo and intended use, see +[here](http://localhost:8000/Demo.elm#/snackbar). -# Action, Update +# Generating messages +@docs Contents, toast, snackbar, add + +# Elm Architecture + +@docs Model, model @docs Action, update - -# View @docs view # Component support -@docs Instance, add, instance +Snackbar does not have component support. It must be used as a regular TEA +component. -} import Html exposing (..) @@ -28,33 +31,49 @@ import Task import Time exposing (Time) import Maybe exposing (andThen) -import Material.Component as Component exposing (Indexed) -import Material.Helpers exposing (mapFx, addFx, delay) +import Material.Helpers exposing (map2nd, delay) + -- MODEL -{-| TODO + +{-| Defines a single snackbar message. Usually, you would use either `toast` +or `snackbar` to construct `Contents`. + + - `message` defines the (text) message displayed + - `action` defines a label for the action-button in the snackbar. If + no action is provided, the snackbar is a message-only toast. + - `payload` defines the data returned by Snackbar actions for this message. + You will usually choose this to be an Action of yours for later dispatch, + e.g., if your snackbar has an "Undo" action, you would store the + corresponding action as the payload. + - `timeout` is the amount of time the snackbar should be visible + - `fade` is the duration of the fading animation of the snackbar. + +If you are satsified with the default timeout and fade, do not construct +values of this type yourself; use `snackbar` and `toast` below instead. -} type alias Contents a = { message : String - , action : Maybe (String, a) + , action : Maybe String + , payload : a , timeout : Time , fade : Time } -{-| TODO +{-| Do not construct this yourself; use `model` below. -} type alias Model a = { queue : List (Contents a) - , state : State' a + , state : State a , seq : Int } -{-| TODO +{-| Default snackbar model. -} model : Model a model = @@ -64,66 +83,37 @@ model = } - - -{-| Generate default toast with given message. -Timeout is 2750ms, fade 250ms. +{-| Generate toast with given payload and message. Timeout is 2750ms, fade 250ms. -} -toast : String -> Contents a -toast message = +toast : a -> String -> Contents a +toast payload message = { message = message , action = Nothing + , payload = payload , timeout = 2750 , fade = 250 } -{-| Generate default snackbar with given message, -action-label, and action. Timeout is 2750ms, fade 250ms. +{-| Generate snackbar with given payload, message and label. +Timeout is 2750ms, fade 250ms. -} -snackbar : String -> String -> a -> Contents a -snackbar message actionMessage action = +snackbar : a -> String -> String -> Contents a +snackbar payload message label = { message = message - , action = Just (actionMessage, action) + , action = Just label + , payload = payload , timeout = 2750 , fade = 250 } -{-| TODO -(Bad name) --} -isActive : Model a -> Maybe (Contents a) -isActive model = - case model.state of - Active c -> - Just c - - _ -> - Nothing - - -{-| TODO --} -activeAction : Model a -> Maybe a -activeAction model = - isActive model - |> flip Maybe.andThen .action - |> Maybe.map snd - - -contentsOf : Model a -> Maybe (Contents a) -contentsOf model = - case model.state of - Inert -> Nothing - Active contents -> Just contents - Fading contents -> Just contents - -- SNACKBAR STATE MACHINE -type State' a + +type State a = Inert | Active (Contents a) | Fading (Contents a) @@ -131,40 +121,65 @@ type State' a type Transition = Timeout - | Click + | Clicked -move : Transition -> Model a -> (Model a, Effects Transition) +forward : a -> Effects a +forward = Task.succeed >> Effects.task + + +next : Model a -> Effects Transition -> Effects (Action a) +next model = + Effects.map (Move model.seq) + + +move : Transition -> Model a -> (Model a, Effects (Action a)) move transition model = case (model.state, transition) of (Inert, Timeout) -> tryDequeue model - (Active contents, _) -> + (Active contents, Clicked) -> ( { model | state = Fading contents } - , delay contents.fade Timeout + , Effects.batch + [ delay contents.fade Timeout |> next model + , Click contents.payload |> forward + ] + ) + + (Active contents, Timeout) -> + ( { model | state = Fading contents } + , Effects.batch + [ delay contents.fade Timeout |> next model + , Begin contents.payload |> forward + ] ) (Fading contents, Timeout) -> ( { model | state = Inert} - , Effects.tick (\_ -> Timeout) + , Effects.batch + [ always Timeout |> Effects.tick |> next model + , End contents.payload |> forward + ] ) _ -> (model, none) + -- NOTIFICATION QUEUE + enqueue : Contents a -> Model a -> Model a enqueue contents model = { model - | queue = List.append model.queue [contents] + | queue = List.append model.queue [contents] } -tryDequeue : Model a -> (Model a, Effects Transition) +tryDequeue : Model a -> (Model a, Effects (Action a)) tryDequeue model = case (model.state, model.queue) of (Inert, c :: cs) -> @@ -173,93 +188,86 @@ tryDequeue model = , queue = cs , seq = model.seq + 1 } - , delay c.timeout Timeout + , Effects.batch + [ delay c.timeout Timeout |> Effects.map (Move (model.seq + 1)) + , forward (Begin c.payload) + ] ) _ -> (model, none) + -- ACTIONS, UPDATE -{-| TODO + +{-| Elm Architecture Action type. +The following actions are observable to you: +- `Begin a`. The snackbar is now displaying the message with payload `a`. +- `End a`. The snackbar is done displaying the message with payload `a`. +- `Click a`. The user clicked the action on the message with payload `a`. +You can consume these three actions without forwarding them to `Snackbar.update`. +(You still need to forward other Snackbar actions.) -} type Action a - = Add (Contents a) - | Action a + = Begin a + | End a + | Click a + -- Private | 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 +{-| Elm Architecture update function. -} 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) + _ -> + -- Begin, End, Click are for external consumption only. + (model, none) + + +{-| Add a message to the snackbar. If another message is currently displayed, +the provided message will be queued. You will be able to observe a `Begin` action +(see `Action` above) once the action begins displaying. + +You must dispatch the returned effect for the Snackbar to begin displaying your +message. +-} +add : Contents a -> Model a -> (Model a, Effects (Action a)) +add contents model = + enqueue contents model |> tryDequeue + + -- VIEW -{-| + +{-| Elm architecture update function. -} view : Signal.Address (Action a) -> Model a -> Html -view addr model = +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 ([], []) + contents = + case model.state of + Inert -> Nothing + Active c -> Just c + Fading c -> Just c isActive = case model.state of Inert -> False Active _ -> True - Fading _ -> False + Fading _ -> False in div [ classList @@ -272,70 +280,44 @@ view addr model = [ div [ class "mdl-snackbar__text" ] - textBody + (contents + |> Maybe.map (\c -> [ text c.message ]) + |> Maybe.withDefault [] + ) , button ( class "mdl-snackbar__action" :: type' "button" -- :: ariaHidden "true" - :: buttonHandler + :: ( contents + |> flip Maybe.andThen .action + |> Maybe.map (always [ onClick addr (Move model.seq Clicked) ]) + |> Maybe.withDefault [] + ) + ) + ( contents + |> flip Maybe.andThen .action + |> Maybe.map (\action -> [ text action ]) + |> Maybe.withDefault [] ) - buttonBody ] + -- COMPONENT -{-| +{- Component support for Snackbar is currently disabled. The type "Model a" of +the Snackbar Model escapes into the global Mdl model, polluting users model +with the type variable "a". This is unacceptable in itself; it makes +component support too hard to use for non-expert users. + +This problem is compounded by the elm compiler bug +[#1192](https://github.com/elm-lang/elm-compiler/issues/1192), which causes +(apparently) unhelpful error messages on errors related to wrong use of type +constructors. + +Component support for snackbar was implemented earlier. In case a solution +presents itself, the last commit to contain this support was: + +f0a85912654713238694f48b1a4b7d5a7459965f -} -type alias Container s obs = - { s | snackbar : Maybe (Model obs) } - - -{-| --} -type alias Instance container obs = - Component.Instance (Model obs) container (Action obs) obs Html - - -{-| --} -type alias Observer obs = - Component.Observer (Action obs) obs - - -actionObserver : Observer ons -actionObserver action = - case action of - Action action' -> - Just action' - - _ -> - Nothing - - -{-| Component instance. --} -instance - : (Component.Action (Container c obs) obs -> obs) - -> (Model obs) - -> Instance (Container c obs) obs - -instance lift model0 = - Component.instance1 - view update .snackbar (\x y -> {y | snackbar = x}) lift model0 [ actionObserver ] - -{-| - TODO --} -add : - Contents obs - -> Instance (Container c obs) obs - -> (Container c obs) - -> (Container c obs, Effects obs) -add contents inst model = - let - (sb, fx) = - update (Add contents) (inst.get model) - in - (inst.set sb model, Effects.map inst.fwd fx)