commit c8b82a9a417945d5d9be43efc1e8a535e8388e59 Author: Søren Debois Date: Tue Mar 8 17:30:09 2016 +0100 Initial commit. diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..4ad753b --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +elm-stuff +.*.sw? diff --git a/Buttons.elm b/Buttons.elm new file mode 100644 index 0000000..7953ec3 --- /dev/null +++ b/Buttons.elm @@ -0,0 +1,142 @@ +module Buttons where + +import Dict +import Html exposing (..) +import Html.Attributes exposing (..) +import Effects + +import Material.Button as Button exposing (Appearance(..), Coloring(..)) +import Material.Grid as Grid +import Material.Icon as Icon + + +-- MODEL + + +type alias Index = (Int, Int) + + +tabulate' : Int -> List a -> List (Int, a) +tabulate' i ys = + case ys of + [] -> [] + y :: ys -> (i, y) :: tabulate' (i+1) ys + + +tabulate : List a -> List (Int, a) +tabulate = tabulate' 0 + + +row : Appearance -> Bool -> List (Int, (Bool, Button.Config)) +row appearance ripple = + [ Plain, Colored, Primary, Accent ] + |> List.map (\c -> (ripple, { coloring = c, appearance = appearance })) + |> tabulate + + +buttons : List (List (Index, (Bool, Button.Config))) +buttons = + [Flat, Raised, FAB, MiniFAB, Icon] + |> List.concatMap (\a -> [row a False, row a True]) + |> tabulate + |> List.map (\(i, row) -> List.map (\(j, x) -> ((i,j), x)) row) + + +model : Model +model = + { clicked = "" + , buttons = + buttons + |> List.concatMap (List.map <| \(idx, (ripple, _)) -> (idx, Button.model ripple)) + |> Dict.fromList + } + + +-- ACTION, UPDATE + + +type Action = Action Index Button.Action + + +type alias Model = + { clicked : String + , buttons : Dict.Dict Index Button.Model + } + + +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) + + +-- VIEW + + +describe : Bool -> Button.Config -> String +describe ripple config = + let + appearance = + case config.appearance of + Flat -> "flat" + Raised -> "raised" + FAB -> "FAB" + MiniFAB -> "mini-FAB" + Icon -> "icon" + coloring = + case config.coloring of + Plain -> "plain" + Colored -> "colored" + Primary -> "primary" + Accent -> "accent" + in + appearance ++ ", " ++ coloring ++ if ripple then " w/ripple" else "" + + + +view : Signal.Address Action -> Model -> Html +view addr model = + buttons |> List.concatMap (\row -> + row |> List.map (\(idx, (ripple, config)) -> + let model' = + Dict.get idx model.buttons |> Maybe.withDefault (Button.model False) + in + Grid.cell + [ Grid.col Grid.All 3] + [ div + [ style + [ ("text-align", "center") + , ("margin-top", "1em") + , ("margin-bottom", "1em") + ] + ] + [ Button.view + (Signal.forwardTo addr (Action idx)) + config + model' + [] + [ case config.appearance 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", "1em") + ] + ] + [ text <| describe ripple config ] + ] + ] + ) + ) + |> Grid.grid diff --git a/Demo.elm b/Demo.elm new file mode 100644 index 0000000..8c79763 --- /dev/null +++ b/Demo.elm @@ -0,0 +1,232 @@ +import StartApp +import Html exposing (..) +import Html.Attributes exposing (href, class, style) +import Signal exposing (Signal) +import Effects exposing (..) +import Task +import Signal +import Task exposing (Task) +import Dict exposing (Dict) + +import Material.Textfield as Textfield +import Material.Grid as Grid exposing (Device(..)) +import Material.Layout as Layout + +import Buttons + + +-- MODEL + + +type alias Model = + { layout : Layout.Model + , buttons : Buttons.Model + , t0 : Textfield.Model + , t1 : Textfield.Model + , t2 : Textfield.Model + , t3 : Textfield.Model + , t4 : Textfield.Model + } + + +layoutModel : Layout.Model +layoutModel = + { selectedTab = "Buttons" + , isDrawerOpen = False + , state = Layout.initState ["Buttons", "Grid", "Textfields"] + } + + +model : Model +model = + let t0 = Textfield.model in + { layout = layoutModel + , buttons = Buttons.model + , t0 = t0 + , t1 = { t0 | label = Just { text = "Labelled", float = False } } + , t2 = { t0 | label = Just { text = "Floating label", float = True }} + , t3 = { t0 + | label = Just { text = "Disabled", float = False } + , isDisabled = True + } + , t4 = { t0 + | label = Just { text = "With error and value", float = False } + , error = Just "The input is wrong!" + , value = "Incorrect input" + } + } + + +-- ACTION, UPDATE + + +type Action + = LayoutAction Layout.Action + | ButtonsAction Buttons.Action + | T0 Textfield.Action + | T1 Textfield.Action + | T2 Textfield.Action + | T3 Textfield.Action + | T4 Textfield.Action + + +update : Action -> Model -> (Model, Effects.Effects Action) +update action model = + case action of + LayoutAction a -> + let + (l, e) = Layout.update a model.layout + in + ({ model | layout = l }, Effects.map LayoutAction e) + + ButtonsAction a -> + let (b, e) = Buttons.update a model.buttons + in + ({ model | buttons = b }, Effects.map ButtonsAction e) + + T0 a -> + ({ model | t0 = Textfield.update a model.t0 }, Effects.none) + + T1 a -> + ({ model | t1 = Textfield.update a model.t1 }, Effects.none) + + T2 a -> + ({ model | t2 = Textfield.update a model.t2 }, Effects.none) + + T3 a -> + ({ model | t3 = Textfield.update a model.t3 }, Effects.none) + + T4 a -> + ({ model | t4 = Textfield.update a model.t4 }, Effects.none) + + +-- VIEW + + +type alias Addr = Signal.Address Action + + +layoutConfig : Layout.Config +layoutConfig = Layout.defaultConfig + + +drawer : List Html +drawer = + [ Layout.title "elm-mdl" + , Layout.navigation + [ Layout.link [] [text "Dead Link 1"] + , Layout.link [] [text "Dead Link 2"] + , Layout.link [] [text "Dead Link 3"] + ] + ] + + +header : List Html +header = + [ Layout.title "elm-mdl" + , Layout.spacer + , Layout.navigation + [ Layout.link + [ href "https://www.getmdl.io/components/index.html" ] + [ text "MDL" ] + ] + ] + + +tabGrid : Addr -> Model -> List Html +tabGrid addr model = + [ Grid.grid + [ Grid.cell [ Grid.col All 4 ] + [ h4 [] [text "Cell 1"] ] + , Grid.cell [ Grid.offset All 2, Grid.col All 4 ] + [ h4 [] [text "Cell 2"], p [] [text "This cell is offset by 2"] ] + , Grid.cell [ Grid.col All 6 ] + [ h4 [] [text "Cell 3"] ] + , Grid.cell [ Grid.col Tablet 6, Grid.col Desktop 12, Grid.col Phone 2 ] + [ h4 [] [text "Cell 4"], p [] [text "Size varies with device"] ] + ] + ] + + +tabButtons : Addr -> Model -> List Html +tabButtons addr model = + [ Buttons.view (Signal.forwardTo addr ButtonsAction) model.buttons ] + + +tabTextfields : Addr -> Model -> List Html +tabTextfields addr model = + let fwd = Signal.forwardTo addr in + [ Textfield.view (fwd T0) model.t0 + , Textfield.view (fwd T1) model.t1 + , Textfield.view (fwd T2) model.t2 + , Textfield.view (fwd T3) model.t3 + , Textfield.view (fwd T4) model.t4 + ] + |> List.map (\elem -> Grid.cell [ Grid.col All 4 ] [elem]) + |> (\content -> [Grid.grid content]) + + + +tabs : Dict String (Addr -> Model -> List Html) +tabs = + Dict.fromList + [ ("Buttons", tabButtons) + , ("Textfields", tabTextfields) + , ("Grid", tabGrid) + ] + + +view : Signal.Address Action -> Model -> Html +view addr model = + let contents = + Dict.get model.layout.selectedTab tabs + |> Maybe.withDefault tabGrid + + top = + div + [ style + [ ("margin", "auto") + , ("width", "90%") + ] + ] + <| contents addr model + + addr' = Signal.forwardTo addr LayoutAction + + in + Layout.view addr' + layoutConfig model.layout + (Just drawer, Just header) + [ top ] + + +init : (Model, Effects.Effects Action) +init = (model, Effects.none) + + +inputs : List (Signal.Signal Action) +inputs = + [ Layout.setupSizeChangeSignal LayoutAction + ] + + +app : StartApp.App Model +app = + StartApp.start + { init = init + , view = view + , update = update + , inputs = inputs + } + +main : Signal Html +main = + app.html + + +-- PORTS + + +port tasks : Signal (Task.Task Never ()) +port tasks = + app.tasks diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..2613999 --- /dev/null +++ b/Makefile @@ -0,0 +1,7 @@ +elm.js: + elm-make elm-mdl-demo.elm --output elm.js + +clean: + rm -rf elm-stuff/build-artifacts elm.js + +.PHONY: clean elm.js diff --git a/Material/Aux.elm b/Material/Aux.elm new file mode 100644 index 0000000..338e993 --- /dev/null +++ b/Material/Aux.elm @@ -0,0 +1,97 @@ +module Material.Aux where + +import Html +import Html.Attributes +import Html.Events +import Json.Decode as Json exposing ((:=)) +import Effects exposing (Effects) +import Native.Material + +filter : (a -> List b -> c) -> a -> List (Maybe b) -> c +filter elem attr html = + elem attr (List.filterMap (\x -> x) html) + + +onClick' : Signal.Address a -> a -> Html.Attribute +onClick' address x = + Html.Events.onWithOptions + "click" + { stopPropagation = True + , preventDefault = True + } + Json.value + (\_ -> Signal.message address x) + + +effect : Effects b -> a -> (a, Effects b) +effect e x = (x, e) + + +pure : a -> (a, Effects b) +pure = effect Effects.none + + +clip : comparable -> comparable -> comparable -> comparable +clip lower upper k = Basics.max lower (Basics.min k upper) + + +type alias Rectangle = + { width : Float + , height : Float + , top : Float + , right : Float + , bottom : Float + , left : Float + } + + +rectangleDecoder : Json.Decoder Rectangle +rectangleDecoder = + "boundingClientRect" := + Json.object6 Rectangle + ("width" := Json.float) + ("height" := Json.float) + ("top" := Json.float) + ("right" := Json.float) + ("bottom" := Json.float) + ("left" := Json.float) + + +{-| Options for an event listener. If `stopPropagation` is true, it means the +event stops traveling through the DOM so it will not trigger any other event +listeners. If `preventDefault` is true, any built-in browser behavior related +to the event is prevented. For example, this is used with touch events when you +want to treat them as gestures of your own, not as scrolls. If `withGeometry` +is true, the event object will be augmented with geometry information for the +events target node; use `geometryDecoder` to decode. +-} +type alias Options = + { stopPropagation : Bool + , preventDefault : Bool + , withGeometry : Bool + } + + +{-| Everything is `False` by default. + defaultOptions = + { stopPropagation = False + , preventDefault = False + , withGeometry = False + } +-} +defaultOptions : Options +defaultOptions = + { stopPropagation = False + , preventDefault = False + , withGeometry = False + } + + +on : String -> Options -> Json.Decoder a -> (a -> Signal.Message) -> Html.Attribute +on = + Native.Material.on + + +blurOn : String -> Html.Attribute +blurOn evt = + Html.Attributes.attribute ("on" ++ evt) <| "this.blur()" diff --git a/Material/Button.elm b/Material/Button.elm new file mode 100644 index 0000000..d84478a --- /dev/null +++ b/Material/Button.elm @@ -0,0 +1,162 @@ +module Material.Button + ( model, update + , Kind(..), Coloring(..), Config + , view + ) where + +{-| From the [Material Design Lite documentation](http://www.getmdl.io/components/#buttons-section): + +> The Material Design Lite (MDL) button component is an enhanced version of the +> standard HTML `