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)
generateCpp :: FilePath -> IO ()
generateCpp :: String -> IO ()
generateCpp String
path = [String] -> IO ()
run [String
"--gen-cpp", String
path]
generateHs :: FilePath -> IO ()
generateHs :: String -> IO ()
generateHs String
path = [String] -> IO ()
run [String
"--gen-hs", String
path]
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
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 ()