-- This file is part of Qtah.
--
-- Copyright 2015-2021 The Qtah Authors.
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Lesser General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

-- | Bindings for @QVector@.
module Graphics.UI.Qtah.Generator.Interface.Core.QVector (
  -- * Template
  Options (..),
  defaultOptions,
  Contents (..),
  -- * Instantiations
  allModules,
  c_QVectorInt,
  c_QVectorQLatin1String,
  c_QVectorQPoint,
  c_QVectorQPointF,
  c_QVectorQRgb,
  c_QVectorQString,
  c_QVectorUInt,
  c_QVectorQXmlStreamAttribute,
  c_QVectorQXmlStreamEntityDeclaration,
  c_QVectorQXmlStreamNamespaceDeclaration,
  c_QVectorQXmlStreamNotationDeclaration,
  ) where

import Control.Monad (forM_, when)
import Foreign.Hoppy.Generator.Language.Haskell (
  HsTypeSide (HsHsSide),
  addImports,
  cppTypeToHsTypeAndUse,
  indent,
  ln,
  prettyPrint,
  sayLn,
  saysLn,
  )
import Foreign.Hoppy.Generator.Spec (
  Class,
  Constness (Const, Nonconst),
  Operator (OpAdd, OpArray),
  Reqs,
  Type,
  addReqs,
  addAddendumHaskell,
  classSetEntityPrefix,
  classSetMonomorphicSuperclass,
  hsImport1,
  hsImports,
  identT,
  includeStd,
  makeClass,
  mkConstMethod,
  mkConstMethod',
  mkCtor,
  mkMethod,
  mkMethod',
  np,
  reqInclude,
  toExtName,
  )
import Foreign.Hoppy.Generator.Spec.Class (
  toHsClassEntityName',
  toHsDataTypeName,
  )
import Foreign.Hoppy.Generator.Spec.ClassFeature (
  ClassFeature (Assignable, Copyable),
  classAddFeatures,
  )
import Foreign.Hoppy.Generator.Types (boolT, constT, intT, objT, ptrT, refT, toGcT, voidT, uintT)
import Foreign.Hoppy.Generator.Version (collect, just, test)
import Graphics.UI.Qtah.Generator.Config (Version, qtVersion)
import Graphics.UI.Qtah.Generator.Interface.Core.QPoint (c_QPoint)
import Graphics.UI.Qtah.Generator.Interface.Core.QPointF (c_QPointF)
import Graphics.UI.Qtah.Generator.Interface.Core.QString (c_QString)
import Graphics.UI.Qtah.Generator.Interface.Core.QLatin1String (c_QLatin1String)
import Graphics.UI.Qtah.Generator.Interface.Core.QXmlStreamAttribute (c_QXmlStreamAttribute)
import Graphics.UI.Qtah.Generator.Interface.Core.QXmlStreamEntityDeclaration (c_QXmlStreamEntityDeclaration)
import Graphics.UI.Qtah.Generator.Interface.Core.QXmlStreamNamespaceDeclaration (c_QXmlStreamNamespaceDeclaration)
import Graphics.UI.Qtah.Generator.Interface.Core.QXmlStreamNotationDeclaration (c_QXmlStreamNotationDeclaration)
import Graphics.UI.Qtah.Generator.Interface.Gui.QColor (qrgb)
import Graphics.UI.Qtah.Generator.Interface.Imports
import Graphics.UI.Qtah.Generator.Module (
  AModule (AQtModule), QtModule, makeQtModule, makeQtModuleWithMinVersion,
  )
import Graphics.UI.Qtah.Generator.Types

-- | Options for instantiating the vector classes.
newtype Options = Options
  { Options -> [ClassFeature]
optVectorClassFeatures :: [ClassFeature]
    -- ^ Additional features to add to the @QVector@ class.  Vectors are always
    -- 'Assignable' and 'Copyable', but you may want to add 'Equatable' if your
    -- value type supports it.
  }

-- | The default options have no additional 'ClassFeature's.
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = [ClassFeature] -> Options
Options []

-- | A set of instantiated classes.
newtype Contents = Contents
  { Contents -> Class
c_QVector :: Class  -- ^ @QVector\<T>@
  }

-- | @instantiate className t tReqs@ creates a set of bindings for an
-- instantiation of @QVector@ and associated types (e.g. iterators).  In the
-- result, the 'c_QVector' class has an external name of @className@.
instantiate :: String -> Type -> Reqs -> Contents
instantiate :: String -> Type -> Reqs -> Contents
instantiate String
vectorName Type
t Reqs
tReqs = String -> Type -> Reqs -> Options -> Contents
instantiate' String
vectorName Type
t Reqs
tReqs Options
defaultOptions

-- | 'instantiate' with additional options.
instantiate' :: String -> Type -> Reqs -> Options -> Contents
instantiate' :: String -> Type -> Reqs -> Options -> Contents
instantiate' String
vectorName Type
t Reqs
tReqs Options
opts =
  let reqs :: Reqs
reqs = [Reqs] -> Reqs
forall a. Monoid a => [a] -> a
mconcat [ Reqs
tReqs
                     , Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ String -> Include
includeStd String
"QVector"
                     ]
      features :: [ClassFeature]
features = ClassFeature
Assignable ClassFeature -> [ClassFeature] -> [ClassFeature]
forall a. a -> [a] -> [a]
: ClassFeature
Copyable ClassFeature -> [ClassFeature] -> [ClassFeature]
forall a. a -> [a] -> [a]
: Options -> [ClassFeature]
optVectorClassFeatures Options
opts

      vector :: Class
vector =
        Reqs -> Class -> Class
forall a. HasReqs a => Reqs -> a -> a
addReqs Reqs
reqs (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
        Generator () -> Class -> Class
forall a. HasAddendum a => Generator () -> a -> a
addAddendumHaskell Generator ()
addendum (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
        [ClassFeature] -> Class -> Class
classAddFeatures [ClassFeature]
features (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
        Class -> Class
classSetMonomorphicSuperclass (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
        String -> Class -> Class
classSetEntityPrefix String
"" (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
        Identifier -> Maybe ExtName -> [Class] -> [ClassEntity] -> Class
makeClass (String -> [Type] -> Identifier
identT String
"QVector" [Type
t]) (ExtName -> Maybe ExtName
forall a. a -> Maybe a
Just (ExtName -> Maybe ExtName) -> ExtName -> Maybe ExtName
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> ExtName
String -> ExtName
toExtName String
vectorName) [] ([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 -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> ClassEntity
forall p. IsParameter p => String -> [p] -> ClassEntity
mkCtor String
"new" [Parameter]
np
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Type] -> ClassEntity
forall p. IsParameter p => String -> [p] -> ClassEntity
mkCtor String
"newWithSize" [Type
intT]
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Type] -> ClassEntity
forall p. IsParameter p => String -> [p] -> ClassEntity
mkCtor String
"newWithSizeAndValue" [Type
intT, Type
t]
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"append" String
"append" [Type
t] 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
5]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"append" String
"appendVector" [Class -> Type
objT Class
vector] Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ Operator -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' Operator
OpArray String
"at" [Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT Type
t
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"at" String
"atConst" [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
$ Type -> Type
constT Type
t
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"capacity" [Parameter]
np Type
intT
          -- OMIT back
          -- OMIT begin
          -- OMIT cbegin
          -- OMIT cend
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"clear" [Parameter]
np Type
voidT
          -- OMIT constBegin
          -- OMIT constData
          -- OMIT constEnd
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"contains" [Type
t] Type
boolT
          -- OMIT count()
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"count" [Type
t] Type
intT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"data" String
"array" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
ptrT Type
t
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"data" String
"arrayConst" [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
t
          -- OMIT empty
        , 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
5]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"endsWith" [Type
t] Type
boolT
          -- OMIT erase
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"fill" String
"fill" [Type
t] Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"fill" String
"fillResize" [Type
t, Type
intT] Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"first" String
"first" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT Type
t
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"first" String
"firstConst" [Parameter]
np (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
$ Type -> Type
constT Type
t
          -- TODO fromList
          -- TODO fromStdVector
          -- OMIT front
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ Operator -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' Operator
OpArray String
"get" [Type
intT] Type
t
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"indexOf" String
"indexOf" [Type
t] Type
intT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"indexOf" String
"indexOfFrom" [Type
t, Type
intT] Type
intT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"insert" String
"insert" [Type
intT, Type
t] Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"insert" String
"insertMany" [Type
intT, Type
intT, Type
t] Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"isEmpty" [Parameter]
np Type
boolT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"last" String
"last" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT Type
t
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"last" String
"lastConst" [Parameter]
np (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
$ Type -> Type
constT Type
t
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"lastIndexOf" String
"lastIndexOf" [Type
t] Type
intT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"lastIndexOf" String
"lastIndexOfFrom" [Type
t, Type
intT] Type
intT
          -- OMIT length
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"mid" String
"mid" [Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
toGcT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
vector
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"mid" String
"midLength" [Type
intT, Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
toGcT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
vector
          -- OMIT pop_back
          -- OMIT pop_front
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"prepend" [Type
t] Type
voidT
          -- OMIT push_back
          -- OMIT push_front
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"remove" String
"remove" [Type
intT] Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"remove" String
"removeMany" [Type
intT, 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
4]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"removeAll" [Type
t] Type
intT
          -- OMIT removeAt
        , 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
1]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"removeFirst" [Parameter]
np 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
1]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"removeLast" [Parameter]
np 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
4]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"removeOne" [Type
t] Type
boolT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"replace" [Type
intT, Type
t] Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"reserve" [Type
intT] Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"resize" [Type
intT] Type
voidT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"size" [Parameter]
np Type
intT
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"squeeze" [Parameter]
np 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
4, Int
5]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"startsWith" [Type
t] 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
4, Int
8]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"swap" [Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
vector] 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
2]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"takeAt" [Type
intT] Type
t
        , 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
1]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"takeFirst" [Parameter]
np Type
t
        , 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
1]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"takeLast" [Parameter]
np Type
t
          -- TODO toList
          -- TODO toStdVector
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"value" String
"value" [Type
intT] Type
t
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"value" String
"valueOr" [Type
intT, Type
t] Type
t
        , ClassEntity -> Filtered ClassEntity
forall a. a -> Maybe a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ Operator -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod Operator
OpAdd [Class -> Type
objT Class
vector] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
toGcT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
vector
        ]

      -- The addendum for the vector class contains HasContents and FromContents
      -- instances.
      addendum :: Generator ()
addendum = do
        HsImportSet -> Generator ()
addImports (HsImportSet -> Generator ()) -> HsImportSet -> Generator ()
forall a b. (a -> b) -> a -> b
$ [HsImportSet] -> HsImportSet
forall a. Monoid a => [a] -> a
mconcat [String -> [String] -> HsImportSet
hsImports String
"Prelude" [String
"($)", String
"(-)"],
                              String -> String -> HsImportSet
hsImport1 String
"Control.Monad" String
"(<=<)",
                              HsImportSet
importForPrelude,
                              HsImportSet
importForRuntime]

        [Constness] -> (Constness -> Generator ()) -> Generator ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Constness
Const, Constness
Nonconst] ((Constness -> Generator ()) -> Generator ())
-> (Constness -> Generator ()) -> Generator ()
forall a b. (a -> b) -> a -> b
$ \Constness
cst -> do
          String
hsDataTypeName <- Constness -> Class -> Generator String
toHsDataTypeName Constness
cst Class
vector
          HsType
hsValueType <- HsTypeSide -> Type -> Generator HsType
cppTypeToHsTypeAndUse HsTypeSide
HsHsSide (Type -> Generator HsType) -> Type -> Generator HsType
forall a b. (a -> b) -> a -> b
$ case Constness
cst of
            Constness
Const -> Type -> Type
constT Type
t
            Constness
Nonconst -> Type
t

          -- Generate const and nonconst HasContents instances.
          Generator ()
ln
          [String] -> Generator ()
saysLn [String
"instance QtahFHR.HasContents ", String
hsDataTypeName,
                  String
" (", HsType -> String
forall a. Pretty a => a -> String
prettyPrint HsType
hsValueType, String
") where"]
          Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
            String -> Generator ()
sayLn String
"toContents this' = do"
            Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
              let vectorAt :: String
vectorAt = case Constness
cst of
                    Constness
Const -> String
"atConst"
                    Constness
Nonconst -> String
"at"
              [String] -> Generator ()
saysLn [String
"size' <- ", Class -> String -> String
forall name. IsFnName String name => Class -> name -> String
toHsClassEntityName' Class
vector String
"size", String
" this'"]
              [String] -> Generator ()
saysLn [String
"QtahP.mapM (QtahFHR.decode <=< ",
                      Class -> String -> String
forall name. IsFnName String name => Class -> name -> String
toHsClassEntityName' Class
vector String
vectorAt, String
" this') [0..size'-1]"]

          -- Only generate a nonconst FromContents instance.
          Bool -> Generator () -> Generator ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Constness
cst Constness -> Constness -> Bool
forall a. Eq a => a -> a -> Bool
== Constness
Nonconst) (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
            Generator ()
ln
            [String] -> Generator ()
saysLn [String
"instance QtahFHR.FromContents ", String
hsDataTypeName,
                    String
" (", HsType -> String
forall a. Pretty a => a -> String
prettyPrint HsType
hsValueType, String
") where"]
            Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
              String -> Generator ()
sayLn String
"fromContents values' = do"
              Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
                [String] -> Generator ()
saysLn [String
"vector' <- ", Class -> String -> String
forall name. IsFnName String name => Class -> name -> String
toHsClassEntityName' Class
vector String
"new"]
                [String] -> Generator ()
saysLn [Class -> String -> String
forall name. IsFnName String name => Class -> name -> String
toHsClassEntityName' Class
vector String
"reserve",
                        String
" vector' $ QtahFHR.coerceIntegral $ QtahP.length values'"]
                [String] -> Generator ()
saysLn [String
"QtahP.mapM_ (", Class -> String -> String
forall name. IsFnName String name => Class -> name -> String
toHsClassEntityName' Class
vector String
"append", String
" vector') values'"]
                String -> Generator ()
sayLn String
"QtahP.return vector'"

  in Contents :: Class -> Contents
Contents
     { c_QVector :: Class
c_QVector = Class
vector
     }

-- | Converts an instantiation into a list of exports to be included in a
-- module.
toExports :: Contents -> [QtExport]
toExports :: Contents -> [QtExport]
toExports Contents
m = [Class -> QtExport
forall a. Exportable a => a -> QtExport
qtExport (Class -> QtExport) -> Class -> QtExport
forall a b. (a -> b) -> a -> b
$ Contents -> Class
c_QVector Contents
m]

createModule :: String -> Contents -> QtModule
createModule :: String -> Contents -> QtModule
createModule String
name Contents
contents =
  [String] -> [QtExport] -> QtModule
makeQtModule [String
"Core", String
"QVector", String
name] ([QtExport] -> QtModule) -> [QtExport] -> QtModule
forall a b. (a -> b) -> a -> b
$ Contents -> [QtExport]
toExports Contents
contents

createModuleWithMinVersion :: String -> Version -> Contents -> QtModule
createModuleWithMinVersion :: String -> Version -> Contents -> QtModule
createModuleWithMinVersion String
name Version
version Contents
contents =
  [String] -> Version -> [QtExport] -> QtModule
makeQtModuleWithMinVersion [String
"Core", String
"QVector", String
name] Version
version ([QtExport] -> QtModule) -> [QtExport] -> QtModule
forall a b. (a -> b) -> a -> b
$
  Contents -> [QtExport]
toExports Contents
contents

allModules :: [AModule]
allModules :: [AModule]
allModules =
  (QtModule -> AModule) -> [QtModule] -> [AModule]
forall a b. (a -> b) -> [a] -> [b]
map QtModule -> AModule
AQtModule
  [ QtModule
qmod_Int
  , QtModule
qmod_QLatin1String
  , QtModule
qmod_QPoint
  , QtModule
qmod_QPointF
  , QtModule
qmod_QRgb
  , QtModule
qmod_QString
  , QtModule
qmod_UInt
  , QtModule
qmod_QXmlStreamAttribute
  , QtModule
qmod_QXmlStreamEntityDeclaration
  , QtModule
qmod_QXmlStreamNamespaceDeclaration
  , QtModule
qmod_QXmlStreamNotationDeclaration
  ]

qmod_Int :: QtModule
qmod_Int :: QtModule
qmod_Int = String -> Contents -> QtModule
createModule String
"Int" Contents
contents_Int

contents_Int :: Contents
contents_Int :: Contents
contents_Int = String -> Type -> Reqs -> Contents
instantiate String
"QVectorInt" Type
intT Reqs
forall a. Monoid a => a
mempty

c_QVectorInt :: Class
c_QVectorInt :: Class
c_QVectorInt = Contents -> Class
c_QVector Contents
contents_Int

qmod_QLatin1String :: QtModule
qmod_QLatin1String :: QtModule
qmod_QLatin1String =
  -- QVector requires value_type to be default-constructible, but QLatin1String
  -- is default-constructible since 5.6 only
  String -> Version -> Contents -> QtModule
createModuleWithMinVersion String
"QLatin1String" [Int
5, Int
6] Contents
contents_QLatin1String

contents_QLatin1String :: Contents
contents_QLatin1String :: Contents
contents_QLatin1String = String -> Type -> Reqs -> Contents
instantiate String
"QVectorQLatin1String" (Class -> Type
objT Class
c_QLatin1String) Reqs
forall a. Monoid a => a
mempty

-- | QVector requires value_type to be default-constructible, but QLatin1String
-- is default-constructible since 5.6 only
c_QVectorQLatin1String :: Class
c_QVectorQLatin1String :: Class
c_QVectorQLatin1String = Contents -> Class
c_QVector Contents
contents_QLatin1String

qmod_QPoint :: QtModule
qmod_QPoint :: QtModule
qmod_QPoint = String -> Contents -> QtModule
createModule String
"QPoint" Contents
contents_QPoint

contents_QPoint :: Contents
contents_QPoint :: Contents
contents_QPoint = String -> Type -> Reqs -> Contents
instantiate String
"QVectorQPoint" (Class -> Type
objT Class
c_QPoint) Reqs
forall a. Monoid a => a
mempty

c_QVectorQPoint :: Class
c_QVectorQPoint :: Class
c_QVectorQPoint = Contents -> Class
c_QVector Contents
contents_QPoint

qmod_QPointF :: QtModule
qmod_QPointF :: QtModule
qmod_QPointF = String -> Contents -> QtModule
createModule String
"QPointF" Contents
contents_QPointF

contents_QPointF :: Contents
contents_QPointF :: Contents
contents_QPointF = String -> Type -> Reqs -> Contents
instantiate String
"QVectorQPointF" (Class -> Type
objT Class
c_QPointF) Reqs
forall a. Monoid a => a
mempty

c_QVectorQPointF :: Class
c_QVectorQPointF :: Class
c_QVectorQPointF = Contents -> Class
c_QVector Contents
contents_QPointF

qmod_QRgb :: QtModule
qmod_QRgb :: QtModule
qmod_QRgb = String -> Contents -> QtModule
createModule String
"QRgb" Contents
contents_QRgb

contents_QRgb :: Contents
contents_QRgb :: Contents
contents_QRgb = String -> Type -> Reqs -> Contents
instantiate String
"QVectorQRgb" Type
qrgb Reqs
forall a. Monoid a => a
mempty

c_QVectorQRgb :: Class
c_QVectorQRgb :: Class
c_QVectorQRgb = Contents -> Class
c_QVector Contents
contents_QRgb

qmod_QString :: QtModule
qmod_QString :: QtModule
qmod_QString = String -> Contents -> QtModule
createModule String
"QString" Contents
contents_QString

contents_QString :: Contents
contents_QString :: Contents
contents_QString = String -> Type -> Reqs -> Contents
instantiate String
"QVectorQString" (Class -> Type
objT Class
c_QString) Reqs
forall a. Monoid a => a
mempty

c_QVectorQString :: Class
c_QVectorQString :: Class
c_QVectorQString = Contents -> Class
c_QVector Contents
contents_QString

qmod_UInt :: QtModule
qmod_UInt :: QtModule
qmod_UInt = String -> Contents -> QtModule
createModule String
"UInt" Contents
contents_UInt

contents_UInt :: Contents
contents_UInt :: Contents
contents_UInt = String -> Type -> Reqs -> Contents
instantiate String
"QVectorUInt" Type
uintT Reqs
forall a. Monoid a => a
mempty

c_QVectorUInt :: Class
c_QVectorUInt :: Class
c_QVectorUInt = Contents -> Class
c_QVector Contents
contents_UInt

qmod_QXmlStreamAttribute :: QtModule
qmod_QXmlStreamAttribute :: QtModule
qmod_QXmlStreamAttribute = String -> Contents -> QtModule
createModule String
"QXmlStreamAttribute" Contents
contents_QXmlStreamAttribute

contents_QXmlStreamAttribute :: Contents
contents_QXmlStreamAttribute :: Contents
contents_QXmlStreamAttribute = String -> Type -> Reqs -> Contents
instantiate String
"QVectorQXmlStreamAttribute" (Class -> Type
objT Class
c_QXmlStreamAttribute) Reqs
forall a. Monoid a => a
mempty

c_QVectorQXmlStreamAttribute :: Class
c_QVectorQXmlStreamAttribute :: Class
c_QVectorQXmlStreamAttribute = Contents -> Class
c_QVector Contents
contents_QXmlStreamAttribute

qmod_QXmlStreamEntityDeclaration :: QtModule
qmod_QXmlStreamEntityDeclaration :: QtModule
qmod_QXmlStreamEntityDeclaration = String -> Contents -> QtModule
createModule String
"QXmlStreamEntityDeclaration" Contents
contents_QXmlStreamEntityDeclaration

contents_QXmlStreamEntityDeclaration :: Contents
contents_QXmlStreamEntityDeclaration :: Contents
contents_QXmlStreamEntityDeclaration = String -> Type -> Reqs -> Contents
instantiate String
"QVectorQXmlStreamEntityDeclaration" (Class -> Type
objT Class
c_QXmlStreamEntityDeclaration) Reqs
forall a. Monoid a => a
mempty

c_QVectorQXmlStreamEntityDeclaration :: Class
c_QVectorQXmlStreamEntityDeclaration :: Class
c_QVectorQXmlStreamEntityDeclaration = Contents -> Class
c_QVector Contents
contents_QXmlStreamEntityDeclaration

qmod_QXmlStreamNamespaceDeclaration :: QtModule
qmod_QXmlStreamNamespaceDeclaration :: QtModule
qmod_QXmlStreamNamespaceDeclaration = String -> Contents -> QtModule
createModule String
"QXmlStreamNamespaceDeclaration" Contents
contents_QXmlStreamNamespaceDeclaration

contents_QXmlStreamNamespaceDeclaration :: Contents
contents_QXmlStreamNamespaceDeclaration :: Contents
contents_QXmlStreamNamespaceDeclaration = String -> Type -> Reqs -> Contents
instantiate String
"QVectorQQXmlStreamNamespaceDeclaration" (Class -> Type
objT Class
c_QXmlStreamNamespaceDeclaration) Reqs
forall a. Monoid a => a
mempty

c_QVectorQXmlStreamNamespaceDeclaration :: Class
c_QVectorQXmlStreamNamespaceDeclaration :: Class
c_QVectorQXmlStreamNamespaceDeclaration = Contents -> Class
c_QVector Contents
contents_QXmlStreamNamespaceDeclaration

qmod_QXmlStreamNotationDeclaration :: QtModule
qmod_QXmlStreamNotationDeclaration :: QtModule
qmod_QXmlStreamNotationDeclaration = String -> Contents -> QtModule
createModule String
"QXmlStreamNotationDeclaration" Contents
contents_QXmlStreamNotationDeclaration

contents_QXmlStreamNotationDeclaration :: Contents
contents_QXmlStreamNotationDeclaration :: Contents
contents_QXmlStreamNotationDeclaration = String -> Type -> Reqs -> Contents
instantiate String
"QVectorQXmlStreamNotationDeclaration" (Class -> Type
objT Class
c_QXmlStreamNotationDeclaration) Reqs
forall a. Monoid a => a
mempty

c_QVectorQXmlStreamNotationDeclaration :: Class
c_QVectorQXmlStreamNotationDeclaration :: Class
c_QVectorQXmlStreamNotationDeclaration = Contents -> Class
c_QVector Contents
contents_QXmlStreamNotationDeclaration