{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Gio.Objects.ApplicationCommandLine
(
ApplicationCommandLine(..) ,
IsApplicationCommandLine ,
toApplicationCommandLine ,
#if defined(ENABLE_OVERLOADING)
ResolveApplicationCommandLineMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
ApplicationCommandLineCreateFileForArgMethodInfo,
#endif
applicationCommandLineCreateFileForArg ,
#if defined(ENABLE_OVERLOADING)
ApplicationCommandLineDoneMethodInfo ,
#endif
applicationCommandLineDone ,
#if defined(ENABLE_OVERLOADING)
ApplicationCommandLineGetArgumentsMethodInfo,
#endif
applicationCommandLineGetArguments ,
#if defined(ENABLE_OVERLOADING)
ApplicationCommandLineGetCwdMethodInfo ,
#endif
applicationCommandLineGetCwd ,
#if defined(ENABLE_OVERLOADING)
ApplicationCommandLineGetEnvironMethodInfo,
#endif
applicationCommandLineGetEnviron ,
#if defined(ENABLE_OVERLOADING)
ApplicationCommandLineGetExitStatusMethodInfo,
#endif
applicationCommandLineGetExitStatus ,
#if defined(ENABLE_OVERLOADING)
ApplicationCommandLineGetIsRemoteMethodInfo,
#endif
applicationCommandLineGetIsRemote ,
#if defined(ENABLE_OVERLOADING)
ApplicationCommandLineGetOptionsDictMethodInfo,
#endif
applicationCommandLineGetOptionsDict ,
#if defined(ENABLE_OVERLOADING)
ApplicationCommandLineGetPlatformDataMethodInfo,
#endif
applicationCommandLineGetPlatformData ,
#if defined(ENABLE_OVERLOADING)
ApplicationCommandLineGetStdinMethodInfo,
#endif
applicationCommandLineGetStdin ,
#if defined(ENABLE_OVERLOADING)
ApplicationCommandLineGetenvMethodInfo ,
#endif
applicationCommandLineGetenv ,
#if defined(ENABLE_OVERLOADING)
ApplicationCommandLinePrintLiteralMethodInfo,
#endif
applicationCommandLinePrintLiteral ,
#if defined(ENABLE_OVERLOADING)
ApplicationCommandLinePrinterrLiteralMethodInfo,
#endif
applicationCommandLinePrinterrLiteral ,
#if defined(ENABLE_OVERLOADING)
ApplicationCommandLineSetExitStatusMethodInfo,
#endif
applicationCommandLineSetExitStatus ,
#if defined(ENABLE_OVERLOADING)
ApplicationCommandLineArgumentsPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
applicationCommandLineArguments ,
#endif
constructApplicationCommandLineArguments,
#if defined(ENABLE_OVERLOADING)
ApplicationCommandLineIsRemotePropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
applicationCommandLineIsRemote ,
#endif
getApplicationCommandLineIsRemote ,
#if defined(ENABLE_OVERLOADING)
ApplicationCommandLineOptionsPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
applicationCommandLineOptions ,
#endif
constructApplicationCommandLineOptions ,
#if defined(ENABLE_OVERLOADING)
ApplicationCommandLinePlatformDataPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
applicationCommandLinePlatformData ,
#endif
constructApplicationCommandLinePlatformData,
) 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
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Enums as GLib.Enums
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.DateTime as GLib.DateTime
import qualified GI.GLib.Structs.PollFD as GLib.PollFD
import qualified GI.GLib.Structs.Source as GLib.Source
import qualified GI.GLib.Structs.TimeVal as GLib.TimeVal
import qualified GI.GLib.Structs.VariantDict as GLib.VariantDict
import qualified GI.GObject.Callbacks as GObject.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import {-# SOURCE #-} qualified GI.Gio.Enums as Gio.Enums
import {-# SOURCE #-} qualified GI.Gio.Flags as Gio.Flags
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AppInfo as Gio.AppInfo
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Drive as Gio.Drive
import {-# SOURCE #-} qualified GI.Gio.Interfaces.File as Gio.File
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Icon as Gio.Icon
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Mount as Gio.Mount
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Seekable as Gio.Seekable
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Volume as Gio.Volume
import {-# SOURCE #-} qualified GI.Gio.Objects.AppLaunchContext as Gio.AppLaunchContext
import {-# SOURCE #-} qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Gio.Objects.FileEnumerator as Gio.FileEnumerator
import {-# SOURCE #-} qualified GI.Gio.Objects.FileIOStream as Gio.FileIOStream
import {-# SOURCE #-} qualified GI.Gio.Objects.FileInfo as Gio.FileInfo
import {-# SOURCE #-} qualified GI.Gio.Objects.FileInputStream as Gio.FileInputStream
import {-# SOURCE #-} qualified GI.Gio.Objects.FileMonitor as Gio.FileMonitor
import {-# SOURCE #-} qualified GI.Gio.Objects.FileOutputStream as Gio.FileOutputStream
import {-# SOURCE #-} qualified GI.Gio.Objects.IOStream as Gio.IOStream
import {-# SOURCE #-} qualified GI.Gio.Objects.InputStream as Gio.InputStream
import {-# SOURCE #-} qualified GI.Gio.Objects.MountOperation as Gio.MountOperation
import {-# SOURCE #-} qualified GI.Gio.Objects.OutputStream as Gio.OutputStream
import {-# SOURCE #-} qualified GI.Gio.Structs.FileAttributeInfo as Gio.FileAttributeInfo
import {-# SOURCE #-} qualified GI.Gio.Structs.FileAttributeInfoList as Gio.FileAttributeInfoList
import {-# SOURCE #-} qualified GI.Gio.Structs.FileAttributeMatcher as Gio.FileAttributeMatcher
import {-# SOURCE #-} qualified GI.Gio.Structs.OutputVector as Gio.OutputVector
#else
import qualified GI.GLib.Structs.VariantDict as GLib.VariantDict
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Interfaces.File as Gio.File
import {-# SOURCE #-} qualified GI.Gio.Objects.InputStream as Gio.InputStream
#endif
newtype ApplicationCommandLine = ApplicationCommandLine (SP.ManagedPtr ApplicationCommandLine)
deriving (ApplicationCommandLine -> ApplicationCommandLine -> Bool
(ApplicationCommandLine -> ApplicationCommandLine -> Bool)
-> (ApplicationCommandLine -> ApplicationCommandLine -> Bool)
-> Eq ApplicationCommandLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApplicationCommandLine -> ApplicationCommandLine -> Bool
== :: ApplicationCommandLine -> ApplicationCommandLine -> Bool
$c/= :: ApplicationCommandLine -> ApplicationCommandLine -> Bool
/= :: ApplicationCommandLine -> ApplicationCommandLine -> Bool
Eq)
instance SP.ManagedPtrNewtype ApplicationCommandLine where
toManagedPtr :: ApplicationCommandLine -> ManagedPtr ApplicationCommandLine
toManagedPtr (ApplicationCommandLine ManagedPtr ApplicationCommandLine
p) = ManagedPtr ApplicationCommandLine
p
foreign import ccall "g_application_command_line_get_type"
c_g_application_command_line_get_type :: IO B.Types.GType
instance B.Types.TypedObject ApplicationCommandLine where
glibType :: IO GType
glibType = IO GType
c_g_application_command_line_get_type
instance B.Types.GObject ApplicationCommandLine
class (SP.GObject o, O.IsDescendantOf ApplicationCommandLine o) => IsApplicationCommandLine o
instance (SP.GObject o, O.IsDescendantOf ApplicationCommandLine o) => IsApplicationCommandLine o
instance O.HasParentTypes ApplicationCommandLine
type instance O.ParentTypes ApplicationCommandLine = '[GObject.Object.Object]
toApplicationCommandLine :: (MIO.MonadIO m, IsApplicationCommandLine o) => o -> m ApplicationCommandLine
toApplicationCommandLine :: forall (m :: * -> *) o.
(MonadIO m, IsApplicationCommandLine o) =>
o -> m ApplicationCommandLine
toApplicationCommandLine = IO ApplicationCommandLine -> m ApplicationCommandLine
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ApplicationCommandLine -> m ApplicationCommandLine)
-> (o -> IO ApplicationCommandLine)
-> o
-> m ApplicationCommandLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr ApplicationCommandLine -> ApplicationCommandLine)
-> o -> IO ApplicationCommandLine
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr ApplicationCommandLine -> ApplicationCommandLine
ApplicationCommandLine
instance B.GValue.IsGValue (Maybe ApplicationCommandLine) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_g_application_command_line_get_type
gvalueSet_ :: Ptr GValue -> Maybe ApplicationCommandLine -> IO ()
gvalueSet_ Ptr GValue
gv Maybe ApplicationCommandLine
P.Nothing = Ptr GValue -> Ptr ApplicationCommandLine -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr ApplicationCommandLine
forall a. Ptr a
FP.nullPtr :: FP.Ptr ApplicationCommandLine)
gvalueSet_ Ptr GValue
gv (P.Just ApplicationCommandLine
obj) = ApplicationCommandLine
-> (Ptr ApplicationCommandLine -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ApplicationCommandLine
obj (Ptr GValue -> Ptr ApplicationCommandLine -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe ApplicationCommandLine)
gvalueGet_ Ptr GValue
gv = do
ptr <- Ptr GValue -> IO (Ptr ApplicationCommandLine)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr ApplicationCommandLine)
if ptr /= FP.nullPtr
then P.Just <$> B.ManagedPtr.newObject ApplicationCommandLine ptr
else return P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveApplicationCommandLineMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveApplicationCommandLineMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveApplicationCommandLineMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveApplicationCommandLineMethod "createFileForArg" o = ApplicationCommandLineCreateFileForArgMethodInfo
ResolveApplicationCommandLineMethod "done" o = ApplicationCommandLineDoneMethodInfo
ResolveApplicationCommandLineMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveApplicationCommandLineMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveApplicationCommandLineMethod "getenv" o = ApplicationCommandLineGetenvMethodInfo
ResolveApplicationCommandLineMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveApplicationCommandLineMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveApplicationCommandLineMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveApplicationCommandLineMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveApplicationCommandLineMethod "printLiteral" o = ApplicationCommandLinePrintLiteralMethodInfo
ResolveApplicationCommandLineMethod "printerrLiteral" o = ApplicationCommandLinePrinterrLiteralMethodInfo
ResolveApplicationCommandLineMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveApplicationCommandLineMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveApplicationCommandLineMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveApplicationCommandLineMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveApplicationCommandLineMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveApplicationCommandLineMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveApplicationCommandLineMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveApplicationCommandLineMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveApplicationCommandLineMethod "getArguments" o = ApplicationCommandLineGetArgumentsMethodInfo
ResolveApplicationCommandLineMethod "getCwd" o = ApplicationCommandLineGetCwdMethodInfo
ResolveApplicationCommandLineMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveApplicationCommandLineMethod "getEnviron" o = ApplicationCommandLineGetEnvironMethodInfo
ResolveApplicationCommandLineMethod "getExitStatus" o = ApplicationCommandLineGetExitStatusMethodInfo
ResolveApplicationCommandLineMethod "getIsRemote" o = ApplicationCommandLineGetIsRemoteMethodInfo
ResolveApplicationCommandLineMethod "getOptionsDict" o = ApplicationCommandLineGetOptionsDictMethodInfo
ResolveApplicationCommandLineMethod "getPlatformData" o = ApplicationCommandLineGetPlatformDataMethodInfo
ResolveApplicationCommandLineMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveApplicationCommandLineMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveApplicationCommandLineMethod "getStdin" o = ApplicationCommandLineGetStdinMethodInfo
ResolveApplicationCommandLineMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveApplicationCommandLineMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveApplicationCommandLineMethod "setExitStatus" o = ApplicationCommandLineSetExitStatusMethodInfo
ResolveApplicationCommandLineMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveApplicationCommandLineMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveApplicationCommandLineMethod t ApplicationCommandLine, O.OverloadedMethod info ApplicationCommandLine p) => OL.IsLabel t (ApplicationCommandLine -> p) where
#if MIN_VERSION_base(4,10,0)
fromLabel :: ApplicationCommandLine -> p
fromLabel = forall {k} (i :: k) o s. OverloadedMethod i o s => o -> s
forall i o s. OverloadedMethod i o s => o -> s
O.overloadedMethod @info
#else
fromLabel _ = O.overloadedMethod @info
#endif
#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveApplicationCommandLineMethod t ApplicationCommandLine, O.OverloadedMethod info ApplicationCommandLine p, R.HasField t ApplicationCommandLine p) => R.HasField t ApplicationCommandLine p where
getField :: ApplicationCommandLine -> p
getField = forall {k} (i :: k) o s. OverloadedMethod i o s => o -> s
forall i o s. OverloadedMethod i o s => o -> s
O.overloadedMethod @info
#endif
instance (info ~ ResolveApplicationCommandLineMethod t ApplicationCommandLine, O.OverloadedMethodInfo info ApplicationCommandLine) => OL.IsLabel t (O.MethodProxy info ApplicationCommandLine) where
#if MIN_VERSION_base(4,10,0)
fromLabel :: MethodProxy info ApplicationCommandLine
fromLabel = MethodProxy info ApplicationCommandLine
forall info obj. MethodProxy info obj
O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
constructApplicationCommandLineArguments :: (IsApplicationCommandLine o, MIO.MonadIO m) => GVariant -> m (GValueConstruct o)
constructApplicationCommandLineArguments :: forall o (m :: * -> *).
(IsApplicationCommandLine o, MonadIO m) =>
GVariant -> m (GValueConstruct o)
constructApplicationCommandLineArguments GVariant
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe GVariant -> IO (GValueConstruct o)
forall o. String -> Maybe GVariant -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyVariant String
"arguments" (GVariant -> Maybe GVariant
forall a. a -> Maybe a
P.Just GVariant
val)
#if defined(ENABLE_OVERLOADING)
data ApplicationCommandLineArgumentsPropertyInfo
instance AttrInfo ApplicationCommandLineArgumentsPropertyInfo where
type AttrAllowedOps ApplicationCommandLineArgumentsPropertyInfo = '[ 'AttrConstruct, 'AttrClear]
type AttrBaseTypeConstraint ApplicationCommandLineArgumentsPropertyInfo = IsApplicationCommandLine
type AttrSetTypeConstraint ApplicationCommandLineArgumentsPropertyInfo = (~) GVariant
type AttrTransferTypeConstraint ApplicationCommandLineArgumentsPropertyInfo = (~) GVariant
type AttrTransferType ApplicationCommandLineArgumentsPropertyInfo = GVariant
type AttrGetType ApplicationCommandLineArgumentsPropertyInfo = ()
type AttrLabel ApplicationCommandLineArgumentsPropertyInfo = "arguments"
type AttrOrigin ApplicationCommandLineArgumentsPropertyInfo = ApplicationCommandLine
attrGet :: forall o.
AttrBaseTypeConstraint
ApplicationCommandLineArgumentsPropertyInfo o =>
o -> IO (AttrGetType ApplicationCommandLineArgumentsPropertyInfo)
attrGet = o -> IO ()
o -> IO (AttrGetType ApplicationCommandLineArgumentsPropertyInfo)
forall a. HasCallStack => a
undefined
attrSet :: forall o b.
(AttrBaseTypeConstraint
ApplicationCommandLineArgumentsPropertyInfo o,
AttrSetTypeConstraint
ApplicationCommandLineArgumentsPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint
ApplicationCommandLineArgumentsPropertyInfo o,
AttrTransferTypeConstraint
ApplicationCommandLineArgumentsPropertyInfo b) =>
Proxy o
-> b
-> IO
(AttrTransferType ApplicationCommandLineArgumentsPropertyInfo)
attrTransfer Proxy o
_ b
v = do
b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
v
attrConstruct :: forall o b.
(AttrBaseTypeConstraint
ApplicationCommandLineArgumentsPropertyInfo o,
AttrSetTypeConstraint
ApplicationCommandLineArgumentsPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
GVariant -> IO (GValueConstruct o)
forall o (m :: * -> *).
(IsApplicationCommandLine o, MonadIO m) =>
GVariant -> m (GValueConstruct o)
constructApplicationCommandLineArguments
attrClear :: forall o.
AttrBaseTypeConstraint
ApplicationCommandLineArgumentsPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ApplicationCommandLine.arguments"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ApplicationCommandLine.html#g:attr:arguments"
})
#endif
getApplicationCommandLineIsRemote :: (MonadIO m, IsApplicationCommandLine o) => o -> m Bool
getApplicationCommandLineIsRemote :: forall (m :: * -> *) o.
(MonadIO m, IsApplicationCommandLine o) =>
o -> m Bool
getApplicationCommandLineIsRemote o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"is-remote"
#if defined(ENABLE_OVERLOADING)
data ApplicationCommandLineIsRemotePropertyInfo
instance AttrInfo ApplicationCommandLineIsRemotePropertyInfo where
type AttrAllowedOps ApplicationCommandLineIsRemotePropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint ApplicationCommandLineIsRemotePropertyInfo = IsApplicationCommandLine
type AttrSetTypeConstraint ApplicationCommandLineIsRemotePropertyInfo = (~) ()
type AttrTransferTypeConstraint ApplicationCommandLineIsRemotePropertyInfo = (~) ()
type AttrTransferType ApplicationCommandLineIsRemotePropertyInfo = ()
type AttrGetType ApplicationCommandLineIsRemotePropertyInfo = Bool
type AttrLabel ApplicationCommandLineIsRemotePropertyInfo = "is-remote"
type AttrOrigin ApplicationCommandLineIsRemotePropertyInfo = ApplicationCommandLine
attrGet :: forall o.
AttrBaseTypeConstraint
ApplicationCommandLineIsRemotePropertyInfo o =>
o -> IO (AttrGetType ApplicationCommandLineIsRemotePropertyInfo)
attrGet = o -> IO Bool
o -> IO (AttrGetType ApplicationCommandLineIsRemotePropertyInfo)
forall (m :: * -> *) o.
(MonadIO m, IsApplicationCommandLine o) =>
o -> m Bool
getApplicationCommandLineIsRemote
attrSet :: forall o b.
(AttrBaseTypeConstraint
ApplicationCommandLineIsRemotePropertyInfo o,
AttrSetTypeConstraint
ApplicationCommandLineIsRemotePropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint
ApplicationCommandLineIsRemotePropertyInfo o,
AttrTransferTypeConstraint
ApplicationCommandLineIsRemotePropertyInfo b) =>
Proxy o
-> b
-> IO (AttrTransferType ApplicationCommandLineIsRemotePropertyInfo)
attrTransfer Proxy o
_ = b
-> IO (AttrTransferType ApplicationCommandLineIsRemotePropertyInfo)
() -> IO ()
forall a. HasCallStack => a
undefined
attrConstruct :: forall o b.
(AttrBaseTypeConstraint
ApplicationCommandLineIsRemotePropertyInfo o,
AttrSetTypeConstraint
ApplicationCommandLineIsRemotePropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall a. HasCallStack => a
undefined
attrClear :: forall o.
AttrBaseTypeConstraint
ApplicationCommandLineIsRemotePropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ApplicationCommandLine.isRemote"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ApplicationCommandLine.html#g:attr:isRemote"
})
#endif
constructApplicationCommandLineOptions :: (IsApplicationCommandLine o, MIO.MonadIO m) => GVariant -> m (GValueConstruct o)
constructApplicationCommandLineOptions :: forall o (m :: * -> *).
(IsApplicationCommandLine o, MonadIO m) =>
GVariant -> m (GValueConstruct o)
constructApplicationCommandLineOptions GVariant
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe GVariant -> IO (GValueConstruct o)
forall o. String -> Maybe GVariant -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyVariant String
"options" (GVariant -> Maybe GVariant
forall a. a -> Maybe a
P.Just GVariant
val)
#if defined(ENABLE_OVERLOADING)
data ApplicationCommandLineOptionsPropertyInfo
instance AttrInfo ApplicationCommandLineOptionsPropertyInfo where
type AttrAllowedOps ApplicationCommandLineOptionsPropertyInfo = '[ 'AttrConstruct, 'AttrClear]
type AttrBaseTypeConstraint ApplicationCommandLineOptionsPropertyInfo = IsApplicationCommandLine
type AttrSetTypeConstraint ApplicationCommandLineOptionsPropertyInfo = (~) GVariant
type AttrTransferTypeConstraint ApplicationCommandLineOptionsPropertyInfo = (~) GVariant
type AttrTransferType ApplicationCommandLineOptionsPropertyInfo = GVariant
type AttrGetType ApplicationCommandLineOptionsPropertyInfo = ()
type AttrLabel ApplicationCommandLineOptionsPropertyInfo = "options"
type AttrOrigin ApplicationCommandLineOptionsPropertyInfo = ApplicationCommandLine
attrGet :: forall o.
AttrBaseTypeConstraint
ApplicationCommandLineOptionsPropertyInfo o =>
o -> IO (AttrGetType ApplicationCommandLineOptionsPropertyInfo)
attrGet = o -> IO ()
o -> IO (AttrGetType ApplicationCommandLineOptionsPropertyInfo)
forall a. HasCallStack => a
undefined
attrSet :: forall o b.
(AttrBaseTypeConstraint
ApplicationCommandLineOptionsPropertyInfo o,
AttrSetTypeConstraint
ApplicationCommandLineOptionsPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint
ApplicationCommandLineOptionsPropertyInfo o,
AttrTransferTypeConstraint
ApplicationCommandLineOptionsPropertyInfo b) =>
Proxy o
-> b
-> IO (AttrTransferType ApplicationCommandLineOptionsPropertyInfo)
attrTransfer Proxy o
_ b
v = do
b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
v
attrConstruct :: forall o b.
(AttrBaseTypeConstraint
ApplicationCommandLineOptionsPropertyInfo o,
AttrSetTypeConstraint
ApplicationCommandLineOptionsPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
GVariant -> IO (GValueConstruct o)
forall o (m :: * -> *).
(IsApplicationCommandLine o, MonadIO m) =>
GVariant -> m (GValueConstruct o)
constructApplicationCommandLineOptions
attrClear :: forall o.
AttrBaseTypeConstraint
ApplicationCommandLineOptionsPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ApplicationCommandLine.options"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ApplicationCommandLine.html#g:attr:options"
})
#endif
constructApplicationCommandLinePlatformData :: (IsApplicationCommandLine o, MIO.MonadIO m) => GVariant -> m (GValueConstruct o)
constructApplicationCommandLinePlatformData :: forall o (m :: * -> *).
(IsApplicationCommandLine o, MonadIO m) =>
GVariant -> m (GValueConstruct o)
constructApplicationCommandLinePlatformData GVariant
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe GVariant -> IO (GValueConstruct o)
forall o. String -> Maybe GVariant -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyVariant String
"platform-data" (GVariant -> Maybe GVariant
forall a. a -> Maybe a
P.Just GVariant
val)
#if defined(ENABLE_OVERLOADING)
data ApplicationCommandLinePlatformDataPropertyInfo
instance AttrInfo ApplicationCommandLinePlatformDataPropertyInfo where
type AttrAllowedOps ApplicationCommandLinePlatformDataPropertyInfo = '[ 'AttrConstruct, 'AttrClear]
type AttrBaseTypeConstraint ApplicationCommandLinePlatformDataPropertyInfo = IsApplicationCommandLine
type AttrSetTypeConstraint ApplicationCommandLinePlatformDataPropertyInfo = (~) GVariant
type AttrTransferTypeConstraint ApplicationCommandLinePlatformDataPropertyInfo = (~) GVariant
type AttrTransferType ApplicationCommandLinePlatformDataPropertyInfo = GVariant
type AttrGetType ApplicationCommandLinePlatformDataPropertyInfo = ()
type AttrLabel ApplicationCommandLinePlatformDataPropertyInfo = "platform-data"
type AttrOrigin ApplicationCommandLinePlatformDataPropertyInfo = ApplicationCommandLine
attrGet :: forall o.
AttrBaseTypeConstraint
ApplicationCommandLinePlatformDataPropertyInfo o =>
o
-> IO (AttrGetType ApplicationCommandLinePlatformDataPropertyInfo)
attrGet = o -> IO ()
o
-> IO (AttrGetType ApplicationCommandLinePlatformDataPropertyInfo)
forall a. HasCallStack => a
undefined
attrSet :: forall o b.
(AttrBaseTypeConstraint
ApplicationCommandLinePlatformDataPropertyInfo o,
AttrSetTypeConstraint
ApplicationCommandLinePlatformDataPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint
ApplicationCommandLinePlatformDataPropertyInfo o,
AttrTransferTypeConstraint
ApplicationCommandLinePlatformDataPropertyInfo b) =>
Proxy o
-> b
-> IO
(AttrTransferType ApplicationCommandLinePlatformDataPropertyInfo)
attrTransfer Proxy o
_ b
v = do
b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
v
attrConstruct :: forall o b.
(AttrBaseTypeConstraint
ApplicationCommandLinePlatformDataPropertyInfo o,
AttrSetTypeConstraint
ApplicationCommandLinePlatformDataPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
GVariant -> IO (GValueConstruct o)
forall o (m :: * -> *).
(IsApplicationCommandLine o, MonadIO m) =>
GVariant -> m (GValueConstruct o)
constructApplicationCommandLinePlatformData
attrClear :: forall o.
AttrBaseTypeConstraint
ApplicationCommandLinePlatformDataPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ApplicationCommandLine.platformData"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ApplicationCommandLine.html#g:attr:platformData"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ApplicationCommandLine
type instance O.AttributeList ApplicationCommandLine = ApplicationCommandLineAttributeList
type ApplicationCommandLineAttributeList = ('[ '("arguments", ApplicationCommandLineArgumentsPropertyInfo), '("isRemote", ApplicationCommandLineIsRemotePropertyInfo), '("options", ApplicationCommandLineOptionsPropertyInfo), '("platformData", ApplicationCommandLinePlatformDataPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
applicationCommandLineArguments :: AttrLabelProxy "arguments"
applicationCommandLineArguments :: AttrLabelProxy "arguments"
applicationCommandLineArguments = AttrLabelProxy "arguments"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
applicationCommandLineIsRemote :: AttrLabelProxy "isRemote"
applicationCommandLineIsRemote :: AttrLabelProxy "isRemote"
applicationCommandLineIsRemote = AttrLabelProxy "isRemote"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
applicationCommandLineOptions :: AttrLabelProxy "options"
applicationCommandLineOptions :: AttrLabelProxy "options"
applicationCommandLineOptions = AttrLabelProxy "options"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
applicationCommandLinePlatformData :: AttrLabelProxy "platformData"
applicationCommandLinePlatformData :: AttrLabelProxy "platformData"
applicationCommandLinePlatformData = AttrLabelProxy "platformData"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ApplicationCommandLine = ApplicationCommandLineSignalList
type ApplicationCommandLineSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "g_application_command_line_create_file_for_arg" g_application_command_line_create_file_for_arg ::
Ptr ApplicationCommandLine ->
CString ->
IO (Ptr Gio.File.File)
applicationCommandLineCreateFileForArg ::
(B.CallStack.HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a
-> [Char]
-> m Gio.File.File
applicationCommandLineCreateFileForArg :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> String -> m File
applicationCommandLineCreateFileForArg a
cmdline String
arg = IO File -> m File
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
cmdline' <- a -> IO (Ptr ApplicationCommandLine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cmdline
arg' <- stringToCString arg
result <- g_application_command_line_create_file_for_arg cmdline' arg'
checkUnexpectedReturnNULL "applicationCommandLineCreateFileForArg" result
result' <- (wrapObject Gio.File.File) result
touchManagedPtr cmdline
freeMem arg'
return result'
#if defined(ENABLE_OVERLOADING)
data ApplicationCommandLineCreateFileForArgMethodInfo
instance (signature ~ ([Char] -> m Gio.File.File), MonadIO m, IsApplicationCommandLine a) => O.OverloadedMethod ApplicationCommandLineCreateFileForArgMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> String -> m File
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> String -> m File
applicationCommandLineCreateFileForArg
instance O.OverloadedMethodInfo ApplicationCommandLineCreateFileForArgMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ApplicationCommandLine.applicationCommandLineCreateFileForArg",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ApplicationCommandLine.html#v:applicationCommandLineCreateFileForArg"
})
#endif
foreign import ccall "g_application_command_line_done" g_application_command_line_done ::
Ptr ApplicationCommandLine ->
IO ()
applicationCommandLineDone ::
(B.CallStack.HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a
-> m ()
applicationCommandLineDone :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> m ()
applicationCommandLineDone a
cmdline = 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
cmdline' <- a -> IO (Ptr ApplicationCommandLine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cmdline
g_application_command_line_done cmdline'
touchManagedPtr cmdline
return ()
#if defined(ENABLE_OVERLOADING)
data ApplicationCommandLineDoneMethodInfo
instance (signature ~ (m ()), MonadIO m, IsApplicationCommandLine a) => O.OverloadedMethod ApplicationCommandLineDoneMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> m ()
applicationCommandLineDone
instance O.OverloadedMethodInfo ApplicationCommandLineDoneMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ApplicationCommandLine.applicationCommandLineDone",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ApplicationCommandLine.html#v:applicationCommandLineDone"
})
#endif
foreign import ccall "g_application_command_line_get_arguments" g_application_command_line_get_arguments ::
Ptr ApplicationCommandLine ->
Ptr Int32 ->
IO (Ptr CString)
applicationCommandLineGetArguments ::
(B.CallStack.HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a
-> m [[Char]]
applicationCommandLineGetArguments :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> m [String]
applicationCommandLineGetArguments a
cmdline = IO [String] -> m [String]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> m [String]) -> IO [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ do
cmdline' <- a -> IO (Ptr ApplicationCommandLine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cmdline
argc <- allocMem :: IO (Ptr Int32)
result <- g_application_command_line_get_arguments cmdline' argc
argc' <- peek argc
checkUnexpectedReturnNULL "applicationCommandLineGetArguments" result
result' <- (unpackFileNameArrayWithLength argc') result
(mapCArrayWithLength argc') freeMem result
freeMem result
touchManagedPtr cmdline
freeMem argc
return result'
#if defined(ENABLE_OVERLOADING)
data ApplicationCommandLineGetArgumentsMethodInfo
instance (signature ~ (m [[Char]]), MonadIO m, IsApplicationCommandLine a) => O.OverloadedMethod ApplicationCommandLineGetArgumentsMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m [String]
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> m [String]
applicationCommandLineGetArguments
instance O.OverloadedMethodInfo ApplicationCommandLineGetArgumentsMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ApplicationCommandLine.applicationCommandLineGetArguments",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ApplicationCommandLine.html#v:applicationCommandLineGetArguments"
})
#endif
foreign import ccall "g_application_command_line_get_cwd" g_application_command_line_get_cwd ::
Ptr ApplicationCommandLine ->
IO CString
applicationCommandLineGetCwd ::
(B.CallStack.HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a
-> m (Maybe [Char])
applicationCommandLineGetCwd :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> m (Maybe String)
applicationCommandLineGetCwd a
cmdline = IO (Maybe String) -> m (Maybe String)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> m (Maybe String))
-> IO (Maybe String) -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
cmdline' <- a -> IO (Ptr ApplicationCommandLine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cmdline
result <- g_application_command_line_get_cwd cmdline'
maybeResult <- convertIfNonNull result $ \CString
result' -> do
result'' <- HasCallStack => CString -> IO String
CString -> IO String
cstringToString CString
result'
return result''
touchManagedPtr cmdline
return maybeResult
#if defined(ENABLE_OVERLOADING)
data ApplicationCommandLineGetCwdMethodInfo
instance (signature ~ (m (Maybe [Char])), MonadIO m, IsApplicationCommandLine a) => O.OverloadedMethod ApplicationCommandLineGetCwdMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m (Maybe String)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> m (Maybe String)
applicationCommandLineGetCwd
instance O.OverloadedMethodInfo ApplicationCommandLineGetCwdMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ApplicationCommandLine.applicationCommandLineGetCwd",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ApplicationCommandLine.html#v:applicationCommandLineGetCwd"
})
#endif
foreign import ccall "g_application_command_line_get_environ" g_application_command_line_get_environ ::
Ptr ApplicationCommandLine ->
IO (Ptr CString)
applicationCommandLineGetEnviron ::
(B.CallStack.HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a
-> m [[Char]]
applicationCommandLineGetEnviron :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> m [String]
applicationCommandLineGetEnviron a
cmdline = IO [String] -> m [String]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> m [String]) -> IO [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ do
cmdline' <- a -> IO (Ptr ApplicationCommandLine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cmdline
result <- g_application_command_line_get_environ cmdline'
checkUnexpectedReturnNULL "applicationCommandLineGetEnviron" result
result' <- unpackZeroTerminatedFileNameArray result
touchManagedPtr cmdline
return result'
#if defined(ENABLE_OVERLOADING)
data ApplicationCommandLineGetEnvironMethodInfo
instance (signature ~ (m [[Char]]), MonadIO m, IsApplicationCommandLine a) => O.OverloadedMethod ApplicationCommandLineGetEnvironMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m [String]
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> m [String]
applicationCommandLineGetEnviron
instance O.OverloadedMethodInfo ApplicationCommandLineGetEnvironMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ApplicationCommandLine.applicationCommandLineGetEnviron",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ApplicationCommandLine.html#v:applicationCommandLineGetEnviron"
})
#endif
foreign import ccall "g_application_command_line_get_exit_status" g_application_command_line_get_exit_status ::
Ptr ApplicationCommandLine ->
IO Int32
applicationCommandLineGetExitStatus ::
(B.CallStack.HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a
-> m Int32
applicationCommandLineGetExitStatus :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> m Int32
applicationCommandLineGetExitStatus a
cmdline = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
cmdline' <- a -> IO (Ptr ApplicationCommandLine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cmdline
result <- g_application_command_line_get_exit_status cmdline'
touchManagedPtr cmdline
return result
#if defined(ENABLE_OVERLOADING)
data ApplicationCommandLineGetExitStatusMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsApplicationCommandLine a) => O.OverloadedMethod ApplicationCommandLineGetExitStatusMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Int32
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> m Int32
applicationCommandLineGetExitStatus
instance O.OverloadedMethodInfo ApplicationCommandLineGetExitStatusMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ApplicationCommandLine.applicationCommandLineGetExitStatus",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ApplicationCommandLine.html#v:applicationCommandLineGetExitStatus"
})
#endif
foreign import ccall "g_application_command_line_get_is_remote" g_application_command_line_get_is_remote ::
Ptr ApplicationCommandLine ->
IO CInt
applicationCommandLineGetIsRemote ::
(B.CallStack.HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a
-> m Bool
applicationCommandLineGetIsRemote :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> m Bool
applicationCommandLineGetIsRemote a
cmdline = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
cmdline' <- a -> IO (Ptr ApplicationCommandLine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cmdline
result <- g_application_command_line_get_is_remote cmdline'
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
touchManagedPtr cmdline
return result'
#if defined(ENABLE_OVERLOADING)
data ApplicationCommandLineGetIsRemoteMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsApplicationCommandLine a) => O.OverloadedMethod ApplicationCommandLineGetIsRemoteMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> m Bool
applicationCommandLineGetIsRemote
instance O.OverloadedMethodInfo ApplicationCommandLineGetIsRemoteMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ApplicationCommandLine.applicationCommandLineGetIsRemote",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ApplicationCommandLine.html#v:applicationCommandLineGetIsRemote"
})
#endif
foreign import ccall "g_application_command_line_get_options_dict" g_application_command_line_get_options_dict ::
Ptr ApplicationCommandLine ->
IO (Ptr GLib.VariantDict.VariantDict)
applicationCommandLineGetOptionsDict ::
(B.CallStack.HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a
-> m GLib.VariantDict.VariantDict
applicationCommandLineGetOptionsDict :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> m VariantDict
applicationCommandLineGetOptionsDict a
cmdline = IO VariantDict -> m VariantDict
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VariantDict -> m VariantDict)
-> IO VariantDict -> m VariantDict
forall a b. (a -> b) -> a -> b
$ do
cmdline' <- a -> IO (Ptr ApplicationCommandLine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cmdline
result <- g_application_command_line_get_options_dict cmdline'
checkUnexpectedReturnNULL "applicationCommandLineGetOptionsDict" result
result' <- (newBoxed GLib.VariantDict.VariantDict) result
touchManagedPtr cmdline
return result'
#if defined(ENABLE_OVERLOADING)
data ApplicationCommandLineGetOptionsDictMethodInfo
instance (signature ~ (m GLib.VariantDict.VariantDict), MonadIO m, IsApplicationCommandLine a) => O.OverloadedMethod ApplicationCommandLineGetOptionsDictMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m VariantDict
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> m VariantDict
applicationCommandLineGetOptionsDict
instance O.OverloadedMethodInfo ApplicationCommandLineGetOptionsDictMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ApplicationCommandLine.applicationCommandLineGetOptionsDict",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ApplicationCommandLine.html#v:applicationCommandLineGetOptionsDict"
})
#endif
foreign import ccall "g_application_command_line_get_platform_data" g_application_command_line_get_platform_data ::
Ptr ApplicationCommandLine ->
IO (Ptr GVariant)
applicationCommandLineGetPlatformData ::
(B.CallStack.HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a
-> m (Maybe GVariant)
applicationCommandLineGetPlatformData :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> m (Maybe GVariant)
applicationCommandLineGetPlatformData a
cmdline = IO (Maybe GVariant) -> m (Maybe GVariant)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GVariant) -> m (Maybe GVariant))
-> IO (Maybe GVariant) -> m (Maybe GVariant)
forall a b. (a -> b) -> a -> b
$ do
cmdline' <- a -> IO (Ptr ApplicationCommandLine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cmdline
result <- g_application_command_line_get_platform_data cmdline'
maybeResult <- convertIfNonNull result $ \Ptr GVariant
result' -> do
result'' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result'
return result''
touchManagedPtr cmdline
return maybeResult
#if defined(ENABLE_OVERLOADING)
data ApplicationCommandLineGetPlatformDataMethodInfo
instance (signature ~ (m (Maybe GVariant)), MonadIO m, IsApplicationCommandLine a) => O.OverloadedMethod ApplicationCommandLineGetPlatformDataMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m (Maybe GVariant)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> m (Maybe GVariant)
applicationCommandLineGetPlatformData
instance O.OverloadedMethodInfo ApplicationCommandLineGetPlatformDataMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ApplicationCommandLine.applicationCommandLineGetPlatformData",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ApplicationCommandLine.html#v:applicationCommandLineGetPlatformData"
})
#endif
foreign import ccall "g_application_command_line_get_stdin" g_application_command_line_get_stdin ::
Ptr ApplicationCommandLine ->
IO (Ptr Gio.InputStream.InputStream)
applicationCommandLineGetStdin ::
(B.CallStack.HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a
-> m (Maybe Gio.InputStream.InputStream)
applicationCommandLineGetStdin :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> m (Maybe InputStream)
applicationCommandLineGetStdin a
cmdline = IO (Maybe InputStream) -> m (Maybe InputStream)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe InputStream) -> m (Maybe InputStream))
-> IO (Maybe InputStream) -> m (Maybe InputStream)
forall a b. (a -> b) -> a -> b
$ do
cmdline' <- a -> IO (Ptr ApplicationCommandLine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cmdline
result <- g_application_command_line_get_stdin cmdline'
maybeResult <- convertIfNonNull result $ \Ptr InputStream
result' -> do
result'' <- ((ManagedPtr InputStream -> InputStream)
-> Ptr InputStream -> IO InputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr InputStream -> InputStream
Gio.InputStream.InputStream) Ptr InputStream
result'
return result''
touchManagedPtr cmdline
return maybeResult
#if defined(ENABLE_OVERLOADING)
data ApplicationCommandLineGetStdinMethodInfo
instance (signature ~ (m (Maybe Gio.InputStream.InputStream)), MonadIO m, IsApplicationCommandLine a) => O.OverloadedMethod ApplicationCommandLineGetStdinMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m (Maybe InputStream)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> m (Maybe InputStream)
applicationCommandLineGetStdin
instance O.OverloadedMethodInfo ApplicationCommandLineGetStdinMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ApplicationCommandLine.applicationCommandLineGetStdin",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ApplicationCommandLine.html#v:applicationCommandLineGetStdin"
})
#endif
foreign import ccall "g_application_command_line_getenv" g_application_command_line_getenv ::
Ptr ApplicationCommandLine ->
CString ->
IO CString
applicationCommandLineGetenv ::
(B.CallStack.HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a
-> [Char]
-> m (Maybe T.Text)
applicationCommandLineGetenv :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> String -> m (Maybe Text)
applicationCommandLineGetenv a
cmdline String
name = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
cmdline' <- a -> IO (Ptr ApplicationCommandLine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cmdline
name' <- stringToCString name
result <- g_application_command_line_getenv cmdline' name'
maybeResult <- convertIfNonNull result $ \CString
result' -> do
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
return result''
touchManagedPtr cmdline
freeMem name'
return maybeResult
#if defined(ENABLE_OVERLOADING)
data ApplicationCommandLineGetenvMethodInfo
instance (signature ~ ([Char] -> m (Maybe T.Text)), MonadIO m, IsApplicationCommandLine a) => O.OverloadedMethod ApplicationCommandLineGetenvMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> String -> m (Maybe Text)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> String -> m (Maybe Text)
applicationCommandLineGetenv
instance O.OverloadedMethodInfo ApplicationCommandLineGetenvMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ApplicationCommandLine.applicationCommandLineGetenv",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ApplicationCommandLine.html#v:applicationCommandLineGetenv"
})
#endif
foreign import ccall "g_application_command_line_print_literal" g_application_command_line_print_literal ::
Ptr ApplicationCommandLine ->
CString ->
IO ()
applicationCommandLinePrintLiteral ::
(B.CallStack.HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a
-> T.Text
-> m ()
applicationCommandLinePrintLiteral :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> Text -> m ()
applicationCommandLinePrintLiteral a
cmdline Text
message = 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
cmdline' <- a -> IO (Ptr ApplicationCommandLine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cmdline
message' <- textToCString message
g_application_command_line_print_literal cmdline' message'
touchManagedPtr cmdline
freeMem message'
return ()
#if defined(ENABLE_OVERLOADING)
data ApplicationCommandLinePrintLiteralMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsApplicationCommandLine a) => O.OverloadedMethod ApplicationCommandLinePrintLiteralMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Text -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> Text -> m ()
applicationCommandLinePrintLiteral
instance O.OverloadedMethodInfo ApplicationCommandLinePrintLiteralMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ApplicationCommandLine.applicationCommandLinePrintLiteral",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ApplicationCommandLine.html#v:applicationCommandLinePrintLiteral"
})
#endif
foreign import ccall "g_application_command_line_printerr_literal" g_application_command_line_printerr_literal ::
Ptr ApplicationCommandLine ->
CString ->
IO ()
applicationCommandLinePrinterrLiteral ::
(B.CallStack.HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a
-> T.Text
-> m ()
applicationCommandLinePrinterrLiteral :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> Text -> m ()
applicationCommandLinePrinterrLiteral a
cmdline Text
message = 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
cmdline' <- a -> IO (Ptr ApplicationCommandLine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cmdline
message' <- textToCString message
g_application_command_line_printerr_literal cmdline' message'
touchManagedPtr cmdline
freeMem message'
return ()
#if defined(ENABLE_OVERLOADING)
data ApplicationCommandLinePrinterrLiteralMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsApplicationCommandLine a) => O.OverloadedMethod ApplicationCommandLinePrinterrLiteralMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Text -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> Text -> m ()
applicationCommandLinePrinterrLiteral
instance O.OverloadedMethodInfo ApplicationCommandLinePrinterrLiteralMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ApplicationCommandLine.applicationCommandLinePrinterrLiteral",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ApplicationCommandLine.html#v:applicationCommandLinePrinterrLiteral"
})
#endif
foreign import ccall "g_application_command_line_set_exit_status" g_application_command_line_set_exit_status ::
Ptr ApplicationCommandLine ->
Int32 ->
IO ()
applicationCommandLineSetExitStatus ::
(B.CallStack.HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a
-> Int32
-> m ()
applicationCommandLineSetExitStatus :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> Int32 -> m ()
applicationCommandLineSetExitStatus a
cmdline Int32
exitStatus = 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
cmdline' <- a -> IO (Ptr ApplicationCommandLine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cmdline
g_application_command_line_set_exit_status cmdline' exitStatus
touchManagedPtr cmdline
return ()
#if defined(ENABLE_OVERLOADING)
data ApplicationCommandLineSetExitStatusMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsApplicationCommandLine a) => O.OverloadedMethod ApplicationCommandLineSetExitStatusMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> Int32 -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplicationCommandLine a) =>
a -> Int32 -> m ()
applicationCommandLineSetExitStatus
instance O.OverloadedMethodInfo ApplicationCommandLineSetExitStatusMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.ApplicationCommandLine.applicationCommandLineSetExitStatus",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-ApplicationCommandLine.html#v:applicationCommandLineSetExitStatus"
})
#endif