diff --git a/reflex-dom-contrib.cabal b/reflex-dom-contrib.cabal --- a/reflex-dom-contrib.cabal +++ b/reflex-dom-contrib.cabal @@ -1,5 +1,5 @@ name: reflex-dom-contrib -version: 0.3 +version: 0.4 synopsis: A playground for experimenting with infrastructure and common code for reflex applications description: This library is intended to be a public playground for developing infrastructure, higher level APIs, and widget @@ -46,11 +46,11 @@ build-depends: aeson >= 0.8 && < 0.11, base >= 4.6 && < 4.9, - bifunctors >= 4.0 && < 5.1, + bifunctors >= 4.0 && < 5.2, bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.6, data-default >= 0.5 && < 0.6, - ghcjs-dom >= 0.1 && < 0.2, + ghcjs-dom >= 0.1 && < 0.3, http-types >= 0.8 && < 0.10, lens >= 4.9 && < 4.14, mtl >= 2.0 && < 2.3, @@ -61,8 +61,8 @@ safe >= 0.3 && < 0.4, string-conv >= 0.1 && < 0.2, text >= 1.2 && < 1.3, - time >= 1.5 && < 1.6, - transformers >= 0.4 && < 0.5 + time >= 1.5 && < 1.7, + transformers >= 0.4 && < 0.6 if impl(ghcjs) build-depends: diff --git a/src/Reflex/Dom/Contrib/Widgets/Common.hs b/src/Reflex/Dom/Contrib/Widgets/Common.hs --- a/src/Reflex/Dom/Contrib/Widgets/Common.hs +++ b/src/Reflex/Dom/Contrib/Widgets/Common.hs @@ -410,6 +410,47 @@ ------------------------------------------------------------------------------ +-- | Returns a unit event that fires when the widget loses focus or enter is +-- pressed. This function does not tagDyn the widget's value like +-- blurOrEnter. +blurOrEnterEvent :: Reflex t => HtmlWidget t a -> Event t () +blurOrEnterEvent w = leftmost + [ () <$ (ffilter (==13) $ _hwidget_keypress w) + , () <$ (ffilter not $ updated $ _hwidget_hasFocus w) + ] + + +------------------------------------------------------------------------------ +-- | Allows you to restrict when a widget fires and only allow valid values to +-- appear. If an invalid value is entered, it will revert to the last known +-- good value when the restrict event fires. +enforcingWidget + :: MonadWidget t m + => (HtmlWidget t (Maybe a) -> Event t ()) + -> GWidget t m (Maybe a) + -> GWidget t m a +enforcingWidget restrictEvent wFunc cfg = do + rec + let iv = Just $ _widgetConfig_initialValue cfg + newSetValue = leftmost [ Just <$> _widgetConfig_setValue cfg + , Just <$> resetEvent + ] + w <- wFunc $ WidgetConfig newSetValue iv + (_widgetConfig_attributes cfg) + let eMay = tag (current $ value w) $ restrictEvent w + e = fmapMaybe id eMay + v <- holdDyn (_widgetConfig_initialValue cfg) e + let resetEvent = tag (current v) $ ffilter isNothing eMay + return $ HtmlWidget { _hwidget_value = v + , _hwidget_change = e + , _hwidget_keypress = _hwidget_keypress w + , _hwidget_keydown = _hwidget_keydown w + , _hwidget_keyup = _hwidget_keyup w + , _hwidget_hasFocus = _hwidget_hasFocus w + } + + +------------------------------------------------------------------------------ -- | Allows you to restrict when a widget fires. For instance, -- @restrictWidget blurOrEnter@ restricts a widget so it only fires on blur -- or when enter is pressed. diff --git a/src/Reflex/Dom/Contrib/Widgets/Modal.hs b/src/Reflex/Dom/Contrib/Widgets/Modal.hs --- a/src/Reflex/Dom/Contrib/Widgets/Modal.hs +++ b/src/Reflex/Dom/Contrib/Widgets/Modal.hs @@ -15,6 +15,7 @@ module Reflex.Dom.Contrib.Widgets.Modal where ------------------------------------------------------------------------------ +import Data.Bifunctor import Data.Either import Data.Map (Map) import Data.Monoid @@ -26,60 +27,80 @@ ------------------------------------------------------------------------------ --- | When the hiding strategy is RemoveFromDOM, the widget adds and removes --- the modal markup from the DOM when the modal is opened and closed. For --- @DisplayNone@ and @VisibilityInvisible@ the modal markup is always kept in --- the DOM and visibility is controlled by setting the style to @display:none@ --- or @visibility:invisible@ respectively. @DisplayNone@ causes the elements --- to be completely taken out of the document flow. This means that widgets --- in the modal will only be able to get things like height when the modal is --- visible. Using @VisibilityInvisible@ gets around this limitation. +-- | The hiding strategies DisplayNone and VisibilityInvisible control +-- visibility by setting the style to @display:none@ or @visibility:invisible@ +-- respectively. @DisplayNone@ causes the elements to remain in the DOM but +-- be taken out of the document flow. This means that widgets in the modal +-- will only be able to get things like height when the modal is visible. +-- Using @VisibilityInvisible@ makes height information available even when +-- modal is not visible. data HidingStrategy = DisplayNone | VisibilityInvisible - | RemoveFromDOM deriving (Eq,Show,Ord,Enum,Bounded) data ModalConfig = ModalConfig - { modalHidingStrategy :: HidingStrategy - , modalAttributes :: Map String String + { modalAttributes :: Map String String -- ^ Attributes to put on the modal's outermost div } ------------------------------------------------------------------------------ -modal +-- | Implements a modal that stays in the DOM but is hidden with either +-- visibility:hidden or display:none when not displayed. +hidingModal :: MonadWidget t m - => ModalConfig + => HidingStrategy + -> ModalConfig -> Event t Bool -- ^ Event to open and/or close the model - -> m (Event t a, Event t ()) + -> m (a, Event t ()) -- ^ Widget rendering the body of the modal. Returns an event with a -- success value and an event triggering the close of the modal. - -> m (Event t a) -modal cfg showm body = do + -> m a +hidingModal strategy cfg showm body = do rec let visE = leftmost [showm, False <$ closem] - (resE, closem) <- case modalHidingStrategy cfg of - RemoveFromDOM -> do - res <- widgetHoldHelper removeFromDOMWrapper False visE - a <- extractEvent fst res - b <- extractEvent snd res - return (a,b) - _ -> go =<< holdDyn False visE + (resE, closem) <- go =<< holdDyn False visE return resE where - removeFromDOMWrapper False = return (never, never) - removeFromDOMWrapper True = go $ constDyn True go vis = do attrs <- mapDyn (\b -> modalAttributes cfg <> visibility b) vis elDynAttr "div" attrs body visibility True = "style" =: "display:block;" visibility False = - case modalHidingStrategy cfg of + case strategy of VisibilityInvisible -> "style" =: "visibility:hidden; display:block;" DisplayNone -> "style" =: "display:none;" - RemoveFromDOM -> mempty + + +------------------------------------------------------------------------------ +-- | Implements a modal that is removed from the DOM when not displayed. This +-- involves a widgetHold and therefore this widget uses a different signature +-- than hidingModal that makes the value inside the event available to the +-- function constructing the modal. +removingModal + :: MonadWidget t m + => ModalConfig + -> Event t a + -- ^ Event to open the model + -> (a -> m (b, Event t ())) + -- ^ Widget rendering the body of the modal. Returns an event with a + -- success value and an event triggering the close of the modal. + -> m (Dynamic t (Maybe b)) +removingModal cfg showm body = do + rec let visE = leftmost [Just <$> showm, Nothing <$ closem] + (resE, closem) <- do + res <- widgetHoldHelper removeFromDOMWrapper Nothing visE + a <- mapDyn fst res + b <- extractEvent snd res + return (a,b) + return resE + where + removeFromDOMWrapper Nothing = return (Nothing, never) + removeFromDOMWrapper (Just a) = + elAttr "div" (modalAttributes cfg) $ + first Just <$> body a ------------------------------------------------------------------------------