{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE JavaScriptFFI #-} -- For HasCallStack compatibility {-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-} module GHCJS.DOM.JSFFI.Generated.Performance (js_webkitGetEntries, webkitGetEntries, webkitGetEntries_, webkitGetEntriesUnsafe, webkitGetEntriesUnchecked, js_webkitGetEntriesByType, webkitGetEntriesByType, webkitGetEntriesByType_, webkitGetEntriesByTypeUnsafe, webkitGetEntriesByTypeUnchecked, js_webkitGetEntriesByName, webkitGetEntriesByName, webkitGetEntriesByName_, webkitGetEntriesByNameUnsafe, webkitGetEntriesByNameUnchecked, js_webkitClearResourceTimings, webkitClearResourceTimings, js_webkitSetResourceTimingBufferSize, webkitSetResourceTimingBufferSize, js_webkitMark, webkitMark, js_webkitClearMarks, webkitClearMarks, js_webkitMeasure, webkitMeasure, js_webkitClearMeasures, webkitClearMeasures, js_now, now, now_, js_getNavigation, getNavigation, getNavigationUnsafe, getNavigationUnchecked, js_getTiming, getTiming, getTimingUnsafe, getTimingUnchecked, webKitResourceTimingBufferFull, Performance(..), gTypePerformance) 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 foreign import javascript unsafe "$1[\"webkitGetEntries\"]()" js_webkitGetEntries :: Performance -> IO (Nullable PerformanceEntryList) -- | webkitGetEntries :: (MonadIO m) => Performance -> m (Maybe PerformanceEntryList) webkitGetEntries self = liftIO (nullableToMaybe <$> (js_webkitGetEntries (self))) -- | webkitGetEntries_ :: (MonadIO m) => Performance -> m () webkitGetEntries_ self = liftIO (void (js_webkitGetEntries (self))) -- | webkitGetEntriesUnsafe :: (MonadIO m, HasCallStack) => Performance -> m PerformanceEntryList webkitGetEntriesUnsafe self = liftIO ((nullableToMaybe <$> (js_webkitGetEntries (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | webkitGetEntriesUnchecked :: (MonadIO m) => Performance -> m PerformanceEntryList webkitGetEntriesUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_webkitGetEntries (self))) foreign import javascript unsafe "$1[\"webkitGetEntriesByType\"]($2)" js_webkitGetEntriesByType :: Performance -> JSString -> IO (Nullable PerformanceEntryList) -- | webkitGetEntriesByType :: (MonadIO m, ToJSString entryType) => Performance -> entryType -> m (Maybe PerformanceEntryList) webkitGetEntriesByType self entryType = liftIO (nullableToMaybe <$> (js_webkitGetEntriesByType (self) (toJSString entryType))) -- | webkitGetEntriesByType_ :: (MonadIO m, ToJSString entryType) => Performance -> entryType -> m () webkitGetEntriesByType_ self entryType = liftIO (void (js_webkitGetEntriesByType (self) (toJSString entryType))) -- | webkitGetEntriesByTypeUnsafe :: (MonadIO m, ToJSString entryType, HasCallStack) => Performance -> entryType -> m PerformanceEntryList webkitGetEntriesByTypeUnsafe self entryType = liftIO ((nullableToMaybe <$> (js_webkitGetEntriesByType (self) (toJSString entryType))) >>= maybe (Prelude.error "Nothing to return") return) -- | webkitGetEntriesByTypeUnchecked :: (MonadIO m, ToJSString entryType) => Performance -> entryType -> m PerformanceEntryList webkitGetEntriesByTypeUnchecked self entryType = liftIO (fromJust . nullableToMaybe <$> (js_webkitGetEntriesByType (self) (toJSString entryType))) foreign import javascript unsafe "$1[\"webkitGetEntriesByName\"]($2,\n$3)" js_webkitGetEntriesByName :: Performance -> JSString -> JSString -> IO (Nullable PerformanceEntryList) -- | webkitGetEntriesByName :: (MonadIO m, ToJSString name, ToJSString entryType) => Performance -> name -> entryType -> m (Maybe PerformanceEntryList) webkitGetEntriesByName self name entryType = liftIO (nullableToMaybe <$> (js_webkitGetEntriesByName (self) (toJSString name) (toJSString entryType))) -- | webkitGetEntriesByName_ :: (MonadIO m, ToJSString name, ToJSString entryType) => Performance -> name -> entryType -> m () webkitGetEntriesByName_ self name entryType = liftIO (void (js_webkitGetEntriesByName (self) (toJSString name) (toJSString entryType))) -- | webkitGetEntriesByNameUnsafe :: (MonadIO m, ToJSString name, ToJSString entryType, HasCallStack) => Performance -> name -> entryType -> m PerformanceEntryList webkitGetEntriesByNameUnsafe self name entryType = liftIO ((nullableToMaybe <$> (js_webkitGetEntriesByName (self) (toJSString name) (toJSString entryType))) >>= maybe (Prelude.error "Nothing to return") return) -- | webkitGetEntriesByNameUnchecked :: (MonadIO m, ToJSString name, ToJSString entryType) => Performance -> name -> entryType -> m PerformanceEntryList webkitGetEntriesByNameUnchecked self name entryType = liftIO (fromJust . nullableToMaybe <$> (js_webkitGetEntriesByName (self) (toJSString name) (toJSString entryType))) foreign import javascript unsafe "$1[\"webkitClearResourceTimings\"]()" js_webkitClearResourceTimings :: Performance -> IO () -- | webkitClearResourceTimings :: (MonadIO m) => Performance -> m () webkitClearResourceTimings self = liftIO (js_webkitClearResourceTimings (self)) foreign import javascript unsafe "$1[\"webkitSetResourceTimingBufferSize\"]($2)" js_webkitSetResourceTimingBufferSize :: Performance -> Word -> IO () -- | webkitSetResourceTimingBufferSize :: (MonadIO m) => Performance -> Word -> m () webkitSetResourceTimingBufferSize self maxSize = liftIO (js_webkitSetResourceTimingBufferSize (self) maxSize) foreign import javascript unsafe "$1[\"webkitMark\"]($2)" js_webkitMark :: Performance -> JSString -> IO () -- | webkitMark :: (MonadIO m, ToJSString markName) => Performance -> markName -> m () webkitMark self markName = liftIO (js_webkitMark (self) (toJSString markName)) foreign import javascript unsafe "$1[\"webkitClearMarks\"]($2)" js_webkitClearMarks :: Performance -> JSString -> IO () -- | webkitClearMarks :: (MonadIO m, ToJSString markName) => Performance -> markName -> m () webkitClearMarks self markName = liftIO (js_webkitClearMarks (self) (toJSString markName)) foreign import javascript unsafe "$1[\"webkitMeasure\"]($2, $3, $4)" js_webkitMeasure :: Performance -> JSString -> JSString -> JSString -> IO () -- | webkitMeasure :: (MonadIO m, ToJSString measureName, ToJSString startMark, ToJSString endMark) => Performance -> measureName -> startMark -> endMark -> m () webkitMeasure self measureName startMark endMark = liftIO (js_webkitMeasure (self) (toJSString measureName) (toJSString startMark) (toJSString endMark)) foreign import javascript unsafe "$1[\"webkitClearMeasures\"]($2)" js_webkitClearMeasures :: Performance -> JSString -> IO () -- | webkitClearMeasures :: (MonadIO m, ToJSString measureName) => Performance -> measureName -> m () webkitClearMeasures self measureName = liftIO (js_webkitClearMeasures (self) (toJSString measureName)) foreign import javascript unsafe "$1[\"now\"]()" js_now :: Performance -> IO Double -- | now :: (MonadIO m) => Performance -> m Double now self = liftIO (js_now (self)) -- | now_ :: (MonadIO m) => Performance -> m () now_ self = liftIO (void (js_now (self))) foreign import javascript unsafe "$1[\"navigation\"]" js_getNavigation :: Performance -> IO (Nullable PerformanceNavigation) -- | getNavigation :: (MonadIO m) => Performance -> m (Maybe PerformanceNavigation) getNavigation self = liftIO (nullableToMaybe <$> (js_getNavigation (self))) -- | getNavigationUnsafe :: (MonadIO m, HasCallStack) => Performance -> m PerformanceNavigation getNavigationUnsafe self = liftIO ((nullableToMaybe <$> (js_getNavigation (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | getNavigationUnchecked :: (MonadIO m) => Performance -> m PerformanceNavigation getNavigationUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getNavigation (self))) foreign import javascript unsafe "$1[\"timing\"]" js_getTiming :: Performance -> IO (Nullable PerformanceTiming) -- | getTiming :: (MonadIO m) => Performance -> m (Maybe PerformanceTiming) getTiming self = liftIO (nullableToMaybe <$> (js_getTiming (self))) -- | getTimingUnsafe :: (MonadIO m, HasCallStack) => Performance -> m PerformanceTiming getTimingUnsafe self = liftIO ((nullableToMaybe <$> (js_getTiming (self))) >>= maybe (Prelude.error "Nothing to return") return) -- | getTimingUnchecked :: (MonadIO m) => Performance -> m PerformanceTiming getTimingUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getTiming (self))) -- | webKitResourceTimingBufferFull :: EventName Performance Event webKitResourceTimingBufferFull = unsafeEventName (toJSString "webkitresourcetimingbufferfull")