-- 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.ListenerGen (
  generateListenerCpp,
  ) where

import Data.List (intercalate)
import Graphics.UI.Qtah.Generator.Common (writeFileIfDifferent)
import Graphics.UI.Qtah.Generator.Config (Version)
import Graphics.UI.Qtah.Generator.Interface.Internal.Listener (ListenerDef (..), listeners)
import System.FilePath ((</>))

generateListenerCpp :: FilePath -> IO ()
generateListenerCpp :: FilePath -> IO ()
generateListenerCpp FilePath
cppDirPath = do
  FilePath -> FilePath -> IO ()
writeFileIfDifferent (FilePath
cppDirPath FilePath -> FilePath -> FilePath
</> FilePath
"listener.hpp") FilePath
hppSource
  FilePath -> FilePath -> IO ()
writeFileIfDifferent (FilePath
cppDirPath FilePath -> FilePath -> FilePath
</> FilePath
"listener.cpp") FilePath
cppSource

-- TODO Generate this from the listener definitions themselves.
cppIncludes :: [String]
cppIncludes :: [FilePath]
cppIncludes =
  [ FilePath
"#include <QAbstractAnimation>"
  , FilePath
"#include <QAbstractButton>"
  , FilePath
"#include <QAbstractSlider>"
  , FilePath
"#include <QAction>"
  , FilePath
"#include <QClipboard>"
  , FilePath
"#include <QDockWidget>"
  , FilePath
"#include <QIcon>"
  , FilePath
"#include <QItemSelection>"
  , FilePath
"#include <QMdiSubWindow>"
  , FilePath
"#include <QMetaObject>"
  , FilePath
"#include <QModelIndex>"
  , FilePath
"#include <QObject>"
  , FilePath
"#include <QPoint>"
  , FilePath
"#include <QProcess>"
  , FilePath
"#include <QSize>"
  , FilePath
"#include <QSystemTrayIcon>"
  , FilePath
"#include <QTreeWidgetItem>"
  , FilePath
"#include <QVariant>"
  , FilePath
"#include <QVector>"
  , FilePath
"#include <QWidget>"
  , FilePath
"#include <Qt>"
  , FilePath
"#include <QtGlobal>"
  , FilePath
"#include <string>"
  , FilePath
"#if QT_VERSION >= 0x050000"
  , FilePath
"#include <QWindow>"
  , FilePath
"#endif"
  , FilePath
"#include \"b_callback.hpp\""
  ]

hppSource :: String
hppSource :: FilePath
hppSource = (FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n") (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\n" ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$
  [ FilePath
"////////// GENERATED FILE, EDITS WILL BE LOST //////////"
  , FilePath
""
  , FilePath
"#ifndef QTAH_LISTENERS_HPP"
  , FilePath
"#define QTAH_LISTENERS_HPP"
  , FilePath
""
  ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
cppIncludes [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
  ((ListenerDef -> [FilePath]) -> [ListenerDef] -> [FilePath])
-> [ListenerDef] -> (ListenerDef -> [FilePath]) -> [FilePath]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ListenerDef -> [FilePath]) -> [ListenerDef] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [ListenerDef]
listeners (\ListenerDef
l ->
    let cn :: FilePath
cn = ListenerDef -> FilePath
listenerClassName ListenerDef
l
        ccn :: FilePath
ccn = ListenerDef -> FilePath
listenerCallbackClassName ListenerDef
l
        pl :: FilePath
pl = ListenerDef -> FilePath
listenerCppParamList ListenerDef
l
    in [ FilePath
"" ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
       [FilePath]
-> (Version -> [FilePath]) -> Maybe Version -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Version
v -> [FilePath
"#if QT_VERSION >= " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
renderVersionCppHex Version
v, FilePath
""]) (ListenerDef -> Maybe Version
listenerMinVersion ListenerDef
l) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
       [ FilePath
"class " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" : public QObject {"
       , FilePath
"    Q_OBJECT"
       , FilePath
""
       , FilePath
"public:"
       , FilePath
"    typedef " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
ccn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" callback;"
       , FilePath
""
       , FilePath
"    " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"(QObject* source, const std::string& signal, callback f);"
       , FilePath
"    ~" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"();"
       , FilePath
"    bool isValid() const;"
       , FilePath
""
       , FilePath
"public slots:"
       , FilePath
"    void invoke(" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pl FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
");"
       , FilePath
""
       , FilePath
"private:"
       , FilePath
"    callback f_;"
       , FilePath
"    QMetaObject::Connection connection_;"
       , FilePath
"};"
       ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
       [FilePath]
-> (Version -> [FilePath]) -> Maybe Version -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Version
_ -> [FilePath
"", FilePath
"#endif"]) (ListenerDef -> Maybe Version
listenerMinVersion ListenerDef
l)
  ) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
  [ FilePath
""
  , FilePath
"#endif"
  ]

cppSource :: String
cppSource :: FilePath
cppSource = (FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n") (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\n" ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$
  [ FilePath
"////////// GENERATED FILE, EDITS WILL BE LOST //////////"
  , FilePath
""
  , FilePath
"#include \"listener.hpp\""
  , FilePath
""
  , FilePath
"#include <iostream>"
  ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
  ((ListenerDef -> [FilePath]) -> [ListenerDef] -> [FilePath])
-> [ListenerDef] -> (ListenerDef -> [FilePath]) -> [FilePath]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ListenerDef -> [FilePath]) -> [ListenerDef] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [ListenerDef]
listeners (\ListenerDef
l ->
    let cn :: FilePath
cn = ListenerDef -> FilePath
listenerClassName ListenerDef
l
        pl :: FilePath
pl = ListenerDef -> FilePath
listenerCppParamList ListenerDef
l
        ptl :: FilePath
ptl = ListenerDef -> FilePath
listenerCppParamTypeList ListenerDef
l
        pnl :: FilePath
pnl = ListenerDef -> FilePath
listenerCppParamNameList ListenerDef
l
    in [ FilePath
"" ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
       [FilePath]
-> (Version -> [FilePath]) -> Maybe Version -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Version
v -> [FilePath
"#if QT_VERSION >= " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
renderVersionCppHex Version
v, FilePath
""]) (ListenerDef -> Maybe Version
listenerMinVersion ListenerDef
l) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
       [ FilePath
cn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"::" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"(QObject* source, const std::string& signal, " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"::callback f) :"
       , FilePath
"    QObject(source), f_(f) {"
       , FilePath
"    connection_ = connect(source, signal.c_str(), this, SLOT(invoke(" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
ptl FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")));"
       , FilePath
"}"
       , FilePath
""
       , FilePath
cn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"::~" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"() {"
       , FilePath
"    QObject::disconnect(connection_);"
       , FilePath
"}"
       , FilePath
""
       , FilePath
"bool " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"::isValid() const {"
       , FilePath
"    return static_cast<bool>(connection_);"
       , FilePath
"}"
       , FilePath
""
       , FilePath
"void " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"::invoke(" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pl FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
") {"
       , FilePath
"    f_(" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pnl FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
");"
       , FilePath
"}"
       ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
       [FilePath]
-> (Version -> [FilePath]) -> Maybe Version -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Version
_ -> [FilePath
"", FilePath
"#endif"]) (ListenerDef -> Maybe Version
listenerMinVersion ListenerDef
l)
  )

renderVersionCppHex :: Version -> String
renderVersionCppHex :: Version -> FilePath
renderVersionCppHex Version
version = FilePath
"0x" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
a' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
b' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
c'
  where [Int
a, Int
b, Int
c] = Int -> Version -> Version
forall a. Int -> [a] -> [a]
take Int
3 (Version -> Version) -> Version -> Version
forall a b. (a -> b) -> a -> b
$ Version
version Version -> Version -> Version
forall a. [a] -> [a] -> [a]
++ Int -> Version
forall a. a -> [a]
repeat Int
0
        a' :: FilePath
a' = Int -> FilePath
forall a. (Ord a, Num a, Show a) => a -> FilePath
pad Int
a
        b' :: FilePath
b' = Int -> FilePath
forall a. (Ord a, Num a, Show a) => a -> FilePath
pad Int
b
        c' :: FilePath
c' = Int -> FilePath
forall a. (Ord a, Num a, Show a) => a -> FilePath
pad Int
c
        pad :: a -> FilePath
pad a
n =
          if a
0 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
n Bool -> Bool -> Bool
&& a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10
          then Char
'0' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: a -> FilePath
forall a. Show a => a -> FilePath
show a
n
          else if a
10 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
n Bool -> Bool -> Bool
&& a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
100
               then a -> FilePath
forall a. Show a => a -> FilePath
show a
n
               else FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"renderVersionCppHex expects 0 <= n < 100, n is " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"."