{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Gtk.Structs.RecentInfo
(
RecentInfo(..) ,
noRecentInfo ,
#if defined(ENABLE_OVERLOADING)
ResolveRecentInfoMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
RecentInfoCreateAppInfoMethodInfo ,
#endif
recentInfoCreateAppInfo ,
#if defined(ENABLE_OVERLOADING)
RecentInfoExistsMethodInfo ,
#endif
recentInfoExists ,
#if defined(ENABLE_OVERLOADING)
RecentInfoGetAddedMethodInfo ,
#endif
recentInfoGetAdded ,
#if defined(ENABLE_OVERLOADING)
RecentInfoGetAgeMethodInfo ,
#endif
recentInfoGetAge ,
#if defined(ENABLE_OVERLOADING)
RecentInfoGetApplicationInfoMethodInfo ,
#endif
recentInfoGetApplicationInfo ,
#if defined(ENABLE_OVERLOADING)
RecentInfoGetApplicationsMethodInfo ,
#endif
recentInfoGetApplications ,
#if defined(ENABLE_OVERLOADING)
RecentInfoGetDescriptionMethodInfo ,
#endif
recentInfoGetDescription ,
#if defined(ENABLE_OVERLOADING)
RecentInfoGetDisplayNameMethodInfo ,
#endif
recentInfoGetDisplayName ,
#if defined(ENABLE_OVERLOADING)
RecentInfoGetGiconMethodInfo ,
#endif
recentInfoGetGicon ,
#if defined(ENABLE_OVERLOADING)
RecentInfoGetGroupsMethodInfo ,
#endif
recentInfoGetGroups ,
#if defined(ENABLE_OVERLOADING)
RecentInfoGetIconMethodInfo ,
#endif
recentInfoGetIcon ,
#if defined(ENABLE_OVERLOADING)
RecentInfoGetMimeTypeMethodInfo ,
#endif
recentInfoGetMimeType ,
#if defined(ENABLE_OVERLOADING)
RecentInfoGetModifiedMethodInfo ,
#endif
recentInfoGetModified ,
#if defined(ENABLE_OVERLOADING)
RecentInfoGetPrivateHintMethodInfo ,
#endif
recentInfoGetPrivateHint ,
#if defined(ENABLE_OVERLOADING)
RecentInfoGetShortNameMethodInfo ,
#endif
recentInfoGetShortName ,
#if defined(ENABLE_OVERLOADING)
RecentInfoGetUriMethodInfo ,
#endif
recentInfoGetUri ,
#if defined(ENABLE_OVERLOADING)
RecentInfoGetUriDisplayMethodInfo ,
#endif
recentInfoGetUriDisplay ,
#if defined(ENABLE_OVERLOADING)
RecentInfoGetVisitedMethodInfo ,
#endif
recentInfoGetVisited ,
#if defined(ENABLE_OVERLOADING)
RecentInfoHasApplicationMethodInfo ,
#endif
recentInfoHasApplication ,
#if defined(ENABLE_OVERLOADING)
RecentInfoHasGroupMethodInfo ,
#endif
recentInfoHasGroup ,
#if defined(ENABLE_OVERLOADING)
RecentInfoIsLocalMethodInfo ,
#endif
recentInfoIsLocal ,
#if defined(ENABLE_OVERLOADING)
RecentInfoLastApplicationMethodInfo ,
#endif
recentInfoLastApplication ,
#if defined(ENABLE_OVERLOADING)
RecentInfoMatchMethodInfo ,
#endif
recentInfoMatch ,
#if defined(ENABLE_OVERLOADING)
RecentInfoRefMethodInfo ,
#endif
recentInfoRef ,
#if defined(ENABLE_OVERLOADING)
RecentInfoUnrefMethodInfo ,
#endif
recentInfoUnref ,
) 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gio.Interfaces.AppInfo as Gio.AppInfo
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
newtype RecentInfo = RecentInfo (ManagedPtr RecentInfo)
deriving (RecentInfo -> RecentInfo -> Bool
(RecentInfo -> RecentInfo -> Bool)
-> (RecentInfo -> RecentInfo -> Bool) -> Eq RecentInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecentInfo -> RecentInfo -> Bool
$c/= :: RecentInfo -> RecentInfo -> Bool
== :: RecentInfo -> RecentInfo -> Bool
$c== :: RecentInfo -> RecentInfo -> Bool
Eq)
foreign import ccall "gtk_recent_info_get_type" c_gtk_recent_info_get_type ::
IO GType
instance BoxedObject RecentInfo where
boxedType :: RecentInfo -> IO GType
boxedType _ = IO GType
c_gtk_recent_info_get_type
instance B.GValue.IsGValue RecentInfo where
toGValue :: RecentInfo -> IO GValue
toGValue o :: RecentInfo
o = do
GType
gtype <- IO GType
c_gtk_recent_info_get_type
RecentInfo -> (Ptr RecentInfo -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr RecentInfo
o (GType
-> (GValue -> Ptr RecentInfo -> IO ())
-> Ptr RecentInfo
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr RecentInfo -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
fromGValue :: GValue -> IO RecentInfo
fromGValue gv :: GValue
gv = do
Ptr RecentInfo
ptr <- GValue -> IO (Ptr RecentInfo)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr RecentInfo)
(ManagedPtr RecentInfo -> RecentInfo)
-> Ptr RecentInfo -> IO RecentInfo
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr RecentInfo -> RecentInfo
RecentInfo Ptr RecentInfo
ptr
noRecentInfo :: Maybe RecentInfo
noRecentInfo :: Maybe RecentInfo
noRecentInfo = Maybe RecentInfo
forall a. Maybe a
Nothing
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList RecentInfo
type instance O.AttributeList RecentInfo = RecentInfoAttributeList
type RecentInfoAttributeList = ('[ ] :: [(Symbol, *)])
#endif
foreign import ccall "gtk_recent_info_create_app_info" gtk_recent_info_create_app_info ::
Ptr RecentInfo ->
CString ->
Ptr (Ptr GError) ->
IO (Ptr Gio.AppInfo.AppInfo)
recentInfoCreateAppInfo ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> Maybe (T.Text)
-> m (Maybe Gio.AppInfo.AppInfo)
recentInfoCreateAppInfo :: RecentInfo -> Maybe Text -> m (Maybe AppInfo)
recentInfoCreateAppInfo info :: RecentInfo
info appName :: Maybe Text
appName = IO (Maybe AppInfo) -> m (Maybe AppInfo)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe AppInfo) -> m (Maybe AppInfo))
-> IO (Maybe AppInfo) -> m (Maybe AppInfo)
forall a b. (a -> b) -> a -> b
$ do
Ptr RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
Ptr CChar
maybeAppName <- case Maybe Text
appName of
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
Just jAppName :: Text
jAppName -> do
Ptr CChar
jAppName' <- Text -> IO (Ptr CChar)
textToCString Text
jAppName
Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jAppName'
IO (Maybe AppInfo) -> IO () -> IO (Maybe AppInfo)
forall a b. IO a -> IO b -> IO a
onException (do
Ptr AppInfo
result <- (Ptr (Ptr GError) -> IO (Ptr AppInfo)) -> IO (Ptr AppInfo)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr AppInfo)) -> IO (Ptr AppInfo))
-> (Ptr (Ptr GError) -> IO (Ptr AppInfo)) -> IO (Ptr AppInfo)
forall a b. (a -> b) -> a -> b
$ Ptr RecentInfo -> Ptr CChar -> Ptr (Ptr GError) -> IO (Ptr AppInfo)
gtk_recent_info_create_app_info Ptr RecentInfo
info' Ptr CChar
maybeAppName
Maybe AppInfo
maybeResult <- Ptr AppInfo -> (Ptr AppInfo -> IO AppInfo) -> IO (Maybe AppInfo)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr AppInfo
result ((Ptr AppInfo -> IO AppInfo) -> IO (Maybe AppInfo))
-> (Ptr AppInfo -> IO AppInfo) -> IO (Maybe AppInfo)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr AppInfo
result' -> do
AppInfo
result'' <- ((ManagedPtr AppInfo -> AppInfo) -> Ptr AppInfo -> IO AppInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr AppInfo -> AppInfo
Gio.AppInfo.AppInfo) Ptr AppInfo
result'
AppInfo -> IO AppInfo
forall (m :: * -> *) a. Monad m => a -> m a
return AppInfo
result''
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeAppName
Maybe AppInfo -> IO (Maybe AppInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AppInfo
maybeResult
) (do
Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeAppName
)
#if defined(ENABLE_OVERLOADING)
data RecentInfoCreateAppInfoMethodInfo
instance (signature ~ (Maybe (T.Text) -> m (Maybe Gio.AppInfo.AppInfo)), MonadIO m) => O.MethodInfo RecentInfoCreateAppInfoMethodInfo RecentInfo signature where
overloadedMethod = recentInfoCreateAppInfo
#endif
foreign import ccall "gtk_recent_info_exists" gtk_recent_info_exists ::
Ptr RecentInfo ->
IO CInt
recentInfoExists ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> m Bool
recentInfoExists :: RecentInfo -> m Bool
recentInfoExists info :: RecentInfo
info = IO Bool -> m Bool
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
Ptr RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
CInt
result <- Ptr RecentInfo -> IO CInt
gtk_recent_info_exists Ptr RecentInfo
info'
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data RecentInfoExistsMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo RecentInfoExistsMethodInfo RecentInfo signature where
overloadedMethod = recentInfoExists
#endif
foreign import ccall "gtk_recent_info_get_added" gtk_recent_info_get_added ::
Ptr RecentInfo ->
IO CLong
recentInfoGetAdded ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> m CLong
recentInfoGetAdded :: RecentInfo -> m CLong
recentInfoGetAdded info :: RecentInfo
info = IO CLong -> m CLong
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CLong -> m CLong) -> IO CLong -> m CLong
forall a b. (a -> b) -> a -> b
$ do
Ptr RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
CLong
result <- Ptr RecentInfo -> IO CLong
gtk_recent_info_get_added Ptr RecentInfo
info'
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
CLong -> IO CLong
forall (m :: * -> *) a. Monad m => a -> m a
return CLong
result
#if defined(ENABLE_OVERLOADING)
data RecentInfoGetAddedMethodInfo
instance (signature ~ (m CLong), MonadIO m) => O.MethodInfo RecentInfoGetAddedMethodInfo RecentInfo signature where
overloadedMethod = recentInfoGetAdded
#endif
foreign import ccall "gtk_recent_info_get_age" gtk_recent_info_get_age ::
Ptr RecentInfo ->
IO Int32
recentInfoGetAge ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> m Int32
recentInfoGetAge :: RecentInfo -> m Int32
recentInfoGetAge info :: RecentInfo
info = IO Int32 -> m Int32
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
Ptr RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
Int32
result <- Ptr RecentInfo -> IO Int32
gtk_recent_info_get_age Ptr RecentInfo
info'
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
#if defined(ENABLE_OVERLOADING)
data RecentInfoGetAgeMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo RecentInfoGetAgeMethodInfo RecentInfo signature where
overloadedMethod = recentInfoGetAge
#endif
foreign import ccall "gtk_recent_info_get_application_info" gtk_recent_info_get_application_info ::
Ptr RecentInfo ->
CString ->
Ptr CString ->
Ptr Word32 ->
Ptr CLong ->
IO CInt
recentInfoGetApplicationInfo ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> T.Text
-> m ((Bool, T.Text, Word32, CLong))
recentInfoGetApplicationInfo :: RecentInfo -> Text -> m (Bool, Text, Word32, CLong)
recentInfoGetApplicationInfo info :: RecentInfo
info appName :: Text
appName = IO (Bool, Text, Word32, CLong) -> m (Bool, Text, Word32, CLong)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Text, Word32, CLong) -> m (Bool, Text, Word32, CLong))
-> IO (Bool, Text, Word32, CLong) -> m (Bool, Text, Word32, CLong)
forall a b. (a -> b) -> a -> b
$ do
Ptr RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
Ptr CChar
appName' <- Text -> IO (Ptr CChar)
textToCString Text
appName
Ptr (Ptr CChar)
appExec <- IO (Ptr (Ptr CChar))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CString)
Ptr Word32
count <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
Ptr CLong
time_ <- IO (Ptr CLong)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CLong)
CInt
result <- Ptr RecentInfo
-> Ptr CChar
-> Ptr (Ptr CChar)
-> Ptr Word32
-> Ptr CLong
-> IO CInt
gtk_recent_info_get_application_info Ptr RecentInfo
info' Ptr CChar
appName' Ptr (Ptr CChar)
appExec Ptr Word32
count Ptr CLong
time_
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
Ptr CChar
appExec' <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
appExec
Text
appExec'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
appExec'
Word32
count' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
count
CLong
time_' <- Ptr CLong -> IO CLong
forall a. Storable a => Ptr a -> IO a
peek Ptr CLong
time_
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
appName'
Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
appExec
Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
count
Ptr CLong -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CLong
time_
(Bool, Text, Word32, CLong) -> IO (Bool, Text, Word32, CLong)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Text
appExec'', Word32
count', CLong
time_')
#if defined(ENABLE_OVERLOADING)
data RecentInfoGetApplicationInfoMethodInfo
instance (signature ~ (T.Text -> m ((Bool, T.Text, Word32, CLong))), MonadIO m) => O.MethodInfo RecentInfoGetApplicationInfoMethodInfo RecentInfo signature where
overloadedMethod = recentInfoGetApplicationInfo
#endif
foreign import ccall "gtk_recent_info_get_applications" gtk_recent_info_get_applications ::
Ptr RecentInfo ->
Ptr Word64 ->
IO (Ptr CString)
recentInfoGetApplications ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> m (([T.Text], Word64))
recentInfoGetApplications :: RecentInfo -> m ([Text], Word64)
recentInfoGetApplications info :: RecentInfo
info = IO ([Text], Word64) -> m ([Text], Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([Text], Word64) -> m ([Text], Word64))
-> IO ([Text], Word64) -> m ([Text], Word64)
forall a b. (a -> b) -> a -> b
$ do
Ptr RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
Ptr (Ptr CChar)
result <- Ptr RecentInfo -> Ptr Word64 -> IO (Ptr (Ptr CChar))
gtk_recent_info_get_applications Ptr RecentInfo
info' Ptr Word64
length_
Text -> Ptr (Ptr CChar) -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "recentInfoGetApplications" Ptr (Ptr CChar)
result
[Text]
result' <- HasCallStack => Ptr (Ptr CChar) -> IO [Text]
Ptr (Ptr CChar) -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr (Ptr CChar)
result
(Ptr CChar -> IO ()) -> Ptr (Ptr CChar) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
result
Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
result
Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
([Text], Word64) -> IO ([Text], Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text]
result', Word64
length_')
#if defined(ENABLE_OVERLOADING)
data RecentInfoGetApplicationsMethodInfo
instance (signature ~ (m (([T.Text], Word64))), MonadIO m) => O.MethodInfo RecentInfoGetApplicationsMethodInfo RecentInfo signature where
overloadedMethod = recentInfoGetApplications
#endif
foreign import ccall "gtk_recent_info_get_description" gtk_recent_info_get_description ::
Ptr RecentInfo ->
IO CString
recentInfoGetDescription ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> m T.Text
recentInfoGetDescription :: RecentInfo -> m Text
recentInfoGetDescription info :: RecentInfo
info = IO Text -> m Text
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 RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
Ptr CChar
result <- Ptr RecentInfo -> IO (Ptr CChar)
gtk_recent_info_get_description Ptr RecentInfo
info'
Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "recentInfoGetDescription" Ptr CChar
result
Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data RecentInfoGetDescriptionMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo RecentInfoGetDescriptionMethodInfo RecentInfo signature where
overloadedMethod = recentInfoGetDescription
#endif
foreign import ccall "gtk_recent_info_get_display_name" gtk_recent_info_get_display_name ::
Ptr RecentInfo ->
IO CString
recentInfoGetDisplayName ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> m T.Text
recentInfoGetDisplayName :: RecentInfo -> m Text
recentInfoGetDisplayName info :: RecentInfo
info = IO Text -> m Text
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 RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
Ptr CChar
result <- Ptr RecentInfo -> IO (Ptr CChar)
gtk_recent_info_get_display_name Ptr RecentInfo
info'
Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "recentInfoGetDisplayName" Ptr CChar
result
Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data RecentInfoGetDisplayNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo RecentInfoGetDisplayNameMethodInfo RecentInfo signature where
overloadedMethod = recentInfoGetDisplayName
#endif
foreign import ccall "gtk_recent_info_get_gicon" gtk_recent_info_get_gicon ::
Ptr RecentInfo ->
IO (Ptr Gio.Icon.Icon)
recentInfoGetGicon ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> m (Maybe Gio.Icon.Icon)
recentInfoGetGicon :: RecentInfo -> m (Maybe Icon)
recentInfoGetGicon info :: RecentInfo
info = IO (Maybe Icon) -> m (Maybe Icon)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Icon) -> m (Maybe Icon))
-> IO (Maybe Icon) -> m (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ do
Ptr RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
Ptr Icon
result <- Ptr RecentInfo -> IO (Ptr Icon)
gtk_recent_info_get_gicon Ptr RecentInfo
info'
Maybe Icon
maybeResult <- Ptr Icon -> (Ptr Icon -> IO Icon) -> IO (Maybe Icon)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Icon
result ((Ptr Icon -> IO Icon) -> IO (Maybe Icon))
-> (Ptr Icon -> IO Icon) -> IO (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Icon
result' -> do
Icon
result'' <- ((ManagedPtr Icon -> Icon) -> Ptr Icon -> IO Icon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Icon -> Icon
Gio.Icon.Icon) Ptr Icon
result'
Icon -> IO Icon
forall (m :: * -> *) a. Monad m => a -> m a
return Icon
result''
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
Maybe Icon -> IO (Maybe Icon)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Icon
maybeResult
#if defined(ENABLE_OVERLOADING)
data RecentInfoGetGiconMethodInfo
instance (signature ~ (m (Maybe Gio.Icon.Icon)), MonadIO m) => O.MethodInfo RecentInfoGetGiconMethodInfo RecentInfo signature where
overloadedMethod = recentInfoGetGicon
#endif
foreign import ccall "gtk_recent_info_get_groups" gtk_recent_info_get_groups ::
Ptr RecentInfo ->
Ptr Word64 ->
IO (Ptr CString)
recentInfoGetGroups ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> m (([T.Text], Word64))
recentInfoGetGroups :: RecentInfo -> m ([Text], Word64)
recentInfoGetGroups info :: RecentInfo
info = IO ([Text], Word64) -> m ([Text], Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([Text], Word64) -> m ([Text], Word64))
-> IO ([Text], Word64) -> m ([Text], Word64)
forall a b. (a -> b) -> a -> b
$ do
Ptr RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
Ptr (Ptr CChar)
result <- Ptr RecentInfo -> Ptr Word64 -> IO (Ptr (Ptr CChar))
gtk_recent_info_get_groups Ptr RecentInfo
info' Ptr Word64
length_
Text -> Ptr (Ptr CChar) -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "recentInfoGetGroups" Ptr (Ptr CChar)
result
[Text]
result' <- HasCallStack => Ptr (Ptr CChar) -> IO [Text]
Ptr (Ptr CChar) -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr (Ptr CChar)
result
(Ptr CChar -> IO ()) -> Ptr (Ptr CChar) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
result
Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
result
Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
([Text], Word64) -> IO ([Text], Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text]
result', Word64
length_')
#if defined(ENABLE_OVERLOADING)
data RecentInfoGetGroupsMethodInfo
instance (signature ~ (m (([T.Text], Word64))), MonadIO m) => O.MethodInfo RecentInfoGetGroupsMethodInfo RecentInfo signature where
overloadedMethod = recentInfoGetGroups
#endif
foreign import ccall "gtk_recent_info_get_icon" gtk_recent_info_get_icon ::
Ptr RecentInfo ->
Int32 ->
IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)
recentInfoGetIcon ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> Int32
-> m (Maybe GdkPixbuf.Pixbuf.Pixbuf)
recentInfoGetIcon :: RecentInfo -> Int32 -> m (Maybe Pixbuf)
recentInfoGetIcon info :: RecentInfo
info size :: Int32
size = IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Pixbuf) -> m (Maybe Pixbuf))
-> IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ do
Ptr RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
Ptr Pixbuf
result <- Ptr RecentInfo -> Int32 -> IO (Ptr Pixbuf)
gtk_recent_info_get_icon Ptr RecentInfo
info' Int32
size
Maybe Pixbuf
maybeResult <- Ptr Pixbuf -> (Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Pixbuf
result ((Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf))
-> (Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Pixbuf
result' -> do
Pixbuf
result'' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result'
Pixbuf -> IO Pixbuf
forall (m :: * -> *) a. Monad m => a -> m a
return Pixbuf
result''
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
Maybe Pixbuf -> IO (Maybe Pixbuf)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pixbuf
maybeResult
#if defined(ENABLE_OVERLOADING)
data RecentInfoGetIconMethodInfo
instance (signature ~ (Int32 -> m (Maybe GdkPixbuf.Pixbuf.Pixbuf)), MonadIO m) => O.MethodInfo RecentInfoGetIconMethodInfo RecentInfo signature where
overloadedMethod = recentInfoGetIcon
#endif
foreign import ccall "gtk_recent_info_get_mime_type" gtk_recent_info_get_mime_type ::
Ptr RecentInfo ->
IO CString
recentInfoGetMimeType ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> m T.Text
recentInfoGetMimeType :: RecentInfo -> m Text
recentInfoGetMimeType info :: RecentInfo
info = IO Text -> m Text
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 RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
Ptr CChar
result <- Ptr RecentInfo -> IO (Ptr CChar)
gtk_recent_info_get_mime_type Ptr RecentInfo
info'
Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "recentInfoGetMimeType" Ptr CChar
result
Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data RecentInfoGetMimeTypeMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo RecentInfoGetMimeTypeMethodInfo RecentInfo signature where
overloadedMethod = recentInfoGetMimeType
#endif
foreign import ccall "gtk_recent_info_get_modified" gtk_recent_info_get_modified ::
Ptr RecentInfo ->
IO CLong
recentInfoGetModified ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> m CLong
recentInfoGetModified :: RecentInfo -> m CLong
recentInfoGetModified info :: RecentInfo
info = IO CLong -> m CLong
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CLong -> m CLong) -> IO CLong -> m CLong
forall a b. (a -> b) -> a -> b
$ do
Ptr RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
CLong
result <- Ptr RecentInfo -> IO CLong
gtk_recent_info_get_modified Ptr RecentInfo
info'
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
CLong -> IO CLong
forall (m :: * -> *) a. Monad m => a -> m a
return CLong
result
#if defined(ENABLE_OVERLOADING)
data RecentInfoGetModifiedMethodInfo
instance (signature ~ (m CLong), MonadIO m) => O.MethodInfo RecentInfoGetModifiedMethodInfo RecentInfo signature where
overloadedMethod = recentInfoGetModified
#endif
foreign import ccall "gtk_recent_info_get_private_hint" gtk_recent_info_get_private_hint ::
Ptr RecentInfo ->
IO CInt
recentInfoGetPrivateHint ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> m Bool
recentInfoGetPrivateHint :: RecentInfo -> m Bool
recentInfoGetPrivateHint info :: RecentInfo
info = IO Bool -> m Bool
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
Ptr RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
CInt
result <- Ptr RecentInfo -> IO CInt
gtk_recent_info_get_private_hint Ptr RecentInfo
info'
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data RecentInfoGetPrivateHintMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo RecentInfoGetPrivateHintMethodInfo RecentInfo signature where
overloadedMethod = recentInfoGetPrivateHint
#endif
foreign import ccall "gtk_recent_info_get_short_name" gtk_recent_info_get_short_name ::
Ptr RecentInfo ->
IO CString
recentInfoGetShortName ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> m T.Text
recentInfoGetShortName :: RecentInfo -> m Text
recentInfoGetShortName info :: RecentInfo
info = IO Text -> m Text
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 RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
Ptr CChar
result <- Ptr RecentInfo -> IO (Ptr CChar)
gtk_recent_info_get_short_name Ptr RecentInfo
info'
Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "recentInfoGetShortName" Ptr CChar
result
Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data RecentInfoGetShortNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo RecentInfoGetShortNameMethodInfo RecentInfo signature where
overloadedMethod = recentInfoGetShortName
#endif
foreign import ccall "gtk_recent_info_get_uri" gtk_recent_info_get_uri ::
Ptr RecentInfo ->
IO CString
recentInfoGetUri ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> m T.Text
recentInfoGetUri :: RecentInfo -> m Text
recentInfoGetUri info :: RecentInfo
info = IO Text -> m Text
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 RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
Ptr CChar
result <- Ptr RecentInfo -> IO (Ptr CChar)
gtk_recent_info_get_uri Ptr RecentInfo
info'
Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "recentInfoGetUri" Ptr CChar
result
Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data RecentInfoGetUriMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo RecentInfoGetUriMethodInfo RecentInfo signature where
overloadedMethod = recentInfoGetUri
#endif
foreign import ccall "gtk_recent_info_get_uri_display" gtk_recent_info_get_uri_display ::
Ptr RecentInfo ->
IO CString
recentInfoGetUriDisplay ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> m (Maybe T.Text)
recentInfoGetUriDisplay :: RecentInfo -> m (Maybe Text)
recentInfoGetUriDisplay info :: RecentInfo
info = IO (Maybe Text) -> m (Maybe Text)
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
Ptr RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
Ptr CChar
result <- Ptr RecentInfo -> IO (Ptr CChar)
gtk_recent_info_get_uri_display Ptr RecentInfo
info'
Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr CChar
result' -> do
Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result'
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult
#if defined(ENABLE_OVERLOADING)
data RecentInfoGetUriDisplayMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.MethodInfo RecentInfoGetUriDisplayMethodInfo RecentInfo signature where
overloadedMethod = recentInfoGetUriDisplay
#endif
foreign import ccall "gtk_recent_info_get_visited" gtk_recent_info_get_visited ::
Ptr RecentInfo ->
IO CLong
recentInfoGetVisited ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> m CLong
recentInfoGetVisited :: RecentInfo -> m CLong
recentInfoGetVisited info :: RecentInfo
info = IO CLong -> m CLong
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CLong -> m CLong) -> IO CLong -> m CLong
forall a b. (a -> b) -> a -> b
$ do
Ptr RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
CLong
result <- Ptr RecentInfo -> IO CLong
gtk_recent_info_get_visited Ptr RecentInfo
info'
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
CLong -> IO CLong
forall (m :: * -> *) a. Monad m => a -> m a
return CLong
result
#if defined(ENABLE_OVERLOADING)
data RecentInfoGetVisitedMethodInfo
instance (signature ~ (m CLong), MonadIO m) => O.MethodInfo RecentInfoGetVisitedMethodInfo RecentInfo signature where
overloadedMethod = recentInfoGetVisited
#endif
foreign import ccall "gtk_recent_info_has_application" gtk_recent_info_has_application ::
Ptr RecentInfo ->
CString ->
IO CInt
recentInfoHasApplication ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> T.Text
-> m Bool
recentInfoHasApplication :: RecentInfo -> Text -> m Bool
recentInfoHasApplication info :: RecentInfo
info appName :: Text
appName = IO Bool -> m Bool
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
Ptr RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
Ptr CChar
appName' <- Text -> IO (Ptr CChar)
textToCString Text
appName
CInt
result <- Ptr RecentInfo -> Ptr CChar -> IO CInt
gtk_recent_info_has_application Ptr RecentInfo
info' Ptr CChar
appName'
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
appName'
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data RecentInfoHasApplicationMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.MethodInfo RecentInfoHasApplicationMethodInfo RecentInfo signature where
overloadedMethod = recentInfoHasApplication
#endif
foreign import ccall "gtk_recent_info_has_group" gtk_recent_info_has_group ::
Ptr RecentInfo ->
CString ->
IO CInt
recentInfoHasGroup ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> T.Text
-> m Bool
recentInfoHasGroup :: RecentInfo -> Text -> m Bool
recentInfoHasGroup info :: RecentInfo
info groupName :: Text
groupName = IO Bool -> m Bool
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
Ptr RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
Ptr CChar
groupName' <- Text -> IO (Ptr CChar)
textToCString Text
groupName
CInt
result <- Ptr RecentInfo -> Ptr CChar -> IO CInt
gtk_recent_info_has_group Ptr RecentInfo
info' Ptr CChar
groupName'
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
groupName'
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data RecentInfoHasGroupMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.MethodInfo RecentInfoHasGroupMethodInfo RecentInfo signature where
overloadedMethod = recentInfoHasGroup
#endif
foreign import ccall "gtk_recent_info_is_local" gtk_recent_info_is_local ::
Ptr RecentInfo ->
IO CInt
recentInfoIsLocal ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> m Bool
recentInfoIsLocal :: RecentInfo -> m Bool
recentInfoIsLocal info :: RecentInfo
info = IO Bool -> m Bool
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
Ptr RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
CInt
result <- Ptr RecentInfo -> IO CInt
gtk_recent_info_is_local Ptr RecentInfo
info'
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data RecentInfoIsLocalMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo RecentInfoIsLocalMethodInfo RecentInfo signature where
overloadedMethod = recentInfoIsLocal
#endif
foreign import ccall "gtk_recent_info_last_application" gtk_recent_info_last_application ::
Ptr RecentInfo ->
IO CString
recentInfoLastApplication ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> m T.Text
recentInfoLastApplication :: RecentInfo -> m Text
recentInfoLastApplication info :: RecentInfo
info = IO Text -> m Text
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 RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
Ptr CChar
result <- Ptr RecentInfo -> IO (Ptr CChar)
gtk_recent_info_last_application Ptr RecentInfo
info'
Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "recentInfoLastApplication" Ptr CChar
result
Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data RecentInfoLastApplicationMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo RecentInfoLastApplicationMethodInfo RecentInfo signature where
overloadedMethod = recentInfoLastApplication
#endif
foreign import ccall "gtk_recent_info_match" gtk_recent_info_match ::
Ptr RecentInfo ->
Ptr RecentInfo ->
IO CInt
recentInfoMatch ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> RecentInfo
-> m Bool
recentInfoMatch :: RecentInfo -> RecentInfo -> m Bool
recentInfoMatch infoA :: RecentInfo
infoA infoB :: RecentInfo
infoB = IO Bool -> m Bool
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
Ptr RecentInfo
infoA' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
infoA
Ptr RecentInfo
infoB' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
infoB
CInt
result <- Ptr RecentInfo -> Ptr RecentInfo -> IO CInt
gtk_recent_info_match Ptr RecentInfo
infoA' Ptr RecentInfo
infoB'
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
infoA
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
infoB
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data RecentInfoMatchMethodInfo
instance (signature ~ (RecentInfo -> m Bool), MonadIO m) => O.MethodInfo RecentInfoMatchMethodInfo RecentInfo signature where
overloadedMethod = recentInfoMatch
#endif
foreign import ccall "gtk_recent_info_ref" gtk_recent_info_ref ::
Ptr RecentInfo ->
IO (Ptr RecentInfo)
recentInfoRef ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> m RecentInfo
recentInfoRef :: RecentInfo -> m RecentInfo
recentInfoRef info :: RecentInfo
info = IO RecentInfo -> m RecentInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RecentInfo -> m RecentInfo) -> IO RecentInfo -> m RecentInfo
forall a b. (a -> b) -> a -> b
$ do
Ptr RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
Ptr RecentInfo
result <- Ptr RecentInfo -> IO (Ptr RecentInfo)
gtk_recent_info_ref Ptr RecentInfo
info'
Text -> Ptr RecentInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "recentInfoRef" Ptr RecentInfo
result
RecentInfo
result' <- ((ManagedPtr RecentInfo -> RecentInfo)
-> Ptr RecentInfo -> IO RecentInfo
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr RecentInfo -> RecentInfo
RecentInfo) Ptr RecentInfo
result
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
RecentInfo -> IO RecentInfo
forall (m :: * -> *) a. Monad m => a -> m a
return RecentInfo
result'
#if defined(ENABLE_OVERLOADING)
data RecentInfoRefMethodInfo
instance (signature ~ (m RecentInfo), MonadIO m) => O.MethodInfo RecentInfoRefMethodInfo RecentInfo signature where
overloadedMethod = recentInfoRef
#endif
foreign import ccall "gtk_recent_info_unref" gtk_recent_info_unref ::
Ptr RecentInfo ->
IO ()
recentInfoUnref ::
(B.CallStack.HasCallStack, MonadIO m) =>
RecentInfo
-> m ()
recentInfoUnref :: RecentInfo -> m ()
recentInfoUnref info :: RecentInfo
info = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr RecentInfo
info' <- RecentInfo -> IO (Ptr RecentInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RecentInfo
info
Ptr RecentInfo -> IO ()
gtk_recent_info_unref Ptr RecentInfo
info'
RecentInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RecentInfo
info
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data RecentInfoUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo RecentInfoUnrefMethodInfo RecentInfo signature where
overloadedMethod = recentInfoUnref
#endif
#if defined(ENABLE_OVERLOADING)
type family ResolveRecentInfoMethod (t :: Symbol) (o :: *) :: * where
ResolveRecentInfoMethod "createAppInfo" o = RecentInfoCreateAppInfoMethodInfo
ResolveRecentInfoMethod "exists" o = RecentInfoExistsMethodInfo
ResolveRecentInfoMethod "hasApplication" o = RecentInfoHasApplicationMethodInfo
ResolveRecentInfoMethod "hasGroup" o = RecentInfoHasGroupMethodInfo
ResolveRecentInfoMethod "isLocal" o = RecentInfoIsLocalMethodInfo
ResolveRecentInfoMethod "lastApplication" o = RecentInfoLastApplicationMethodInfo
ResolveRecentInfoMethod "match" o = RecentInfoMatchMethodInfo
ResolveRecentInfoMethod "ref" o = RecentInfoRefMethodInfo
ResolveRecentInfoMethod "unref" o = RecentInfoUnrefMethodInfo
ResolveRecentInfoMethod "getAdded" o = RecentInfoGetAddedMethodInfo
ResolveRecentInfoMethod "getAge" o = RecentInfoGetAgeMethodInfo
ResolveRecentInfoMethod "getApplicationInfo" o = RecentInfoGetApplicationInfoMethodInfo
ResolveRecentInfoMethod "getApplications" o = RecentInfoGetApplicationsMethodInfo
ResolveRecentInfoMethod "getDescription" o = RecentInfoGetDescriptionMethodInfo
ResolveRecentInfoMethod "getDisplayName" o = RecentInfoGetDisplayNameMethodInfo
ResolveRecentInfoMethod "getGicon" o = RecentInfoGetGiconMethodInfo
ResolveRecentInfoMethod "getGroups" o = RecentInfoGetGroupsMethodInfo
ResolveRecentInfoMethod "getIcon" o = RecentInfoGetIconMethodInfo
ResolveRecentInfoMethod "getMimeType" o = RecentInfoGetMimeTypeMethodInfo
ResolveRecentInfoMethod "getModified" o = RecentInfoGetModifiedMethodInfo
ResolveRecentInfoMethod "getPrivateHint" o = RecentInfoGetPrivateHintMethodInfo
ResolveRecentInfoMethod "getShortName" o = RecentInfoGetShortNameMethodInfo
ResolveRecentInfoMethod "getUri" o = RecentInfoGetUriMethodInfo
ResolveRecentInfoMethod "getUriDisplay" o = RecentInfoGetUriDisplayMethodInfo
ResolveRecentInfoMethod "getVisited" o = RecentInfoGetVisitedMethodInfo
ResolveRecentInfoMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveRecentInfoMethod t RecentInfo, O.MethodInfo info RecentInfo p) => OL.IsLabel t (RecentInfo -> p) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.overloadedMethod @info
#else
fromLabel _ = O.overloadedMethod @info
#endif
#endif