{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.Path2D
       (newPath2D, newPath2D', newPath2D'', addPath, addPathWithTransform,
        Path2D(..), gTypePath2D)
       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/Path2D Mozilla Path2D documentation> 
newPath2D :: (MonadDOM m) => m Path2D
newPath2D :: m Path2D
newPath2D = DOM Path2D -> m Path2D
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSVal -> Path2D
Path2D (JSVal -> Path2D) -> JSM JSVal -> DOM Path2D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSM JSVal -> () -> JSM JSVal
forall constructor args.
(MakeObject constructor, MakeArgs args) =>
constructor -> args -> JSM JSVal
new ([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"Path2D") ())

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Path2D Mozilla Path2D documentation> 
newPath2D' :: (MonadDOM m) => Path2D -> m Path2D
newPath2D' :: Path2D -> m Path2D
newPath2D' Path2D
path
  = DOM Path2D -> m Path2D
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSVal -> Path2D
Path2D (JSVal -> Path2D) -> JSM JSVal -> DOM Path2D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSM JSVal -> [JSM JSVal] -> JSM JSVal
forall constructor args.
(MakeObject constructor, MakeArgs args) =>
constructor -> args -> JSM JSVal
new ([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"Path2D") [Path2D -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Path2D
path])

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Path2D Mozilla Path2D documentation> 
newPath2D'' :: (MonadDOM m, ToJSString text) => text -> m Path2D
newPath2D'' :: text -> m Path2D
newPath2D'' text
text
  = DOM Path2D -> m Path2D
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSVal -> Path2D
Path2D (JSVal -> Path2D) -> JSM JSVal -> DOM Path2D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSM JSVal -> [JSM JSVal] -> JSM JSVal
forall constructor args.
(MakeObject constructor, MakeArgs args) =>
constructor -> args -> JSM JSVal
new ([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"Path2D") [text -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal text
text])

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Path2D.addPath Mozilla Path2D.addPath documentation> 
addPath :: (MonadDOM m) => Path2D -> Maybe Path2D -> m ()
addPath :: Path2D -> Maybe Path2D -> m ()
addPath Path2D
self Maybe Path2D
path
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Path2D
self Path2D -> Getting (JSM JSVal) Path2D (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"addPath" [Maybe Path2D -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Path2D
path]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Path2D.addPath Mozilla Path2D.addPath documentation> 
addPathWithTransform ::
                     (MonadDOM m) => Path2D -> Maybe Path2D -> SVGMatrix -> m ()
addPathWithTransform :: Path2D -> Maybe Path2D -> SVGMatrix -> m ()
addPathWithTransform Path2D
self Maybe Path2D
path SVGMatrix
transform
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Path2D
self Path2D -> Getting (JSM JSVal) Path2D (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"addPath" [Maybe Path2D -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Path2D
path, SVGMatrix -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal SVGMatrix
transform]))