module Graphics.UI.Qtah.Generator.Interface.Core.QByteArray (
aModule,
c_QByteArray,
e_Base64Option,
fl_Base64Options,
) where
import Foreign.Hoppy.Generator.Language.Haskell (
addImports,
indent,
ln,
sayLn,
)
import Foreign.Hoppy.Generator.Spec (
Class,
ClassHaskellConversion (
ClassHaskellConversion,
classHaskellConversionFromCppFn,
classHaskellConversionToCppFn,
classHaskellConversionType
),
addAddendumHaskell,
addReqIncludes,
classSetEntityPrefix,
classSetHaskellConversion,
hsImport1,
ident,
ident1,
includeStd,
makeClass,
mkConstMethod,
mkConstMethod',
mkCtor,
mkMethod,
mkMethod',
np,
)
import Foreign.Hoppy.Generator.Spec.ClassFeature (
ClassFeature (Assignable, Copyable, Comparable, Equatable),
classAddFeatures,
)
import Foreign.Hoppy.Generator.Types (ushortT, shortT, uintT, floatT, doubleT, boolT, charT, constT, intT, ptrT, voidT, refT, objT, enumT)
import Graphics.UI.Qtah.Generator.Interface.Core.Types (e_CaseSensitivity)
import Foreign.Hoppy.Generator.Version (collect, just, test)
import Graphics.UI.Qtah.Generator.Config (qtVersion)
import {-# SOURCE #-} Graphics.UI.Qtah.Generator.Interface.Core.QString (c_QString)
import Graphics.UI.Qtah.Generator.Interface.Imports
import Graphics.UI.Qtah.Generator.Module (AModule (AQtModule), makeQtModule)
import Graphics.UI.Qtah.Generator.Types
import Language.Haskell.Syntax (
HsName (HsIdent),
HsQName (UnQual),
HsType (HsTyCon),
)
{-# ANN module "HLint: ignore Use camelCase" #-}
aModule :: AModule
aModule :: AModule
aModule =
QtModule -> AModule
AQtModule (QtModule -> AModule) -> QtModule -> AModule
forall a b. (a -> b) -> a -> b
$
[ErrorMsg] -> [QtExport] -> QtModule
makeQtModule [ErrorMsg
"Core", ErrorMsg
"QByteArray"] ([QtExport] -> QtModule) -> [QtExport] -> QtModule
forall a b. (a -> b) -> a -> b
$
[Filtered QtExport] -> [QtExport]
forall a. [Filtered a] -> [a]
collect
[ QtExport -> Filtered QtExport
forall a. a -> Filtered a
just (QtExport -> Filtered QtExport) -> QtExport -> Filtered QtExport
forall a b. (a -> b) -> a -> b
$ Class -> QtExport
forall a. Exportable a => a -> QtExport
qtExport Class
c_QByteArray
, Bool -> QtExport -> Filtered QtExport
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
5, Int
2]) (QtExport -> Filtered QtExport) -> QtExport -> Filtered QtExport
forall a b. (a -> b) -> a -> b
$ CppEnum -> QtExport
forall a. Exportable a => a -> QtExport
qtExport CppEnum
e_Base64Option
, Bool -> QtExport -> Filtered QtExport
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
5, Int
2]) (QtExport -> Filtered QtExport) -> QtExport -> Filtered QtExport
forall a b. (a -> b) -> a -> b
$ Flags -> QtExport
forall a. Exportable a => a -> QtExport
qtExport Flags
fl_Base64Options
]
c_QByteArray :: Class
c_QByteArray :: Class
c_QByteArray =
[Include] -> Class -> Class
forall a. HasReqs a => [Include] -> a -> a
addReqIncludes [ErrorMsg -> Include
includeStd ErrorMsg
"QByteArray"] (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
Class -> Class
addAddendum (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
[ClassFeature] -> Class -> Class
classAddFeatures [ClassFeature
Assignable, ClassFeature
Copyable, ClassFeature
Comparable, ClassFeature
Equatable] (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
ClassHaskellConversion -> Class -> Class
classSetHaskellConversion ClassHaskellConversion
conversion (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
ErrorMsg -> Class -> Class
classSetEntityPrefix ErrorMsg
"" (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
Identifier -> Maybe ExtName -> [Class] -> [ClassEntity] -> Class
makeClass (ErrorMsg -> Identifier
ident ErrorMsg
"QByteArray") Maybe ExtName
forall a. Maybe a
Nothing [] ([ClassEntity] -> Class) -> [ClassEntity] -> Class
forall a b. (a -> b) -> a -> b
$
[Filtered ClassEntity] -> [ClassEntity]
forall a. [Filtered a] -> [a]
collect
[ ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> [Parameter] -> ClassEntity
forall p. IsParameter p => ErrorMsg -> [p] -> ClassEntity
mkCtor ErrorMsg
"new" [Parameter]
np
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> [Type] -> ClassEntity
forall p. IsParameter p => ErrorMsg -> [p] -> ClassEntity
mkCtor ErrorMsg
"newFromData" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT]
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> [Type] -> ClassEntity
forall p. IsParameter p => ErrorMsg -> [p] -> ClassEntity
mkCtor ErrorMsg
"newFromDataAndSize" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT, Type
intT]
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> [Type] -> ClassEntity
forall p. IsParameter p => ErrorMsg -> [p] -> ClassEntity
mkCtor ErrorMsg
"newFromRepeatedChar" [Type
intT, Type
charT]
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"append" ErrorMsg
"append" [Class -> Type
objT Class
c_QByteArray] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
5, Int
7]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"append" ErrorMsg
"appendCountAndChar" [Type
intT, Type
charT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"append" ErrorMsg
"appendPtrConstChar" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"append" ErrorMsg
"appendPtrConstCharAndSize" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT, Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"append" ErrorMsg
"appendChar" [Type
charT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int
6]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"append" ErrorMsg
"appendString" [Class -> Type
objT Class
c_QString] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"insert" ErrorMsg
"insert" [Type
intT, Class -> Type
objT Class
c_QByteArray] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
5, Int
7]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"insert" ErrorMsg
"insertCountAndChar" [Type
intT, Type
intT, Type
charT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"insert" ErrorMsg
"insertPtrConstChar" [Type
intT, Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
4, Int
6]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"insert" ErrorMsg
"insertPtrConstCharAndSize" [Type
intT, Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT, Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"insert" ErrorMsg
"insertChar" [Type
intT, Type
charT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int
6]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"insert" ErrorMsg
"insertString" [Type
intT, Class -> Type
objT Class
c_QString] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"prepend" ErrorMsg
"prepend" [Class -> Type
objT Class
c_QByteArray] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
5, Int
7]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"prepend" ErrorMsg
"prependCountAndChar" [Type
intT, Type
charT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"prepend" ErrorMsg
"prependPtrConstChar" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
4, Int
6]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"prepend" ErrorMsg
"prependPtrConstCharAndSize" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT, Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"prepend" ErrorMsg
"prependChar" [Type
charT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"replace" ErrorMsg
"replaceRangeWithByteArray" [Type
intT, Type
intT, Class -> Type
objT Class
c_QByteArray] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
4, Int
7]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"replace" ErrorMsg
"replaceRangeWithPtrConstCharAndSize" [Type
intT, Type
intT, Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT, Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"replace" ErrorMsg
"replaceRangeWithPtrConstChar" [Type
intT, Type
intT, Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"replace" ErrorMsg
"replaceCharWithPtrConstChar" [Type
charT, Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"replace" ErrorMsg
"replaceCharWithByteArray" [Type
charT, Class -> Type
objT Class
c_QByteArray] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"replace" ErrorMsg
"replacePtrConstChar" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT, Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"replace" ErrorMsg
"replacePtrConstCharAndSize" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT, Type
intT, Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT, Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"replace" ErrorMsg
"replaceByteArray" [Class -> Type
objT Class
c_QByteArray, Class -> Type
objT Class
c_QByteArray] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"replace" ErrorMsg
"replaceByteArrayWithPtrConstChar" [Class -> Type
objT Class
c_QByteArray, Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"replace" ErrorMsg
"replacePtrConstCharWithByteArray" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT, Class -> Type
objT Class
c_QByteArray] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"replace" ErrorMsg
"replaceChar" [Type
charT, Type
charT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int
6]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"replace" ErrorMsg
"replaceStringWithPtrConstChar" [Class -> Type
objT Class
c_QString, Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int
6]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"replace" ErrorMsg
"replaceCharWithString" [Type
charT, Class -> Type
objT Class
c_QString] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int
6]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"replace" ErrorMsg
"replaceStringWithByteArray" [Class -> Type
objT Class
c_QString, Class -> Type
objT Class
c_QByteArray] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"indexOf" ErrorMsg
"indexOf" [Class -> Type
objT Class
c_QByteArray] Type
intT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"indexOf" ErrorMsg
"indexOfFrom" [Class -> Type
objT Class
c_QByteArray, Type
intT] Type
intT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"indexOf" ErrorMsg
"indexOfPtrConstChar" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT] Type
intT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"indexOf" ErrorMsg
"indexOfPtrConstCharFrom" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT, Type
intT] Type
intT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"indexOf" ErrorMsg
"indexOfChar" [Type
charT] Type
intT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"indexOf" ErrorMsg
"indexOfCharFrom" [Type
charT, Type
intT] Type
intT
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int
6]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"indexOf" ErrorMsg
"indexOfString" [Class -> Type
objT Class
c_QString, Type
intT] Type
intT
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int
6]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"indexOf" ErrorMsg
"indexOfStringFrom" [Class -> Type
objT Class
c_QString, Type
intT] Type
intT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"lastIndexOf" ErrorMsg
"lastIndexOf" [Class -> Type
objT Class
c_QByteArray] Type
intT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"lastIndexOf" ErrorMsg
"lastIndexOfFrom" [Class -> Type
objT Class
c_QByteArray, Type
intT] Type
intT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"lastIndexOf" ErrorMsg
"lastIndexOfPtrConstChar" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT] Type
intT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"lastIndexOf" ErrorMsg
"lastIndexOfPtrConstCharFrom" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT, Type
intT] Type
intT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"lastIndexOf" ErrorMsg
"lastIndexOfChar" [Type
charT] Type
intT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"lastIndexOf" ErrorMsg
"lastIndexOfCharFrom" [Type
charT, Type
intT] Type
intT
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int
6]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"lastIndexOf" ErrorMsg
"lastIndexOfString" [Class -> Type
objT Class
c_QString, Type
intT] Type
intT
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int
6]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"lastIndexOf" ErrorMsg
"lastIndexOfStringFrom" [Class -> Type
objT Class
c_QString, Type
intT] Type
intT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"setNum" ErrorMsg
"setNumInt" [Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"setNum" ErrorMsg
"setNumIntWithBase" [Type
intT, Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"setNum" ErrorMsg
"setNumUshort" [Type
ushortT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"setNum" ErrorMsg
"setNumUshortWithBase" [Type
ushortT, Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"setNum" ErrorMsg
"setNumShort" [Type
shortT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"setNum" ErrorMsg
"setNumShortWithBase" [Type
shortT, Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"setNum" ErrorMsg
"setNumUint" [Type
uintT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"setNum" ErrorMsg
"setNumUintWithBase" [Type
uintT, Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"setNum" ErrorMsg
"setNumFloat" [Type
floatT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"setNum" ErrorMsg
"setNumFloatWithFormat" [Type
floatT, Type
charT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"setNum" ErrorMsg
"setNumFloatWithFormatAndPrecision" [Type
floatT, Type
charT, Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"setNum" ErrorMsg
"setNumDouble" [Type
doubleT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"setNum" ErrorMsg
"setNumDoubleWithFormat" [Type
doubleT, Type
charT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"setNum" ErrorMsg
"setNumDoubleWithFormatAndPrecision" [Type
doubleT, Type
charT, Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod ErrorMsg
"at" [Type
intT] Type
charT
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
5, Int
10]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod ErrorMsg
"back" [Parameter]
np Type
charT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod ErrorMsg
"capacity" [Parameter]
np Type
intT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod ErrorMsg
"chop" [Type
intT] Type
voidT
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
5, Int
10]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod ErrorMsg
"chopped" [Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
5, Int
12]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"compare" ErrorMsg
"comparePtrConstChar" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT] Type
intT
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
5, Int
12]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"compare" ErrorMsg
"comparePtrConstCharWithCase" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT, CppEnum -> Type
enumT CppEnum
e_CaseSensitivity] Type
intT
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
5, Int
12]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"compare" ErrorMsg
"compare" [Class -> Type
objT Class
c_QByteArray] Type
intT
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
5, Int
12]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"compare" ErrorMsg
"compareWithCase" [Class -> Type
objT Class
c_QByteArray, CppEnum -> Type
enumT CppEnum
e_CaseSensitivity] Type
intT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod ErrorMsg
"constData" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"contains" ErrorMsg
"contains" [Class -> Type
objT Class
c_QByteArray] Type
boolT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"contains" ErrorMsg
"containsPtrConstChar" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT] Type
boolT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"contains" ErrorMsg
"containsChar" [Type
charT] Type
boolT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"count" ErrorMsg
"countByteArray" [Class -> Type
objT Class
c_QByteArray] Type
intT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"count" ErrorMsg
"countPtrConstChar" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT] Type
intT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"count" ErrorMsg
"countChar" [Type
charT] Type
intT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"count" ErrorMsg
"count" [Parameter]
np Type
intT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod ErrorMsg
"clear" [Parameter]
np Type
voidT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"data" ErrorMsg
"getData" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
ptrT Type
charT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"data" ErrorMsg
"getDataConst" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"endsWith" ErrorMsg
"endsWith" [Class -> Type
objT Class
c_QByteArray] Type
boolT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"endsWith" ErrorMsg
"endsWithPtrConstChar" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
charT] Type
boolT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"endsWith" ErrorMsg
"endsWithChar" [Type
charT] Type
boolT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"fill" ErrorMsg
"fill" [Type
charT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"fill" ErrorMsg
"fillWithSize" [Type
charT, Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
5, Int
10]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod ErrorMsg
"front" [Parameter]
np Type
charT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod ErrorMsg
"isEmpty" [Parameter]
np Type
boolT
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
5, Int
12]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod ErrorMsg
"isLower" [Parameter]
np Type
boolT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod ErrorMsg
"isNull" [Parameter]
np Type
boolT
, Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
5, Int
12]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod ErrorMsg
"isUpper" [Parameter]
np Type
boolT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod ErrorMsg
"left" [Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"leftJustified" ErrorMsg
"leftJustified" [Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"leftJustified" ErrorMsg
"leftJustifiedWithChar" [Type
intT, Type
charT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"leftJustified" ErrorMsg
"leftJustifiedWithCharAndTruncate" [Type
intT, Type
charT, Type
boolT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QByteArray
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod ErrorMsg
"length" [Parameter]
np Type
intT
, ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod ErrorMsg
"size" [Parameter]
np Type
intT
]
conversion :: ClassHaskellConversion
conversion :: ClassHaskellConversion
conversion =
ClassHaskellConversion
{ classHaskellConversionType :: Maybe (Generator HsType)
classHaskellConversionType = Generator HsType -> Maybe (Generator HsType)
forall a. a -> Filtered a
Just (Generator HsType -> Maybe (Generator HsType))
-> Generator HsType -> Maybe (Generator HsType)
forall a b. (a -> b) -> a -> b
$ do
HsImportSet -> Generator ()
addImports HsImportSet
importForByteString
HsType -> Generator HsType
forall a. a -> ReaderT Env (WriterT Output (Except ErrorMsg)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> HsName
HsIdent ErrorMsg
"QtahDBS.ByteString"
, classHaskellConversionToCppFn :: Maybe (Generator ())
classHaskellConversionToCppFn = Generator () -> Maybe (Generator ())
forall a. a -> Filtered a
Just (Generator () -> Maybe (Generator ()))
-> Generator () -> Maybe (Generator ())
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> Generator ()
sayLn ErrorMsg
"convertToCpp"
, classHaskellConversionFromCppFn :: Maybe (Generator ())
classHaskellConversionFromCppFn = Generator () -> Maybe (Generator ())
forall a. a -> Filtered a
Just (Generator () -> Maybe (Generator ()))
-> Generator () -> Maybe (Generator ())
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> Generator ()
sayLn ErrorMsg
"convertFromCpp"
}
addAddendum :: Class -> Class
addAddendum :: Class -> Class
addAddendum = Generator () -> Class -> Class
forall a. HasAddendum a => Generator () -> a -> a
addAddendumHaskell (Generator () -> Class -> Class) -> Generator () -> Class -> Class
forall a b. (a -> b) -> a -> b
$ do
HsImportSet -> Generator ()
addImports (HsImportSet -> Generator ()) -> HsImportSet -> Generator ()
forall a b. (a -> b) -> a -> b
$ [HsImportSet] -> HsImportSet
forall a. Monoid a => [a] -> a
mconcat [ErrorMsg -> ErrorMsg -> HsImportSet
hsImport1 ErrorMsg
"Prelude" ErrorMsg
"($)",
HsImportSet
importForByteString,
HsImportSet
importForByteStringUnsafe,
HsImportSet
importForPrelude]
Generator ()
ln
ErrorMsg -> Generator ()
sayLn ErrorMsg
"convertToCpp :: QtahDBS.ByteString -> QtahP.IO QByteArray"
ErrorMsg -> Generator ()
sayLn ErrorMsg
"convertToCpp ="
Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$
ErrorMsg -> Generator ()
sayLn ErrorMsg
"QtahP.flip QtahDBSU.unsafeUseAsCStringLen $ QtahP.uncurry newFromDataAndSize"
Generator ()
ln
ErrorMsg -> Generator ()
sayLn ErrorMsg
"convertFromCpp :: QByteArrayValue ba => ba -> QtahP.IO QtahDBS.ByteString"
ErrorMsg -> Generator ()
sayLn ErrorMsg
"convertFromCpp ba = do"
Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
ErrorMsg -> Generator ()
sayLn ErrorMsg
"d <- getDataConst ba"
ErrorMsg -> Generator ()
sayLn ErrorMsg
"len <- size ba"
ErrorMsg -> Generator ()
sayLn ErrorMsg
"QtahDBS.packCStringLen (d, len)"
(CppEnum
e_Base64Option, Flags
fl_Base64Options) =
Identifier
-> ErrorMsg -> [Include] -> [ErrorMsg] -> (CppEnum, Flags)
makeQtEnumAndFlags (ErrorMsg -> ErrorMsg -> Identifier
ident1 ErrorMsg
"QByteArray" ErrorMsg
"Base64Option") ErrorMsg
"Base64Options" [ErrorMsg -> Include
includeStd ErrorMsg
"QByteArray"]
[ ErrorMsg
"Base64Encoding"
, ErrorMsg
"KeepTrailingEquals"
, ErrorMsg
"Base64UrlEncoding"
, ErrorMsg
"OmitTrailingEquals"
]