{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Describes condition for an [class/@breakpoint@/].
-- 
-- /Since: 1.4/

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

module GI.Adw.Structs.BreakpointCondition
    ( 

-- * Exported types
    BreakpointCondition(..)                 ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.Adw.Structs.BreakpointCondition#g:method:copy"), [free]("GI.Adw.Structs.BreakpointCondition#g:method:free"), [toString]("GI.Adw.Structs.BreakpointCondition#g:method:toString").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveBreakpointConditionMethod        ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    BreakpointConditionCopyMethodInfo       ,
#endif
    breakpointConditionCopy                 ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    BreakpointConditionFreeMethodInfo       ,
#endif
    breakpointConditionFree                 ,


-- ** newAnd #method:newAnd#

    breakpointConditionNewAnd               ,


-- ** newLength #method:newLength#

    breakpointConditionNewLength            ,


-- ** newOr #method:newOr#

    breakpointConditionNewOr                ,


-- ** newRatio #method:newRatio#

    breakpointConditionNewRatio             ,


-- ** parse #method:parse#

    breakpointConditionParse                ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    BreakpointConditionToStringMethodInfo   ,
#endif
    breakpointConditionToString             ,




    ) 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.GHashTable as B.GHT
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.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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 GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import {-# SOURCE #-} qualified GI.Adw.Enums as Adw.Enums

#else
import {-# SOURCE #-} qualified GI.Adw.Enums as Adw.Enums

#endif

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

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

foreign import ccall "adw_breakpoint_condition_get_type" c_adw_breakpoint_condition_get_type :: 
    IO GType

type instance O.ParentTypes BreakpointCondition = '[]
instance O.HasParentTypes BreakpointCondition

instance B.Types.TypedObject BreakpointCondition where
    glibType :: IO GType
glibType = IO GType
c_adw_breakpoint_condition_get_type

instance B.Types.GBoxed BreakpointCondition

-- | Convert 'BreakpointCondition' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe BreakpointCondition) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_adw_breakpoint_condition_get_type
    gvalueSet_ :: Ptr GValue -> Maybe BreakpointCondition -> IO ()
gvalueSet_ Ptr GValue
gv Maybe BreakpointCondition
P.Nothing = Ptr GValue -> Ptr BreakpointCondition -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr BreakpointCondition
forall a. Ptr a
FP.nullPtr :: FP.Ptr BreakpointCondition)
    gvalueSet_ Ptr GValue
gv (P.Just BreakpointCondition
obj) = BreakpointCondition -> (Ptr BreakpointCondition -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr BreakpointCondition
obj (Ptr GValue -> Ptr BreakpointCondition -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe BreakpointCondition)
gvalueGet_ Ptr GValue
gv = do
        Ptr BreakpointCondition
ptr <- Ptr GValue -> IO (Ptr BreakpointCondition)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr BreakpointCondition)
        if Ptr BreakpointCondition
ptr Ptr BreakpointCondition -> Ptr BreakpointCondition -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr BreakpointCondition
forall a. Ptr a
FP.nullPtr
        then BreakpointCondition -> Maybe BreakpointCondition
forall a. a -> Maybe a
P.Just (BreakpointCondition -> Maybe BreakpointCondition)
-> IO BreakpointCondition -> IO (Maybe BreakpointCondition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr BreakpointCondition -> BreakpointCondition)
-> Ptr BreakpointCondition -> IO BreakpointCondition
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr BreakpointCondition -> BreakpointCondition
BreakpointCondition Ptr BreakpointCondition
ptr
        else Maybe BreakpointCondition -> IO (Maybe BreakpointCondition)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BreakpointCondition
forall a. Maybe a
P.Nothing
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BreakpointCondition
type instance O.AttributeList BreakpointCondition = BreakpointConditionAttributeList
type BreakpointConditionAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method BreakpointCondition::new_and
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "condition_1"
--           , argType =
--               TInterface
--                 Name { namespace = "Adw" , name = "BreakpointCondition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "first condition" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "condition_2"
--           , argType =
--               TInterface
--                 Name { namespace = "Adw" , name = "BreakpointCondition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "second condition" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Adw" , name = "BreakpointCondition" })
-- throws : False
-- Skip return : False

foreign import ccall "adw_breakpoint_condition_new_and" adw_breakpoint_condition_new_and :: 
    Ptr BreakpointCondition ->              -- condition_1 : TInterface (Name {namespace = "Adw", name = "BreakpointCondition"})
    Ptr BreakpointCondition ->              -- condition_2 : TInterface (Name {namespace = "Adw", name = "BreakpointCondition"})
    IO (Ptr BreakpointCondition)

-- | Creates a condition that triggers when /@condition1@/ and /@condition2@/ are both
-- true.
-- 
-- /Since: 1.4/
breakpointConditionNewAnd ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BreakpointCondition
    -- ^ /@condition1@/: first condition
    -> BreakpointCondition
    -- ^ /@condition2@/: second condition
    -> m BreakpointCondition
    -- ^ __Returns:__ the newly created condition
breakpointConditionNewAnd :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BreakpointCondition -> BreakpointCondition -> m BreakpointCondition
breakpointConditionNewAnd BreakpointCondition
condition1 BreakpointCondition
condition2 = IO BreakpointCondition -> m BreakpointCondition
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BreakpointCondition -> m BreakpointCondition)
-> IO BreakpointCondition -> m BreakpointCondition
forall a b. (a -> b) -> a -> b
$ do
    Ptr BreakpointCondition
condition1' <- BreakpointCondition -> IO (Ptr BreakpointCondition)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed BreakpointCondition
condition1
    Ptr BreakpointCondition
condition2' <- BreakpointCondition -> IO (Ptr BreakpointCondition)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed BreakpointCondition
condition2
    Ptr BreakpointCondition
result <- Ptr BreakpointCondition
-> Ptr BreakpointCondition -> IO (Ptr BreakpointCondition)
adw_breakpoint_condition_new_and Ptr BreakpointCondition
condition1' Ptr BreakpointCondition
condition2'
    Text -> Ptr BreakpointCondition -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"breakpointConditionNewAnd" Ptr BreakpointCondition
result
    BreakpointCondition
result' <- ((ManagedPtr BreakpointCondition -> BreakpointCondition)
-> Ptr BreakpointCondition -> IO BreakpointCondition
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BreakpointCondition -> BreakpointCondition
BreakpointCondition) Ptr BreakpointCondition
result
    BreakpointCondition -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BreakpointCondition
condition1
    BreakpointCondition -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BreakpointCondition
condition2
    BreakpointCondition -> IO BreakpointCondition
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BreakpointCondition
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BreakpointCondition::new_length
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "type"
--           , argType =
--               TInterface
--                 Name { namespace = "Adw" , name = "BreakpointConditionLengthType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "unit"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "LengthUnit" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length unit" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Adw" , name = "BreakpointCondition" })
-- throws : False
-- Skip return : False

foreign import ccall "adw_breakpoint_condition_new_length" adw_breakpoint_condition_new_length :: 
    CUInt ->                                -- type : TInterface (Name {namespace = "Adw", name = "BreakpointConditionLengthType"})
    CDouble ->                              -- value : TBasicType TDouble
    CUInt ->                                -- unit : TInterface (Name {namespace = "Adw", name = "LengthUnit"})
    IO (Ptr BreakpointCondition)

-- | Creates a condition that triggers on length changes.
-- 
-- /Since: 1.4/
breakpointConditionNewLength ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Adw.Enums.BreakpointConditionLengthType
    -- ^ /@type@/: the length type
    -> Double
    -- ^ /@value@/: the length value
    -> Adw.Enums.LengthUnit
    -- ^ /@unit@/: the length unit
    -> m BreakpointCondition
    -- ^ __Returns:__ the newly created condition
breakpointConditionNewLength :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BreakpointConditionLengthType
-> Double -> LengthUnit -> m BreakpointCondition
breakpointConditionNewLength BreakpointConditionLengthType
type_ Double
value LengthUnit
unit = IO BreakpointCondition -> m BreakpointCondition
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BreakpointCondition -> m BreakpointCondition)
-> IO BreakpointCondition -> m BreakpointCondition
forall a b. (a -> b) -> a -> b
$ do
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (BreakpointConditionLengthType -> Int)
-> BreakpointConditionLengthType
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BreakpointConditionLengthType -> Int
forall a. Enum a => a -> Int
fromEnum) BreakpointConditionLengthType
type_
    let value' :: CDouble
value' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
value
    let unit' :: CUInt
unit' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (LengthUnit -> Int) -> LengthUnit -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LengthUnit -> Int
forall a. Enum a => a -> Int
fromEnum) LengthUnit
unit
    Ptr BreakpointCondition
result <- CUInt -> CDouble -> CUInt -> IO (Ptr BreakpointCondition)
adw_breakpoint_condition_new_length CUInt
type_' CDouble
value' CUInt
unit'
    Text -> Ptr BreakpointCondition -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"breakpointConditionNewLength" Ptr BreakpointCondition
result
    BreakpointCondition
result' <- ((ManagedPtr BreakpointCondition -> BreakpointCondition)
-> Ptr BreakpointCondition -> IO BreakpointCondition
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BreakpointCondition -> BreakpointCondition
BreakpointCondition) Ptr BreakpointCondition
result
    BreakpointCondition -> IO BreakpointCondition
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BreakpointCondition
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BreakpointCondition::new_or
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "condition_1"
--           , argType =
--               TInterface
--                 Name { namespace = "Adw" , name = "BreakpointCondition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "first condition" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "condition_2"
--           , argType =
--               TInterface
--                 Name { namespace = "Adw" , name = "BreakpointCondition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "second condition" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Adw" , name = "BreakpointCondition" })
-- throws : False
-- Skip return : False

foreign import ccall "adw_breakpoint_condition_new_or" adw_breakpoint_condition_new_or :: 
    Ptr BreakpointCondition ->              -- condition_1 : TInterface (Name {namespace = "Adw", name = "BreakpointCondition"})
    Ptr BreakpointCondition ->              -- condition_2 : TInterface (Name {namespace = "Adw", name = "BreakpointCondition"})
    IO (Ptr BreakpointCondition)

-- | Creates a condition that triggers when either /@condition1@/ or /@condition2@/ is
-- true.
-- 
-- /Since: 1.4/
breakpointConditionNewOr ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BreakpointCondition
    -- ^ /@condition1@/: first condition
    -> BreakpointCondition
    -- ^ /@condition2@/: second condition
    -> m BreakpointCondition
    -- ^ __Returns:__ the newly created condition
breakpointConditionNewOr :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BreakpointCondition -> BreakpointCondition -> m BreakpointCondition
breakpointConditionNewOr BreakpointCondition
condition1 BreakpointCondition
condition2 = IO BreakpointCondition -> m BreakpointCondition
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BreakpointCondition -> m BreakpointCondition)
-> IO BreakpointCondition -> m BreakpointCondition
forall a b. (a -> b) -> a -> b
$ do
    Ptr BreakpointCondition
condition1' <- BreakpointCondition -> IO (Ptr BreakpointCondition)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed BreakpointCondition
condition1
    Ptr BreakpointCondition
condition2' <- BreakpointCondition -> IO (Ptr BreakpointCondition)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed BreakpointCondition
condition2
    Ptr BreakpointCondition
result <- Ptr BreakpointCondition
-> Ptr BreakpointCondition -> IO (Ptr BreakpointCondition)
adw_breakpoint_condition_new_or Ptr BreakpointCondition
condition1' Ptr BreakpointCondition
condition2'
    Text -> Ptr BreakpointCondition -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"breakpointConditionNewOr" Ptr BreakpointCondition
result
    BreakpointCondition
result' <- ((ManagedPtr BreakpointCondition -> BreakpointCondition)
-> Ptr BreakpointCondition -> IO BreakpointCondition
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BreakpointCondition -> BreakpointCondition
BreakpointCondition) Ptr BreakpointCondition
result
    BreakpointCondition -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BreakpointCondition
condition1
    BreakpointCondition -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BreakpointCondition
condition2
    BreakpointCondition -> IO BreakpointCondition
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BreakpointCondition
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BreakpointCondition::new_ratio
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "type"
--           , argType =
--               TInterface
--                 Name { namespace = "Adw" , name = "BreakpointConditionRatioType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the ratio type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "ratio width" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "ratio height" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Adw" , name = "BreakpointCondition" })
-- throws : False
-- Skip return : False

foreign import ccall "adw_breakpoint_condition_new_ratio" adw_breakpoint_condition_new_ratio :: 
    CUInt ->                                -- type : TInterface (Name {namespace = "Adw", name = "BreakpointConditionRatioType"})
    Int32 ->                                -- width : TBasicType TInt
    Int32 ->                                -- height : TBasicType TInt
    IO (Ptr BreakpointCondition)

-- | Creates a condition that triggers on ratio changes.
-- 
-- The ratio is represented as /@width@/ divided by /@height@/.
-- 
-- /Since: 1.4/
breakpointConditionNewRatio ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Adw.Enums.BreakpointConditionRatioType
    -- ^ /@type@/: the ratio type
    -> Int32
    -- ^ /@width@/: ratio width
    -> Int32
    -- ^ /@height@/: ratio height
    -> m BreakpointCondition
    -- ^ __Returns:__ the newly created condition
breakpointConditionNewRatio :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BreakpointConditionRatioType
-> Int32 -> Int32 -> m BreakpointCondition
breakpointConditionNewRatio BreakpointConditionRatioType
type_ Int32
width Int32
height = IO BreakpointCondition -> m BreakpointCondition
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BreakpointCondition -> m BreakpointCondition)
-> IO BreakpointCondition -> m BreakpointCondition
forall a b. (a -> b) -> a -> b
$ do
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (BreakpointConditionRatioType -> Int)
-> BreakpointConditionRatioType
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BreakpointConditionRatioType -> Int
forall a. Enum a => a -> Int
fromEnum) BreakpointConditionRatioType
type_
    Ptr BreakpointCondition
result <- CUInt -> Int32 -> Int32 -> IO (Ptr BreakpointCondition)
adw_breakpoint_condition_new_ratio CUInt
type_' Int32
width Int32
height
    Text -> Ptr BreakpointCondition -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"breakpointConditionNewRatio" Ptr BreakpointCondition
result
    BreakpointCondition
result' <- ((ManagedPtr BreakpointCondition -> BreakpointCondition)
-> Ptr BreakpointCondition -> IO BreakpointCondition
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BreakpointCondition -> BreakpointCondition
BreakpointCondition) Ptr BreakpointCondition
result
    BreakpointCondition -> IO BreakpointCondition
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BreakpointCondition
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BreakpointCondition::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Adw" , name = "BreakpointCondition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a breakpoint condition"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Adw" , name = "BreakpointCondition" })
-- throws : False
-- Skip return : False

foreign import ccall "adw_breakpoint_condition_copy" adw_breakpoint_condition_copy :: 
    Ptr BreakpointCondition ->              -- self : TInterface (Name {namespace = "Adw", name = "BreakpointCondition"})
    IO (Ptr BreakpointCondition)

-- | Copies /@self@/.
-- 
-- /Since: 1.4/
breakpointConditionCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BreakpointCondition
    -- ^ /@self@/: a breakpoint condition
    -> m BreakpointCondition
    -- ^ __Returns:__ a copy of /@self@/
breakpointConditionCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BreakpointCondition -> m BreakpointCondition
breakpointConditionCopy BreakpointCondition
self = IO BreakpointCondition -> m BreakpointCondition
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BreakpointCondition -> m BreakpointCondition)
-> IO BreakpointCondition -> m BreakpointCondition
forall a b. (a -> b) -> a -> b
$ do
    Ptr BreakpointCondition
self' <- BreakpointCondition -> IO (Ptr BreakpointCondition)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BreakpointCondition
self
    Ptr BreakpointCondition
result <- Ptr BreakpointCondition -> IO (Ptr BreakpointCondition)
adw_breakpoint_condition_copy Ptr BreakpointCondition
self'
    Text -> Ptr BreakpointCondition -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"breakpointConditionCopy" Ptr BreakpointCondition
result
    BreakpointCondition
result' <- ((ManagedPtr BreakpointCondition -> BreakpointCondition)
-> Ptr BreakpointCondition -> IO BreakpointCondition
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BreakpointCondition -> BreakpointCondition
BreakpointCondition) Ptr BreakpointCondition
result
    BreakpointCondition -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BreakpointCondition
self
    BreakpointCondition -> IO BreakpointCondition
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BreakpointCondition
result'

#if defined(ENABLE_OVERLOADING)
data BreakpointConditionCopyMethodInfo
instance (signature ~ (m BreakpointCondition), MonadIO m) => O.OverloadedMethod BreakpointConditionCopyMethodInfo BreakpointCondition signature where
    overloadedMethod = breakpointConditionCopy

instance O.OverloadedMethodInfo BreakpointConditionCopyMethodInfo BreakpointCondition where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Structs.BreakpointCondition.breakpointConditionCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Structs-BreakpointCondition.html#v:breakpointConditionCopy"
        })


#endif

-- method BreakpointCondition::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Adw" , name = "BreakpointCondition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a breakpoint condition"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_breakpoint_condition_free" adw_breakpoint_condition_free :: 
    Ptr BreakpointCondition ->              -- self : TInterface (Name {namespace = "Adw", name = "BreakpointCondition"})
    IO ()

-- | Frees /@self@/.
-- 
-- /Since: 1.4/
breakpointConditionFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BreakpointCondition
    -- ^ /@self@/: a breakpoint condition
    -> m ()
breakpointConditionFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BreakpointCondition -> m ()
breakpointConditionFree BreakpointCondition
self = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BreakpointCondition
self' <- BreakpointCondition -> IO (Ptr BreakpointCondition)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BreakpointCondition
self
    Ptr BreakpointCondition -> IO ()
adw_breakpoint_condition_free Ptr BreakpointCondition
self'
    BreakpointCondition -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BreakpointCondition
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BreakpointConditionFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod BreakpointConditionFreeMethodInfo BreakpointCondition signature where
    overloadedMethod = breakpointConditionFree

instance O.OverloadedMethodInfo BreakpointConditionFreeMethodInfo BreakpointCondition where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Structs.BreakpointCondition.breakpointConditionFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Structs-BreakpointCondition.html#v:breakpointConditionFree"
        })


#endif

-- method BreakpointCondition::to_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Adw" , name = "BreakpointCondition" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a breakpoint condition"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "adw_breakpoint_condition_to_string" adw_breakpoint_condition_to_string :: 
    Ptr BreakpointCondition ->              -- self : TInterface (Name {namespace = "Adw", name = "BreakpointCondition"})
    IO CString

-- | Returns a textual representation of /@self@/.
-- 
-- The returned string can be parsed by @/BreakpointCondition.parse/@.
-- 
-- /Since: 1.4/
breakpointConditionToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BreakpointCondition
    -- ^ /@self@/: a breakpoint condition
    -> m T.Text
    -- ^ __Returns:__ A newly allocated text string
breakpointConditionToString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BreakpointCondition -> m Text
breakpointConditionToString BreakpointCondition
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr BreakpointCondition
self' <- BreakpointCondition -> IO (Ptr BreakpointCondition)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BreakpointCondition
self
    CString
result <- Ptr BreakpointCondition -> IO CString
adw_breakpoint_condition_to_string Ptr BreakpointCondition
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"breakpointConditionToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    BreakpointCondition -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BreakpointCondition
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data BreakpointConditionToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod BreakpointConditionToStringMethodInfo BreakpointCondition signature where
    overloadedMethod = breakpointConditionToString

instance O.OverloadedMethodInfo BreakpointConditionToStringMethodInfo BreakpointCondition where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Structs.BreakpointCondition.breakpointConditionToString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Structs-BreakpointCondition.html#v:breakpointConditionToString"
        })


#endif

-- method BreakpointCondition::parse
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the string specifying the condition"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Adw" , name = "BreakpointCondition" })
-- throws : False
-- Skip return : False

foreign import ccall "adw_breakpoint_condition_parse" adw_breakpoint_condition_parse :: 
    CString ->                              -- str : TBasicType TUTF8
    IO (Ptr BreakpointCondition)

-- | Parses a condition from a string.
-- 
-- Length conditions are specified as @\<type>: \<value>[\<unit>]@, where:
-- 
-- * @\<type>@ can be @min-width@, @max-width@, @min-height@ or @max-height@
-- * @\<value>@ is a fractional number
-- * @\<unit>@ can be @px@, @pt@ or @sp@
-- 
-- 
-- If the unit is omitted, @px@ is assumed.
-- 
-- See [ctor/@breakpointCondition@/.new_length].
-- 
-- Examples:
-- 
-- * @min-width: 500px@
-- * @min-height: 400pt@
-- * @max-width: 100sp@
-- * @max-height: 500@
-- 
-- 
-- Ratio conditions are specified as @\<type>: \<width>[\/\<height>]@, where:
-- 
-- * @\<type>@ can be @min-aspect-ratio@ or @max-aspect-ratio@
-- * @\<width>@ and @\<height>@ are integer numbers
-- 
-- 
-- See [ctor/@breakpointCondition@/.new_ratio].
-- 
-- The ratio is represented as @\<width>@ divided by @\<height>@.
-- 
-- If @\<height>@ is omitted, it\'s assumed to be 1.
-- 
-- Examples:
-- 
-- * @min-aspect-ratio: 4\/3@
-- * @max-aspect-ratio: 1@
-- 
-- 
-- The logical operators @and@, @or@ can be used to compose a complex condition
-- as follows:
-- 
-- * @\<condition> and \<condition>@: the condition is true when both
-- @\<condition>@s are true, same as when using
-- [ctor/@breakpointCondition@/.new_and]
-- * @\<condition> or \<condition>@: the condition is true when either of the
-- @\<condition>@s is true, same as when using
-- [ctor/@breakpointCondition@/.new_or]
-- 
-- 
-- Examples:
-- 
-- * @min-width: 400px and max-aspect-ratio: 4\/3@
-- * @max-width: 360sp or max-width: 360px@
-- 
-- 
-- Conditions can be further nested using parentheses, for example:
-- 
-- * @min-width: 400px and (max-aspect-ratio: 4\/3 or max-height: 400px)@
-- 
-- 
-- If parentheses are omitted, the first operator takes priority.
-- 
-- /Since: 1.4/
breakpointConditionParse ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@str@/: the string specifying the condition
    -> m BreakpointCondition
    -- ^ __Returns:__ the parsed condition
breakpointConditionParse :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m BreakpointCondition
breakpointConditionParse Text
str = IO BreakpointCondition -> m BreakpointCondition
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BreakpointCondition -> m BreakpointCondition)
-> IO BreakpointCondition -> m BreakpointCondition
forall a b. (a -> b) -> a -> b
$ do
    CString
str' <- Text -> IO CString
textToCString Text
str
    Ptr BreakpointCondition
result <- CString -> IO (Ptr BreakpointCondition)
adw_breakpoint_condition_parse CString
str'
    Text -> Ptr BreakpointCondition -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"breakpointConditionParse" Ptr BreakpointCondition
result
    BreakpointCondition
result' <- ((ManagedPtr BreakpointCondition -> BreakpointCondition)
-> Ptr BreakpointCondition -> IO BreakpointCondition
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BreakpointCondition -> BreakpointCondition
BreakpointCondition) Ptr BreakpointCondition
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
    BreakpointCondition -> IO BreakpointCondition
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BreakpointCondition
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveBreakpointConditionMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveBreakpointConditionMethod "copy" o = BreakpointConditionCopyMethodInfo
    ResolveBreakpointConditionMethod "free" o = BreakpointConditionFreeMethodInfo
    ResolveBreakpointConditionMethod "toString" o = BreakpointConditionToStringMethodInfo
    ResolveBreakpointConditionMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveBreakpointConditionMethod t BreakpointCondition, O.OverloadedMethod info BreakpointCondition p, R.HasField t BreakpointCondition p) => R.HasField t BreakpointCondition p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveBreakpointConditionMethod t BreakpointCondition, O.OverloadedMethodInfo info BreakpointCondition) => OL.IsLabel t (O.MethodProxy info BreakpointCondition) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif