{-# LANGUAGE PatternSynonyms, ForeignFunctionInterface, JavaScriptFFI #-} module GHCJS.DOM.JSFFI.Generated.SVGLengthList (js_clear, clear, js_initialize, initialize, js_getItem, getItem, js_insertItemBefore, insertItemBefore, js_replaceItem, replaceItem, js_removeItem, removeItem, js_appendItem, appendItem, js_getNumberOfItems, getNumberOfItems, SVGLengthList, castToSVGLengthList, gTypeSVGLengthList) where import Prelude ((.), (==), (>>=), return, IO, Int, Float, Double, Bool(..), Maybe, maybe, fromIntegral, round, fmap, Show, Read, Eq, Ord) import Data.Typeable (Typeable) import GHCJS.Types (JSRef(..), JSString, castRef) import GHCJS.Foreign (jsNull) import GHCJS.Foreign.Callback (syncCallback, asyncCallback, syncCallback1, asyncCallback1, syncCallback2, asyncCallback2, OnBlocked(..)) import GHCJS.Marshal (ToJSRef(..), FromJSRef(..)) import GHCJS.Marshal.Pure (PToJSRef(..), PFromJSRef(..)) import Control.Monad.IO.Class (MonadIO(..)) import Data.Int (Int64) import Data.Word (Word, Word64) import GHCJS.DOM.Types import Control.Applicative ((<$>)) import GHCJS.DOM.EventTargetClosures (EventName, unsafeEventName) import GHCJS.DOM.Enums foreign import javascript unsafe "$1[\"clear\"]()" js_clear :: JSRef SVGLengthList -> IO () -- | clear :: (MonadIO m) => SVGLengthList -> m () clear self = liftIO (js_clear (unSVGLengthList self)) foreign import javascript unsafe "$1[\"initialize\"]($2)" js_initialize :: JSRef SVGLengthList -> JSRef SVGLength -> IO (JSRef SVGLength) -- | initialize :: (MonadIO m) => SVGLengthList -> Maybe SVGLength -> m (Maybe SVGLength) initialize self item = liftIO ((js_initialize (unSVGLengthList self) (maybe jsNull pToJSRef item)) >>= fromJSRef) foreign import javascript unsafe "$1[\"getItem\"]($2)" js_getItem :: JSRef SVGLengthList -> Word -> IO (JSRef SVGLength) -- | getItem :: (MonadIO m) => SVGLengthList -> Word -> m (Maybe SVGLength) getItem self index = liftIO ((js_getItem (unSVGLengthList self) index) >>= fromJSRef) foreign import javascript unsafe "$1[\"insertItemBefore\"]($2, $3)" js_insertItemBefore :: JSRef SVGLengthList -> JSRef SVGLength -> Word -> IO (JSRef SVGLength) -- | insertItemBefore :: (MonadIO m) => SVGLengthList -> Maybe SVGLength -> Word -> m (Maybe SVGLength) insertItemBefore self item index = liftIO ((js_insertItemBefore (unSVGLengthList self) (maybe jsNull pToJSRef item) index) >>= fromJSRef) foreign import javascript unsafe "$1[\"replaceItem\"]($2, $3)" js_replaceItem :: JSRef SVGLengthList -> JSRef SVGLength -> Word -> IO (JSRef SVGLength) -- | replaceItem :: (MonadIO m) => SVGLengthList -> Maybe SVGLength -> Word -> m (Maybe SVGLength) replaceItem self item index = liftIO ((js_replaceItem (unSVGLengthList self) (maybe jsNull pToJSRef item) index) >>= fromJSRef) foreign import javascript unsafe "$1[\"removeItem\"]($2)" js_removeItem :: JSRef SVGLengthList -> Word -> IO (JSRef SVGLength) -- | removeItem :: (MonadIO m) => SVGLengthList -> Word -> m (Maybe SVGLength) removeItem self index = liftIO ((js_removeItem (unSVGLengthList self) index) >>= fromJSRef) foreign import javascript unsafe "$1[\"appendItem\"]($2)" js_appendItem :: JSRef SVGLengthList -> JSRef SVGLength -> IO (JSRef SVGLength) -- | appendItem :: (MonadIO m) => SVGLengthList -> Maybe SVGLength -> m (Maybe SVGLength) appendItem self item = liftIO ((js_appendItem (unSVGLengthList self) (maybe jsNull pToJSRef item)) >>= fromJSRef) foreign import javascript unsafe "$1[\"numberOfItems\"]" js_getNumberOfItems :: JSRef SVGLengthList -> IO Word -- | getNumberOfItems :: (MonadIO m) => SVGLengthList -> m Word getNumberOfItems self = liftIO (js_getNumberOfItems (unSVGLengthList self))