{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Reflex.Dom.Widget.Resize where

import Reflex.Class
import Reflex.Time
import Reflex.Dom.Builder.Class
import Reflex.Dom.Builder.Immediate
import Reflex.Dom.Class
import Reflex.Dom.Widget.Basic
import Reflex.PerformEvent.Class
import Reflex.PostBuild.Class
import Reflex.TriggerEvent.Class

import Control.Monad
import Control.Monad.Fix
import Control.Monad.IO.Class
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import GHCJS.DOM.Element
import GHCJS.DOM.EventM (on)
import qualified GHCJS.DOM.GlobalEventHandlers as Events (scroll)
import GHCJS.DOM.Types (MonadJSM, liftJSM, uncheckedCastTo, HTMLElement(..))
import GHCJS.DOM.HTMLElement (getOffsetWidth, getOffsetHeight)
import qualified GHCJS.DOM.Types as DOM

-- | A widget that wraps the given widget in a div and fires an event when resized.
--   Adapted from @github.com\/marcj\/css-element-queries@
--
-- This function can cause strange scrollbars to appear in some circumstances.
-- These can be hidden with pseudo selectors, for example, in webkit browsers:
-- .wrapper *::-webkit-scrollbar { width: 0px; background: transparent; }
resizeDetector :: (MonadJSM m, DomBuilder t m, PostBuild t m, TriggerEvent t m, PerformEvent t m, MonadHold t m, DomBuilderSpace m ~ GhcjsDomSpace, MonadJSM (Performable m), MonadFix m) => m a -> m (Event t (Maybe Double, Maybe Double), a)
resizeDetector :: m a -> m (Event t (Maybe Double, Maybe Double), a)
resizeDetector = Text -> m a -> m (Event t (Maybe Double, Maybe Double), a)
forall (m :: * -> *) t a.
(MonadJSM m, DomBuilder t m, PostBuild t m, TriggerEvent t m,
 PerformEvent t m, MonadHold t m, DomBuilderSpace m ~ GhcjsDomSpace,
 MonadJSM (Performable m), MonadFix m) =>
Text -> m a -> m (Event t (Maybe Double, Maybe Double), a)
resizeDetectorWithStyle ""

resizeDetectorWithStyle :: (MonadJSM m, DomBuilder t m, PostBuild t m, TriggerEvent t m, PerformEvent t m, MonadHold t m, DomBuilderSpace m ~ GhcjsDomSpace, MonadJSM (Performable m), MonadFix m)
  => Text -- ^ A css style string. Warning: It should not contain the "position" style attribute.
  -> m a -- ^ The embedded widget
  -> m (Event t (Maybe Double, Maybe Double), a) -- ^ An 'Event' that fires on resize, and the result of the embedded widget
resizeDetectorWithStyle :: Text -> m a -> m (Event t (Maybe Double, Maybe Double), a)
resizeDetectorWithStyle styleString :: Text
styleString = Map Text Text -> m a -> m (Event t (Maybe Double, Maybe Double), a)
forall (m :: * -> *) t a.
(MonadJSM m, DomBuilder t m, PostBuild t m, TriggerEvent t m,
 PerformEvent t m, MonadHold t m, DomBuilderSpace m ~ GhcjsDomSpace,
 MonadJSM (Performable m), MonadFix m) =>
Map Text Text -> m a -> m (Event t (Maybe Double, Maybe Double), a)
resizeDetectorWithAttrs ("style" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: Text
IxValue (Map Text Text)
styleString)

resizeDetectorWithAttrs :: (MonadJSM m, DomBuilder t m, PostBuild t m, TriggerEvent t m, PerformEvent t m, MonadHold t m, DomBuilderSpace m ~ GhcjsDomSpace, MonadJSM (Performable m), MonadFix m)
  => Map Text Text -- ^ A map of attributes. Warning: It should not modify the "position" style attribute.
  -> m a -- ^ The embedded widget
  -> m (Event t (Maybe Double, Maybe Double), a) -- ^ An 'Event' that fires on resize, and the result of the embedded widget
resizeDetectorWithAttrs :: Map Text Text -> m a -> m (Event t (Maybe Double, Maybe Double), a)
resizeDetectorWithAttrs attrs :: Map Text Text
attrs w :: m a
w = do
  let childStyle :: Text
childStyle = "position: absolute; left: 0; top: 0;"
      containerAttrs :: Map Text Text
containerAttrs = "style" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: "position: absolute; left: 0; top: 0; right: 0; bottom: 0; overflow: scroll; z-index: -1; visibility: hidden;"
  (parent :: Element EventResult GhcjsDomSpace t
parent, (expand :: Element EventResult GhcjsDomSpace t
expand, expandChild :: Element EventResult GhcjsDomSpace t
expandChild, shrink :: Element EventResult GhcjsDomSpace t
shrink, w' :: a
w')) <- Text
-> Map Text Text
-> m (Element EventResult GhcjsDomSpace t,
      Element EventResult GhcjsDomSpace t,
      Element EventResult GhcjsDomSpace t, a)
-> m (Element EventResult (DomBuilderSpace m) t,
      (Element EventResult GhcjsDomSpace t,
       Element EventResult GhcjsDomSpace t,
       Element EventResult GhcjsDomSpace t, a))
forall t (m :: * -> *) a.
DomBuilder t m =>
Text
-> Map Text Text
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
elAttr' "div" ((Text -> Text -> Text)
-> Map Text Text -> Map Text Text -> Map Text Text
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) Map Text Text
attrs ("style" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: "position: relative;")) (m (Element EventResult GhcjsDomSpace t,
    Element EventResult GhcjsDomSpace t,
    Element EventResult GhcjsDomSpace t, a)
 -> m (Element EventResult GhcjsDomSpace t,
       (Element EventResult GhcjsDomSpace t,
        Element EventResult GhcjsDomSpace t,
        Element EventResult GhcjsDomSpace t, a)))
-> m (Element EventResult GhcjsDomSpace t,
      Element EventResult GhcjsDomSpace t,
      Element EventResult GhcjsDomSpace t, a)
-> m (Element EventResult GhcjsDomSpace t,
      (Element EventResult GhcjsDomSpace t,
       Element EventResult GhcjsDomSpace t,
       Element EventResult GhcjsDomSpace t, a))
forall a b. (a -> b) -> a -> b
$ do
    a
w' <- m a
w
    Text
-> Map Text Text
-> m (Element EventResult GhcjsDomSpace t,
      Element EventResult GhcjsDomSpace t,
      Element EventResult GhcjsDomSpace t, a)
-> m (Element EventResult GhcjsDomSpace t,
      Element EventResult GhcjsDomSpace t,
      Element EventResult GhcjsDomSpace t, a)
forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> Map Text Text -> m a -> m a
elAttr "div" Map Text Text
containerAttrs (m (Element EventResult GhcjsDomSpace t,
    Element EventResult GhcjsDomSpace t,
    Element EventResult GhcjsDomSpace t, a)
 -> m (Element EventResult GhcjsDomSpace t,
       Element EventResult GhcjsDomSpace t,
       Element EventResult GhcjsDomSpace t, a))
-> m (Element EventResult GhcjsDomSpace t,
      Element EventResult GhcjsDomSpace t,
      Element EventResult GhcjsDomSpace t, a)
-> m (Element EventResult GhcjsDomSpace t,
      Element EventResult GhcjsDomSpace t,
      Element EventResult GhcjsDomSpace t, a)
forall a b. (a -> b) -> a -> b
$ do
      (expand :: Element EventResult GhcjsDomSpace t
expand, (expandChild :: Element EventResult GhcjsDomSpace t
expandChild, _)) <- Text
-> Map Text Text
-> m (Element EventResult GhcjsDomSpace t, ())
-> m (Element EventResult (DomBuilderSpace m) t,
      (Element EventResult GhcjsDomSpace t, ()))
forall t (m :: * -> *) a.
DomBuilder t m =>
Text
-> Map Text Text
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
elAttr' "div" Map Text Text
containerAttrs (m (Element EventResult GhcjsDomSpace t, ())
 -> m (Element EventResult GhcjsDomSpace t,
       (Element EventResult GhcjsDomSpace t, ())))
-> m (Element EventResult GhcjsDomSpace t, ())
-> m (Element EventResult GhcjsDomSpace t,
      (Element EventResult GhcjsDomSpace t, ()))
forall a b. (a -> b) -> a -> b
$ Text
-> Map Text Text
-> m ()
-> m (Element EventResult (DomBuilderSpace m) t, ())
forall t (m :: * -> *) a.
DomBuilder t m =>
Text
-> Map Text Text
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
elAttr' "div" ("style" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: Text
IxValue (Map Text Text)
childStyle) (m () -> m (Element EventResult GhcjsDomSpace t, ()))
-> m () -> m (Element EventResult GhcjsDomSpace t, ())
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      (shrink :: Element EventResult GhcjsDomSpace t
shrink, _) <- Text
-> Map Text Text
-> m ()
-> m (Element EventResult (DomBuilderSpace m) t, ())
forall t (m :: * -> *) a.
DomBuilder t m =>
Text
-> Map Text Text
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
elAttr' "div" Map Text Text
containerAttrs (m () -> m (Element EventResult GhcjsDomSpace t, ()))
-> m () -> m (Element EventResult GhcjsDomSpace t, ())
forall a b. (a -> b) -> a -> b
$ Text -> Map Text Text -> m () -> m ()
forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> Map Text Text -> m a -> m a
elAttr "div" ("style" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: (Text
childStyle Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "width: 200%; height: 200%;")) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      (Element EventResult GhcjsDomSpace t,
 Element EventResult GhcjsDomSpace t,
 Element EventResult GhcjsDomSpace t, a)
-> m (Element EventResult GhcjsDomSpace t,
      Element EventResult GhcjsDomSpace t,
      Element EventResult GhcjsDomSpace t, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Element EventResult GhcjsDomSpace t
expand, Element EventResult GhcjsDomSpace t
expandChild, Element EventResult GhcjsDomSpace t
shrink, a
w')
  let p :: HTMLElement
p = (JSVal -> HTMLElement) -> Element -> HTMLElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLElement
HTMLElement (Element -> HTMLElement) -> Element -> HTMLElement
forall a b. (a -> b) -> a -> b
$ Element EventResult GhcjsDomSpace t -> RawElement GhcjsDomSpace
forall (er :: EventTag -> *) k1 (d :: k1) k2 (t :: k2).
Element er d t -> RawElement d
_element_raw Element EventResult GhcjsDomSpace t
parent
      reset :: JSM (Maybe Double, Maybe Double)
reset = do
        let e :: HTMLElement
e = (JSVal -> HTMLElement) -> Element -> HTMLElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLElement
HTMLElement (Element -> HTMLElement) -> Element -> HTMLElement
forall a b. (a -> b) -> a -> b
$ Element EventResult GhcjsDomSpace t -> RawElement GhcjsDomSpace
forall (er :: EventTag -> *) k1 (d :: k1) k2 (t :: k2).
Element er d t -> RawElement d
_element_raw Element EventResult GhcjsDomSpace t
expand
            s :: RawElement GhcjsDomSpace
s = Element EventResult GhcjsDomSpace t -> RawElement GhcjsDomSpace
forall (er :: EventTag -> *) k1 (d :: k1) k2 (t :: k2).
Element er d t -> RawElement d
_element_raw Element EventResult GhcjsDomSpace t
shrink
        Double
eow <- HTMLElement -> JSM Double
forall (m :: * -> *) self.
(MonadDOM m, IsHTMLElement self) =>
self -> m Double
getOffsetWidth HTMLElement
e
        Double
eoh <- HTMLElement -> JSM Double
forall (m :: * -> *) self.
(MonadDOM m, IsHTMLElement self) =>
self -> m Double
getOffsetHeight HTMLElement
e
        let ecw :: Double
ecw = Double
eow Double -> Double -> Double
forall a. Num a => a -> a -> a
+ 10
            ech :: Double
ech = Double
eoh Double -> Double -> Double
forall a. Num a => a -> a -> a
+ 10
        Element -> Text -> Text -> JSM ()
forall (m :: * -> *) self qualifiedName value.
(MonadDOM m, IsElement self, ToJSString qualifiedName,
 ToJSString value) =>
self -> qualifiedName -> value -> m ()
setAttribute (Element EventResult GhcjsDomSpace t -> RawElement GhcjsDomSpace
forall (er :: EventTag -> *) k1 (d :: k1) k2 (t :: k2).
Element er d t -> RawElement d
_element_raw Element EventResult GhcjsDomSpace t
expandChild) ("style" :: Text) (Text
childStyle Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "width: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Double -> String
forall a. Show a => a -> String
show Double
ecw) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "px;" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "height: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Double -> String
forall a. Show a => a -> String
show Double
ech) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "px;")
        Int
esw <- HTMLElement -> JSM Int
forall (m :: * -> *) self.
(MonadDOM m, IsElement self) =>
self -> m Int
getScrollWidth HTMLElement
e
        HTMLElement -> Int -> JSM ()
forall (m :: * -> *) self.
(MonadDOM m, IsElement self) =>
self -> Int -> m ()
setScrollLeft HTMLElement
e Int
esw
        Int
esh <- HTMLElement -> JSM Int
forall (m :: * -> *) self.
(MonadDOM m, IsElement self) =>
self -> m Int
getScrollHeight HTMLElement
e
        HTMLElement -> Int -> JSM ()
forall (m :: * -> *) self.
(MonadDOM m, IsElement self) =>
self -> Int -> m ()
setScrollTop HTMLElement
e Int
esh
        Int
ssw <- Element -> JSM Int
forall (m :: * -> *) self.
(MonadDOM m, IsElement self) =>
self -> m Int
getScrollWidth Element
RawElement GhcjsDomSpace
s
        Element -> Int -> JSM ()
forall (m :: * -> *) self.
(MonadDOM m, IsElement self) =>
self -> Int -> m ()
setScrollLeft Element
RawElement GhcjsDomSpace
s Int
ssw
        Int
ssh <- Element -> JSM Int
forall (m :: * -> *) self.
(MonadDOM m, IsElement self) =>
self -> m Int
getScrollHeight Element
RawElement GhcjsDomSpace
s
        Element -> Int -> JSM ()
forall (m :: * -> *) self.
(MonadDOM m, IsElement self) =>
self -> Int -> m ()
setScrollTop Element
RawElement GhcjsDomSpace
s Int
ssh
        Double
lastWidth <- HTMLElement -> JSM Double
forall (m :: * -> *) self.
(MonadDOM m, IsHTMLElement self) =>
self -> m Double
getOffsetWidth HTMLElement
p
        Double
lastHeight <- HTMLElement -> JSM Double
forall (m :: * -> *) self.
(MonadDOM m, IsHTMLElement self) =>
self -> m Double
getOffsetHeight HTMLElement
p
        (Maybe Double, Maybe Double) -> JSM (Maybe Double, Maybe Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
lastWidth, Double -> Maybe Double
forall a. a -> Maybe a
Just Double
lastHeight)
      resetIfChanged :: (Maybe Double, Maybe Double)
-> JSM (Maybe (Maybe Double, Maybe Double))
resetIfChanged ds :: (Maybe Double, Maybe Double)
ds = do
        Double
pow <- HTMLElement -> JSM Double
forall (m :: * -> *) self.
(MonadDOM m, IsHTMLElement self) =>
self -> m Double
getOffsetWidth HTMLElement
p
        Double
poh <- HTMLElement -> JSM Double
forall (m :: * -> *) self.
(MonadDOM m, IsHTMLElement self) =>
self -> m Double
getOffsetHeight HTMLElement
p
        if (Maybe Double, Maybe Double)
ds (Maybe Double, Maybe Double)
-> (Maybe Double, Maybe Double) -> Bool
forall a. Eq a => a -> a -> Bool
== (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
pow, Double -> Maybe Double
forall a. a -> Maybe a
Just Double
poh)
          then Maybe (Maybe Double, Maybe Double)
-> JSM (Maybe (Maybe Double, Maybe Double))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Maybe Double, Maybe Double)
forall a. Maybe a
Nothing
          else ((Maybe Double, Maybe Double)
 -> Maybe (Maybe Double, Maybe Double))
-> JSM (Maybe Double, Maybe Double)
-> JSM (Maybe (Maybe Double, Maybe Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Double, Maybe Double) -> Maybe (Maybe Double, Maybe Double)
forall a. a -> Maybe a
Just JSM (Maybe Double, Maybe Double)
reset
  Event t ()
pb <- NominalDiffTime -> Event t () -> m (Event t ())
forall t (m :: * -> *) a.
(PerformEvent t m, TriggerEvent t m, MonadIO (Performable m)) =>
NominalDiffTime -> Event t a -> m (Event t a)
delay 0 (Event t () -> m (Event t ())) -> m (Event t ()) -> m (Event t ())
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Event t ())
forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild
  Event t ()
expandScroll <- HTMLElement
-> (HTMLElement -> EventM HTMLElement UIEvent () -> JSM (JSM ()))
-> EventM HTMLElement UIEvent ()
-> m (Event t ())
forall t (m :: * -> *) e event a.
(TriggerEvent t m, MonadJSM m) =>
e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event a
-> m (Event t a)
wrapDomEvent ((JSVal -> HTMLElement) -> Element -> HTMLElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
DOM.uncheckedCastTo JSVal -> HTMLElement
DOM.HTMLElement (Element -> HTMLElement) -> Element -> HTMLElement
forall a b. (a -> b) -> a -> b
$ Element EventResult GhcjsDomSpace t -> RawElement GhcjsDomSpace
forall (er :: EventTag -> *) k1 (d :: k1) k2 (t :: k2).
Element er d t -> RawElement d
_element_raw Element EventResult GhcjsDomSpace t
expand) (HTMLElement
-> EventName HTMLElement UIEvent
-> EventM HTMLElement UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
`on` EventName HTMLElement UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.scroll) (EventM HTMLElement UIEvent () -> m (Event t ()))
-> EventM HTMLElement UIEvent () -> m (Event t ())
forall a b. (a -> b) -> a -> b
$ () -> EventM HTMLElement UIEvent ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Event t ()
shrinkScroll <- HTMLElement
-> (HTMLElement -> EventM HTMLElement UIEvent () -> JSM (JSM ()))
-> EventM HTMLElement UIEvent ()
-> m (Event t ())
forall t (m :: * -> *) e event a.
(TriggerEvent t m, MonadJSM m) =>
e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event a
-> m (Event t a)
wrapDomEvent ((JSVal -> HTMLElement) -> Element -> HTMLElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
DOM.uncheckedCastTo JSVal -> HTMLElement
DOM.HTMLElement (Element -> HTMLElement) -> Element -> HTMLElement
forall a b. (a -> b) -> a -> b
$ Element EventResult GhcjsDomSpace t -> RawElement GhcjsDomSpace
forall (er :: EventTag -> *) k1 (d :: k1) k2 (t :: k2).
Element er d t -> RawElement d
_element_raw Element EventResult GhcjsDomSpace t
shrink) (HTMLElement
-> EventName HTMLElement UIEvent
-> EventM HTMLElement UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
`on` EventName HTMLElement UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.scroll) (EventM HTMLElement UIEvent () -> m (Event t ()))
-> EventM HTMLElement UIEvent () -> m (Event t ())
forall a b. (a -> b) -> a -> b
$ () -> EventM HTMLElement UIEvent ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Event t (Maybe Double, Maybe Double)
size0 <- Event t (Performable m (Maybe Double, Maybe Double))
-> m (Event t (Maybe Double, Maybe Double))
forall t (m :: * -> *) a.
PerformEvent t m =>
Event t (Performable m a) -> m (Event t a)
performEvent (Event t (Performable m (Maybe Double, Maybe Double))
 -> m (Event t (Maybe Double, Maybe Double)))
-> Event t (Performable m (Maybe Double, Maybe Double))
-> m (Event t (Maybe Double, Maybe Double))
forall a b. (a -> b) -> a -> b
$ (() -> Performable m (Maybe Double, Maybe Double))
-> Event t ()
-> Event t (Performable m (Maybe Double, Maybe Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Performable m (Maybe Double, Maybe Double)
-> () -> Performable m (Maybe Double, Maybe Double)
forall a b. a -> b -> a
const (Performable m (Maybe Double, Maybe Double)
 -> () -> Performable m (Maybe Double, Maybe Double))
-> Performable m (Maybe Double, Maybe Double)
-> ()
-> Performable m (Maybe Double, Maybe Double)
forall a b. (a -> b) -> a -> b
$ JSM (Maybe Double, Maybe Double)
-> Performable m (Maybe Double, Maybe Double)
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM (Maybe Double, Maybe Double)
reset) Event t ()
pb
  rec Event t (Maybe (Maybe Double, Maybe Double))
resize <- Event
  t
  ((Maybe (Maybe Double, Maybe Double) -> IO ()) -> Performable m ())
-> m (Event t (Maybe (Maybe Double, Maybe Double)))
forall t (m :: * -> *) a.
(TriggerEvent t m, PerformEvent t m) =>
Event t ((a -> IO ()) -> Performable m ()) -> m (Event t a)
performEventAsync (Event
   t
   ((Maybe (Maybe Double, Maybe Double) -> IO ()) -> Performable m ())
 -> m (Event t (Maybe (Maybe Double, Maybe Double))))
-> Event
     t
     ((Maybe (Maybe Double, Maybe Double) -> IO ()) -> Performable m ())
-> m (Event t (Maybe (Maybe Double, Maybe Double)))
forall a b. (a -> b) -> a -> b
$ ((Maybe Double, Maybe Double)
 -> (Maybe (Maybe Double, Maybe Double) -> IO ())
 -> Performable m ())
-> Event t (Maybe Double, Maybe Double)
-> Event
     t
     ((Maybe (Maybe Double, Maybe Double) -> IO ()) -> Performable m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\d :: (Maybe Double, Maybe Double)
d cb :: Maybe (Maybe Double, Maybe Double) -> IO ()
cb -> (IO () -> Performable m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Performable m ())
-> (Maybe (Maybe Double, Maybe Double) -> IO ())
-> Maybe (Maybe Double, Maybe Double)
-> Performable m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Maybe Double, Maybe Double) -> IO ()
cb) (Maybe (Maybe Double, Maybe Double) -> Performable m ())
-> Performable m (Maybe (Maybe Double, Maybe Double))
-> Performable m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSM (Maybe (Maybe Double, Maybe Double))
-> Performable m (Maybe (Maybe Double, Maybe Double))
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM ((Maybe Double, Maybe Double)
-> JSM (Maybe (Maybe Double, Maybe Double))
resetIfChanged (Maybe Double, Maybe Double)
d)) (Event t (Maybe Double, Maybe Double)
 -> Event
      t
      ((Maybe (Maybe Double, Maybe Double) -> IO ())
       -> Performable m ()))
-> Event t (Maybe Double, Maybe Double)
-> Event
     t
     ((Maybe (Maybe Double, Maybe Double) -> IO ()) -> Performable m ())
forall a b. (a -> b) -> a -> b
$ Behavior t (Maybe Double, Maybe Double)
-> Event t () -> Event t (Maybe Double, Maybe Double)
forall k (t :: k) b a.
Reflex t =>
Behavior t b -> Event t a -> Event t b
tag (Dynamic t (Maybe Double, Maybe Double)
-> Behavior t (Maybe Double, Maybe Double)
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Maybe Double, Maybe Double)
dimensions) (Event t () -> Event t (Maybe Double, Maybe Double))
-> Event t () -> Event t (Maybe Double, Maybe Double)
forall a b. (a -> b) -> a -> b
$ [Event t ()] -> Event t ()
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t ()
expandScroll, Event t ()
shrinkScroll]
      Dynamic t (Maybe Double, Maybe Double)
dimensions <- (Maybe Double, Maybe Double)
-> Event t (Maybe Double, Maybe Double)
-> m (Dynamic t (Maybe Double, Maybe Double))
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn (Maybe Double
forall a. Maybe a
Nothing, Maybe Double
forall a. Maybe a
Nothing) (Event t (Maybe Double, Maybe Double)
 -> m (Dynamic t (Maybe Double, Maybe Double)))
-> Event t (Maybe Double, Maybe Double)
-> m (Dynamic t (Maybe Double, Maybe Double))
forall a b. (a -> b) -> a -> b
$ [Event t (Maybe Double, Maybe Double)]
-> Event t (Maybe Double, Maybe Double)
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [ Event t (Maybe Double, Maybe Double)
size0, (Maybe (Maybe Double, Maybe Double)
 -> Maybe (Maybe Double, Maybe Double))
-> Event t (Maybe (Maybe Double, Maybe Double))
-> Event t (Maybe Double, Maybe Double)
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe Maybe (Maybe Double, Maybe Double)
-> Maybe (Maybe Double, Maybe Double)
forall a. a -> a
id Event t (Maybe (Maybe Double, Maybe Double))
resize ]
  (Event t (Maybe Double, Maybe Double), a)
-> m (Event t (Maybe Double, Maybe Double), a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamic t (Maybe Double, Maybe Double)
-> Event t (Maybe Double, Maybe Double)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Maybe Double, Maybe Double)
dimensions, a
w')