{-# LANGUAGE CPP #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE JavaScriptFFI #-} -- For HasCallStack compatibility {-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-} module GHCJS.DOM.JSFFI.Generated.Range (js_newRange, newRange, js_setStart, setStart, js_setEnd, setEnd, js_setStartBefore, setStartBefore, js_setStartAfter, setStartAfter, js_setEndBefore, setEndBefore, js_setEndAfter, setEndAfter, js_collapse, collapse, js_selectNode, selectNode, js_selectNodeContents, selectNodeContents, js_compareBoundaryPoints, compareBoundaryPoints, compareBoundaryPoints_, js_deleteContents, deleteContents, js_extractContents, extractContents, extractContents_, extractContentsUnsafe, extractContentsUnchecked, js_cloneContents, cloneContents, cloneContents_, cloneContentsUnsafe, cloneContentsUnchecked, js_insertNode, insertNode, js_surroundContents, surroundContents, js_cloneRange, cloneRange, cloneRange_, cloneRangeUnsafe, cloneRangeUnchecked, js_toString, toString, toString_, js_detach, detach, js_getClientRects, getClientRects, getClientRects_, getClientRectsUnsafe, getClientRectsUnchecked, js_getBoundingClientRect, getBoundingClientRect, getBoundingClientRect_, getBoundingClientRectUnsafe, getBoundingClientRectUnchecked, js_createContextualFragment, createContextualFragment, createContextualFragment_, createContextualFragmentUnsafe, createContextualFragmentUnchecked, js_intersectsNode, intersectsNode, intersectsNode_, js_compareNode, compareNode, compareNode_, js_comparePoint, comparePoint, comparePoint_, js_isPointInRange, isPointInRange, isPointInRange_, js_expand, expand, pattern START_TO_START, pattern START_TO_END, pattern END_TO_END, pattern END_TO_START, pattern NODE_BEFORE, pattern NODE_AFTER, pattern NODE_BEFORE_AND_AFTER, pattern NODE_INSIDE, js_getStartContainer, getStartContainer, getStartContainerUnsafe, getStartContainerUnchecked, js_getStartOffset, getStartOffset, js_getEndContainer, getEndContainer, getEndContainerUnsafe, getEndContainerUnchecked, js_getEndOffset, getEndOffset, js_getCollapsed, getCollapsed, js_getCommonAncestorContainer, getCommonAncestorContainer, getCommonAncestorContainerUnsafe, getCommonAncestorContainerUnchecked, Range(..), gTypeRange) where import Prelude ((.), (==), (>>=), return, IO, Int, Float, Double, Bool(..), Maybe, maybe, fromIntegral, round, fmap, Show, Read, Eq, Ord) import qualified Prelude (error) import Data.Typeable (Typeable) import GHCJS.Types (JSVal(..), JSString) import GHCJS.Foreign (jsNull) import GHCJS.Foreign.Callback (syncCallback, asyncCallback, syncCallback1, asyncCallback1, syncCallback2, asyncCallback2, OnBlocked(..)) import GHCJS.Marshal (ToJSVal(..), FromJSVal(..)) import GHCJS.Marshal.Pure (PToJSVal(..), PFromJSVal(..)) import Control.Monad (void) import Control.Monad.IO.Class (MonadIO(..)) import Data.Int (Int64) import Data.Word (Word, Word64) import Data.Maybe (fromJust) import GHCJS.DOM.Types import Control.Applicative ((<$>)) import GHCJS.DOM.EventTargetClosures (EventName, unsafeEventName) import GHCJS.DOM.JSFFI.Generated.Enums #if MIN_VERSION_base(4,9,0) import GHC.Stack (HasCallStack) #elif MIN_VERSION_base(4,8,0) import GHC.Stack (CallStack) import GHC.Exts (Constraint) type HasCallStack = ((?callStack :: CallStack) :: Constraint) #else import GHC.Exts (Constraint) type HasCallStack = (() :: Constraint) #endif foreign import javascript unsafe "new window[\"Range\"]()" js_newRange :: IO Range -- | newRange :: (MonadIO m) => m Range newRange = liftIO (js_newRange) foreign import javascript unsafe "$1[\"setStart\"]($2, $3)" js_setStart :: Range -> Nullable Node -> Int -> IO () -- | setStart :: (MonadIO m, IsNode refNode) => Range -> Maybe refNode -> Int -> m () setStart self refNode offset = liftIO (js_setStart (self) (maybeToNullable (fmap toNode refNode)) offset) foreign import javascript unsafe "$1[\"setEnd\"]($2, $3)" js_setEnd :: Range -> Nullable Node -> Int -> IO () -- | setEnd :: (MonadIO m, IsNode refNode) => Range -> Maybe refNode -> Int -> m () setEnd self refNode offset = liftIO (js_setEnd (self) (maybeToNullable (fmap toNode refNode)) offset) foreign import javascript unsafe "$1[\"setStartBefore\"]($2)" js_setStartBefore :: Range -> Nullable Node -> IO () -- | setStartBefore :: (MonadIO m, IsNode refNode) => Range -> Maybe refNode -> m () setStartBefore self refNode = liftIO (js_setStartBefore (self) (maybeToNullable (fmap toNode refNode))) foreign import javascript unsafe "$1[\"setStartAfter\"]($2)" js_setStartAfter :: Range -> Nullable Node -> IO () -- | setStartAfter :: (MonadIO m, IsNode refNode) => Range -> Maybe refNode -> m () setStartAfter self refNode = liftIO (js_setStartAfter (self) (maybeToNullable (fmap toNode refNode))) foreign import javascript unsafe "$1[\"setEndBefore\"]($2)" js_setEndBefore :: Range -> Nullable Node -> IO () -- | setEndBefore :: (MonadIO m, IsNode refNode) => Range -> Maybe refNode -> m () setEndBefore self refNode = liftIO (js_setEndBefore (self) (maybeToNullable (fmap toNode refNode))) foreign import javascript unsafe "$1[\"setEndAfter\"]($2)" js_setEndAfter :: Range -> Nullable Node -> IO () -- | setEndAfter :: (MonadIO m, IsNode refNode) => Range -> Maybe refNode -> m () setEndAfter self refNode = liftIO (js_setEndAfter (self) (maybeToNullable (fmap toNode refNode))) foreign import javascript unsafe "$1[\"collapse\"]($2)" js_collapse :: Range -> Bool -> IO () -- | collapse :: (MonadIO m) => Range -> Bool -> m () collapse self toStart = liftIO (js_collapse (self) toStart) foreign import javascript unsafe "$1[\"selectNode\"]($2)" js_selectNode :: Range -> Nullable Node -> IO () -- | selectNode :: (MonadIO m, IsNode refNode) => Range -> Maybe refNode -> m () selectNode self refNode = liftIO (js_selectNode (self) (maybeToNullable (fmap toNode refNode))) foreign import javascript unsafe "$1[\"selectNodeContents\"]($2)" js_selectNodeContents :: Range -> Nullable Node -> IO () -- | selectNodeContents :: (MonadIO m, IsNode refNode) => Range -> Maybe refNode -> m () selectNodeContents self refNode = liftIO (js_selectNodeContents (self) (maybeToNullable (fmap toNode refNode))) foreign import javascript unsafe "$1[\"compareBoundaryPoints\"]($2,\n$3)" js_compareBoundaryPoints :: Range -> Word -> Nullable Range -> IO Int -- | compareBoundaryPoints :: (MonadIO m) => Range -> Word -> Maybe Range -> m Int compareBoundaryPoints self how sourceRange = liftIO (js_compareBoundaryPoints (self) how (maybeToNullable sourceRange)) -- | compareBoundaryPoints_ :: (MonadIO m) => Range -> Word -> Maybe Range -> m () compareBoundaryPoints_ self how sourceRange = liftIO (void (js_compareBoundaryPoints (self) how (maybeToNullable sourceRange))) foreign import javascript unsafe "$1[\"deleteContents\"]()" js_deleteContents :: Range -> IO () -- | deleteContents :: (MonadIO m) => Range -> m () deleteContents self = liftIO (js_deleteContents (self)) foreign import javascript unsafe "$1[\"extractContents\"]()" js_extractContents :: Range -> IO (Nullable DocumentFragment) -- | extractContents :: (MonadIO m) => Range -> m (Maybe DocumentFragment) extractContents self = liftIO (nullableToMaybe <$> (js_extractContents (self))) -- | extractContents_ :: (MonadIO m) => Range -> m () extractContents_ self = liftIO (void (js_extractContents (self))) -- | extractContentsUnsafe :: (MonadIO m, HasCallStack) => Range -> m DocumentFragment extractContentsUnsafe self = liftIO ((nullableToMaybe <$> (js_extractContents (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | extractContentsUnchecked :: (MonadIO m) => Range -> m DocumentFragment extractContentsUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_extractContents (self))) foreign import javascript unsafe "$1[\"cloneContents\"]()" js_cloneContents :: Range -> IO (Nullable DocumentFragment) -- | cloneContents :: (MonadIO m) => Range -> m (Maybe DocumentFragment) cloneContents self = liftIO (nullableToMaybe <$> (js_cloneContents (self))) -- | cloneContents_ :: (MonadIO m) => Range -> m () cloneContents_ self = liftIO (void (js_cloneContents (self))) -- | cloneContentsUnsafe :: (MonadIO m, HasCallStack) => Range -> m DocumentFragment cloneContentsUnsafe self = liftIO ((nullableToMaybe <$> (js_cloneContents (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | cloneContentsUnchecked :: (MonadIO m) => Range -> m DocumentFragment cloneContentsUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_cloneContents (self))) foreign import javascript unsafe "$1[\"insertNode\"]($2)" js_insertNode :: Range -> Nullable Node -> IO () -- | insertNode :: (MonadIO m, IsNode newNode) => Range -> Maybe newNode -> m () insertNode self newNode = liftIO (js_insertNode (self) (maybeToNullable (fmap toNode newNode))) foreign import javascript unsafe "$1[\"surroundContents\"]($2)" js_surroundContents :: Range -> Nullable Node -> IO () -- | surroundContents :: (MonadIO m, IsNode newParent) => Range -> Maybe newParent -> m () surroundContents self newParent = liftIO (js_surroundContents (self) (maybeToNullable (fmap toNode newParent))) foreign import javascript unsafe "$1[\"cloneRange\"]()" js_cloneRange :: Range -> IO (Nullable Range) -- | cloneRange :: (MonadIO m) => Range -> m (Maybe Range) cloneRange self = liftIO (nullableToMaybe <$> (js_cloneRange (self))) -- | cloneRange_ :: (MonadIO m) => Range -> m () cloneRange_ self = liftIO (void (js_cloneRange (self))) -- | cloneRangeUnsafe :: (MonadIO m, HasCallStack) => Range -> m Range cloneRangeUnsafe self = liftIO ((nullableToMaybe <$> (js_cloneRange (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | cloneRangeUnchecked :: (MonadIO m) => Range -> m Range cloneRangeUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_cloneRange (self))) foreign import javascript unsafe "$1[\"toString\"]()" js_toString :: Range -> IO JSString -- | toString :: (MonadIO m, FromJSString result) => Range -> m result toString self = liftIO (fromJSString <$> (js_toString (self))) -- | toString_ :: (MonadIO m) => Range -> m () toString_ self = liftIO (void (js_toString (self))) foreign import javascript unsafe "$1[\"detach\"]()" js_detach :: Range -> IO () -- | detach :: (MonadIO m) => Range -> m () detach self = liftIO (js_detach (self)) foreign import javascript unsafe "$1[\"getClientRects\"]()" js_getClientRects :: Range -> IO (Nullable ClientRectList) -- | getClientRects :: (MonadIO m) => Range -> m (Maybe ClientRectList) getClientRects self = liftIO (nullableToMaybe <$> (js_getClientRects (self))) -- | getClientRects_ :: (MonadIO m) => Range -> m () getClientRects_ self = liftIO (void (js_getClientRects (self))) -- | getClientRectsUnsafe :: (MonadIO m, HasCallStack) => Range -> m ClientRectList getClientRectsUnsafe self = liftIO ((nullableToMaybe <$> (js_getClientRects (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | getClientRectsUnchecked :: (MonadIO m) => Range -> m ClientRectList getClientRectsUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getClientRects (self))) foreign import javascript unsafe "$1[\"getBoundingClientRect\"]()" js_getBoundingClientRect :: Range -> IO (Nullable ClientRect) -- | getBoundingClientRect :: (MonadIO m) => Range -> m (Maybe ClientRect) getBoundingClientRect self = liftIO (nullableToMaybe <$> (js_getBoundingClientRect (self))) -- | getBoundingClientRect_ :: (MonadIO m) => Range -> m () getBoundingClientRect_ self = liftIO (void (js_getBoundingClientRect (self))) -- | getBoundingClientRectUnsafe :: (MonadIO m, HasCallStack) => Range -> m ClientRect getBoundingClientRectUnsafe self = liftIO ((nullableToMaybe <$> (js_getBoundingClientRect (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | getBoundingClientRectUnchecked :: (MonadIO m) => Range -> m ClientRect getBoundingClientRectUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getBoundingClientRect (self))) foreign import javascript unsafe "$1[\"createContextualFragment\"]($2)" js_createContextualFragment :: Range -> JSString -> IO (Nullable DocumentFragment) -- | createContextualFragment :: (MonadIO m, ToJSString html) => Range -> html -> m (Maybe DocumentFragment) createContextualFragment self html = liftIO (nullableToMaybe <$> (js_createContextualFragment (self) (toJSString html))) -- | createContextualFragment_ :: (MonadIO m, ToJSString html) => Range -> html -> m () createContextualFragment_ self html = liftIO (void (js_createContextualFragment (self) (toJSString html))) -- | createContextualFragmentUnsafe :: (MonadIO m, ToJSString html, HasCallStack) => Range -> html -> m DocumentFragment createContextualFragmentUnsafe self html = liftIO ((nullableToMaybe <$> (js_createContextualFragment (self) (toJSString html))) >>= maybe (Prelude.error "Nothing to return") return) -- | createContextualFragmentUnchecked :: (MonadIO m, ToJSString html) => Range -> html -> m DocumentFragment createContextualFragmentUnchecked self html = liftIO (fromJust . nullableToMaybe <$> (js_createContextualFragment (self) (toJSString html))) foreign import javascript unsafe "($1[\"intersectsNode\"]($2) ? 1 : 0)" js_intersectsNode :: Range -> Nullable Node -> IO Bool -- | intersectsNode :: (MonadIO m, IsNode refNode) => Range -> Maybe refNode -> m Bool intersectsNode self refNode = liftIO (js_intersectsNode (self) (maybeToNullable (fmap toNode refNode))) -- | intersectsNode_ :: (MonadIO m, IsNode refNode) => Range -> Maybe refNode -> m () intersectsNode_ self refNode = liftIO (void (js_intersectsNode (self) (maybeToNullable (fmap toNode refNode)))) foreign import javascript unsafe "$1[\"compareNode\"]($2)" js_compareNode :: Range -> Nullable Node -> IO Int -- | compareNode :: (MonadIO m, IsNode refNode) => Range -> Maybe refNode -> m Int compareNode self refNode = liftIO (js_compareNode (self) (maybeToNullable (fmap toNode refNode))) -- | compareNode_ :: (MonadIO m, IsNode refNode) => Range -> Maybe refNode -> m () compareNode_ self refNode = liftIO (void (js_compareNode (self) (maybeToNullable (fmap toNode refNode)))) foreign import javascript unsafe "$1[\"comparePoint\"]($2, $3)" js_comparePoint :: Range -> Nullable Node -> Int -> IO Int -- | comparePoint :: (MonadIO m, IsNode refNode) => Range -> Maybe refNode -> Int -> m Int comparePoint self refNode offset = liftIO (js_comparePoint (self) (maybeToNullable (fmap toNode refNode)) offset) -- | comparePoint_ :: (MonadIO m, IsNode refNode) => Range -> Maybe refNode -> Int -> m () comparePoint_ self refNode offset = liftIO (void (js_comparePoint (self) (maybeToNullable (fmap toNode refNode)) offset)) foreign import javascript unsafe "($1[\"isPointInRange\"]($2,\n$3) ? 1 : 0)" js_isPointInRange :: Range -> Nullable Node -> Int -> IO Bool -- | isPointInRange :: (MonadIO m, IsNode refNode) => Range -> Maybe refNode -> Int -> m Bool isPointInRange self refNode offset = liftIO (js_isPointInRange (self) (maybeToNullable (fmap toNode refNode)) offset) -- | isPointInRange_ :: (MonadIO m, IsNode refNode) => Range -> Maybe refNode -> Int -> m () isPointInRange_ self refNode offset = liftIO (void (js_isPointInRange (self) (maybeToNullable (fmap toNode refNode)) offset)) foreign import javascript unsafe "$1[\"expand\"]($2)" js_expand :: Range -> JSString -> IO () -- | expand :: (MonadIO m, ToJSString unit) => Range -> unit -> m () expand self unit = liftIO (js_expand (self) (toJSString unit)) pattern START_TO_START = 0 pattern START_TO_END = 1 pattern END_TO_END = 2 pattern END_TO_START = 3 pattern NODE_BEFORE = 0 pattern NODE_AFTER = 1 pattern NODE_BEFORE_AND_AFTER = 2 pattern NODE_INSIDE = 3 foreign import javascript unsafe "$1[\"startContainer\"]" js_getStartContainer :: Range -> IO (Nullable Node) -- | getStartContainer :: (MonadIO m) => Range -> m (Maybe Node) getStartContainer self = liftIO (nullableToMaybe <$> (js_getStartContainer (self))) -- | getStartContainerUnsafe :: (MonadIO m, HasCallStack) => Range -> m Node getStartContainerUnsafe self = liftIO ((nullableToMaybe <$> (js_getStartContainer (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | getStartContainerUnchecked :: (MonadIO m) => Range -> m Node getStartContainerUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getStartContainer (self))) foreign import javascript unsafe "$1[\"startOffset\"]" js_getStartOffset :: Range -> IO Int -- | getStartOffset :: (MonadIO m) => Range -> m Int getStartOffset self = liftIO (js_getStartOffset (self)) foreign import javascript unsafe "$1[\"endContainer\"]" js_getEndContainer :: Range -> IO (Nullable Node) -- | getEndContainer :: (MonadIO m) => Range -> m (Maybe Node) getEndContainer self = liftIO (nullableToMaybe <$> (js_getEndContainer (self))) -- | getEndContainerUnsafe :: (MonadIO m, HasCallStack) => Range -> m Node getEndContainerUnsafe self = liftIO ((nullableToMaybe <$> (js_getEndContainer (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | getEndContainerUnchecked :: (MonadIO m) => Range -> m Node getEndContainerUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getEndContainer (self))) foreign import javascript unsafe "$1[\"endOffset\"]" js_getEndOffset :: Range -> IO Int -- | getEndOffset :: (MonadIO m) => Range -> m Int getEndOffset self = liftIO (js_getEndOffset (self)) foreign import javascript unsafe "($1[\"collapsed\"] ? 1 : 0)" js_getCollapsed :: Range -> IO Bool -- | getCollapsed :: (MonadIO m) => Range -> m Bool getCollapsed self = liftIO (js_getCollapsed (self)) foreign import javascript unsafe "$1[\"commonAncestorContainer\"]" js_getCommonAncestorContainer :: Range -> IO (Nullable Node) -- | getCommonAncestorContainer :: (MonadIO m) => Range -> m (Maybe Node) getCommonAncestorContainer self = liftIO (nullableToMaybe <$> (js_getCommonAncestorContainer (self))) -- | getCommonAncestorContainerUnsafe :: (MonadIO m, HasCallStack) => Range -> m Node getCommonAncestorContainerUnsafe self = liftIO ((nullableToMaybe <$> (js_getCommonAncestorContainer (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | getCommonAncestorContainerUnchecked :: (MonadIO m) => Range -> m Node getCommonAncestorContainerUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getCommonAncestorContainer (self)))