{- |
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(..)                              ,
    newZeroString                           ,
    noString                                ,


 -- * Methods
-- ** append #method:append#
    StringAppendMethodInfo                  ,
    stringAppend                            ,


-- ** appendC #method:appendC#
    StringAppendCMethodInfo                 ,
    stringAppendC                           ,


-- ** appendLen #method:appendLen#
    StringAppendLenMethodInfo               ,
    stringAppendLen                         ,


-- ** appendUnichar #method:appendUnichar#
    StringAppendUnicharMethodInfo           ,
    stringAppendUnichar                     ,


-- ** appendUriEscaped #method:appendUriEscaped#
    StringAppendUriEscapedMethodInfo        ,
    stringAppendUriEscaped                  ,


-- ** asciiDown #method:asciiDown#
    StringAsciiDownMethodInfo               ,
    stringAsciiDown                         ,


-- ** asciiUp #method:asciiUp#
    StringAsciiUpMethodInfo                 ,
    stringAsciiUp                           ,


-- ** assign #method:assign#
    StringAssignMethodInfo                  ,
    stringAssign                            ,


-- ** down #method:down#
    StringDownMethodInfo                    ,
    stringDown                              ,


-- ** equal #method:equal#
    StringEqualMethodInfo                   ,
    stringEqual                             ,


-- ** erase #method:erase#
    StringEraseMethodInfo                   ,
    stringErase                             ,


-- ** free #method:free#
    StringFreeMethodInfo                    ,
    stringFree                              ,


-- ** freeToBytes #method:freeToBytes#
    StringFreeToBytesMethodInfo             ,
    stringFreeToBytes                       ,


-- ** hash #method:hash#
    StringHashMethodInfo                    ,
    stringHash                              ,


-- ** insert #method:insert#
    StringInsertMethodInfo                  ,
    stringInsert                            ,


-- ** insertC #method:insertC#
    StringInsertCMethodInfo                 ,
    stringInsertC                           ,


-- ** insertLen #method:insertLen#
    StringInsertLenMethodInfo               ,
    stringInsertLen                         ,


-- ** insertUnichar #method:insertUnichar#
    StringInsertUnicharMethodInfo           ,
    stringInsertUnichar                     ,


-- ** overwrite #method:overwrite#
    StringOverwriteMethodInfo               ,
    stringOverwrite                         ,


-- ** overwriteLen #method:overwriteLen#
    StringOverwriteLenMethodInfo            ,
    stringOverwriteLen                      ,


-- ** prepend #method:prepend#
    StringPrependMethodInfo                 ,
    stringPrepend                           ,


-- ** prependC #method:prependC#
    StringPrependCMethodInfo                ,
    stringPrependC                          ,


-- ** prependLen #method:prependLen#
    StringPrependLenMethodInfo              ,
    stringPrependLen                        ,


-- ** prependUnichar #method:prependUnichar#
    StringPrependUnicharMethodInfo          ,
    stringPrependUnichar                    ,


-- ** setSize #method:setSize#
    StringSetSizeMethodInfo                 ,
    stringSetSize                           ,


-- ** truncate #method:truncate#
    StringTruncateMethodInfo                ,
    stringTruncate                          ,


-- ** up #method:up#
    StringUpMethodInfo                      ,
    stringUp                                ,




 -- * Properties
-- ** allocatedLen #attr:allocatedLen#
    getStringAllocatedLen                   ,
    setStringAllocatedLen                   ,
    string_allocatedLen                     ,


-- ** len #attr:len#
    getStringLen                            ,
    setStringLen                            ,
    string_len                              ,


-- ** str #attr:str#
    clearStringStr                          ,
    getStringStr                            ,
    setStringStr                            ,
    string_str                              ,




    ) 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.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
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 {-# SOURCE #-} qualified GI.GLib.Structs.Bytes as GLib.Bytes

newtype String = String (ManagedPtr 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

-- | Construct a `String` struct initialized to zero.
newZeroString :: MonadIO m => m String
newZeroString = liftIO $ callocBoxedBytes 24 >>= wrapBoxed String

instance tag ~ 'AttrSet => Constructible String tag where
    new _ attrs = do
        o <- newZeroString
        GI.Attributes.set o attrs
        return o


noString :: Maybe String
noString = Nothing

getStringStr :: MonadIO m => String -> m (Maybe T.Text)
getStringStr s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setStringStr :: MonadIO m => String -> CString -> m ()
setStringStr s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: CString)

clearStringStr :: MonadIO m => String -> m ()
clearStringStr s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (FP.nullPtr :: CString)

data StringStrFieldInfo
instance AttrInfo StringStrFieldInfo where
    type AttrAllowedOps StringStrFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint StringStrFieldInfo = (~) CString
    type AttrBaseTypeConstraint StringStrFieldInfo = (~) String
    type AttrGetType StringStrFieldInfo = Maybe T.Text
    type AttrLabel StringStrFieldInfo = "str"
    type AttrOrigin StringStrFieldInfo = String
    attrGet _ = getStringStr
    attrSet _ = setStringStr
    attrConstruct = undefined
    attrClear _ = clearStringStr

string_str :: AttrLabelProxy "str"
string_str = AttrLabelProxy


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

setStringLen :: MonadIO m => String -> Word64 -> m ()
setStringLen s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (val :: Word64)

data StringLenFieldInfo
instance AttrInfo StringLenFieldInfo where
    type AttrAllowedOps StringLenFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint StringLenFieldInfo = (~) Word64
    type AttrBaseTypeConstraint StringLenFieldInfo = (~) String
    type AttrGetType StringLenFieldInfo = Word64
    type AttrLabel StringLenFieldInfo = "len"
    type AttrOrigin StringLenFieldInfo = String
    attrGet _ = getStringLen
    attrSet _ = setStringLen
    attrConstruct = undefined
    attrClear _ = undefined

string_len :: AttrLabelProxy "len"
string_len = AttrLabelProxy


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

setStringAllocatedLen :: MonadIO m => String -> Word64 -> m ()
setStringAllocatedLen s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (val :: Word64)

data StringAllocatedLenFieldInfo
instance AttrInfo StringAllocatedLenFieldInfo where
    type AttrAllowedOps StringAllocatedLenFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint StringAllocatedLenFieldInfo = (~) Word64
    type AttrBaseTypeConstraint StringAllocatedLenFieldInfo = (~) String
    type AttrGetType StringAllocatedLenFieldInfo = Word64
    type AttrLabel StringAllocatedLenFieldInfo = "allocated_len"
    type AttrOrigin StringAllocatedLenFieldInfo = String
    attrGet _ = getStringAllocatedLen
    attrSet _ = setStringAllocatedLen
    attrConstruct = undefined
    attrClear _ = undefined

string_allocatedLen :: AttrLabelProxy "allocatedLen"
string_allocatedLen = AttrLabelProxy



instance O.HasAttributeList String
type instance O.AttributeList String = StringAttributeList
type StringAttributeList = ('[ '("str", StringStrFieldInfo), '("len", StringLenFieldInfo), '("allocatedLen", StringAllocatedLenFieldInfo)] :: [(Symbol, *)])

-- method String::append
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the string to append onto the end of @string", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_append" g_string_append :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    CString ->                              -- val : TBasicType TUTF8
    IO (Ptr String)

{- |
Adds a string onto the end of a 'GI.GLib.Structs.String.String', expanding
it if necessary.
-}
stringAppend ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> T.Text
    {- ^ /@val@/: the string to append onto the end of /@string@/ -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringAppend string val = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    val' <- textToCString val
    result <- g_string_append string' val'
    checkUnexpectedReturnNULL "stringAppend" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    freeMem val'
    return result'

data StringAppendMethodInfo
instance (signature ~ (T.Text -> m String), MonadIO m) => O.MethodInfo StringAppendMethodInfo String signature where
    overloadedMethod _ = stringAppend

-- method String::append_c
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the byte to append onto the end of @string", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_append_c" g_string_append_c :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    Int8 ->                                 -- c : TBasicType TInt8
    IO (Ptr String)

{- |
Adds a byte onto the end of a 'GI.GLib.Structs.String.String', expanding
it if necessary.
-}
stringAppendC ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> Int8
    {- ^ /@c@/: the byte to append onto the end of /@string@/ -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringAppendC string c = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    result <- g_string_append_c string' c
    checkUnexpectedReturnNULL "stringAppendC" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    return result'

data StringAppendCMethodInfo
instance (signature ~ (Int8 -> m String), MonadIO m) => O.MethodInfo StringAppendCMethodInfo String signature where
    overloadedMethod _ = stringAppendC

-- method String::append_len
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "bytes to append", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "number of bytes of @val to use", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_append_len" g_string_append_len :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    CString ->                              -- val : TBasicType TUTF8
    Int64 ->                                -- len : TBasicType TInt64
    IO (Ptr String)

{- |
Appends /@len@/ bytes of /@val@/ to /@string@/. Because /@len@/ is
provided, /@val@/ may contain embedded nuls and need not
be nul-terminated.

Since this function does not stop at nul bytes, it is
the caller\'s responsibility to ensure that /@val@/ has at
least /@len@/ addressable bytes.
-}
stringAppendLen ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> T.Text
    {- ^ /@val@/: bytes to append -}
    -> Int64
    {- ^ /@len@/: number of bytes of /@val@/ to use -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringAppendLen string val len = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    val' <- textToCString val
    result <- g_string_append_len string' val' len
    checkUnexpectedReturnNULL "stringAppendLen" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    freeMem val'
    return result'

data StringAppendLenMethodInfo
instance (signature ~ (T.Text -> Int64 -> m String), MonadIO m) => O.MethodInfo StringAppendLenMethodInfo String signature where
    overloadedMethod _ = stringAppendLen

-- method String::append_unichar
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "wc", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a Unicode character", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_append_unichar" g_string_append_unichar :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    CInt ->                                 -- wc : TBasicType TUniChar
    IO (Ptr String)

{- |
Converts a Unicode character into UTF-8, and appends it
to the string.
-}
stringAppendUnichar ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> Char
    {- ^ /@wc@/: a Unicode character -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringAppendUnichar string wc = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    let wc' = (fromIntegral . ord) wc
    result <- g_string_append_unichar string' wc'
    checkUnexpectedReturnNULL "stringAppendUnichar" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    return result'

data StringAppendUnicharMethodInfo
instance (signature ~ (Char -> m String), MonadIO m) => O.MethodInfo StringAppendUnicharMethodInfo String signature where
    overloadedMethod _ = stringAppendUnichar

-- method String::append_uri_escaped
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "unescaped", 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 = "reserved_chars_allowed", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a string of reserved characters allowed\n    to be used, or %NULL", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "allow_utf8", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "set %TRUE if the escaped string may include UTF8 characters", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_append_uri_escaped" g_string_append_uri_escaped :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    CString ->                              -- unescaped : TBasicType TUTF8
    CString ->                              -- reserved_chars_allowed : TBasicType TUTF8
    CInt ->                                 -- allow_utf8 : TBasicType TBoolean
    IO (Ptr String)

{- |
Appends /@unescaped@/ to /@string@/, escaped any characters that
are reserved in URIs using URI-style escape sequences.

@since 2.16
-}
stringAppendUriEscaped ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> T.Text
    {- ^ /@unescaped@/: a string -}
    -> T.Text
    {- ^ /@reservedCharsAllowed@/: a string of reserved characters allowed
    to be used, or 'Nothing' -}
    -> Bool
    {- ^ /@allowUtf8@/: set 'True' if the escaped string may include UTF8 characters -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringAppendUriEscaped string unescaped reservedCharsAllowed allowUtf8 = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    unescaped' <- textToCString unescaped
    reservedCharsAllowed' <- textToCString reservedCharsAllowed
    let allowUtf8' = (fromIntegral . fromEnum) allowUtf8
    result <- g_string_append_uri_escaped string' unescaped' reservedCharsAllowed' allowUtf8'
    checkUnexpectedReturnNULL "stringAppendUriEscaped" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    freeMem unescaped'
    freeMem reservedCharsAllowed'
    return result'

data StringAppendUriEscapedMethodInfo
instance (signature ~ (T.Text -> T.Text -> Bool -> m String), MonadIO m) => O.MethodInfo StringAppendUriEscapedMethodInfo String signature where
    overloadedMethod _ = stringAppendUriEscaped

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

foreign import ccall "g_string_ascii_down" g_string_ascii_down :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    IO (Ptr String)

{- |
Converts all uppercase ASCII letters to lowercase ASCII letters.
-}
stringAsciiDown ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a GString -}
    -> m String
    {- ^ __Returns:__ passed-in /@string@/ pointer, with all the
    uppercase characters converted to lowercase in place,
    with semantics that exactly match 'GI.GLib.Functions.asciiTolower'. -}
stringAsciiDown string = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    result <- g_string_ascii_down string'
    checkUnexpectedReturnNULL "stringAsciiDown" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    return result'

data StringAsciiDownMethodInfo
instance (signature ~ (m String), MonadIO m) => O.MethodInfo StringAsciiDownMethodInfo String signature where
    overloadedMethod _ = stringAsciiDown

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

foreign import ccall "g_string_ascii_up" g_string_ascii_up :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    IO (Ptr String)

{- |
Converts all lowercase ASCII letters to uppercase ASCII letters.
-}
stringAsciiUp ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a GString -}
    -> m String
    {- ^ __Returns:__ passed-in /@string@/ pointer, with all the
    lowercase characters converted to uppercase in place,
    with semantics that exactly match 'GI.GLib.Functions.asciiToupper'. -}
stringAsciiUp string = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    result <- g_string_ascii_up string'
    checkUnexpectedReturnNULL "stringAsciiUp" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    return result'

data StringAsciiUpMethodInfo
instance (signature ~ (m String), MonadIO m) => O.MethodInfo StringAsciiUpMethodInfo String signature where
    overloadedMethod _ = stringAsciiUp

-- method String::assign
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the destination #GString. Its current contents\n         are destroyed.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "rval", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the string to copy into @string", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_assign" g_string_assign :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    CString ->                              -- rval : TBasicType TUTF8
    IO (Ptr String)

{- |
Copies the bytes from a string into a 'GI.GLib.Structs.String.String',
destroying any previous contents. It is rather like
the standard @/strcpy()/@ function, except that you do not
have to worry about having enough space to copy the string.
-}
stringAssign ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: the destination 'GI.GLib.Structs.String.String'. Its current contents
         are destroyed. -}
    -> T.Text
    {- ^ /@rval@/: the string to copy into /@string@/ -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringAssign string rval = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    rval' <- textToCString rval
    result <- g_string_assign string' rval'
    checkUnexpectedReturnNULL "stringAssign" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    freeMem rval'
    return result'

data StringAssignMethodInfo
instance (signature ~ (T.Text -> m String), MonadIO m) => O.MethodInfo StringAssignMethodInfo String signature where
    overloadedMethod _ = stringAssign

-- method String::down
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_down" g_string_down :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "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 'GI.GLib.Structs.String.stringAsciiDown' or 'GI.GLib.Functions.utf8Strdown' instead."] #-}
{- |
Converts a 'GI.GLib.Structs.String.String' to lowercase.
-}
stringDown ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> m String
    {- ^ __Returns:__ the 'GI.GLib.Structs.String.String' -}
stringDown string = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    result <- g_string_down string'
    checkUnexpectedReturnNULL "stringDown" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    return result'

data StringDownMethodInfo
instance (signature ~ (m String), MonadIO m) => O.MethodInfo StringDownMethodInfo String signature where
    overloadedMethod _ = stringDown

-- method String::equal
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "v", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "v2", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "another #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_string_equal" g_string_equal :: 
    Ptr String ->                           -- v : TInterface (Name {namespace = "GLib", name = "String"})
    Ptr String ->                           -- v2 : TInterface (Name {namespace = "GLib", name = "String"})
    IO CInt

{- |
Compares two strings for equality, returning 'True' if they are equal.
For use with 'GI.GLib.Structs.HashTable.HashTable'.
-}
stringEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@v@/: a 'GI.GLib.Structs.String.String' -}
    -> String
    {- ^ /@v2@/: another 'GI.GLib.Structs.String.String' -}
    -> m Bool
    {- ^ __Returns:__ 'True' if the strings are the same length and contain the
    same bytes -}
stringEqual v v2 = liftIO $ do
    v' <- unsafeManagedPtrGetPtr v
    v2' <- unsafeManagedPtrGetPtr v2
    result <- g_string_equal v' v2'
    let result' = (/= 0) result
    touchManagedPtr v
    touchManagedPtr v2
    return result'

data StringEqualMethodInfo
instance (signature ~ (String -> m Bool), MonadIO m) => O.MethodInfo StringEqualMethodInfo String signature where
    overloadedMethod _ = stringEqual

-- method String::erase
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the position of the content to remove", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the number of bytes to remove, or -1 to remove all\n      following bytes", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_erase" g_string_erase :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    Int64 ->                                -- pos : TBasicType TInt64
    Int64 ->                                -- len : TBasicType TInt64
    IO (Ptr String)

{- |
Removes /@len@/ bytes from a 'GI.GLib.Structs.String.String', starting at position /@pos@/.
The rest of the 'GI.GLib.Structs.String.String' is shifted down to fill the gap.
-}
stringErase ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> Int64
    {- ^ /@pos@/: the position of the content to remove -}
    -> Int64
    {- ^ /@len@/: the number of bytes to remove, or -1 to remove all
      following bytes -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringErase string pos len = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    result <- g_string_erase string' pos len
    checkUnexpectedReturnNULL "stringErase" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    return result'

data StringEraseMethodInfo
instance (signature ~ (Int64 -> Int64 -> m String), MonadIO m) => O.MethodInfo StringEraseMethodInfo String signature where
    overloadedMethod _ = stringErase

-- method String::free
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "free_segment", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "if %TRUE, the actual character data is freed as well", 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 "g_string_free" g_string_free :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    CInt ->                                 -- free_segment : TBasicType TBoolean
    IO CString

{- |
Frees the memory allocated for the 'GI.GLib.Structs.String.String'.
If /@freeSegment@/ is 'True' it also frees the character data.  If
it\'s 'False', the caller gains ownership of the buffer and must
free it after use with 'GI.GLib.Functions.free'.
-}
stringFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> Bool
    {- ^ /@freeSegment@/: if 'True', the actual character data is freed as well -}
    -> m (Maybe T.Text)
    {- ^ __Returns:__ the character data of /@string@/
         (i.e. 'Nothing' if /@freeSegment@/ is 'True') -}
stringFree string freeSegment = liftIO $ do
    string' <- B.ManagedPtr.disownBoxed string
    let freeSegment' = (fromIntegral . fromEnum) freeSegment
    result <- g_string_free string' freeSegment'
    maybeResult <- convertIfNonNull result $ \result' -> do
        result'' <- cstringToText result'
        freeMem result'
        return result''
    touchManagedPtr string
    return maybeResult

data StringFreeMethodInfo
instance (signature ~ (Bool -> m (Maybe T.Text)), MonadIO m) => O.MethodInfo StringFreeMethodInfo String signature where
    overloadedMethod _ = stringFree

-- method String::free_to_bytes
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "Bytes"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_free_to_bytes" g_string_free_to_bytes :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    IO (Ptr GLib.Bytes.Bytes)

{- |
Transfers ownership of the contents of /@string@/ to a newly allocated
'GI.GLib.Structs.Bytes.Bytes'.  The 'GI.GLib.Structs.String.String' structure itself is deallocated, and it is
therefore invalid to use /@string@/ after invoking this function.

Note that while 'GI.GLib.Structs.String.String' ensures that its buffer always has a
trailing nul character (not reflected in its \"len\"), the returned
'GI.GLib.Structs.Bytes.Bytes' does not include this extra nul; i.e. it has length exactly
equal to the \"len\" member.

@since 2.34
-}
stringFreeToBytes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> m GLib.Bytes.Bytes
    {- ^ __Returns:__ A newly allocated 'GI.GLib.Structs.Bytes.Bytes' containing contents of /@string@/; /@string@/ itself is freed -}
stringFreeToBytes string = liftIO $ do
    string' <- B.ManagedPtr.disownBoxed string
    result <- g_string_free_to_bytes string'
    checkUnexpectedReturnNULL "stringFreeToBytes" result
    result' <- (wrapBoxed GLib.Bytes.Bytes) result
    touchManagedPtr string
    return result'

data StringFreeToBytesMethodInfo
instance (signature ~ (m GLib.Bytes.Bytes), MonadIO m) => O.MethodInfo StringFreeToBytesMethodInfo String signature where
    overloadedMethod _ = stringFreeToBytes

-- method String::hash
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "str", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a string to hash", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_string_hash" g_string_hash :: 
    Ptr String ->                           -- str : TInterface (Name {namespace = "GLib", name = "String"})
    IO Word32

{- |
Creates a hash code for /@str@/; for use with 'GI.GLib.Structs.HashTable.HashTable'.
-}
stringHash ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@str@/: a string to hash -}
    -> m Word32
    {- ^ __Returns:__ hash code for /@str@/ -}
stringHash str = liftIO $ do
    str' <- unsafeManagedPtrGetPtr str
    result <- g_string_hash str'
    touchManagedPtr str
    return result

data StringHashMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo StringHashMethodInfo String signature where
    overloadedMethod _ = stringHash

-- method String::insert
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the position to insert the copy of the string", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the string to insert", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_insert" g_string_insert :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    Int64 ->                                -- pos : TBasicType TInt64
    CString ->                              -- val : TBasicType TUTF8
    IO (Ptr String)

{- |
Inserts a copy of a string into a 'GI.GLib.Structs.String.String',
expanding it if necessary.
-}
stringInsert ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> Int64
    {- ^ /@pos@/: the position to insert the copy of the string -}
    -> T.Text
    {- ^ /@val@/: the string to insert -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringInsert string pos val = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    val' <- textToCString val
    result <- g_string_insert string' pos val'
    checkUnexpectedReturnNULL "stringInsert" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    freeMem val'
    return result'

data StringInsertMethodInfo
instance (signature ~ (Int64 -> T.Text -> m String), MonadIO m) => O.MethodInfo StringInsertMethodInfo String signature where
    overloadedMethod _ = stringInsert

-- method String::insert_c
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the position to insert the byte", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the byte to insert", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_insert_c" g_string_insert_c :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    Int64 ->                                -- pos : TBasicType TInt64
    Int8 ->                                 -- c : TBasicType TInt8
    IO (Ptr String)

{- |
Inserts a byte into a 'GI.GLib.Structs.String.String', expanding it if necessary.
-}
stringInsertC ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> Int64
    {- ^ /@pos@/: the position to insert the byte -}
    -> Int8
    {- ^ /@c@/: the byte to insert -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringInsertC string pos c = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    result <- g_string_insert_c string' pos c
    checkUnexpectedReturnNULL "stringInsertC" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    return result'

data StringInsertCMethodInfo
instance (signature ~ (Int64 -> Int8 -> m String), MonadIO m) => O.MethodInfo StringInsertCMethodInfo String signature where
    overloadedMethod _ = stringInsertC

-- method String::insert_len
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "position in @string where insertion should\n      happen, or -1 for at the end", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "bytes to insert", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "number of bytes of @val to insert", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_insert_len" g_string_insert_len :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    Int64 ->                                -- pos : TBasicType TInt64
    CString ->                              -- val : TBasicType TUTF8
    Int64 ->                                -- len : TBasicType TInt64
    IO (Ptr String)

{- |
Inserts /@len@/ bytes of /@val@/ into /@string@/ at /@pos@/.
Because /@len@/ is provided, /@val@/ may contain embedded
nuls and need not be nul-terminated. If /@pos@/ is -1,
bytes are inserted at the end of the string.

Since this function does not stop at nul bytes, it is
the caller\'s responsibility to ensure that /@val@/ has at
least /@len@/ addressable bytes.
-}
stringInsertLen ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> Int64
    {- ^ /@pos@/: position in /@string@/ where insertion should
      happen, or -1 for at the end -}
    -> T.Text
    {- ^ /@val@/: bytes to insert -}
    -> Int64
    {- ^ /@len@/: number of bytes of /@val@/ to insert -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringInsertLen string pos val len = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    val' <- textToCString val
    result <- g_string_insert_len string' pos val' len
    checkUnexpectedReturnNULL "stringInsertLen" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    freeMem val'
    return result'

data StringInsertLenMethodInfo
instance (signature ~ (Int64 -> T.Text -> Int64 -> m String), MonadIO m) => O.MethodInfo StringInsertLenMethodInfo String signature where
    overloadedMethod _ = stringInsertLen

-- method String::insert_unichar
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "pos", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the position at which to insert character, or -1\n    to append at the end of the string", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "wc", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a Unicode character", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_insert_unichar" g_string_insert_unichar :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    Int64 ->                                -- pos : TBasicType TInt64
    CInt ->                                 -- wc : TBasicType TUniChar
    IO (Ptr String)

{- |
Converts a Unicode character into UTF-8, and insert it
into the string at the given position.
-}
stringInsertUnichar ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> Int64
    {- ^ /@pos@/: the position at which to insert character, or -1
    to append at the end of the string -}
    -> Char
    {- ^ /@wc@/: a Unicode character -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringInsertUnichar string pos wc = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    let wc' = (fromIntegral . ord) wc
    result <- g_string_insert_unichar string' pos wc'
    checkUnexpectedReturnNULL "stringInsertUnichar" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    return result'

data StringInsertUnicharMethodInfo
instance (signature ~ (Int64 -> Char -> m String), MonadIO m) => O.MethodInfo StringInsertUnicharMethodInfo String signature where
    overloadedMethod _ = stringInsertUnichar

-- method String::overwrite
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "pos", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the position at which to start overwriting", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the string that will overwrite the @string starting at @pos", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_overwrite" g_string_overwrite :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    Word64 ->                               -- pos : TBasicType TUInt64
    CString ->                              -- val : TBasicType TUTF8
    IO (Ptr String)

{- |
Overwrites part of a string, lengthening it if necessary.

@since 2.14
-}
stringOverwrite ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> Word64
    {- ^ /@pos@/: the position at which to start overwriting -}
    -> T.Text
    {- ^ /@val@/: the string that will overwrite the /@string@/ starting at /@pos@/ -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringOverwrite string pos val = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    val' <- textToCString val
    result <- g_string_overwrite string' pos val'
    checkUnexpectedReturnNULL "stringOverwrite" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    freeMem val'
    return result'

data StringOverwriteMethodInfo
instance (signature ~ (Word64 -> T.Text -> m String), MonadIO m) => O.MethodInfo StringOverwriteMethodInfo String signature where
    overloadedMethod _ = stringOverwrite

-- method String::overwrite_len
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "pos", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the position at which to start overwriting", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the string that will overwrite the @string starting at @pos", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the number of bytes to write from @val", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_overwrite_len" g_string_overwrite_len :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    Word64 ->                               -- pos : TBasicType TUInt64
    CString ->                              -- val : TBasicType TUTF8
    Int64 ->                                -- len : TBasicType TInt64
    IO (Ptr String)

{- |
Overwrites part of a string, lengthening it if necessary.
This function will work with embedded nuls.

@since 2.14
-}
stringOverwriteLen ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> Word64
    {- ^ /@pos@/: the position at which to start overwriting -}
    -> T.Text
    {- ^ /@val@/: the string that will overwrite the /@string@/ starting at /@pos@/ -}
    -> Int64
    {- ^ /@len@/: the number of bytes to write from /@val@/ -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringOverwriteLen string pos val len = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    val' <- textToCString val
    result <- g_string_overwrite_len string' pos val' len
    checkUnexpectedReturnNULL "stringOverwriteLen" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    freeMem val'
    return result'

data StringOverwriteLenMethodInfo
instance (signature ~ (Word64 -> T.Text -> Int64 -> m String), MonadIO m) => O.MethodInfo StringOverwriteLenMethodInfo String signature where
    overloadedMethod _ = stringOverwriteLen

-- method String::prepend
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the string to prepend on the start of @string", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_prepend" g_string_prepend :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    CString ->                              -- val : TBasicType TUTF8
    IO (Ptr String)

{- |
Adds a string on to the start of a 'GI.GLib.Structs.String.String',
expanding it if necessary.
-}
stringPrepend ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> T.Text
    {- ^ /@val@/: the string to prepend on the start of /@string@/ -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringPrepend string val = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    val' <- textToCString val
    result <- g_string_prepend string' val'
    checkUnexpectedReturnNULL "stringPrepend" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    freeMem val'
    return result'

data StringPrependMethodInfo
instance (signature ~ (T.Text -> m String), MonadIO m) => O.MethodInfo StringPrependMethodInfo String signature where
    overloadedMethod _ = stringPrepend

-- method String::prepend_c
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "c", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the byte to prepend on the start of the #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_prepend_c" g_string_prepend_c :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    Int8 ->                                 -- c : TBasicType TInt8
    IO (Ptr String)

{- |
Adds a byte onto the start of a 'GI.GLib.Structs.String.String',
expanding it if necessary.
-}
stringPrependC ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> Int8
    {- ^ /@c@/: the byte to prepend on the start of the 'GI.GLib.Structs.String.String' -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringPrependC string c = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    result <- g_string_prepend_c string' c
    checkUnexpectedReturnNULL "stringPrependC" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    return result'

data StringPrependCMethodInfo
instance (signature ~ (Int8 -> m String), MonadIO m) => O.MethodInfo StringPrependCMethodInfo String signature where
    overloadedMethod _ = stringPrependC

-- method String::prepend_len
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "val", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "bytes to prepend", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "len", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "number of bytes in @val to prepend", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_prepend_len" g_string_prepend_len :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    CString ->                              -- val : TBasicType TUTF8
    Int64 ->                                -- len : TBasicType TInt64
    IO (Ptr String)

{- |
Prepends /@len@/ bytes of /@val@/ to /@string@/.
Because /@len@/ is provided, /@val@/ may contain
embedded nuls and need not be nul-terminated.

Since this function does not stop at nul bytes,
it is the caller\'s responsibility to ensure that
/@val@/ has at least /@len@/ addressable bytes.
-}
stringPrependLen ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> T.Text
    {- ^ /@val@/: bytes to prepend -}
    -> Int64
    {- ^ /@len@/: number of bytes in /@val@/ to prepend -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringPrependLen string val len = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    val' <- textToCString val
    result <- g_string_prepend_len string' val' len
    checkUnexpectedReturnNULL "stringPrependLen" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    freeMem val'
    return result'

data StringPrependLenMethodInfo
instance (signature ~ (T.Text -> Int64 -> m String), MonadIO m) => O.MethodInfo StringPrependLenMethodInfo String signature where
    overloadedMethod _ = stringPrependLen

-- method String::prepend_unichar
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "wc", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a Unicode character", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_prepend_unichar" g_string_prepend_unichar :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    CInt ->                                 -- wc : TBasicType TUniChar
    IO (Ptr String)

{- |
Converts a Unicode character into UTF-8, and prepends it
to the string.
-}
stringPrependUnichar ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> Char
    {- ^ /@wc@/: a Unicode character -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringPrependUnichar string wc = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    let wc' = (fromIntegral . ord) wc
    result <- g_string_prepend_unichar string' wc'
    checkUnexpectedReturnNULL "stringPrependUnichar" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    return result'

data StringPrependUnicharMethodInfo
instance (signature ~ (Char -> m String), MonadIO m) => O.MethodInfo StringPrependUnicharMethodInfo String signature where
    overloadedMethod _ = stringPrependUnichar

-- method String::set_size
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the new length", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_set_size" g_string_set_size :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    Word64 ->                               -- len : TBasicType TUInt64
    IO (Ptr String)

{- |
Sets the length of a 'GI.GLib.Structs.String.String'. If the length is less than
the current length, the string will be truncated. If the
length is greater than the current length, the contents
of the newly added area are undefined. (However, as
always, string->str[string->len] will be a nul byte.)
-}
stringSetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> Word64
    {- ^ /@len@/: the new length -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringSetSize string len = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    result <- g_string_set_size string' len
    checkUnexpectedReturnNULL "stringSetSize" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    return result'

data StringSetSizeMethodInfo
instance (signature ~ (Word64 -> m String), MonadIO m) => O.MethodInfo StringSetSizeMethodInfo String signature where
    overloadedMethod _ = stringSetSize

-- method String::truncate
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "len", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the new size of @string", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_truncate" g_string_truncate :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "String"})
    Word64 ->                               -- len : TBasicType TUInt64
    IO (Ptr String)

{- |
Cuts off the end of the GString, leaving the first /@len@/ bytes.
-}
stringTruncate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> Word64
    {- ^ /@len@/: the new size of /@string@/ -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringTruncate string len = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    result <- g_string_truncate string' len
    checkUnexpectedReturnNULL "stringTruncate" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    return result'

data StringTruncateMethodInfo
instance (signature ~ (Word64 -> m String), MonadIO m) => O.MethodInfo StringTruncateMethodInfo String signature where
    overloadedMethod _ = stringTruncate

-- method String::up
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "string", argType = TInterface (Name {namespace = "GLib", name = "String"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GString", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "GLib", name = "String"}))
-- throws : False
-- Skip return : False

foreign import ccall "g_string_up" g_string_up :: 
    Ptr String ->                           -- string : TInterface (Name {namespace = "GLib", name = "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 'GI.GLib.Structs.String.stringAsciiUp' or 'GI.GLib.Functions.utf8Strup' instead."] #-}
{- |
Converts a 'GI.GLib.Structs.String.String' to uppercase.
-}
stringUp ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    String
    {- ^ /@string@/: a 'GI.GLib.Structs.String.String' -}
    -> m String
    {- ^ __Returns:__ /@string@/ -}
stringUp string = liftIO $ do
    string' <- unsafeManagedPtrGetPtr string
    result <- g_string_up string'
    checkUnexpectedReturnNULL "stringUp" result
    result' <- (newBoxed String) result
    touchManagedPtr string
    return result'

data StringUpMethodInfo
instance (signature ~ (m String), MonadIO m) => O.MethodInfo StringUpMethodInfo String signature where
    overloadedMethod _ = stringUp

type family ResolveStringMethod (t :: Symbol) (o :: *) :: * where
    ResolveStringMethod "append" o = StringAppendMethodInfo
    ResolveStringMethod "appendC" o = StringAppendCMethodInfo
    ResolveStringMethod "appendLen" o = StringAppendLenMethodInfo
    ResolveStringMethod "appendUnichar" o = StringAppendUnicharMethodInfo
    ResolveStringMethod "appendUriEscaped" o = StringAppendUriEscapedMethodInfo
    ResolveStringMethod "asciiDown" o = StringAsciiDownMethodInfo
    ResolveStringMethod "asciiUp" o = StringAsciiUpMethodInfo
    ResolveStringMethod "assign" o = StringAssignMethodInfo
    ResolveStringMethod "down" o = StringDownMethodInfo
    ResolveStringMethod "equal" o = StringEqualMethodInfo
    ResolveStringMethod "erase" o = StringEraseMethodInfo
    ResolveStringMethod "free" o = StringFreeMethodInfo
    ResolveStringMethod "freeToBytes" o = StringFreeToBytesMethodInfo
    ResolveStringMethod "hash" o = StringHashMethodInfo
    ResolveStringMethod "insert" o = StringInsertMethodInfo
    ResolveStringMethod "insertC" o = StringInsertCMethodInfo
    ResolveStringMethod "insertLen" o = StringInsertLenMethodInfo
    ResolveStringMethod "insertUnichar" o = StringInsertUnicharMethodInfo
    ResolveStringMethod "overwrite" o = StringOverwriteMethodInfo
    ResolveStringMethod "overwriteLen" o = StringOverwriteLenMethodInfo
    ResolveStringMethod "prepend" o = StringPrependMethodInfo
    ResolveStringMethod "prependC" o = StringPrependCMethodInfo
    ResolveStringMethod "prependLen" o = StringPrependLenMethodInfo
    ResolveStringMethod "prependUnichar" o = StringPrependUnicharMethodInfo
    ResolveStringMethod "truncate" o = StringTruncateMethodInfo
    ResolveStringMethod "up" o = StringUpMethodInfo
    ResolveStringMethod "setSize" o = StringSetSizeMethodInfo
    ResolveStringMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveStringMethod t String, O.MethodInfo info String p) => O.IsLabelProxy t (String -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveStringMethod t String, O.MethodInfo info String p) => O.IsLabel t (String -> p) where
    fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif