From 02983df4bd074b325648c4f9c644510dbaceda71 Mon Sep 17 00:00:00 2001 From: Benedict Aas Date: Thu, 25 Jul 2019 16:26:04 +0100 Subject: [PATCH 1/4] Add scroll, scrollTo, scrollBy, scrollIntoView We add [`Element.scroll`][1], [`Element.scrollTo`][2], [`Element.scrollBy`][3], and [`Element.scrollIntoView`][4]. [1]: https://developer.mozilla.org/en-US/docs/Web/API/Element/scroll [2]: https://developer.mozilla.org/en-US/docs/Web/API/Element/scrollTo [3]: https://developer.mozilla.org/en-US/docs/Web/API/Element/scrollBy [4]: https://developer.mozilla.org/en-US/docs/Web/API/Element/scrollIntoView --- src/Web/DOM/Element.js | 36 ++++++++++++++++++ src/Web/DOM/Element.purs | 81 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 117 insertions(+) diff --git a/src/Web/DOM/Element.js b/src/Web/DOM/Element.js index b6dd761..01b6188 100644 --- a/src/Web/DOM/Element.js +++ b/src/Web/DOM/Element.js @@ -133,6 +133,42 @@ exports.setScrollLeft = function (scrollLeft) { }; }; +exports._scroll = function (scrollToOptions) { + return function (node) { + return function () { + node.scroll(scrollToOptions); + return {}; + }; + }; +}; + +exports._scrollTo = function (scrollToOptions) { + return function (node) { + return function () { + node.scrollTo(scrollToOptions); + return {}; + }; + }; +}; + +exports._scrollBy = function (scrollToOptions) { + return function (node) { + return function () { + node.scrollBy(scrollToOptions); + return {}; + }; + }; +}; + +exports._scrollIntoView = function (scrollIntoViewOptions) { + return function (node) { + return function () { + node.scrollIntoView(scrollIntoViewOptions); + return {}; + }; + }; +}; + exports.scrollWidth = function (el) { return function () { return el.scrollWidth; diff --git a/src/Web/DOM/Element.purs b/src/Web/DOM/Element.purs index b02366e..b5f4466 100644 --- a/src/Web/DOM/Element.purs +++ b/src/Web/DOM/Element.purs @@ -29,6 +29,14 @@ module Web.DOM.Element , setScrollTop , scrollLeft , setScrollLeft + , ScrollToOptions + , ScrollBehavior + , ScrollAlignment + , scroll + , scrollTo + , scrollBy + , ScrollIntoViewOptions + , scrollIntoView , scrollWidth , scrollHeight , clientTop @@ -121,6 +129,79 @@ foreign import setScrollTop :: Number -> Element -> Effect Unit foreign import scrollLeft :: Element -> Effect Number foreign import setScrollLeft :: Number -> Element -> Effect Unit +data ScrollBehavior = Auto | Smooth + +stringScrollBehavior :: ScrollBehavior -> String +stringScrollBehavior Auto = "auto" +stringScrollBehavior Smooth = "smooth" + +type ScrollToOptions = + { top :: Number + , left :: Number + , behavior :: ScrollBehavior + } + +type ScrollToOptions_ = + { top :: Number + , left :: Number + , behavior :: String + } + +foreign import _scroll :: Element -> ScrollToOptions_ -> Effect Unit + +scroll :: Element -> ScrollToOptions -> Effect Unit +scroll elem _opts = _scroll elem opts + where + opts = let { top,left, behavior } = _opts + in { top, left, behavior: stringScrollBehavior behavior } + +foreign import _scrollTo :: Element -> ScrollToOptions_ -> Effect Unit + +scrollTo :: Element -> ScrollToOptions -> Effect Unit +scrollTo elem _opts = _scrollTo elem opts + where + opts = let { top,left, behavior } = _opts + in { top, left, behavior: stringScrollBehavior behavior } + +foreign import _scrollBy :: Element -> ScrollToOptions_ -> Effect Unit + +scrollBy :: Element -> ScrollToOptions -> Effect Unit +scrollBy elem _opts = _scrollBy elem opts + where + opts = let { top,left, behavior } = _opts + in { top, left, behavior: stringScrollBehavior behavior } + +data ScrollAlignment = Start | Center | End | Nearest + +stringScrollAlignment :: ScrollAlignment -> String +stringScrollAlignment Start = "start" +stringScrollAlignment Center = "center" +stringScrollAlignment End = "end" +stringScrollAlignment Nearest = "nearest" + +type ScrollIntoViewOptions = + { behavior :: ScrollBehavior + , block :: ScrollAlignment + , inline :: ScrollAlignment + } + +type ScrollIntoViewOptions_ = + { behavior :: String + , block :: String + , inline :: String + } + +foreign import _scrollIntoView :: Element -> ScrollIntoViewOptions_ -> Effect Unit + +scrollIntoView :: Element -> ScrollIntoViewOptions -> Effect Unit +scrollIntoView elem _opts = _scrollIntoView elem opts + where + opts = let { behavior, block, inline } = _opts + in { behavior: stringScrollBehavior behavior + , block: stringScrollAlignment block + , inline: stringScrollAlignment inline + } + foreign import scrollWidth :: Element -> Effect Number foreign import scrollHeight :: Element -> Effect Number foreign import clientTop :: Element -> Effect Number From c557720bdf067a32e9ffb01c1040036831f40e52 Mon Sep 17 00:00:00 2001 From: Benedict Aas Date: Fri, 26 Jul 2019 10:08:37 +0100 Subject: [PATCH 2/4] use record update syntax --- src/Web/DOM/Element.purs | 24 +++++++----------------- 1 file changed, 7 insertions(+), 17 deletions(-) diff --git a/src/Web/DOM/Element.purs b/src/Web/DOM/Element.purs index b5f4466..c4ea2eb 100644 --- a/src/Web/DOM/Element.purs +++ b/src/Web/DOM/Element.purs @@ -150,26 +150,17 @@ type ScrollToOptions_ = foreign import _scroll :: Element -> ScrollToOptions_ -> Effect Unit scroll :: Element -> ScrollToOptions -> Effect Unit -scroll elem _opts = _scroll elem opts - where - opts = let { top,left, behavior } = _opts - in { top, left, behavior: stringScrollBehavior behavior } +scroll elem opts = _scroll elem (opts { behavior = stringScrollBehavior opts.behavior }) foreign import _scrollTo :: Element -> ScrollToOptions_ -> Effect Unit scrollTo :: Element -> ScrollToOptions -> Effect Unit -scrollTo elem _opts = _scrollTo elem opts - where - opts = let { top,left, behavior } = _opts - in { top, left, behavior: stringScrollBehavior behavior } +scrollTo elem opts = _scrollTo elem (opts { behavior = stringScrollBehavior opts.behavior }) foreign import _scrollBy :: Element -> ScrollToOptions_ -> Effect Unit scrollBy :: Element -> ScrollToOptions -> Effect Unit -scrollBy elem _opts = _scrollBy elem opts - where - opts = let { top,left, behavior } = _opts - in { top, left, behavior: stringScrollBehavior behavior } +scrollBy elem opts = _scrollBy elem (opts { behavior = stringScrollBehavior opts.behavior }) data ScrollAlignment = Start | Center | End | Nearest @@ -196,11 +187,10 @@ foreign import _scrollIntoView :: Element -> ScrollIntoViewOptions_ -> Effect Un scrollIntoView :: Element -> ScrollIntoViewOptions -> Effect Unit scrollIntoView elem _opts = _scrollIntoView elem opts where - opts = let { behavior, block, inline } = _opts - in { behavior: stringScrollBehavior behavior - , block: stringScrollAlignment block - , inline: stringScrollAlignment inline - } + opts = { behavior: stringScrollBehavior _opts.behavior + , block: stringScrollAlignment _opts.block + , inline: stringScrollAlignment _opts.inline + } foreign import scrollWidth :: Element -> Effect Number foreign import scrollHeight :: Element -> Effect Number From 3e40224c1b3672723983a6813f6e39455be660f6 Mon Sep 17 00:00:00 2001 From: Benedict Aas Date: Fri, 26 Jul 2019 11:25:00 +0100 Subject: [PATCH 3/4] I did an oopsie Swap function argument order so that it coincides with FFI functions. --- src/Web/DOM/Element.purs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/Web/DOM/Element.purs b/src/Web/DOM/Element.purs index c4ea2eb..bad040e 100644 --- a/src/Web/DOM/Element.purs +++ b/src/Web/DOM/Element.purs @@ -147,20 +147,20 @@ type ScrollToOptions_ = , behavior :: String } -foreign import _scroll :: Element -> ScrollToOptions_ -> Effect Unit +foreign import _scroll :: ScrollToOptions_ -> Element -> Effect Unit -scroll :: Element -> ScrollToOptions -> Effect Unit -scroll elem opts = _scroll elem (opts { behavior = stringScrollBehavior opts.behavior }) +scroll :: ScrollToOptions -> Element -> Effect Unit +scroll opts = _scroll (opts { behavior = stringScrollBehavior opts.behavior }) -foreign import _scrollTo :: Element -> ScrollToOptions_ -> Effect Unit +foreign import _scrollTo :: ScrollToOptions_ -> Element -> Effect Unit -scrollTo :: Element -> ScrollToOptions -> Effect Unit -scrollTo elem opts = _scrollTo elem (opts { behavior = stringScrollBehavior opts.behavior }) +scrollTo :: ScrollToOptions -> Element -> Effect Unit +scrollTo opts = _scrollTo (opts { behavior = stringScrollBehavior opts.behavior }) -foreign import _scrollBy :: Element -> ScrollToOptions_ -> Effect Unit +foreign import _scrollBy :: ScrollToOptions_ -> Element -> Effect Unit -scrollBy :: Element -> ScrollToOptions -> Effect Unit -scrollBy elem opts = _scrollBy elem (opts { behavior = stringScrollBehavior opts.behavior }) +scrollBy :: ScrollToOptions -> Element -> Effect Unit +scrollBy opts = _scrollBy (opts { behavior = stringScrollBehavior opts.behavior }) data ScrollAlignment = Start | Center | End | Nearest @@ -182,10 +182,10 @@ type ScrollIntoViewOptions_ = , inline :: String } -foreign import _scrollIntoView :: Element -> ScrollIntoViewOptions_ -> Effect Unit +foreign import _scrollIntoView :: ScrollIntoViewOptions_ -> Element -> Effect Unit -scrollIntoView :: Element -> ScrollIntoViewOptions -> Effect Unit -scrollIntoView elem _opts = _scrollIntoView elem opts +scrollIntoView :: ScrollIntoViewOptions -> Element -> Effect Unit +scrollIntoView _opts = _scrollIntoView opts where opts = { behavior: stringScrollBehavior _opts.behavior , block: stringScrollAlignment _opts.block From 57e117c179c9ad9dfec10bc9decbaaa512b388da Mon Sep 17 00:00:00 2001 From: Benedict Aas Date: Fri, 26 Jul 2019 11:48:54 +0100 Subject: [PATCH 4/4] export data constructors --- src/Web/DOM/Element.purs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Web/DOM/Element.purs b/src/Web/DOM/Element.purs index bad040e..9cc9feb 100644 --- a/src/Web/DOM/Element.purs +++ b/src/Web/DOM/Element.purs @@ -30,8 +30,8 @@ module Web.DOM.Element , scrollLeft , setScrollLeft , ScrollToOptions - , ScrollBehavior - , ScrollAlignment + , ScrollBehavior(..) + , ScrollAlignment(..) , scroll , scrollTo , scrollBy