{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

The GString struct contains the public fields of a GString.
-}

module GI.GLib.Structs.String
    ( 

-- * Exported types
    String(..)                              ,
    noString                                ,


 -- * Methods
-- ** stringAppend
    stringAppend                            ,


-- ** stringAppendC
    stringAppendC                           ,


-- ** stringAppendLen
    stringAppendLen                         ,


-- ** stringAppendUnichar
    stringAppendUnichar                     ,


-- ** stringAppendUriEscaped
    stringAppendUriEscaped                  ,


-- ** stringAsciiDown
    stringAsciiDown                         ,


-- ** stringAsciiUp
    stringAsciiUp                           ,


-- ** stringAssign
    stringAssign                            ,


-- ** stringDown
    stringDown                              ,


-- ** stringEqual
    stringEqual                             ,


-- ** stringErase
    stringErase                             ,


-- ** stringFree
    stringFree                              ,


-- ** stringFreeToBytes
    stringFreeToBytes                       ,


-- ** stringHash
    stringHash                              ,


-- ** stringInsert
    stringInsert                            ,


-- ** stringInsertC
    stringInsertC                           ,


-- ** stringInsertLen
    stringInsertLen                         ,


-- ** stringInsertUnichar
    stringInsertUnichar                     ,


-- ** stringOverwrite
    stringOverwrite                         ,


-- ** stringOverwriteLen
    stringOverwriteLen                      ,


-- ** stringPrepend
    stringPrepend                           ,


-- ** stringPrependC
    stringPrependC                          ,


-- ** stringPrependLen
    stringPrependLen                        ,


-- ** stringPrependUnichar
    stringPrependUnichar                    ,


-- ** stringSetSize
    stringSetSize                           ,


-- ** stringTruncate
    stringTruncate                          ,


-- ** stringUp
    stringUp                                ,




 -- * Properties
-- ** AllocatedLen
    stringReadAllocatedLen                  ,


-- ** Len
    stringReadLen                           ,


-- ** Str
    stringReadStr                           ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.GLib.Types
import GI.GLib.Callbacks

newtype String = String (ForeignPtr String)
foreign import ccall "g_gstring_get_type" c_g_gstring_get_type :: 
    IO GType

instance BoxedObject String where
    boxedType _ = c_g_gstring_get_type

noString :: Maybe String
noString = Nothing

stringReadStr :: String -> IO T.Text
stringReadStr s = withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CString
    val' <- cstringToText val
    return val'

stringReadLen :: String -> IO Word64
stringReadLen s = withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO Word64
    return val

stringReadAllocatedLen :: String -> IO Word64
stringReadAllocatedLen s = withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO Word64
    return val

-- method String::append
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_append" g_string_append :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    CString ->                              -- val : TBasicType TUTF8
    IO (Ptr String)


stringAppend ::
    (MonadIO m) =>
    String ->                               -- _obj
    T.Text ->                               -- val
    m String
stringAppend _obj val = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    val' <- textToCString val
    result <- g_string_append _obj' val'
    checkUnexpectedReturnNULL "g_string_append" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    freeMem val'
    return result'

-- method String::append_c
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_append_c" g_string_append_c :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    Int8 ->                                 -- c : TBasicType TInt8
    IO (Ptr String)


stringAppendC ::
    (MonadIO m) =>
    String ->                               -- _obj
    Int8 ->                                 -- c
    m String
stringAppendC _obj c = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    result <- g_string_append_c _obj' c
    checkUnexpectedReturnNULL "g_string_append_c" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    return result'

-- method String::append_len
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_append_len" g_string_append_len :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    CString ->                              -- val : TBasicType TUTF8
    Int64 ->                                -- len : TBasicType TInt64
    IO (Ptr String)


stringAppendLen ::
    (MonadIO m) =>
    String ->                               -- _obj
    T.Text ->                               -- val
    Int64 ->                                -- len
    m String
stringAppendLen _obj val len = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    val' <- textToCString val
    result <- g_string_append_len _obj' val' len
    checkUnexpectedReturnNULL "g_string_append_len" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    freeMem val'
    return result'

-- method String::append_unichar
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wc", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wc", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_append_unichar" g_string_append_unichar :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    CInt ->                                 -- wc : TBasicType TUniChar
    IO (Ptr String)


stringAppendUnichar ::
    (MonadIO m) =>
    String ->                               -- _obj
    Char ->                                 -- wc
    m String
stringAppendUnichar _obj wc = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    let wc' = (fromIntegral . ord) wc
    result <- g_string_append_unichar _obj' wc'
    checkUnexpectedReturnNULL "g_string_append_unichar" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    return result'

-- method String::append_uri_escaped
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "unescaped", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "reserved_chars_allowed", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "allow_utf8", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "unescaped", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "reserved_chars_allowed", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "allow_utf8", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_append_uri_escaped" g_string_append_uri_escaped :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    CString ->                              -- unescaped : TBasicType TUTF8
    CString ->                              -- reserved_chars_allowed : TBasicType TUTF8
    CInt ->                                 -- allow_utf8 : TBasicType TBoolean
    IO (Ptr String)


stringAppendUriEscaped ::
    (MonadIO m) =>
    String ->                               -- _obj
    T.Text ->                               -- unescaped
    T.Text ->                               -- reserved_chars_allowed
    Bool ->                                 -- allow_utf8
    m String
stringAppendUriEscaped _obj unescaped reserved_chars_allowed allow_utf8 = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    unescaped' <- textToCString unescaped
    reserved_chars_allowed' <- textToCString reserved_chars_allowed
    let allow_utf8' = (fromIntegral . fromEnum) allow_utf8
    result <- g_string_append_uri_escaped _obj' unescaped' reserved_chars_allowed' allow_utf8'
    checkUnexpectedReturnNULL "g_string_append_uri_escaped" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    freeMem unescaped'
    freeMem reserved_chars_allowed'
    return result'

-- method String::ascii_down
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_ascii_down" g_string_ascii_down :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    IO (Ptr String)


stringAsciiDown ::
    (MonadIO m) =>
    String ->                               -- _obj
    m String
stringAsciiDown _obj = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    result <- g_string_ascii_down _obj'
    checkUnexpectedReturnNULL "g_string_ascii_down" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    return result'

-- method String::ascii_up
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_ascii_up" g_string_ascii_up :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    IO (Ptr String)


stringAsciiUp ::
    (MonadIO m) =>
    String ->                               -- _obj
    m String
stringAsciiUp _obj = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    result <- g_string_ascii_up _obj'
    checkUnexpectedReturnNULL "g_string_ascii_up" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    return result'

-- method String::assign
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rval", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rval", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_assign" g_string_assign :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    CString ->                              -- rval : TBasicType TUTF8
    IO (Ptr String)


stringAssign ::
    (MonadIO m) =>
    String ->                               -- _obj
    T.Text ->                               -- rval
    m String
stringAssign _obj rval = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    rval' <- textToCString rval
    result <- g_string_assign _obj' rval'
    checkUnexpectedReturnNULL "g_string_assign" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    freeMem rval'
    return result'

-- method String::down
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_down" g_string_down :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    IO (Ptr String)

{-# DEPRECATED stringDown ["(Since version 2.2)","This function uses the locale-specific","    tolower() function, which is almost never the right thing.","    Use g_string_ascii_down() or g_utf8_strdown() instead."]#-}
stringDown ::
    (MonadIO m) =>
    String ->                               -- _obj
    m String
stringDown _obj = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    result <- g_string_down _obj'
    checkUnexpectedReturnNULL "g_string_down" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    return result'

-- method String::equal
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "v2", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "v2", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "g_string_equal" g_string_equal :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    Ptr String ->                           -- v2 : TInterface "GLib" "String"
    IO CInt


stringEqual ::
    (MonadIO m) =>
    String ->                               -- _obj
    String ->                               -- v2
    m Bool
stringEqual _obj v2 = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    let v2' = unsafeManagedPtrGetPtr v2
    result <- g_string_equal _obj' v2'
    let result' = (/= 0) result
    touchManagedPtr _obj
    touchManagedPtr v2
    return result'

-- method String::erase
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_erase" g_string_erase :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    Int64 ->                                -- pos : TBasicType TInt64
    Int64 ->                                -- len : TBasicType TInt64
    IO (Ptr String)


stringErase ::
    (MonadIO m) =>
    String ->                               -- _obj
    Int64 ->                                -- pos
    Int64 ->                                -- len
    m String
stringErase _obj pos len = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    result <- g_string_erase _obj' pos len
    checkUnexpectedReturnNULL "g_string_erase" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    return result'

-- method String::free
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "free_segment", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "free_segment", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "g_string_free" g_string_free :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    CInt ->                                 -- free_segment : TBasicType TBoolean
    IO CString


stringFree ::
    (MonadIO m) =>
    String ->                               -- _obj
    Bool ->                                 -- free_segment
    m T.Text
stringFree _obj free_segment = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    let free_segment' = (fromIntegral . fromEnum) free_segment
    result <- g_string_free _obj' free_segment'
    checkUnexpectedReturnNULL "g_string_free" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr _obj
    return result'

-- method String::free_to_bytes
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "Bytes"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_free_to_bytes" g_string_free_to_bytes :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    IO (Ptr Bytes)


stringFreeToBytes ::
    (MonadIO m) =>
    String ->                               -- _obj
    m Bytes
stringFreeToBytes _obj = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    result <- g_string_free_to_bytes _obj'
    checkUnexpectedReturnNULL "g_string_free_to_bytes" result
    result' <- (wrapBoxed Bytes) result
    touchManagedPtr _obj
    return result'

-- method String::hash
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUInt32
-- throws : False
-- Skip return : False

foreign import ccall "g_string_hash" g_string_hash :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    IO Word32


stringHash ::
    (MonadIO m) =>
    String ->                               -- _obj
    m Word32
stringHash _obj = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    result <- g_string_hash _obj'
    touchManagedPtr _obj
    return result

-- method String::insert
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_insert" g_string_insert :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    Int64 ->                                -- pos : TBasicType TInt64
    CString ->                              -- val : TBasicType TUTF8
    IO (Ptr String)


stringInsert ::
    (MonadIO m) =>
    String ->                               -- _obj
    Int64 ->                                -- pos
    T.Text ->                               -- val
    m String
stringInsert _obj pos val = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    val' <- textToCString val
    result <- g_string_insert _obj' pos val'
    checkUnexpectedReturnNULL "g_string_insert" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    freeMem val'
    return result'

-- method String::insert_c
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_insert_c" g_string_insert_c :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    Int64 ->                                -- pos : TBasicType TInt64
    Int8 ->                                 -- c : TBasicType TInt8
    IO (Ptr String)


stringInsertC ::
    (MonadIO m) =>
    String ->                               -- _obj
    Int64 ->                                -- pos
    Int8 ->                                 -- c
    m String
stringInsertC _obj pos c = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    result <- g_string_insert_c _obj' pos c
    checkUnexpectedReturnNULL "g_string_insert_c" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    return result'

-- method String::insert_len
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_insert_len" g_string_insert_len :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    Int64 ->                                -- pos : TBasicType TInt64
    CString ->                              -- val : TBasicType TUTF8
    Int64 ->                                -- len : TBasicType TInt64
    IO (Ptr String)


stringInsertLen ::
    (MonadIO m) =>
    String ->                               -- _obj
    Int64 ->                                -- pos
    T.Text ->                               -- val
    Int64 ->                                -- len
    m String
stringInsertLen _obj pos val len = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    val' <- textToCString val
    result <- g_string_insert_len _obj' pos val' len
    checkUnexpectedReturnNULL "g_string_insert_len" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    freeMem val'
    return result'

-- method String::insert_unichar
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wc", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wc", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_insert_unichar" g_string_insert_unichar :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    Int64 ->                                -- pos : TBasicType TInt64
    CInt ->                                 -- wc : TBasicType TUniChar
    IO (Ptr String)


stringInsertUnichar ::
    (MonadIO m) =>
    String ->                               -- _obj
    Int64 ->                                -- pos
    Char ->                                 -- wc
    m String
stringInsertUnichar _obj pos wc = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    let wc' = (fromIntegral . ord) wc
    result <- g_string_insert_unichar _obj' pos wc'
    checkUnexpectedReturnNULL "g_string_insert_unichar" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    return result'

-- method String::overwrite
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_overwrite" g_string_overwrite :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    Word64 ->                               -- pos : TBasicType TUInt64
    CString ->                              -- val : TBasicType TUTF8
    IO (Ptr String)


stringOverwrite ::
    (MonadIO m) =>
    String ->                               -- _obj
    Word64 ->                               -- pos
    T.Text ->                               -- val
    m String
stringOverwrite _obj pos val = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    val' <- textToCString val
    result <- g_string_overwrite _obj' pos val'
    checkUnexpectedReturnNULL "g_string_overwrite" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    freeMem val'
    return result'

-- method String::overwrite_len
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_overwrite_len" g_string_overwrite_len :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    Word64 ->                               -- pos : TBasicType TUInt64
    CString ->                              -- val : TBasicType TUTF8
    Int64 ->                                -- len : TBasicType TInt64
    IO (Ptr String)


stringOverwriteLen ::
    (MonadIO m) =>
    String ->                               -- _obj
    Word64 ->                               -- pos
    T.Text ->                               -- val
    Int64 ->                                -- len
    m String
stringOverwriteLen _obj pos val len = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    val' <- textToCString val
    result <- g_string_overwrite_len _obj' pos val' len
    checkUnexpectedReturnNULL "g_string_overwrite_len" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    freeMem val'
    return result'

-- method String::prepend
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_prepend" g_string_prepend :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    CString ->                              -- val : TBasicType TUTF8
    IO (Ptr String)


stringPrepend ::
    (MonadIO m) =>
    String ->                               -- _obj
    T.Text ->                               -- val
    m String
stringPrepend _obj val = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    val' <- textToCString val
    result <- g_string_prepend _obj' val'
    checkUnexpectedReturnNULL "g_string_prepend" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    freeMem val'
    return result'

-- method String::prepend_c
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_prepend_c" g_string_prepend_c :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    Int8 ->                                 -- c : TBasicType TInt8
    IO (Ptr String)


stringPrependC ::
    (MonadIO m) =>
    String ->                               -- _obj
    Int8 ->                                 -- c
    m String
stringPrependC _obj c = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    result <- g_string_prepend_c _obj' c
    checkUnexpectedReturnNULL "g_string_prepend_c" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    return result'

-- method String::prepend_len
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_prepend_len" g_string_prepend_len :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    CString ->                              -- val : TBasicType TUTF8
    Int64 ->                                -- len : TBasicType TInt64
    IO (Ptr String)


stringPrependLen ::
    (MonadIO m) =>
    String ->                               -- _obj
    T.Text ->                               -- val
    Int64 ->                                -- len
    m String
stringPrependLen _obj val len = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    val' <- textToCString val
    result <- g_string_prepend_len _obj' val' len
    checkUnexpectedReturnNULL "g_string_prepend_len" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    freeMem val'
    return result'

-- method String::prepend_unichar
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wc", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wc", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_prepend_unichar" g_string_prepend_unichar :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    CInt ->                                 -- wc : TBasicType TUniChar
    IO (Ptr String)


stringPrependUnichar ::
    (MonadIO m) =>
    String ->                               -- _obj
    Char ->                                 -- wc
    m String
stringPrependUnichar _obj wc = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    let wc' = (fromIntegral . ord) wc
    result <- g_string_prepend_unichar _obj' wc'
    checkUnexpectedReturnNULL "g_string_prepend_unichar" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    return result'

-- method String::set_size
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_set_size" g_string_set_size :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    Word64 ->                               -- len : TBasicType TUInt64
    IO (Ptr String)


stringSetSize ::
    (MonadIO m) =>
    String ->                               -- _obj
    Word64 ->                               -- len
    m String
stringSetSize _obj len = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    result <- g_string_set_size _obj' len
    checkUnexpectedReturnNULL "g_string_set_size" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    return result'

-- method String::truncate
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_truncate" g_string_truncate :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    Word64 ->                               -- len : TBasicType TUInt64
    IO (Ptr String)


stringTruncate ::
    (MonadIO m) =>
    String ->                               -- _obj
    Word64 ->                               -- len
    m String
stringTruncate _obj len = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    result <- g_string_truncate _obj' len
    checkUnexpectedReturnNULL "g_string_truncate" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    return result'

-- method String::up
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "GLib" "String", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "String"
-- throws : False
-- Skip return : False

foreign import ccall "g_string_up" g_string_up :: 
    Ptr String ->                           -- _obj : TInterface "GLib" "String"
    IO (Ptr String)

{-# DEPRECATED stringUp ["(Since version 2.2)","This function uses the locale-specific","    toupper() function, which is almost never the right thing.","    Use g_string_ascii_up() or g_utf8_strup() instead."]#-}
stringUp ::
    (MonadIO m) =>
    String ->                               -- _obj
    m String
stringUp _obj = liftIO $ do
    let _obj' = unsafeManagedPtrGetPtr _obj
    result <- g_string_up _obj'
    checkUnexpectedReturnNULL "g_string_up" result
    result' <- (wrapBoxed String) result
    touchManagedPtr _obj
    return result'