@@ -9,7 +9,8 @@
99{-# LANGUAGE TypeFamilies #-}
1010module Reflex.Dom.Modals.Base
1111 ( ModalsT (..)
12− , withModalLayerClass
12+ , ModalLayerConfig (..)
13+ , withModalLayer
1314 )where
1415
1516import Control.Lens hiding (element)
@@ -35,7 +36,6 @@ import Reflex.Dom.Builder.Class
3536import Reflex.Dom.Builder.Immediate
3637import Reflex.Dom.Class
3738import Reflex.Dom.Modals.Class
38−import Reflex.Dom.Widget.Basic
3939import Reflex.Host.Class
4040
4141instance (Reflex t, PrimMonad m) => ModalOpener t (ModalsT t m) where
@@ -122,23 +122,44 @@ instance HasJSContext m => HasJSContext (ModalsT t m) where
122122instance MonadJSM m => MonadJSM (ModalsT t m)
123123#endif
124124
125−withModalLayerClass :: forall t m a. (Reflex t, MonadFix m, DomBuilder t m, MonadHold t m)
126− => Text
127− -> ModalsT t m a
128− -> m a
129−withModalLayerClass c (ModalsT a) = elAttr "div" ("class" =: c) $ do
125+data ModalLayerConfig t m = ModalLayerConfig
126+ { _modalLayerConfig_backdropElementConfig :: ElementConfig EventResult t (DomBuilderSpace m)
127+ , _modalLayerConfig_bodyElementConfig :: ElementConfig EventResult t (DomBuilderSpace m)
128+ }
129+
130+instance (DomBuilder t m) => Default (ModalLayerConfig t m) where
131+ def = ModalLayerConfig
132+ { _modalLayerConfig_backdropElementConfig = (def :: ElementConfig EventResult t (DomBuilderSpace m))
133+ & elementConfig_eventSpec %~ addEventSpecFlags (Proxy :: Proxy (DomBuilderSpace m)) Click (const stopPropagation)
134+ & initialAttributes .~ ("style" =: (T.intercalate ";"
135+ [ "position:absolute"
136+ , "left:0", "right:0", "top:0", "bottom:0"
137+ , "background-color:rgba(0,0,0,0.1)"
138+ , "display:flex", "justify-content:center", "align-items:center"
139+ ]))
140+ , _modalLayerConfig_bodyElementConfig = (def :: ElementConfig EventResult t (DomBuilderSpace m))
141+ & elementConfig_eventSpec %~ addEventSpecFlags (Proxy :: Proxy (DomBuilderSpace m)) Click (const stopPropagation)
142+ & initialAttributes .~ ("style" =: "background-color:white;opacity:1;padding:1em")
143+ }
144+
145+withModalLayer :: forall t m a. (Reflex t, MonadFix m, DomBuilder t m, MonadHold t m)
146+ => ModalLayerConfig t m
147+ -> ModalsT t m a
148+ -> m a
149+withModalLayer cfg (ModalsT a) = do
130150 rec (result, requests) <- do
131151 runRequesterT a modalDone
132− modalDone <- modalInner requests
152+ modalDone <- modalInner requests cfg
133153 return result
134154
135155modalInner :: forall t m k. (GCompare k, MonadHold t m, MonadFix m, DomBuilder t m)
136156 => Event t (DMap k (Compose (ModalsT t m) (Event t)))
157+ -> ModalLayerConfig t m
137158 -> m (Event t (DMap k Maybe))
138−modalInner rqs' = do
159+modalInner rqs' cfg = do
139160 rec let rqs = fmap toInsertionsDMap rqs'
140161 dones = fmap toDeletionsDMap modalDone
141− (m0, mpatch) <- traverseDMapWithKeyWithAdjust (\k v -> Compose <$> modalBody k v) DMap.empty (rqs <> dones)
162+ (m0, mpatch) <- traverseDMapWithKeyWithAdjust (\_ v -> Compose <$> modalBody cfg v) DMap.empty (rqs <> dones)
142163 modal <- fmap (merge . mapKeyValuePairsMonotonic wrapArgs) . incrementalToDynamic <$> holdIncremental m0 mpatch
143164 let modalDone = fmap (mapKeyValuePairsMonotonic unwrapArgs) $ switch $ current modal
144165 return modalDone
@@ -151,29 +172,15 @@ modalInner rqs' = do
151172 toDeletionsDMap :: forall k' v v'. DMap k' v -> PatchDMap k' v'
152173 toDeletionsDMap = coerce . DMap.map (\(_ :: v a) -> ComposeMaybe (Nothing :: Maybe (v' a)))
153174
154−modalBody :: forall t m k a. (MonadHold t m, MonadFix m, DomBuilder t m)
155− => k a
175+modalBody :: forall t m a. (MonadHold t m, MonadFix m, DomBuilder t m)
176+ => ModalLayerConfig t m
156177 -> Compose (ModalsT t m) (Event t) a
157178 -> m (Event t (Maybe a))
158−modalBody _ v = do
159− let style = T.intercalate ";"
160− [ "position:absolute"
161− , "left:0", "right:0", "top:0", "bottom:0"
162− , "background-color:rgba(0,0,0,0.1)"
163− , "display:flex", "justify-content:center", "align-items:center"
164− ]
165− backdropConfig = (def :: ElementConfig EventResult t (DomBuilderSpace m))
166− & elementConfig_eventSpec %~ addEventSpecFlags (Proxy :: Proxy (DomBuilderSpace m)) Click
167− (\_ -> stopPropagation)
168− & initialAttributes .~ ("style" =: style)
169− (overlay, complete) <- element "div" backdropConfig $ do
170− let bodyCfg = (def :: ElementConfig EventResult t (DomBuilderSpace m))
171− & elementConfig_eventSpec %~ addEventSpecFlags (Proxy :: Proxy (DomBuilderSpace m)) Click
172− (\_ -> stopPropagation)
173− & initialAttributes .~ ("style" =: "background-color:white;opacity:1;padding:1em")
174− fmap snd $ element "div" bodyCfg $ do
179+modalBody cfg v = do
180+ (overlay, complete) <- element "div" (_modalLayerConfig_backdropElementConfig cfg) $ do
181+ fmap snd $ element "div" (_modalLayerConfig_bodyElementConfig cfg) $ do
175182 rec (rsps, rqs') <- runRequesterT (unModalsT (getCompose v)) innerDone
176− innerDone <- modalInner rqs'
183+ innerDone <- modalInner rqs' cfg
177184 return rsps
178185 return $ leftmost
179186 [ Just <$> complete