-- This file is part of Qtah.
--
-- Copyright 2015-2016 Bryan Gardiner <bog@khumba.net>
--
-- 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 Main where

import Data.Foldable (forM_)
import Data.List (intercalate)
import Foreign.Hoppy.Generator.Main (Action (GenHaskell), 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.Flags (qtVersion)
import Graphics.UI.Qtah.Generator.Common (maybeFail)
import Graphics.UI.Qtah.Generator.Module
import Graphics.UI.Qtah.Generator.Types
import qualified Graphics.UI.Qtah.Generator.Interface.Callback as Callback
import qualified Graphics.UI.Qtah.Generator.Interface.Core as Core
import qualified Graphics.UI.Qtah.Generator.Interface.EventListener as EventListener
import qualified Graphics.UI.Qtah.Generator.Interface.Gui as Gui
import qualified Graphics.UI.Qtah.Generator.Interface.Listener as Listener
import qualified Graphics.UI.Qtah.Generator.Interface.Widgets as Widgets
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.FilePath (
  dropTrailingPathSeparator,
  takeDirectory,
  takeFileName,
  )

mod_std :: Module
mod_std = moduleModify' Std.mod_std $ do
  moduleSetHppPath "b_std.hpp"
  moduleSetCppPath "b_std.cpp"

modules :: [AModule]
modules =
  concat
  [ [ AHoppyModule mod_std
    , Callback.aModule
    , EventListener.aModule
    , Listener.aModule
    ]
  , Core.modules
  , Gui.modules
  , Widgets.modules
  ]

interfaceResult :: Either String Interface
interfaceResult =
  interfaceAddHaskellModuleBase ["Graphics", "UI", "Qtah", "Generated"] =<<
  interface "qtah" (map aModuleHoppy modules)

main :: IO ()
main =
  case interfaceResult of
    Left errorMsg -> do
      putStrLn $ "Error initializing interface: " ++ errorMsg
      exitFailure
    Right iface -> do
      args <- getArgs
      case args of
        ["--qt-version"] -> putStrLn $ intercalate "." $ map show qtVersion
        _ -> do
          actions <- run [iface] args
          forM_ actions $ \action -> case action of
            GenHaskell path -> do
              -- Generate nicely-named Qt modules that will point to the bindings,
              -- and also contain signal definitions.
              srcDir <- maybeFail ("Couldn't find src directory for path " ++ show path ++
                                   " to generate Qt modules.") $
                        findSrcDir path
              forM_ modules $ \aModule -> case aModule of
                AHoppyModule _ -> return ()
                AQtModule qm -> generateModule iface srcDir "Graphics.UI.Qtah" qm

            _ -> return ()

findSrcDir :: FilePath -> Maybe FilePath
findSrcDir = go . dropTrailingPathSeparator
  where go "" = Nothing
        go path =
          let dir = takeDirectory path
              file = takeFileName path
          in if file == "src" then Just path
             else if dir == path
                  then Nothing  -- Can't go up any more.
                  else go dir