-- 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.QPair (
  -- * Template
  Options (..),
  defaultOptions,
  Contents (..),
  -- * Instantiations
  allModules,
  c_QPairIntInt,
  c_QPairDoubleQColor,
  ) where

import Foreign.Hoppy.Generator.Spec (
  Class,
  Reqs,
  Type,
  addReqs,
  classSetEntityPrefix,
  identT,
  includeStd,
  makeClass,
  mkCtor,
  mkMethod,
  np,
  reqInclude,
  toExtName,
  )
import Foreign.Hoppy.Generator.Spec.ClassFeature (
  ClassFeature (Assignable, Copyable),
  classAddFeatures,
  )
import Foreign.Hoppy.Generator.Types (intT, objT, refT, voidT, constT)
import Foreign.Hoppy.Generator.Version (collect, just, test)
import Graphics.UI.Qtah.Generator.Config (qtVersion)
import Graphics.UI.Qtah.Generator.Interface.Core.Types (qreal)
import Graphics.UI.Qtah.Generator.Interface.Gui.QColor (c_QColor)
import Graphics.UI.Qtah.Generator.Module (AModule (AQtModule), QtModule, makeQtModule)
import Graphics.UI.Qtah.Generator.Types

-- | Options for instantiating the pair classes.
newtype Options = Options
  { Options -> [ClassFeature]
optPairClassFeatures :: [ClassFeature]
    -- ^ Additional features to add to the @QPair@ class.  QPairs are always
    -- 'Assignable', and are 'Copyable' (>= Qt 5.2), 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_QPair :: Class  -- ^ @QPair\<T>@
  }

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

-- | 'instantiate' with additional options.
instantiate' :: String -> Type -> Type -> Reqs -> Options -> Contents
instantiate' :: String -> Type -> Type -> Reqs -> Options -> Contents
instantiate' String
pairName Type
t1 Type
t2 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
"QPair"
                     ]
      features :: [ClassFeature]
features =
        [Filtered ClassFeature] -> [ClassFeature]
forall a. [Filtered a] -> [a]
collect [ ClassFeature -> Filtered ClassFeature
forall a. a -> Filtered a
just ClassFeature
Assignable
                , Bool -> ClassFeature -> Filtered ClassFeature
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
5, Int
2]) ClassFeature
Copyable
                ] [ClassFeature] -> [ClassFeature] -> [ClassFeature]
forall a. [a] -> [a] -> [a]
++
        Options -> [ClassFeature]
optPairClassFeatures Options
opts

      pair :: Class
pair =
        Reqs -> Class -> Class
forall a. HasReqs a => Reqs -> a -> a
addReqs Reqs
reqs (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
$
        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
"QPair" [Type
t1,Type
t2]) (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
pairName) [] ([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
"newWithValues" [Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
t1, Type -> Type
refT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
t2]
        , 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 -> [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
pair] Type
voidT
          -- TODO first, second
        ]


  in Contents :: Class -> Contents
Contents
     { c_QPair :: Class
c_QPair = Class
pair
     }

-- | 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_QPair Contents
m]

createModule :: String -> Contents -> QtModule
createModule :: String -> Contents -> QtModule
createModule String
name Contents
contents = [String] -> [QtExport] -> QtModule
makeQtModule [String
"Core", String
"QPair", String
name] ([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_IntInt
  , QtModule
qmod_DoubleQColor
  ]

qmod_IntInt :: QtModule
qmod_IntInt :: QtModule
qmod_IntInt = String -> Contents -> QtModule
createModule String
"IntInt" Contents
contents_IntInt

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

c_QPairIntInt :: Class
c_QPairIntInt :: Class
c_QPairIntInt = Contents -> Class
c_QPair Contents
contents_IntInt

qmod_DoubleQColor :: QtModule
qmod_DoubleQColor :: QtModule
qmod_DoubleQColor = String -> Contents -> QtModule
createModule String
"DoubleQColor" Contents
contents_DoubleQColor

contents_DoubleQColor :: Contents
contents_DoubleQColor :: Contents
contents_DoubleQColor = String -> Type -> Type -> Reqs -> Contents
instantiate String
"QPairDoubleQColor" Type
qreal (Class -> Type
objT Class
c_QColor) (Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ String -> Include
includeStd String
"QColor")

c_QPairDoubleQColor :: Class
c_QPairDoubleQColor :: Class
c_QPairDoubleQColor = Contents -> Class
c_QPair Contents
contents_DoubleQColor