Removed native code, now depends on debois/elm-dom.

elm-package.json

@@ -17,6 +17,7 @@
     ],
     "native-modules": true,
     "dependencies": {
+        "debois/elm-dom": "1.0.0 <= v < 2.0.0",
         "elm-lang/core": "3.0.0 <= v < 4.0.0",
         "evancz/elm-effects": "2.0.1 <= v < 3.0.0",
         "evancz/elm-html": "4.0.2 <= v < 5.0.0",

src/Material/Aux.elm

@@ -2,10 +2,7 @@ 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 =
@@ -23,18 +20,6 @@ mapWithIndex f xs =
     loop 0 xs
 
 
-
-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)
 
@@ -47,63 +32,6 @@ 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()"

src/Material/Ripple.elm

@@ -7,13 +7,14 @@ import Json.Decode as Json exposing ((:=), at)
 import Effects exposing (Effects, tick, none)
 
 import Material.Aux exposing (Rectangle, rectangleDecoder, effect)
+import DOM
 
 
 -- MODEL
 
 
 type alias Metrics =
-  { rect : Rectangle
+  { rect : DOM.Rectangle
   , x : Float
   , y : Float
   }
@@ -41,7 +42,7 @@ model =
 
 
 type alias Geometry =
-  { rect : Rectangle
+  { rect : DOM.Rectangle
   , clientX : Maybe Float
   , clientY : Maybe Float
   , touchX : Maybe Float
@@ -52,21 +53,22 @@ type alias Geometry =
 geometryDecoder : Json.Decoder Geometry
 geometryDecoder =
   Json.object5 Geometry
-    rectangleDecoder
+    (DOM.target DOM.boundingClientRect)
     (Json.maybe ("clientX" := Json.float))
     (Json.maybe ("clientY" := Json.float))
     (Json.maybe (at ["touches", "0", "clientX"] Json.float))
     (Json.maybe (at ["touches", "0", "clientY"] Json.float))
 
 
-computeMetrics : Geometry -> Metrics
+computeMetrics : Geometry -> Maybe Metrics
 computeMetrics g =
   let
     rect = g.rect
-    set x y = (x - rect.left, y - rect.top)
+    set x y = (x - rect.left, y - rect.top) |> Just
-    (x,y) = case (g.clientX, g.clientY, g.touchX, g.touchY) of
+  in
+    (case (g.clientX, g.clientY, g.touchX, g.touchY) of
       (Just 0.0, Just 0.0, _, _) ->
-        (rect.width / 2.0, rect.height / 2.0)
+        (rect.width / 2.0, rect.height / 2.0) |> Just
 
       (Just x, Just y, _, _) ->
         set x y
@@ -75,12 +77,9 @@ computeMetrics g =
         set x y
 
       _ ->
-        Debug.crash "Impossible value from geometryDecoder"
+        Nothing
-  in
+
-    { rect = rect
+    ) |> Maybe.map (\(x,y) -> Metrics rect x y)
-    , x = x
-    , y = y
-    }
 
 
 type Action
@@ -95,7 +94,7 @@ update action model =
     Down geometry ->
       { model
       | animation = Frame 0
-      , metrics = computeMetrics geometry |> Just
+      , metrics = computeMetrics geometry
       }
       |> effect (tick <| \_ -> Tick)
 
@@ -118,12 +117,9 @@ update action model =
 
 downOn : String -> Signal.Address Action -> Attribute
 downOn name addr =
-  Material.Aux.on
+  --Material.Aux.on
+  Html.Events.on
     name
-    { preventDefault = False
-    , stopPropagation = False
-    , withGeometry = True
-    }
     geometryDecoder
     (Down >> Signal.message addr)
 
@@ -144,7 +140,8 @@ styles m frame =
     offset = "translate(" ++ toPx m.x ++ ", " ++ toPx m.y ++ ")"
     transformString = "translate(-50%, -50%) " ++ offset ++ scale
     r = m.rect
-    rippleSize = sqrt (r.width * r.width + r.height * r.height) * 2 + 2 |> toPx
+    rippleSize =
+      sqrt (r.width * r.width + r.height * r.height) * 2.0 + 2.0 |> toPx
   in
     [ ("width", rippleSize)
     , ("height", rippleSize)
@@ -173,12 +170,12 @@ view addr attrs model =
       :: attrs
       )
       [ span
-          [ classList
+        [ classList
-              [ ("mdl-ripple", True)
+          [ ("mdl-ripple", True)
-              , ("is-animating", model.animation /= Frame 0)
+          , ("is-animating", model.animation /= Frame 0)
-              , ("is-visible", model.animation /= Inert)
+          , ("is-visible", model.animation /= Inert)
-              ]
-          , style styling
           ]
-          []
+        , style styling
+        ]
+        []
       ]

src/Native/Material.js

@@ -1,50 +0,0 @@
-/*
- * Helper functions for accessing Google Material Design lite.
- */
-
-// ELM Boilerplate
-Elm.Native.Material = {};
-Elm.Native.Material.make = function(elm) {
-  elm.Native = elm.Native || {};
-  elm.Native.Material = elm.Native.Material || {};
-  if (elm.Native.Material.values) {
-    return elm.Native.Material.values;
-  }
-
-  var Signal = Elm.Native.Signal.make(elm);
-  var Json = Elm.Native.Json.make(elm);
-
-  function property(key, value) {
-    return { key: key, value: value };
-  }
-
-  function on(name, options, decoder, createMessage)
-  {
-    function eventHandler(event)
-    {
-      if (options.withGeometry)
-      {
-        event.boundingClientRect = event.currentTarget.getBoundingClientRect();
-      }
-      var value = A2(Json.runDecoderValue, decoder, event);
-      if (value.ctor === 'Ok')
-      {
-        if (options.stopPropagation)
-        {
-          event.stopPropagation();
-        }
-        if (options.preventDefault)
-        {
-          event.preventDefault();
-        }
-        Signal.sendMessage(createMessage(value._0));
-      }
-    }
-
-    return property('on' + name, eventHandler);
-  }
-
-  return elm.Native.Material.values = {
-    on : F4(on)
-  }
-}