-- 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/>.

module Graphics.UI.Qtah.Generator.Interface.Gui.QColor (
  aModule,
  c_QColor,
  qrgb,
  ) where

import Control.Monad (forM_)
import Foreign.Hoppy.Generator.Language.Haskell (
  addImports,
  indent,
  sayLn,
  saysLn,
  )
import Foreign.Hoppy.Generator.Spec (
  ClassHaskellConversion (
    ClassHaskellConversion,
    classHaskellConversionFromCppFn,
    classHaskellConversionToCppFn,
    classHaskellConversionType
  ),
  Purity (Pure),
  addReqIncludes,
  classSetEntityPrefix,
  classSetHaskellConversion,
  hsImports,
  hsQualifiedImport,
  ident,
  ident1,
  includeStd,
  makeClass,
  makeFn,
  mkConstMethod,
  mkConstMethod',
  mkCtor,
  mkMethod,
  mkMethod',
  mkProp,
  mkStaticMethod,
  np,
  toExtName,
  )
import Foreign.Hoppy.Generator.Spec.ClassFeature (
  ClassFeature (Assignable, Copyable, Equatable),
  classAddFeatures,
  )
import Foreign.Hoppy.Generator.Types (boolT, enumT, intT, objT, uintT, voidT)
import Foreign.Hoppy.Generator.Version (collect, just, test)
import Graphics.UI.Qtah.Generator.Config (qtVersion)
import Graphics.UI.Qtah.Generator.Interface.Core.QString (c_QString)
import Graphics.UI.Qtah.Generator.Interface.Core.QStringList (c_QStringList)
import Graphics.UI.Qtah.Generator.Interface.Core.Types (e_GlobalColor, qreal)
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 =
  QtModule -> AModule
AQtModule (QtModule -> AModule) -> QtModule -> AModule
forall a b. (a -> b) -> a -> b
$
  [String] -> [QtExport] -> QtModule
makeQtModule [String
"Gui", String
"QColor"] ([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_QColor
  , 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_NameFormat
  , QtExport -> Filtered QtExport
forall a. a -> Filtered a
just (QtExport -> Filtered QtExport) -> QtExport -> Filtered QtExport
forall a b. (a -> b) -> a -> b
$ CppEnum -> QtExport
forall a. Exportable a => a -> QtExport
qtExport CppEnum
e_Spec
  , QtExport -> Filtered QtExport
forall a. a -> Filtered a
just (QtExport -> Filtered QtExport) -> QtExport -> Filtered QtExport
forall a b. (a -> b) -> a -> b
$ Function -> QtExport
forall a. Exportable a => a -> QtExport
qtExport Function
f_qAlpha
  , QtExport -> Filtered QtExport
forall a. a -> Filtered a
just (QtExport -> Filtered QtExport) -> QtExport -> Filtered QtExport
forall a b. (a -> b) -> a -> b
$ Function -> QtExport
forall a. Exportable a => a -> QtExport
qtExport Function
f_qBlue
  , QtExport -> Filtered QtExport
forall a. a -> Filtered a
just (QtExport -> Filtered QtExport) -> QtExport -> Filtered QtExport
forall a b. (a -> b) -> a -> b
$ Function -> QtExport
forall a. Exportable a => a -> QtExport
qtExport Function
f_qGray
  , QtExport -> Filtered QtExport
forall a. a -> Filtered a
just (QtExport -> Filtered QtExport) -> QtExport -> Filtered QtExport
forall a b. (a -> b) -> a -> b
$ Function -> QtExport
forall a. Exportable a => a -> QtExport
qtExport Function
f_qGrayFromRgb
  , QtExport -> Filtered QtExport
forall a. a -> Filtered a
just (QtExport -> Filtered QtExport) -> QtExport -> Filtered QtExport
forall a b. (a -> b) -> a -> b
$ Function -> QtExport
forall a. Exportable a => a -> QtExport
qtExport Function
f_qGreen
  , 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
3]) (QtExport -> Filtered QtExport) -> QtExport -> Filtered QtExport
forall a b. (a -> b) -> a -> b
$ Function -> QtExport
forall a. Exportable a => a -> QtExport
qtExport Function
f_qPremultiply
  , QtExport -> Filtered QtExport
forall a. a -> Filtered a
just (QtExport -> Filtered QtExport) -> QtExport -> Filtered QtExport
forall a b. (a -> b) -> a -> b
$ Function -> QtExport
forall a. Exportable a => a -> QtExport
qtExport Function
f_qRed
  , QtExport -> Filtered QtExport
forall a. a -> Filtered a
just (QtExport -> Filtered QtExport) -> QtExport -> Filtered QtExport
forall a b. (a -> b) -> a -> b
$ Function -> QtExport
forall a. Exportable a => a -> QtExport
qtExport Function
f_qRgb
  , QtExport -> Filtered QtExport
forall a. a -> Filtered a
just (QtExport -> Filtered QtExport) -> QtExport -> Filtered QtExport
forall a b. (a -> b) -> a -> b
$ Function -> QtExport
forall a. Exportable a => a -> QtExport
qtExport Function
f_qRgba
  , 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
3]) (QtExport -> Filtered QtExport) -> QtExport -> Filtered QtExport
forall a b. (a -> b) -> a -> b
$ Function -> QtExport
forall a. Exportable a => a -> QtExport
qtExport Function
f_qUnpremultiply
  ]

c_QColor :: Class
c_QColor =
  [Include] -> Class -> Class
forall a. HasReqs a => [Include] -> a -> a
addReqIncludes [String -> Include
includeStd String
"QColor"] (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
$
  [ClassFeature] -> Class -> Class
classAddFeatures [ClassFeature
Assignable, ClassFeature
Copyable, ClassFeature
Equatable] (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 -> Identifier
ident String
"QColor") 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
$ String -> [Parameter] -> ClassEntity
forall p. IsParameter p => String -> [p] -> ClassEntity
mkCtor String
"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
$ String -> [Type] -> ClassEntity
forall p. IsParameter p => String -> [p] -> ClassEntity
mkCtor String
"newQRgb" [Type
qrgb]
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"newRgb" [Type
intT, 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
$ String -> [Type] -> ClassEntity
forall p. IsParameter p => String -> [p] -> ClassEntity
mkCtor String
"newRgba" [Type
intT, Type
intT, 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
$ String -> [Type] -> ClassEntity
forall p. IsParameter p => String -> [p] -> ClassEntity
mkCtor String
"newNamedColor" [Class -> Type
objT Class
c_QString]
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"newGlobalColor" [CppEnum -> Type
enumT CppEnum
e_GlobalColor]
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> Type -> ClassEntity
mkProp String
"alpha" Type
intT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> Type -> ClassEntity
mkProp String
"alphaF" Type
qreal
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"black" [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
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"blackF" [Parameter]
np Type
qreal
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> Type -> ClassEntity
mkProp String
"blue" Type
intT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> Type -> ClassEntity
mkProp String
"blueF" Type
qreal
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
mkStaticMethod String
"colorNames" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QStringList
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"convertTo" [CppEnum -> Type
enumT CppEnum
e_Spec] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QColor
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"cyan" [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
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"cyanF" [Parameter]
np Type
qreal
  , 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
3]) (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
"darker" String
"darker" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QColor
  , 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
3]) (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
"darker" String
"darkerBy" [Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QColor
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> Type -> ClassEntity
mkProp String
"green" Type
intT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> Type -> ClassEntity
mkProp String
"greenF" Type
qreal
  , 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
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"hslHue" [Parameter]
np 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
4, Int
6]) (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
"hslHueF" [Parameter]
np Type
qreal
  , 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
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"hslSaturation" [Parameter]
np 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
4, Int
6]) (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
"hslSaturationF" [Parameter]
np Type
qreal
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"hsvHue" [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
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"hsvHueF" [Parameter]
np Type
qreal
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"hsvSaturation" [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
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"hsvSaturationF" [Parameter]
np Type
qreal
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"hue" [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
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"hueF" [Parameter]
np Type
qreal
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"isValid" [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
4, Int
7]) (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
mkStaticMethod String
"isValidColor" [Class -> Type
objT Class
c_QString] 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
3]) (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
"lighter" String
"lighter" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QColor
  , 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
3]) (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
"lighter" String
"lighterBy" [Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QColor
  , 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
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"lightness" [Parameter]
np 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
4, Int
6]) (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
"lightnessF" [Parameter]
np Type
qreal
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"magenta" [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
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"magentaF" [Parameter]
np Type
qreal
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"name" String
"name" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QString
  , 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 -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"name" String
"nameWithFormat" [CppEnum -> Type
enumT CppEnum
e_NameFormat] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QString
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> Type -> ClassEntity
mkProp String
"red" Type
intT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> Type -> ClassEntity
mkProp String
"redF" Type
qreal
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"rgb" [Parameter]
np Type
qrgb
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"rgba" [Parameter]
np Type
qrgb
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"saturation" [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
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"saturationF" [Parameter]
np Type
qreal
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"setCmyk" String
"setCmyk" [Type
intT, Type
intT, Type
intT, Type
intT] Type
voidT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"setCmyk" String
"setCmyka" [Type
intT, Type
intT, Type
intT, Type
intT, Type
intT] Type
voidT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"setCmykF" String
"setCmykF" [Type
qreal, Type
qreal, Type
qreal, Type
qreal] Type
voidT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"setCmykF" String
"setCmykaF" [Type
qreal, Type
qreal, Type
qreal, Type
qreal, Type
qreal] 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
6]) (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
"setHsl" String
"setHsl" [Type
intT, 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
4, Int
6]) (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
"setHsl" String
"setHsla" [Type
intT, Type
intT, 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
4, Int
6]) (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
"setHslF" String
"setHslF" [Type
qreal, Type
qreal, Type
qreal] 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
6]) (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
"setHslF" String
"setHslaF" [Type
qreal, Type
qreal, Type
qreal, Type
qreal] Type
voidT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"setHsv" String
"setHsv" [Type
intT, Type
intT, Type
intT] Type
voidT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"setHsv" String
"setHsva" [Type
intT, Type
intT, Type
intT, Type
intT] Type
voidT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"setHsvF" String
"setHsvF" [Type
qreal, Type
qreal, Type
qreal] Type
voidT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"setHsvF" String
"setHsvaF" [Type
qreal, Type
qreal, Type
qreal, Type
qreal] Type
voidT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"setNamedColor" [Class -> Type
objT Class
c_QString] Type
voidT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"setRgb" String
"setQRgb" [Type
qrgb] Type
voidT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"setRgb" String
"setQRgba" [Type
qrgb] Type
voidT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"setRgb" String
"setRgb" [Type
intT, Type
intT, Type
intT] Type
voidT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"setRgb" String
"setRgba" [Type
intT, Type
intT, Type
intT, Type
intT] Type
voidT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"setRgbF" String
"setRgbF" [Type
qreal, Type
qreal, Type
qreal] Type
voidT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"setRgbF" String
"setRgbaF" [Type
qreal, Type
qreal, Type
qreal, Type
qreal] Type
voidT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"spec" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ CppEnum -> Type
enumT CppEnum
e_Spec
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"toCmyk" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QColor
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"toHsl" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QColor
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"toHsv" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QColor
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"toRgb" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QColor
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"value" [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
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"valueF" [Parameter]
np Type
qreal
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered 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
"yellow" [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
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"yellowF" [Parameter]
np Type
qreal
  ]

  where
    components :: [(String, String, [String])]
components =
      [ (String
"Invalid", String
"", [])
      , (String
"Rgb", String
"rgba", [String
"red", String
"green", String
"blue", String
"alpha"])
      , (String
"Cmyk", String
"cmyka", [String
"cyan", String
"magenta", String
"yellow", String
"black", String
"alpha"])
      , (String
"Hsl", String
"hsla", [String
"hslHue", String
"hslSaturation", String
"lightness", String
"alpha"])
      , (String
"Hsv", String
"hsva", [String
"hsvHue", String
"hsvSaturation", String
"value", String
"alpha"])
      ]

    hColorImport :: HsImportSet
hColorImport = String -> String -> HsImportSet
hsQualifiedImport String
"Graphics.UI.Qtah.Gui.HColor" String
"HColor"

    conversion :: ClassHaskellConversion
conversion =
      ClassHaskellConversion :: Maybe (Generator HsType)
-> Maybe (Generator ())
-> Maybe (Generator ())
-> ClassHaskellConversion
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
hColorImport
        HsType -> Generator HsType
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
$ String -> HsName
HsIdent String
"HColor.HColor"

      , 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
$ do
        HsImportSet -> Generator ()
addImports (HsImportSet -> Generator ()) -> HsImportSet -> Generator ()
forall a b. (a -> b) -> a -> b
$ [HsImportSet] -> HsImportSet
forall a. Monoid a => [a] -> a
mconcat [HsImportSet
importForPrelude,
                              HsImportSet
importForRuntime,
                              HsImportSet
hColorImport]
        String -> Generator ()
sayLn String
"\\color' -> do"
        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
"this' <- new"
          String -> Generator ()
sayLn String
"case color' of"
          Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ [(String, String, [String])]
-> ((String, String, [String]) -> Generator ()) -> Generator ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, String, [String])]
components (((String, String, [String]) -> Generator ()) -> Generator ())
-> ((String, String, [String]) -> Generator ()) -> Generator ()
forall a b. (a -> b) -> a -> b
$ \(String
spec, String
letters, [String]
_) ->
            [String] -> Generator ()
saysLn ([String] -> Generator ()) -> [String] -> Generator ()
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [String
"HColor.", String
spec]
            , (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
var -> [Char
' ', Char
var, Char
'\'']) String
letters
            , if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
letters
              then [String
" -> QtahP.return ()"]
              else [String
" -> set", String
spec, String
"a this'"]
            , (Char -> [String]) -> String -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Char
var -> [String
" (QtahFHR.coerceIntegral ", [Char
var], String
"')"]) String
letters
            ]
          String -> Generator ()
sayLn String
"QtahP.return this'"

      , 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
$ 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
"(>>=)"],
                              HsImportSet
importForPrelude,
                              HsImportSet
importForRuntime,
                              HsImportSet
hColorImport]
        String -> Generator ()
sayLn String
"\\this' -> spec this' >>= \\spec' -> case spec' of"
        Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
          [(String, String, [String])]
-> ((String, String, [String]) -> Generator ()) -> Generator ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, String, [String])]
components (((String, String, [String]) -> Generator ()) -> Generator ())
-> ((String, String, [String]) -> Generator ()) -> Generator ()
forall a b. (a -> b) -> a -> b
$ \(String
spec, String
letters, [String]
getters) -> do
            [String] -> Generator ()
saysLn [String
spec, String
" -> do"]
            Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
              [(Char, String)]
-> ((Char, String) -> Generator ()) -> Generator ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (String -> [String] -> [(Char, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
letters [String]
getters) (((Char, String) -> Generator ()) -> Generator ())
-> ((Char, String) -> Generator ()) -> Generator ()
forall a b. (a -> b) -> a -> b
$ \(Char
var, String
get) ->
                [String] -> Generator ()
saysLn [[Char
var], String
"' <- QtahP.fmap QtahFHR.coerceIntegral $ ", String
get, String
" this'"]
              [String] -> Generator ()
saysLn ([String] -> Generator ()) -> [String] -> Generator ()
forall a b. (a -> b) -> a -> b
$ [String
"QtahP.return $ HColor.", String
spec] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
var -> [Char
' ', Char
var, Char
'\'']) String
letters
          [String] -> Generator ()
saysLn [String
"_ -> QtahP.error $ \"HColor's Decodable instance doesn't understand ",
                  String
"QColor::Spec \" ++ QtahP.show spec' ++ \".\""]
      }

-- Introduced in Qt 5.2.
e_NameFormat :: CppEnum
e_NameFormat =
  Identifier -> [Include] -> [String] -> CppEnum
makeQtEnum (String -> String -> Identifier
ident1 String
"QColor" String
"NameFormat") [String -> Include
includeStd String
"QColor"]
  [ String
"HexRgb"
  , String
"HexArgb"
  ]

e_Spec :: CppEnum
e_Spec =
  Identifier -> [Include] -> [String] -> CppEnum
makeQtEnum (String -> String -> Identifier
ident1 String
"QColor" String
"Spec") [String -> Include
includeStd String
"QColor"]
  [ String
"Invalid"
  , String
"Rgb"
  , String
"Hsv"
  , String
"Cmyk"
  , String
"Hsl"
  ]

-- | This is a typedef QRgb that holds a AARRGGBB value and is
-- "equivalent to an unsigned int."
qrgb :: Type
qrgb = Type
uintT

-- TODO Qrgba64 overloads (and methods above).

f_qAlpha :: Function
f_qAlpha = Identifier -> Maybe ExtName -> Purity -> [Type] -> Type -> Function
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name -> Maybe ExtName -> Purity -> [p] -> Type -> Function
makeFn (String -> Identifier
ident String
"qAlpha") Maybe ExtName
forall a. Maybe a
Nothing Purity
Pure [Type
qrgb] Type
intT

f_qBlue :: Function
f_qBlue = Identifier -> Maybe ExtName -> Purity -> [Type] -> Type -> Function
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name -> Maybe ExtName -> Purity -> [p] -> Type -> Function
makeFn (String -> Identifier
ident String
"qBlue") Maybe ExtName
forall a. Maybe a
Nothing Purity
Pure [Type
qrgb] Type
intT

f_qGray :: Function
f_qGray = Identifier -> Maybe ExtName -> Purity -> [Type] -> Type -> Function
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name -> Maybe ExtName -> Purity -> [p] -> Type -> Function
makeFn (String -> Identifier
ident String
"qGray") Maybe ExtName
forall a. Maybe a
Nothing Purity
Pure [Type
qrgb] Type
intT

f_qGrayFromRgb :: Function
f_qGrayFromRgb =
  Identifier -> Maybe ExtName -> Purity -> [Type] -> Type -> Function
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name -> Maybe ExtName -> Purity -> [p] -> Type -> Function
makeFn (String -> Identifier
ident String
"qGray") (ExtName -> Maybe ExtName
forall a. a -> Filtered a
Just (ExtName -> Maybe ExtName) -> ExtName -> Maybe ExtName
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> ExtName
String -> ExtName
toExtName String
"qGrayFromRgb") Purity
Pure
  [Type
intT, Type
intT, Type
intT] Type
intT

f_qGreen :: Function
f_qGreen = Identifier -> Maybe ExtName -> Purity -> [Type] -> Type -> Function
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name -> Maybe ExtName -> Purity -> [p] -> Type -> Function
makeFn (String -> Identifier
ident String
"qGreen") Maybe ExtName
forall a. Maybe a
Nothing Purity
Pure [Type
qrgb] Type
intT

f_qPremultiply :: Function
f_qPremultiply = Identifier -> Maybe ExtName -> Purity -> [Type] -> Type -> Function
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name -> Maybe ExtName -> Purity -> [p] -> Type -> Function
makeFn (String -> Identifier
ident String
"qPremultiply") Maybe ExtName
forall a. Maybe a
Nothing Purity
Pure [Type
qrgb] Type
qrgb

f_qRed :: Function
f_qRed = Identifier -> Maybe ExtName -> Purity -> [Type] -> Type -> Function
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name -> Maybe ExtName -> Purity -> [p] -> Type -> Function
makeFn (String -> Identifier
ident String
"qRed") Maybe ExtName
forall a. Maybe a
Nothing Purity
Pure [Type
qrgb] Type
intT

f_qRgb :: Function
f_qRgb = Identifier -> Maybe ExtName -> Purity -> [Type] -> Type -> Function
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name -> Maybe ExtName -> Purity -> [p] -> Type -> Function
makeFn (String -> Identifier
ident String
"qRgb") Maybe ExtName
forall a. Maybe a
Nothing Purity
Pure [Type
intT, Type
intT, Type
intT] Type
qrgb

f_qRgba :: Function
f_qRgba = Identifier -> Maybe ExtName -> Purity -> [Type] -> Type -> Function
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name -> Maybe ExtName -> Purity -> [p] -> Type -> Function
makeFn (String -> Identifier
ident String
"qRgba") Maybe ExtName
forall a. Maybe a
Nothing Purity
Pure [Type
intT, Type
intT, Type
intT, Type
intT] Type
qrgb

f_qUnpremultiply :: Function
f_qUnpremultiply = Identifier -> Maybe ExtName -> Purity -> [Type] -> Type -> Function
forall name p.
(IsFnName Identifier name, IsParameter p) =>
name -> Maybe ExtName -> Purity -> [p] -> Type -> Function
makeFn (String -> Identifier
ident String
"qUnpremultiply") Maybe ExtName
forall a. Maybe a
Nothing Purity
Pure [Type
qrgb] Type
qrgb