-- 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.Main (
  run,
  generateCpp,
  generateHs,
  ) where

import Control.Monad (when)
import Data.List (intercalate)
import qualified Foreign.Hoppy.Generator.Main as GeneratorMain (run)
import Foreign.Hoppy.Generator.Spec (
  Interface,
  Module,
  interface,
  interfaceAddHaskellModuleBase,
  moduleModify',
  moduleSetCppPath,
  moduleSetHppPath,
  )
import qualified Foreign.Hoppy.Generator.Std as Std
import Graphics.UI.Qtah.Generator.Enum (installEnumCalculator)
import Graphics.UI.Qtah.Generator.Config (qmakeArguments, qmakeExecutable, qtVersion)
import Graphics.UI.Qtah.Generator.Module
import qualified Graphics.UI.Qtah.Generator.Interface.Core as Core
import qualified Graphics.UI.Qtah.Generator.Interface.Gui as Gui
import qualified Graphics.UI.Qtah.Generator.Interface.Internal as Internal
import qualified Graphics.UI.Qtah.Generator.Interface.Widgets as Widgets
import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)

mod_std :: Module
mod_std :: Module
mod_std = HasCallStack =>
Module -> StateT Module (Either String) () -> Module
Module -> StateT Module (Either String) () -> Module
moduleModify' Module
Std.mod_std (StateT Module (Either String) () -> Module)
-> StateT Module (Either String) () -> Module
forall a b. (a -> b) -> a -> b
$ do
  String -> StateT Module (Either String) ()
forall (m :: * -> *). MonadState Module m => String -> m ()
moduleSetHppPath String
"b_std.hpp"
  String -> StateT Module (Either String) ()
forall (m :: * -> *). MonadState Module m => String -> m ()
moduleSetCppPath String
"b_std.cpp"

modules :: [AModule]
modules :: [AModule]
modules =
  [[AModule]] -> [AModule]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [ Module -> AModule
AHoppyModule Module
mod_std
    ]
  , [AModule]
Core.modules
  , [AModule]
Gui.modules
  , [AModule]
Internal.modules
  , [AModule]
Widgets.modules
  ]

interfaceResult :: Either String Interface
interfaceResult :: Either String Interface
interfaceResult =
  (Interface -> Interface)
-> Either String Interface -> Either String Interface
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Interface -> Interface
installEnumCalculator (Either String Interface -> Either String Interface)
-> Either String Interface -> Either String Interface
forall a b. (a -> b) -> a -> b
$
  [String] -> Interface -> Either String Interface
interfaceAddHaskellModuleBase [String
"Graphics", String
"UI", String
"Qtah"] (Interface -> Either String Interface)
-> Either String Interface -> Either String Interface
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
  String -> [Module] -> Either String Interface
interface String
"qtah" ((AModule -> [Module]) -> [AModule] -> [Module]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AModule -> [Module]
aModuleHoppyModules [AModule]
modules)

-- | Generates the C++ side of the Qtah bindings, producing files in the given
-- directory.
generateCpp :: FilePath -> IO ()
generateCpp :: String -> IO ()
generateCpp String
path = [String] -> IO ()
run [String
"--gen-cpp", String
path]

-- | Generates the Haskell side of the Qtah bindings in the given source
-- directory.
generateHs :: FilePath -> IO ()
generateHs :: String -> IO ()
generateHs String
path = [String] -> IO ()
run [String
"--gen-hs", String
path]

-- | Runs the Qtah generator with the given command line arguments.
run :: [String] -> IO ()
run :: [String] -> IO ()
run [String]
args =
  case Either String Interface
interfaceResult of
    Left String
errorMsg -> do
      String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error initializing interface: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errorMsg
      IO ()
forall a. IO a
exitFailure
    Right Interface
iface -> do
      -- If building against Qt 4, then warn that it is no longer supported.
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int
5, Int
0]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
          String
"WARNING: Qtah no longer supports Qt 4.x.  Please upgrade to Qt 5.  Found version " String -> String -> String
forall a. [a] -> [a] -> [a]
++
          String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ((Int -> String) -> Version -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show Version
qtVersion) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."

      case [String]
args of
        [String
"--qt-version"] -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Int -> String) -> Version -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show Version
qtVersion
        [String
"--qmake-executable"] -> String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
qmakeExecutable String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
qmakeArguments
        [String]
_ -> do
          [Action]
_ <- [Interface] -> [String] -> IO [Action]
GeneratorMain.run [Interface
iface] [String]
args
          () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()