-- 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/>.

-- | Haskell definitions for preprocessor flags that Qt uses for conditional
-- compilation.
--
-- A list of flags enabled on your system can be obtained with:
--
-- > gcc -dM -E $(pkg-config --cflags QtCore) /usr/include/qt4/Qt/qconfig.h | grep '#define QT'
--
-- Using @qglobal.h@ and @#define Q@ provides additional defintions,
-- e.g. version and windowing system information.
module Graphics.UI.Qtah.Generator.Config (
  Version,
  qtVersion,
  qmakeExecutable,
  qmakeArguments,
  keypadNavigation,
  qdoc,
  qrealFloat,
  wsWince,
  ) where

import Control.Monad (unless)
import Data.Char (isDigit, isSpace)
import Data.List (intercalate, isPrefixOf)
import Graphics.UI.Qtah.Generator.Common (firstM, fromMaybeM, splitOn)
import System.Directory (findExecutable)
import System.Environment (lookupEnv)
import System.Exit (ExitCode (ExitSuccess))
import System.IO.Unsafe (unsafePerformIO)
import System.Process (readProcessWithExitCode)

-- | A type synonym for Qt version specifications.  These are just lists of
-- integers, of length two.  Examples are @[4, 8]@ and @[5, 0]@ to denote
-- versions 4.8 and 5.0 respectively.  A third component may be used in the
-- future, if necessary.
type Version = [Int]

showVersion :: Version -> String
showVersion :: Version -> String
showVersion = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String) -> (Version -> [String]) -> Version -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String) -> Version -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show

-- | An internal record of Qt configuration info.
data QtConfig = QtConfig
  { QtConfig -> Version
configVersion :: Version
  , QtConfig -> String
configQmakeExecutable :: FilePath
  , QtConfig -> [String]
configQmakeArguments :: [String]
  }

-- | This is initialized at program startup with the version of Qt that the
-- generator will work with, along with the corresponding QMake binary and
-- arguments necessary to invoke it.  The Qt version which functions and types
-- are made available in the API.
--
-- The Qt version determined the following method:
--
-- * If @QTAH_QT=x.y@ is in the environment, then this value will be used.
--
-- * Otherwise, if @QTAH_QT=x@ is in the environment, then we query @qmake
-- -qt=$QTAH_QT -version@ for the version of Qt to use.
--
-- * Otherwise, we query @qmake -version@ for the version of Qt to use.  Setting
-- @QT_SELECT@ in the environment can select a major version of Qt to use.
--
-- For more information on @qmake -qt@ and @QT_SELECT@, see @man qtchooser@.
qtConfig :: QtConfig
{-# NOINLINE qtConfig #-}
qtConfig :: QtConfig
qtConfig = IO QtConfig -> QtConfig
forall a. IO a -> a
unsafePerformIO IO QtConfig
readQt

qtVersion :: Version
qtVersion :: Version
qtVersion = QtConfig -> Version
configVersion QtConfig
qtConfig

qmakeExecutable :: FilePath
qmakeExecutable :: String
qmakeExecutable = QtConfig -> String
configQmakeExecutable QtConfig
qtConfig

qmakeArguments :: [String]
qmakeArguments :: [String]
qmakeArguments = QtConfig -> [String]
configQmakeArguments QtConfig
qtConfig

-- If this ever gets made a proper flag, then QEvent::EnterEditFocus and
-- QEvent::LeaveEditFocus should get added, conditional on it.
keypadNavigation :: Bool
keypadNavigation :: Bool
keypadNavigation = Bool
False

qdoc :: Bool
qdoc :: Bool
qdoc = Bool
False

-- | Whether Qt was configured with qreal=float instead of double.
qrealFloat :: Bool
{-# NOINLINE qrealFloat #-}
qrealFloat :: Bool
qrealFloat = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO Bool
readBool String
"QTAH_QREAL_FLOAT" Bool
False

wsWince :: Bool
wsWince :: Bool
wsWince = Bool
False

-- | Reads a Qt version from the environment variable @QTAH_QT@, and looks up a
-- qmake binary.
readQt :: IO QtConfig
readQt :: IO QtConfig
readQt = do
  Maybe String
maybeStr <- (\Maybe String
x -> case Maybe String
x of
                 Just String
"" -> Maybe String
forall a. Maybe a
Nothing
                 Maybe String
_ -> Maybe String
x) (Maybe String -> Maybe String)
-> IO (Maybe String) -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
              String -> IO (Maybe String)
lookupEnv String
"QTAH_QT"
  case Maybe String
maybeStr of
    Just String
str -> do
      let strs :: [String]
strs = Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
splitOn Char
'.' String
str
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
strs Int -> Version -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1, Int
2] Bool -> Bool -> Bool
&& (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\String
n -> Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
n) Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
n) [String]
strs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [String
"qtah-generator requires QTAH_QT=x or QTAH_QT=x.y, can't parse value ", String -> String
forall a. Show a => a -> String
show String
str, String
"."]
      let version :: Version
version = (String -> Int) -> [String] -> Version
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
forall a. Read a => String -> a
read :: String -> Int) [String]
strs
      case Version
version of
        [Int
x] -> Maybe Int -> IO QtConfig
queryQmake (Maybe Int -> IO QtConfig) -> Maybe Int -> IO QtConfig
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
        [Int
x, Int
y] -> do
          QtConfig
config <- Maybe Int -> IO QtConfig
queryQmake (Maybe Int -> IO QtConfig) -> Maybe Int -> IO QtConfig
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
          case QtConfig -> Version
configVersion QtConfig
config of
            foundVersion :: Version
foundVersion@(Int
x':Int
y':Version
_) | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
x' Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
y' ->
              String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"qtah-generator: Mismatch between requested and installed " String -> String -> String
forall a. [a] -> [a] -> [a]
++
              String
"Qt versions.  Requested " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
version String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", found " String -> String -> String
forall a. [a] -> [a] -> [a]
++
              Version -> String
showVersion Version
foundVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
            Version
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          QtConfig -> IO QtConfig
forall (m :: * -> *) a. Monad m => a -> m a
return QtConfig
config
        Version
_ -> String -> IO QtConfig
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO QtConfig) -> String -> IO QtConfig
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
             [String
"qtah-generator: Internal error, incorrect parsing of QTAH_QT value ", String -> String
forall a. Show a => a -> String
show String
str, String
"."]
    Maybe String
Nothing -> Maybe Int -> IO QtConfig
queryQmake Maybe Int
forall a. Maybe a
Nothing

  where -- | When we don't have a preferred qmake version, then we'll search for
        -- qmake's executables, first unqualified, then qualified by version
        -- number in decreasing order.
        allQmakeExecutableNames :: [String]
        allQmakeExecutableNames :: [String]
allQmakeExecutableNames = [String
"qmake", String
"qmake-qt5", String
"qmake-qt4"]

        -- | When we /do/ have a prefered qmake version, then try the qualified
        -- version name first, falling back to the generic qmake executable if
        -- possible.
        qmakeExecutableNamesForVersion :: Int -> [String]
        qmakeExecutableNamesForVersion :: Int -> [String]
qmakeExecutableNamesForVersion Int
major = [String
"qmake-qt" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
major, String
"qmake"]

        queryQmake :: Maybe Int -> IO QtConfig
        queryQmake :: Maybe Int -> IO QtConfig
queryQmake Maybe Int
maybePreferredMajorVersion =
          case Maybe Int
maybePreferredMajorVersion of
            Maybe Int
Nothing ->
              -- No major version preference, so take whatever Qt is available.
              [String] -> [String] -> IO QtConfig
queryQmake' [String]
allQmakeExecutableNames []
            Just Int
preferredMajorVersion -> do
              -- Even though we have a preferred major version, we don't want to
              -- run "qmake -qt=X -version" initially because we might be on a
              -- system (NixOS) where qtchooser isn't available and the only
              -- qmake available *is* the desired version (in NixOS's case, the
              -- binary is called "qmake", not "qmake-qtX").  Only pass "-qt=X"
              -- if we get the wrong default version.
              let executableNames :: [String]
executableNames = Int -> [String]
qmakeExecutableNamesForVersion Int
preferredMajorVersion
              QtConfig
defaultConfig <- [String] -> [String] -> IO QtConfig
queryQmake' [String]
executableNames []
              case QtConfig -> Version
configVersion QtConfig
defaultConfig of
                (Int
x:Version
_) | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
preferredMajorVersion -> QtConfig -> IO QtConfig
forall (m :: * -> *) a. Monad m => a -> m a
return QtConfig
defaultConfig
                Version
_ -> [String] -> [String] -> IO QtConfig
queryQmake' [String]
executableNames [String
"-qt=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
preferredMajorVersion]

        queryQmake' :: [String] -> [String] -> IO QtConfig
        queryQmake' :: [String] -> [String] -> IO QtConfig
queryQmake' [String]
executableNames [String]
extraArgs = do
          String
qmakePath <- [String] -> IO String
findQMake [String]
executableNames
          let args :: [String]
args = [String]
extraArgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-version"]
          (ExitCode
exitCode, String
out, String
err) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
qmakePath [String]
args String
""
          let qmakeDebugWords :: [String]
qmakeDebugWords =
                [String
"  Ran ", [String] -> String
forall a. Show a => a -> String
show (String
qmakePath String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args), String
".\nStdout:\n", String
out, String
"\nStderr:\n", String
err]
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
"qtah-generator: qmake returned non-zero exit code." String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
qmakeDebugWords

          let versionLinePrefix :: String
versionLinePrefix = String
"Using Qt version "

              maybeVersionStrs :: Maybe [String]
maybeVersionStrs = do
                String
versionLine <- [String] -> Maybe String
forall a. [a] -> Maybe a
expectSingle ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$
                               (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
versionLinePrefix String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
                               String -> [String]
lines String
out
                let str :: String
str = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
versionLinePrefix) String
versionLine
                    strs :: [String]
strs = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
2 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
splitOn Char
'.' String
str
                if [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
strs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
&& (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\String
n -> Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
n) Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
n) [String]
strs
                  then [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
strs
                  else Maybe [String]
forall a. Maybe a
Nothing

          case Maybe [String]
maybeVersionStrs of
            Just [String]
strs ->
              QtConfig -> IO QtConfig
forall (m :: * -> *) a. Monad m => a -> m a
return QtConfig :: Version -> String -> [String] -> QtConfig
QtConfig
              { configVersion :: Version
configVersion = (String -> Int) -> [String] -> Version
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
forall a. Read a => String -> a
read :: String -> Int) [String]
strs
              , configQmakeExecutable :: String
configQmakeExecutable = String
qmakePath
              , configQmakeArguments :: [String]
configQmakeArguments = [String]
extraArgs
              }
            Maybe [String]
Nothing ->
              String -> IO QtConfig
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO QtConfig) -> String -> IO QtConfig
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
              String
"qtah-generator: Can't parse Qt version from qmake output." String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
qmakeDebugWords

        expectSingle :: [a] -> Maybe a
        expectSingle :: [a] -> Maybe a
expectSingle [a
x] = a -> Maybe a
forall a. a -> Maybe a
Just a
x
        expectSingle [a]
_ = Maybe a
forall a. Maybe a
Nothing

-- | Reads a boolean value from the program's environment.  If the variable is
-- set and non-empty, then if must be one of the strings @true@ or @false@.  An
-- empty or unset value is treated as the provided default value.
readBool :: String -> Bool -> IO Bool
readBool :: String -> Bool -> IO Bool
readBool String
name Bool
defaultValue = do
  Maybe String
maybeStr <- String -> IO (Maybe String)
lookupEnv String
name
  case Maybe String
maybeStr of
    Maybe String
Nothing -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
defaultValue
    Just String
str -> case String
str of
      String
"" -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
defaultValue
      String
"true" -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      String
"false" -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      String
s -> String -> IO Bool
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
           [String
"qtah-generator: Expected a boolean value for ", String
name,
            String
" (true/false).  Got ", String -> String
forall a. Show a => a -> String
show String
s, String
"."]

findQMake :: [String] -> IO FilePath
findQMake :: [String] -> IO String
findQMake [String]
executableNames = String -> IO (Maybe String)
lookupEnv String
"QTAH_QMAKE" IO (Maybe String) -> (Maybe String -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO String -> Maybe String -> IO String
forall (m :: * -> *) a. Monad m => m a -> Maybe a -> m a
fromMaybeM IO String
findBinary
  where findBinary :: IO String
findBinary =
          [IO (Maybe String)] -> IO (Maybe String)
forall (m :: * -> *) a.
(Functor m, Monad m) =>
[m (Maybe a)] -> m (Maybe a)
firstM ((String -> IO (Maybe String)) -> [String] -> [IO (Maybe String)]
forall a b. (a -> b) -> [a] -> [b]
map String -> IO (Maybe String)
findExecutable [String]
executableNames) IO (Maybe String) -> (Maybe String -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          IO String -> Maybe String -> IO String
forall (m :: * -> *) a. Monad m => m a -> Maybe a -> m a
fromMaybeM
          (String -> IO String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"qtah-generator: Can't find qmake named any of " String -> String -> String
forall a. [a] -> [a] -> [a]
++
           [String] -> String
forall a. Show a => a -> String
show [String]
executableNames String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".  Please ensure qmake is installed " String -> String -> String
forall a. [a] -> [a] -> [a]
++
           String
"and set QTAH_QMAKE to qmake's path.")