{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An opaque type representing a string as an index into a table
-- of strings on the X server.

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

module GI.Gdk.Structs.Atom
    ( 

-- * Exported types
    Atom(..)                                ,
    noAtom                                  ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveAtomMethod                       ,
#endif


-- ** intern #method:intern#

    atomIntern                              ,


-- ** internStaticString #method:internStaticString#

    atomInternStaticString                  ,


-- ** name #method:name#

#if defined(ENABLE_OVERLOADING)
    AtomNameMethodInfo                      ,
#endif
    atomName                                ,




    ) 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


-- | Memory-managed wrapper type.
newtype Atom = Atom (ManagedPtr Atom)
    deriving (Atom -> Atom -> Bool
(Atom -> Atom -> Bool) -> (Atom -> Atom -> Bool) -> Eq Atom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Atom -> Atom -> Bool
$c/= :: Atom -> Atom -> Bool
== :: Atom -> Atom -> Bool
$c== :: Atom -> Atom -> Bool
Eq)
-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance WrappedPtr Atom where
    wrappedPtrCalloc :: IO (Ptr Atom)
wrappedPtrCalloc = Ptr Atom -> IO (Ptr Atom)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Atom
forall a. Ptr a
nullPtr
    wrappedPtrCopy :: Atom -> IO Atom
wrappedPtrCopy = Atom -> IO Atom
forall (m :: * -> *) a. Monad m => a -> m a
return
    wrappedPtrFree :: Maybe (GDestroyNotify Atom)
wrappedPtrFree = Maybe (GDestroyNotify Atom)
forall a. Maybe a
Nothing

-- | A convenience alias for `Nothing` :: `Maybe` `Atom`.
noAtom :: Maybe Atom
noAtom :: Maybe Atom
noAtom = Maybe Atom
forall a. Maybe a
Nothing


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

-- method Atom::name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "atom"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Atom" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkAtom." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_atom_name" gdk_atom_name :: 
    Ptr Atom ->                             -- atom : TInterface (Name {namespace = "Gdk", name = "Atom"})
    IO CString

-- | Determines the string corresponding to an atom.
atomName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Atom
    -- ^ /@atom@/: a t'GI.Gdk.Structs.Atom.Atom'.
    -> m T.Text
    -- ^ __Returns:__ a newly-allocated string containing the string
    --   corresponding to /@atom@/. When you are done with the
    --   return value, you should free it using 'GI.GLib.Functions.free'.
atomName :: Atom -> m Text
atomName atom :: Atom
atom = 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 Atom
atom' <- Atom -> IO (Ptr Atom)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Atom
atom
    CString
result <- Ptr Atom -> IO CString
gdk_atom_name Ptr Atom
atom'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "atomName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    Atom -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Atom
atom
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AtomNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo AtomNameMethodInfo Atom signature where
    overloadedMethod = atomName

#endif

-- method Atom::intern
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "atom_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "only_if_exists"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "if %TRUE, GDK is allowed to not create a new atom, but\n  just return %GDK_NONE if the requested atom doesn\8217t already\n  exists. Currently, the flag is ignored, since checking the\n  existance of an atom is as expensive as creating it."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Atom" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_atom_intern" gdk_atom_intern :: 
    CString ->                              -- atom_name : TBasicType TUTF8
    CInt ->                                 -- only_if_exists : TBasicType TBoolean
    IO (Ptr Atom)

-- | Finds or creates an atom corresponding to a given string.
atomIntern ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@atomName@/: a string.
    -> Bool
    -- ^ /@onlyIfExists@/: if 'P.True', GDK is allowed to not create a new atom, but
    --   just return @/GDK_NONE/@ if the requested atom doesn’t already
    --   exists. Currently, the flag is ignored, since checking the
    --   existance of an atom is as expensive as creating it.
    -> m Atom
    -- ^ __Returns:__ the atom corresponding to /@atomName@/.
atomIntern :: Text -> Bool -> m Atom
atomIntern atomName :: Text
atomName onlyIfExists :: Bool
onlyIfExists = IO Atom -> m Atom
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Atom -> m Atom) -> IO Atom -> m Atom
forall a b. (a -> b) -> a -> b
$ do
    CString
atomName' <- Text -> IO CString
textToCString Text
atomName
    let onlyIfExists' :: CInt
onlyIfExists' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
onlyIfExists
    Ptr Atom
result <- CString -> CInt -> IO (Ptr Atom)
gdk_atom_intern CString
atomName' CInt
onlyIfExists'
    Text -> Ptr Atom -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "atomIntern" Ptr Atom
result
    Atom
result' <- ((ManagedPtr Atom -> Atom) -> Ptr Atom -> IO Atom
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Atom -> Atom
Atom) Ptr Atom
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
atomName'
    Atom -> IO Atom
forall (m :: * -> *) a. Monad m => a -> m a
return Atom
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Atom::intern_static_string
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "atom_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a static string" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Atom" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_atom_intern_static_string" gdk_atom_intern_static_string :: 
    CString ->                              -- atom_name : TBasicType TUTF8
    IO (Ptr Atom)

-- | Finds or creates an atom corresponding to a given string.
-- 
-- Note that this function is identical to 'GI.Gdk.Functions.atomIntern' except
-- that if a new t'GI.Gdk.Structs.Atom.Atom' is created the string itself is used rather
-- than a copy. This saves memory, but can only be used if the string
-- will always exist. It can be used with statically
-- allocated strings in the main program, but not with statically
-- allocated memory in dynamically loaded modules, if you expect to
-- ever unload the module again (e.g. do not use this function in
-- GTK+ theme engines).
-- 
-- /Since: 2.10/
atomInternStaticString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@atomName@/: a static string
    -> m Atom
    -- ^ __Returns:__ the atom corresponding to /@atomName@/
atomInternStaticString :: Text -> m Atom
atomInternStaticString atomName :: Text
atomName = IO Atom -> m Atom
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Atom -> m Atom) -> IO Atom -> m Atom
forall a b. (a -> b) -> a -> b
$ do
    CString
atomName' <- Text -> IO CString
textToCString Text
atomName
    Ptr Atom
result <- CString -> IO (Ptr Atom)
gdk_atom_intern_static_string CString
atomName'
    Text -> Ptr Atom -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "atomInternStaticString" Ptr Atom
result
    Atom
result' <- ((ManagedPtr Atom -> Atom) -> Ptr Atom -> IO Atom
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Atom -> Atom
Atom) Ptr Atom
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
atomName'
    Atom -> IO Atom
forall (m :: * -> *) a. Monad m => a -> m a
return Atom
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveAtomMethod (t :: Symbol) (o :: *) :: * where
    ResolveAtomMethod "name" o = AtomNameMethodInfo
    ResolveAtomMethod l o = O.MethodResolutionFailed l o

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

#endif