{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Poppler.Objects.AnnotSquare
    ( 

-- * Exported types
    AnnotSquare(..)                         ,
    IsAnnotSquare                           ,
    toAnnotSquare                           ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveAnnotSquareMethod                ,
#endif


-- ** getInteriorColor #method:getInteriorColor#

#if defined(ENABLE_OVERLOADING)
    AnnotSquareGetInteriorColorMethodInfo   ,
#endif
    annotSquareGetInteriorColor             ,


-- ** new #method:new#

    annotSquareNew                          ,


-- ** setInteriorColor #method:setInteriorColor#

#if defined(ENABLE_OVERLOADING)
    AnnotSquareSetInteriorColorMethodInfo   ,
#endif
    annotSquareSetInteriorColor             ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Poppler.Objects.Annot as Poppler.Annot
import {-# SOURCE #-} qualified GI.Poppler.Objects.AnnotMarkup as Poppler.AnnotMarkup
import {-# SOURCE #-} qualified GI.Poppler.Objects.Document as Poppler.Document
import {-# SOURCE #-} qualified GI.Poppler.Structs.Color as Poppler.Color
import {-# SOURCE #-} qualified GI.Poppler.Structs.Rectangle as Poppler.Rectangle

-- | Memory-managed wrapper type.
newtype AnnotSquare = AnnotSquare (SP.ManagedPtr AnnotSquare)
    deriving (AnnotSquare -> AnnotSquare -> Bool
(AnnotSquare -> AnnotSquare -> Bool)
-> (AnnotSquare -> AnnotSquare -> Bool) -> Eq AnnotSquare
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnnotSquare -> AnnotSquare -> Bool
$c/= :: AnnotSquare -> AnnotSquare -> Bool
== :: AnnotSquare -> AnnotSquare -> Bool
$c== :: AnnotSquare -> AnnotSquare -> Bool
Eq)

instance SP.ManagedPtrNewtype AnnotSquare where
    toManagedPtr :: AnnotSquare -> ManagedPtr AnnotSquare
toManagedPtr (AnnotSquare ManagedPtr AnnotSquare
p) = ManagedPtr AnnotSquare
p

foreign import ccall "poppler_annot_square_get_type"
    c_poppler_annot_square_get_type :: IO B.Types.GType

instance B.Types.TypedObject AnnotSquare where
    glibType :: IO GType
glibType = IO GType
c_poppler_annot_square_get_type

instance B.Types.GObject AnnotSquare

-- | Convert 'AnnotSquare' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue AnnotSquare where
    toGValue :: AnnotSquare -> IO GValue
toGValue AnnotSquare
o = do
        GType
gtype <- IO GType
c_poppler_annot_square_get_type
        AnnotSquare -> (Ptr AnnotSquare -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr AnnotSquare
o (GType
-> (GValue -> Ptr AnnotSquare -> IO ())
-> Ptr AnnotSquare
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr AnnotSquare -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO AnnotSquare
fromGValue GValue
gv = do
        Ptr AnnotSquare
ptr <- GValue -> IO (Ptr AnnotSquare)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr AnnotSquare)
        (ManagedPtr AnnotSquare -> AnnotSquare)
-> Ptr AnnotSquare -> IO AnnotSquare
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr AnnotSquare -> AnnotSquare
AnnotSquare Ptr AnnotSquare
ptr
        
    

-- | Type class for types which can be safely cast to `AnnotSquare`, for instance with `toAnnotSquare`.
class (SP.GObject o, O.IsDescendantOf AnnotSquare o) => IsAnnotSquare o
instance (SP.GObject o, O.IsDescendantOf AnnotSquare o) => IsAnnotSquare o

instance O.HasParentTypes AnnotSquare
type instance O.ParentTypes AnnotSquare = '[Poppler.AnnotMarkup.AnnotMarkup, Poppler.Annot.Annot, GObject.Object.Object]

-- | Cast to `AnnotSquare`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toAnnotSquare :: (MonadIO m, IsAnnotSquare o) => o -> m AnnotSquare
toAnnotSquare :: o -> m AnnotSquare
toAnnotSquare = IO AnnotSquare -> m AnnotSquare
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnnotSquare -> m AnnotSquare)
-> (o -> IO AnnotSquare) -> o -> m AnnotSquare
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr AnnotSquare -> AnnotSquare) -> o -> IO AnnotSquare
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr AnnotSquare -> AnnotSquare
AnnotSquare

#if defined(ENABLE_OVERLOADING)
type family ResolveAnnotSquareMethod (t :: Symbol) (o :: *) :: * where
    ResolveAnnotSquareMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAnnotSquareMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAnnotSquareMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAnnotSquareMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAnnotSquareMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAnnotSquareMethod "hasPopup" o = Poppler.AnnotMarkup.AnnotMarkupHasPopupMethodInfo
    ResolveAnnotSquareMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAnnotSquareMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAnnotSquareMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAnnotSquareMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAnnotSquareMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAnnotSquareMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAnnotSquareMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAnnotSquareMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAnnotSquareMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAnnotSquareMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAnnotSquareMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAnnotSquareMethod "getAnnotType" o = Poppler.Annot.AnnotGetAnnotTypeMethodInfo
    ResolveAnnotSquareMethod "getColor" o = Poppler.Annot.AnnotGetColorMethodInfo
    ResolveAnnotSquareMethod "getContents" o = Poppler.Annot.AnnotGetContentsMethodInfo
    ResolveAnnotSquareMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAnnotSquareMethod "getDate" o = Poppler.AnnotMarkup.AnnotMarkupGetDateMethodInfo
    ResolveAnnotSquareMethod "getExternalData" o = Poppler.AnnotMarkup.AnnotMarkupGetExternalDataMethodInfo
    ResolveAnnotSquareMethod "getFlags" o = Poppler.Annot.AnnotGetFlagsMethodInfo
    ResolveAnnotSquareMethod "getInteriorColor" o = AnnotSquareGetInteriorColorMethodInfo
    ResolveAnnotSquareMethod "getLabel" o = Poppler.AnnotMarkup.AnnotMarkupGetLabelMethodInfo
    ResolveAnnotSquareMethod "getModified" o = Poppler.Annot.AnnotGetModifiedMethodInfo
    ResolveAnnotSquareMethod "getName" o = Poppler.Annot.AnnotGetNameMethodInfo
    ResolveAnnotSquareMethod "getOpacity" o = Poppler.AnnotMarkup.AnnotMarkupGetOpacityMethodInfo
    ResolveAnnotSquareMethod "getPageIndex" o = Poppler.Annot.AnnotGetPageIndexMethodInfo
    ResolveAnnotSquareMethod "getPopupIsOpen" o = Poppler.AnnotMarkup.AnnotMarkupGetPopupIsOpenMethodInfo
    ResolveAnnotSquareMethod "getPopupRectangle" o = Poppler.AnnotMarkup.AnnotMarkupGetPopupRectangleMethodInfo
    ResolveAnnotSquareMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAnnotSquareMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAnnotSquareMethod "getRectangle" o = Poppler.Annot.AnnotGetRectangleMethodInfo
    ResolveAnnotSquareMethod "getReplyTo" o = Poppler.AnnotMarkup.AnnotMarkupGetReplyToMethodInfo
    ResolveAnnotSquareMethod "getSubject" o = Poppler.AnnotMarkup.AnnotMarkupGetSubjectMethodInfo
    ResolveAnnotSquareMethod "setColor" o = Poppler.Annot.AnnotSetColorMethodInfo
    ResolveAnnotSquareMethod "setContents" o = Poppler.Annot.AnnotSetContentsMethodInfo
    ResolveAnnotSquareMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAnnotSquareMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAnnotSquareMethod "setFlags" o = Poppler.Annot.AnnotSetFlagsMethodInfo
    ResolveAnnotSquareMethod "setInteriorColor" o = AnnotSquareSetInteriorColorMethodInfo
    ResolveAnnotSquareMethod "setLabel" o = Poppler.AnnotMarkup.AnnotMarkupSetLabelMethodInfo
    ResolveAnnotSquareMethod "setOpacity" o = Poppler.AnnotMarkup.AnnotMarkupSetOpacityMethodInfo
    ResolveAnnotSquareMethod "setPopup" o = Poppler.AnnotMarkup.AnnotMarkupSetPopupMethodInfo
    ResolveAnnotSquareMethod "setPopupIsOpen" o = Poppler.AnnotMarkup.AnnotMarkupSetPopupIsOpenMethodInfo
    ResolveAnnotSquareMethod "setPopupRectangle" o = Poppler.AnnotMarkup.AnnotMarkupSetPopupRectangleMethodInfo
    ResolveAnnotSquareMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAnnotSquareMethod "setRectangle" o = Poppler.Annot.AnnotSetRectangleMethodInfo
    ResolveAnnotSquareMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveAnnotSquareMethod t AnnotSquare, O.MethodInfo info AnnotSquare p) => OL.IsLabel t (AnnotSquare -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AnnotSquare
type instance O.AttributeList AnnotSquare = AnnotSquareAttributeList
type AnnotSquareAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList AnnotSquare = AnnotSquareSignalList
type AnnotSquareSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method AnnotSquare::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "doc"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rect"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerRectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Poppler" , name = "AnnotSquare" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_annot_square_new" poppler_annot_square_new :: 
    Ptr Poppler.Document.Document ->        -- doc : TInterface (Name {namespace = "Poppler", name = "Document"})
    Ptr Poppler.Rectangle.Rectangle ->      -- rect : TInterface (Name {namespace = "Poppler", name = "Rectangle"})
    IO (Ptr AnnotSquare)

-- | Creates a new Square annotation that will be
-- located on /@rect@/ when added to a page. See
-- 'GI.Poppler.Objects.Page.pageAddAnnot'
-- 
-- /Since: 0.26/
annotSquareNew ::
    (B.CallStack.HasCallStack, MonadIO m, Poppler.Document.IsDocument a) =>
    a
    -- ^ /@doc@/: a t'GI.Poppler.Objects.Document.Document'
    -> Poppler.Rectangle.Rectangle
    -- ^ /@rect@/: a t'GI.Poppler.Structs.Rectangle.Rectangle'
    -> m AnnotSquare
    -- ^ __Returns:__ a newly created t'GI.Poppler.Objects.AnnotSquare.AnnotSquare' annotation
annotSquareNew :: a -> Rectangle -> m AnnotSquare
annotSquareNew a
doc Rectangle
rect = IO AnnotSquare -> m AnnotSquare
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnnotSquare -> m AnnotSquare)
-> IO AnnotSquare -> m AnnotSquare
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
doc' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
doc
    Ptr Rectangle
rect' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
rect
    Ptr AnnotSquare
result <- Ptr Document -> Ptr Rectangle -> IO (Ptr AnnotSquare)
poppler_annot_square_new Ptr Document
doc' Ptr Rectangle
rect'
    Text -> Ptr AnnotSquare -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"annotSquareNew" Ptr AnnotSquare
result
    AnnotSquare
result' <- ((ManagedPtr AnnotSquare -> AnnotSquare)
-> Ptr AnnotSquare -> IO AnnotSquare
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr AnnotSquare -> AnnotSquare
AnnotSquare) Ptr AnnotSquare
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
doc
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
rect
    AnnotSquare -> IO AnnotSquare
forall (m :: * -> *) a. Monad m => a -> m a
return AnnotSquare
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method AnnotSquare::get_interior_color
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "AnnotSquare" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnotSquare"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Poppler" , name = "Color" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_annot_square_get_interior_color" poppler_annot_square_get_interior_color :: 
    Ptr AnnotSquare ->                      -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotSquare"})
    IO (Ptr Poppler.Color.Color)

-- | Retrieves the interior color of /@popplerAnnot@/.
-- 
-- /Since: 0.26/
annotSquareGetInteriorColor ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotSquare a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotSquare.AnnotSquare'
    -> m Poppler.Color.Color
    -- ^ __Returns:__ a new allocated t'GI.Poppler.Structs.Color.Color' with the color values of
    --               /@popplerAnnot@/, or 'P.Nothing'. It must be freed with 'GI.GLib.Functions.free' when done.
annotSquareGetInteriorColor :: a -> m Color
annotSquareGetInteriorColor a
popplerAnnot = IO Color -> m Color
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Color -> m Color) -> IO Color -> m Color
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotSquare
popplerAnnot' <- a -> IO (Ptr AnnotSquare)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    Ptr Color
result <- Ptr AnnotSquare -> IO (Ptr Color)
poppler_annot_square_get_interior_color Ptr AnnotSquare
popplerAnnot'
    Text -> Ptr Color -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"annotSquareGetInteriorColor" Ptr Color
result
    Color
result' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Color -> Color
Poppler.Color.Color) Ptr Color
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Color -> IO Color
forall (m :: * -> *) a. Monad m => a -> m a
return Color
result'

#if defined(ENABLE_OVERLOADING)
data AnnotSquareGetInteriorColorMethodInfo
instance (signature ~ (m Poppler.Color.Color), MonadIO m, IsAnnotSquare a) => O.MethodInfo AnnotSquareGetInteriorColorMethodInfo a signature where
    overloadedMethod = annotSquareGetInteriorColor

#endif

-- method AnnotSquare::set_interior_color
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "AnnotSquare" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnotSquare"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "poppler_color"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerColor, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_annot_square_set_interior_color" poppler_annot_square_set_interior_color :: 
    Ptr AnnotSquare ->                      -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotSquare"})
    Ptr Poppler.Color.Color ->              -- poppler_color : TInterface (Name {namespace = "Poppler", name = "Color"})
    IO ()

-- | Sets the interior color of /@popplerAnnot@/.
-- 
-- /Since: 0.26/
annotSquareSetInteriorColor ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotSquare a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotSquare.AnnotSquare'
    -> Maybe (Poppler.Color.Color)
    -- ^ /@popplerColor@/: a t'GI.Poppler.Structs.Color.Color', or 'P.Nothing'
    -> m ()
annotSquareSetInteriorColor :: a -> Maybe Color -> m ()
annotSquareSetInteriorColor a
popplerAnnot Maybe Color
popplerColor = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotSquare
popplerAnnot' <- a -> IO (Ptr AnnotSquare)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    Ptr Color
maybePopplerColor <- case Maybe Color
popplerColor of
        Maybe Color
Nothing -> Ptr Color -> IO (Ptr Color)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Color
forall a. Ptr a
nullPtr
        Just Color
jPopplerColor -> do
            Ptr Color
jPopplerColor' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
jPopplerColor
            Ptr Color -> IO (Ptr Color)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Color
jPopplerColor'
    Ptr AnnotSquare -> Ptr Color -> IO ()
poppler_annot_square_set_interior_color Ptr AnnotSquare
popplerAnnot' Ptr Color
maybePopplerColor
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Maybe Color -> (Color -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Color
popplerColor Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnnotSquareSetInteriorColorMethodInfo
instance (signature ~ (Maybe (Poppler.Color.Color) -> m ()), MonadIO m, IsAnnotSquare a) => O.MethodInfo AnnotSquareSetInteriorColorMethodInfo a signature where
    overloadedMethod = annotSquareSetInteriorColor

#endif