@@ -1,4 +1,5 @@
11{-# LANGUAGE ConstraintKinds #-}
2+{-# LANGUAGE ExplicitForAll #-}
23{-# LANGUAGE FlexibleContexts #-}
34{-# LANGUAGE FlexibleInstances #-}
45{-# LANGUAGE MultiParamTypeClasses #-}
@@ -14,10 +15,12 @@ module Reflex.Dom.Old
1415 , buildElement
1516 , buildEmptyElement
1617 , buildEmptyElementNS
18+ , deleteBetweenExclusive
1719 ) where
1820
1921import Control.Arrow ((***))
2022import Control.Lens ((&), (.~))
23+import Control.Monad
2124import Control.Monad.Exception
2225import Control.Monad.Fix
2326import Control.Monad.IO.Class
@@ -28,6 +31,8 @@ import qualified Data.Map as Map
2831import qualified Data.Text as T
2932import Foreign.JavaScript.TH
3033import qualified GHCJS.DOM.Element as DOM
34+import GHCJS.DOM.Node (getParentNode, getPreviousSibling, removeChild, toNode)
35+import GHCJS.DOM.Types (IsNode)
3136import Reflex
3237import Reflex.Dom.Builder.Class
3338import Reflex.Dom.Builder.Immediate
@@ -107,3 +112,17 @@ buildElementInternal :: MonadWidget t m => String -> m a -> ElementConfig en t m
107112buildElementInternal elementTag child cfg = do
108113 (e, result) <- element (T.pack elementTag) cfg child
109114 return (_element_raw e, result)
115+
116+-- | s and e must both be children of the same node and s must precede e
117+deleteBetweenExclusive :: (IsNode start, IsNode end) => start -> end -> IO ()
118+deleteBetweenExclusive s e = do
119+ mCurrentParent <- getParentNode e -- May be different than it was at initial construction, e.g., because the parent may have dumped us in from a DocumentFragment
120+ case mCurrentParent of
121+ Nothing -> return () --TODO: Is this the right behavior?
122+ Just currentParent -> do
123+ let go = do
124+ Just x <- getPreviousSibling e -- This can't be Nothing because we should hit 's' first
125+ when (toNode s /= toNode x) $ do
126+ _ <- removeChild currentParent $ Just x
127+ go
128+ go