{-# LANGUAGE TypeApplications #-}


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

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

module GI.Dazzle.Structs.Trie
    ( 

-- * Exported types
    Trie(..)                                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [destroy]("GI.Dazzle.Structs.Trie#g:method:destroy"), [insert]("GI.Dazzle.Structs.Trie#g:method:insert"), [lookup]("GI.Dazzle.Structs.Trie#g:method:lookup"), [ref]("GI.Dazzle.Structs.Trie#g:method:ref"), [remove]("GI.Dazzle.Structs.Trie#g:method:remove"), [traverse]("GI.Dazzle.Structs.Trie#g:method:traverse"), [unref]("GI.Dazzle.Structs.Trie#g:method:unref").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveTrieMethod                       ,
#endif

-- ** destroy #method:destroy#

#if defined(ENABLE_OVERLOADING)
    TrieDestroyMethodInfo                   ,
#endif
    trieDestroy                             ,


-- ** insert #method:insert#

#if defined(ENABLE_OVERLOADING)
    TrieInsertMethodInfo                    ,
#endif
    trieInsert                              ,


-- ** lookup #method:lookup#

#if defined(ENABLE_OVERLOADING)
    TrieLookupMethodInfo                    ,
#endif
    trieLookup                              ,


-- ** new #method:new#

    trieNew                                 ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    TrieRefMethodInfo                       ,
#endif
    trieRef                                 ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    TrieRemoveMethodInfo                    ,
#endif
    trieRemove                              ,


-- ** traverse #method:traverse#

#if defined(ENABLE_OVERLOADING)
    TrieTraverseMethodInfo                  ,
#endif
    trieTraverse                            ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    TrieUnrefMethodInfo                     ,
#endif
    trieUnref                               ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Dazzle.Callbacks as Dazzle.Callbacks
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Enums as GLib.Enums
import qualified GI.GLib.Flags as GLib.Flags

#else
import qualified GI.Dazzle.Callbacks as Dazzle.Callbacks
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Enums as GLib.Enums
import qualified GI.GLib.Flags as GLib.Flags

#endif

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

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

foreign import ccall "dzl_trie_get_type" c_dzl_trie_get_type :: 
    IO GType

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

instance B.Types.TypedObject Trie where
    glibType :: IO GType
glibType = IO GType
c_dzl_trie_get_type

instance B.Types.GBoxed Trie

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


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

-- method Trie::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "value_destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDestroyNotify, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Dazzle" , name = "Trie" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_trie_new" dzl_trie_new :: 
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- value_destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO (Ptr Trie)

-- | Creates a new t'GI.Dazzle.Structs.Trie.Trie'. When a value is removed from the trie, /@valueDestroy@/
-- will be called to allow you to release any resources.
trieNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GLib.Callbacks.DestroyNotify
    -- ^ /@valueDestroy@/: A t'GI.GLib.Callbacks.DestroyNotify', or 'P.Nothing'.
    -> m Trie
    -- ^ __Returns:__ A newly allocated t'GI.Dazzle.Structs.Trie.Trie' that should be freed
    --   with 'GI.Dazzle.Structs.Trie.trieUnref'.
trieNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => IO () -> m Trie
trieNew IO ()
valueDestroy = IO Trie -> m Trie
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Trie -> m Trie) -> IO Trie -> m Trie
forall a b. (a -> b) -> a -> b
$ do
    Ptr (FunPtr C_DestroyNotify)
ptrvalueDestroy <- IO (Ptr (FunPtr C_DestroyNotify))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr GLib.Callbacks.C_DestroyNotify))
    FunPtr C_DestroyNotify
valueDestroy' <- C_DestroyNotify -> IO (FunPtr C_DestroyNotify)
GLib.Callbacks.mk_DestroyNotify (Maybe (Ptr (FunPtr C_DestroyNotify))
-> C_DestroyNotify -> C_DestroyNotify
GLib.Callbacks.wrap_DestroyNotify (Ptr (FunPtr C_DestroyNotify)
-> Maybe (Ptr (FunPtr C_DestroyNotify))
forall a. a -> Maybe a
Just Ptr (FunPtr C_DestroyNotify)
ptrvalueDestroy) (IO () -> C_DestroyNotify
GLib.Callbacks.drop_closures_DestroyNotify IO ()
valueDestroy))
    Ptr (FunPtr C_DestroyNotify) -> FunPtr C_DestroyNotify -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_DestroyNotify)
ptrvalueDestroy FunPtr C_DestroyNotify
valueDestroy'
    Ptr Trie
result <- FunPtr C_DestroyNotify -> IO (Ptr Trie)
dzl_trie_new FunPtr C_DestroyNotify
valueDestroy'
    Text -> Ptr Trie -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"trieNew" Ptr Trie
result
    Trie
result' <- ((ManagedPtr Trie -> Trie) -> Ptr Trie -> IO Trie
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Trie -> Trie
Trie) Ptr Trie
result
    Trie -> IO Trie
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Trie
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Trie::destroy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "trie"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Trie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlTrie or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_trie_destroy" dzl_trie_destroy :: 
    Ptr Trie ->                             -- trie : TInterface (Name {namespace = "Dazzle", name = "Trie"})
    IO ()

-- | This is an alias for 'GI.Dazzle.Structs.Trie.trieUnref'.
trieDestroy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Trie
    -- ^ /@trie@/: A t'GI.Dazzle.Structs.Trie.Trie' or 'P.Nothing'.
    -> m ()
trieDestroy :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Trie -> m ()
trieDestroy Trie
trie = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Trie
trie' <- Trie -> IO (Ptr Trie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Trie
trie
    Ptr Trie -> IO ()
dzl_trie_destroy Ptr Trie
trie'
    Trie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Trie
trie
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TrieDestroyMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod TrieDestroyMethodInfo Trie signature where
    overloadedMethod = trieDestroy

instance O.OverloadedMethodInfo TrieDestroyMethodInfo Trie where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Trie.trieDestroy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Trie.html#v:trieDestroy"
        })


#endif

-- method Trie::insert
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "trie"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Trie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlTrie." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key to insert." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to insert."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_trie_insert" dzl_trie_insert :: 
    Ptr Trie ->                             -- trie : TInterface (Name {namespace = "Dazzle", name = "Trie"})
    CString ->                              -- key : TBasicType TUTF8
    Ptr () ->                               -- value : TBasicType TPtr
    IO ()

-- | Inserts /@value@/ into /@trie@/ located with /@key@/.
trieInsert ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Trie
    -- ^ /@trie@/: A t'GI.Dazzle.Structs.Trie.Trie'.
    -> T.Text
    -- ^ /@key@/: The key to insert.
    -> Ptr ()
    -- ^ /@value@/: The value to insert.
    -> m ()
trieInsert :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Trie -> Text -> Ptr () -> m ()
trieInsert Trie
trie Text
key Ptr ()
value = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Trie
trie' <- Trie -> IO (Ptr Trie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Trie
trie
    CString
key' <- Text -> IO CString
textToCString Text
key
    Ptr Trie -> CString -> C_DestroyNotify
dzl_trie_insert Ptr Trie
trie' CString
key' Ptr ()
value
    Trie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Trie
trie
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TrieInsertMethodInfo
instance (signature ~ (T.Text -> Ptr () -> m ()), MonadIO m) => O.OverloadedMethod TrieInsertMethodInfo Trie signature where
    overloadedMethod = trieInsert

instance O.OverloadedMethodInfo TrieInsertMethodInfo Trie where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Trie.trieInsert",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Trie.html#v:trieInsert"
        })


#endif

-- method Trie::lookup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "trie"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Trie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlTrie." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key to lookup." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_trie_lookup" dzl_trie_lookup :: 
    Ptr Trie ->                             -- trie : TInterface (Name {namespace = "Dazzle", name = "Trie"})
    CString ->                              -- key : TBasicType TUTF8
    IO (Ptr ())

-- | Looks up /@key@/ in /@trie@/ and returns the value associated.
trieLookup ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Trie
    -- ^ /@trie@/: A t'GI.Dazzle.Structs.Trie.Trie'.
    -> T.Text
    -- ^ /@key@/: The key to lookup.
    -> m (Ptr ())
    -- ^ __Returns:__ The value inserted or 'P.Nothing'.
trieLookup :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Trie -> Text -> m (Ptr ())
trieLookup Trie
trie Text
key = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    Ptr Trie
trie' <- Trie -> IO (Ptr Trie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Trie
trie
    CString
key' <- Text -> IO CString
textToCString Text
key
    Ptr ()
result <- Ptr Trie -> CString -> IO (Ptr ())
dzl_trie_lookup Ptr Trie
trie' CString
key'
    Trie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Trie
trie
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

#if defined(ENABLE_OVERLOADING)
data TrieLookupMethodInfo
instance (signature ~ (T.Text -> m (Ptr ())), MonadIO m) => O.OverloadedMethod TrieLookupMethodInfo Trie signature where
    overloadedMethod = trieLookup

instance O.OverloadedMethodInfo TrieLookupMethodInfo Trie where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Trie.trieLookup",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Trie.html#v:trieLookup"
        })


#endif

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

foreign import ccall "dzl_trie_ref" dzl_trie_ref :: 
    Ptr Trie ->                             -- trie : TInterface (Name {namespace = "Dazzle", name = "Trie"})
    IO (Ptr Trie)

-- | /No description available in the introspection data./
trieRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Trie
    -> m Trie
trieRef :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Trie -> m Trie
trieRef Trie
trie = IO Trie -> m Trie
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Trie -> m Trie) -> IO Trie -> m Trie
forall a b. (a -> b) -> a -> b
$ do
    Ptr Trie
trie' <- Trie -> IO (Ptr Trie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Trie
trie
    Ptr Trie
result <- Ptr Trie -> IO (Ptr Trie)
dzl_trie_ref Ptr Trie
trie'
    Text -> Ptr Trie -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"trieRef" Ptr Trie
result
    Trie
result' <- ((ManagedPtr Trie -> Trie) -> Ptr Trie -> IO Trie
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Trie -> Trie
Trie) Ptr Trie
result
    Trie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Trie
trie
    Trie -> IO Trie
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Trie
result'

#if defined(ENABLE_OVERLOADING)
data TrieRefMethodInfo
instance (signature ~ (m Trie), MonadIO m) => O.OverloadedMethod TrieRefMethodInfo Trie signature where
    overloadedMethod = trieRef

instance O.OverloadedMethodInfo TrieRefMethodInfo Trie where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Trie.trieRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Trie.html#v:trieRef"
        })


#endif

-- method Trie::remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "trie"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Trie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlTrie." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key to remove." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_trie_remove" dzl_trie_remove :: 
    Ptr Trie ->                             -- trie : TInterface (Name {namespace = "Dazzle", name = "Trie"})
    CString ->                              -- key : TBasicType TUTF8
    IO CInt

-- | Removes /@key@/ from /@trie@/, possibly destroying the value associated with
-- the key.
trieRemove ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Trie
    -- ^ /@trie@/: A t'GI.Dazzle.Structs.Trie.Trie'.
    -> T.Text
    -- ^ /@key@/: The key to remove.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@key@/ was found, otherwise 'P.False'.
trieRemove :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Trie -> Text -> m Bool
trieRemove Trie
trie Text
key = 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
    Ptr Trie
trie' <- Trie -> IO (Ptr Trie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Trie
trie
    CString
key' <- Text -> IO CString
textToCString Text
key
    CInt
result <- Ptr Trie -> CString -> IO CInt
dzl_trie_remove Ptr Trie
trie' CString
key'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Trie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Trie
trie
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TrieRemoveMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.OverloadedMethod TrieRemoveMethodInfo Trie signature where
    overloadedMethod = trieRemove

instance O.OverloadedMethodInfo TrieRemoveMethodInfo Trie where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Trie.trieRemove",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Trie.html#v:trieRemove"
        })


#endif

-- method Trie::traverse
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "trie"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Trie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlTrie." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key to start traversal from."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "order"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "TraverseType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The order to traverse."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "TraverseFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The flags for which nodes to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "max_depth"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the maximum depth to process."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "TrieTraverseFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The func to execute for each matching node."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "User data for @func."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_trie_traverse" dzl_trie_traverse :: 
    Ptr Trie ->                             -- trie : TInterface (Name {namespace = "Dazzle", name = "Trie"})
    CString ->                              -- key : TBasicType TUTF8
    CUInt ->                                -- order : TInterface (Name {namespace = "GLib", name = "TraverseType"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GLib", name = "TraverseFlags"})
    Int32 ->                                -- max_depth : TBasicType TInt
    FunPtr Dazzle.Callbacks.C_TrieTraverseFunc -> -- func : TInterface (Name {namespace = "Dazzle", name = "TrieTraverseFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Traverses all nodes of /@trie@/ according to the parameters. For each node
-- matching the traversal parameters, /@func@/ will be executed.
-- 
-- Only 'GI.GLib.Enums.TraverseTypePreOrder' and 'GI.GLib.Enums.TraverseTypePostOrder' are supported for /@order@/.
-- 
-- If /@maxDepth@/ is less than zero, the entire tree will be traversed.
-- If max_depth is 1, then only the root will be traversed.
trieTraverse ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Trie
    -- ^ /@trie@/: A t'GI.Dazzle.Structs.Trie.Trie'.
    -> T.Text
    -- ^ /@key@/: The key to start traversal from.
    -> GLib.Enums.TraverseType
    -- ^ /@order@/: The order to traverse.
    -> [GLib.Flags.TraverseFlags]
    -- ^ /@flags@/: The flags for which nodes to callback.
    -> Int32
    -- ^ /@maxDepth@/: the maximum depth to process.
    -> Dazzle.Callbacks.TrieTraverseFunc
    -- ^ /@func@/: The func to execute for each matching node.
    -> m ()
trieTraverse :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Trie
-> Text
-> TraverseType
-> [TraverseFlags]
-> Int32
-> TrieTraverseFunc
-> m ()
trieTraverse Trie
trie Text
key TraverseType
order [TraverseFlags]
flags Int32
maxDepth TrieTraverseFunc
func = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Trie
trie' <- Trie -> IO (Ptr Trie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Trie
trie
    CString
key' <- Text -> IO CString
textToCString Text
key
    let order' :: CUInt
order' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (TraverseType -> Int) -> TraverseType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraverseType -> Int
forall a. Enum a => a -> Int
fromEnum) TraverseType
order
    let flags' :: CUInt
flags' = [TraverseFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [TraverseFlags]
flags
    FunPtr C_TrieTraverseFunc
func' <- C_TrieTraverseFunc -> IO (FunPtr C_TrieTraverseFunc)
Dazzle.Callbacks.mk_TrieTraverseFunc (Maybe (Ptr (FunPtr C_TrieTraverseFunc))
-> TrieTraverseFunc_WithClosures -> C_TrieTraverseFunc
Dazzle.Callbacks.wrap_TrieTraverseFunc Maybe (Ptr (FunPtr C_TrieTraverseFunc))
forall a. Maybe a
Nothing (TrieTraverseFunc -> TrieTraverseFunc_WithClosures
Dazzle.Callbacks.drop_closures_TrieTraverseFunc TrieTraverseFunc
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Trie
-> CString
-> CUInt
-> CUInt
-> Int32
-> FunPtr C_TrieTraverseFunc
-> C_DestroyNotify
dzl_trie_traverse Ptr Trie
trie' CString
key' CUInt
order' CUInt
flags' Int32
maxDepth FunPtr C_TrieTraverseFunc
func' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_TrieTraverseFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_TrieTraverseFunc
func'
    Trie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Trie
trie
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TrieTraverseMethodInfo
instance (signature ~ (T.Text -> GLib.Enums.TraverseType -> [GLib.Flags.TraverseFlags] -> Int32 -> Dazzle.Callbacks.TrieTraverseFunc -> m ()), MonadIO m) => O.OverloadedMethod TrieTraverseMethodInfo Trie signature where
    overloadedMethod = trieTraverse

instance O.OverloadedMethodInfo TrieTraverseMethodInfo Trie where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Trie.trieTraverse",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Trie.html#v:trieTraverse"
        })


#endif

-- method Trie::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "trie"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Trie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlTrie or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_trie_unref" dzl_trie_unref :: 
    Ptr Trie ->                             -- trie : TInterface (Name {namespace = "Dazzle", name = "Trie"})
    IO ()

-- | Drops the reference count by one on /@trie@/. When it reaches zero, the
-- structure is freed.
trieUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Trie
    -- ^ /@trie@/: A t'GI.Dazzle.Structs.Trie.Trie' or 'P.Nothing'.
    -> m ()
trieUnref :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Trie -> m ()
trieUnref Trie
trie = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Trie
trie' <- Trie -> IO (Ptr Trie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Trie
trie
    Ptr Trie -> IO ()
dzl_trie_unref Ptr Trie
trie'
    Trie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Trie
trie
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TrieUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod TrieUnrefMethodInfo Trie signature where
    overloadedMethod = trieUnref

instance O.OverloadedMethodInfo TrieUnrefMethodInfo Trie where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Trie.trieUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Trie.html#v:trieUnref"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveTrieMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveTrieMethod "destroy" o = TrieDestroyMethodInfo
    ResolveTrieMethod "insert" o = TrieInsertMethodInfo
    ResolveTrieMethod "lookup" o = TrieLookupMethodInfo
    ResolveTrieMethod "ref" o = TrieRefMethodInfo
    ResolveTrieMethod "remove" o = TrieRemoveMethodInfo
    ResolveTrieMethod "traverse" o = TrieTraverseMethodInfo
    ResolveTrieMethod "unref" o = TrieUnrefMethodInfo
    ResolveTrieMethod l o = O.MethodResolutionFailed l o

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

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

#endif

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

#endif