{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.HTMLAttachmentElement
       (setFile, getFile, getFileUnsafe, getFileUnchecked,
        HTMLAttachmentElement(..), gTypeHTMLAttachmentElement)
       where
import Prelude ((.), (==), (>>=), return, IO, Int, Float, Double, Bool(..), Maybe, maybe, fromIntegral, round, realToFrac, fmap, Show, Read, Eq, Ord, Maybe(..))
import qualified Prelude (error)
import Data.Typeable (Typeable)
import Data.Traversable (mapM)
import Language.Javascript.JSaddle (JSM(..), JSVal(..), JSString, strictEqual, toJSVal, valToStr, valToNumber, valToBool, js, jss, jsf, jsg, function, asyncFunction, new, array, jsUndefined, (!), (!!))
import Data.Int (Int64)
import Data.Word (Word, Word64)
import JSDOM.Types
import Control.Applicative ((<$>))
import Control.Monad (void)
import Control.Lens.Operators ((^.))
import JSDOM.EventTargetClosures (EventName, unsafeEventName, unsafeEventNameAsync)
import JSDOM.Enums

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAttachmentElement.file Mozilla HTMLAttachmentElement.file documentation> 
setFile ::
        (MonadDOM m) => HTMLAttachmentElement -> Maybe File -> m ()
setFile :: forall (m :: * -> *).
MonadDOM m =>
HTMLAttachmentElement -> Maybe File -> m ()
setFile HTMLAttachmentElement
self Maybe File
val = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (HTMLAttachmentElement
self HTMLAttachmentElement
-> Getting (DOM ()) HTMLAttachmentElement (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. String
-> JSM JSVal
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
forall name val.
(ToJSString name, ToJSVal val) =>
name
-> val
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
jss String
"file" (Maybe File -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe File
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAttachmentElement.file Mozilla HTMLAttachmentElement.file documentation> 
getFile :: (MonadDOM m) => HTMLAttachmentElement -> m (Maybe File)
getFile :: forall (m :: * -> *).
MonadDOM m =>
HTMLAttachmentElement -> m (Maybe File)
getFile HTMLAttachmentElement
self = DOM (Maybe File) -> m (Maybe File)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((HTMLAttachmentElement
self HTMLAttachmentElement
-> Getting (JSM JSVal) HTMLAttachmentElement (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter HTMLAttachmentElement (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"file") JSM JSVal -> (JSVal -> DOM (Maybe File)) -> DOM (Maybe File)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe File)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAttachmentElement.file Mozilla HTMLAttachmentElement.file documentation> 
getFileUnsafe ::
              (MonadDOM m, HasCallStack) => HTMLAttachmentElement -> m File
getFileUnsafe :: forall (m :: * -> *).
(MonadDOM m, HasCallStack) =>
HTMLAttachmentElement -> m File
getFileUnsafe HTMLAttachmentElement
self
  = DOM File -> m File
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((HTMLAttachmentElement
self HTMLAttachmentElement
-> Getting (JSM JSVal) HTMLAttachmentElement (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter HTMLAttachmentElement (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"file") JSM JSVal -> (JSVal -> DOM (Maybe File)) -> DOM (Maybe File)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe File)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe File) -> (Maybe File -> DOM File) -> DOM File
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM File -> (File -> DOM File) -> Maybe File -> DOM File
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM File
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") File -> DOM File
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAttachmentElement.file Mozilla HTMLAttachmentElement.file documentation> 
getFileUnchecked :: (MonadDOM m) => HTMLAttachmentElement -> m File
getFileUnchecked :: forall (m :: * -> *). MonadDOM m => HTMLAttachmentElement -> m File
getFileUnchecked HTMLAttachmentElement
self
  = DOM File -> m File
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((HTMLAttachmentElement
self HTMLAttachmentElement
-> Getting (JSM JSVal) HTMLAttachmentElement (JSM JSVal)
-> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter HTMLAttachmentElement (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"file") JSM JSVal -> (JSVal -> DOM File) -> DOM File
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM File
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)