-- -- Main.hs -- Copyright (C) 2014 Ivan Cukic -- -- Distributed under terms of the GPLv3 license. -- {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ImplicitParams #-} import System.Console.CmdArgs import System.Console.ANSI import System.Process import System.Exit import System.Directory import System.IO.Error import System.IO import Control.Monad -- (when, unless, forM, forM_, filterM, (>>=)) import Data.Maybe (fromMaybe, maybeToList, isJust, isNothing) import Data.List (any, isPrefixOf, intercalate) import Data.String.Utils import qualified Config as C import qualified ConfigParser as C import qualified StringListParser as SL _PROGRAM_NAME = "kdesrc-build-extra" _PROGRAM_VERSION = "2014.10.0" _PROGRAM_INFO = _PROGRAM_NAME ++ " " ++ _PROGRAM_VERSION _PROGRAM_COPYRIGHT = "(C) 2014 Ivan Cukic" data CliOptions = CliOptions { no_build :: Bool , no_install :: Bool , pretend :: Bool , rc_file :: Maybe String , extra_rc_file :: Maybe String , reconfigure :: Bool , otherArgs :: [String] } deriving (Data, Show, Eq, Typeable) data ProjectInfo = ProjectInfo { project :: String , projectSourceDir :: String , projectBuildDir :: String , cmakeArguments :: [String] , getLogFile :: String -> String } getCliOptions :: IO CliOptions getCliOptions = cmdArgs $ CliOptions { no_build = def &= help "Just run CMake, do not build" , no_install = def &= help "Build the project, do not install" , pretend = def &= help "Do not do anything, just pretend" , rc_file = def &= help "Path to the kdesrc-build configuration file" , extra_rc_file = def &= help "Path to the kdesrc-build-extra configuration file" , reconfigure = def &= help "Clean CMakeCache and run CMake again" , otherArgs = def &= args &= typ "build-profile] [projects..." } &= program _PROGRAM_NAME &= help _PROGRAM_INFO &= helpArg [explicit, name "help", name "h"] &= verbosityArgs [explicit, name "verbose", name "V"] [] &= versionArg [explicit, name "version", name "v", summary _PROGRAM_INFO] run :: (?debug :: Bool) => CliOptions -> C.Config -> C.BuildProfile -> IO () run CliOptions{..} C.Config{..} C.BuildProfile{..} = do let projectsToBuild = if length otherArgs /= 1 then tail otherArgs else projects debugMessage [ "Source location: " ++ show sourceDir, "Log location: " ++ show logDir, "Available profiles: " ++ show availableProfiles, "Build dir: " ++ show buildDir, "Install dir: " ++ show installDir, "CXX compiler: " ++ show cxxCompiler, "C compiler: " ++ show cCompiler, "CMake options remove: " ++ show cmakeOptionsRemove, "CMake options add: " ++ show cmakeOptionsAdd, "Projects: " ++ show projectsToBuild ] -- Running kdesrc-build to get the default cmake values userMessage [ "Running kdesrc-build for " ++ show projectsToBuild ++ " in order to get the default cmake arguments" ++ " (--reconfigure --build-system-only)" ] (ksbExitCode, ksbOut, ksbErr) <- readProcessWithExitCode "./kdesrc-build" ( projectsToBuild ++ [ "--reconfigure" , "--build-system-only" , "--no-src" ] ) [] case ksbExitCode of ExitSuccess -> debugMessage [ "Successfully finished kdesrc-build" ] ExitFailure _ -> fatalError [ "kdesrc-build failed.", "stdout: " ++ ksbOut, "stderr: " ++ ksbErr ] -- And now, processing the projects one by one let getProjectInfo :: String -> IO ProjectInfo getProjectInfo project = do userMessage [ "", "Building " ++ colorOk project, "" ] -- reading the first line of the log to get the cmake invocation logContent <- readFile $ logDir ++ "/latest/" ++ project ++ "/cmake.log" -- some options are removed even if not specified explicitly let cmakeOptionsRemove' = cmakeOptionsRemove ++ [ "-DCMAKE_C_COMPILER" , "-DCMAKE_CXX_COMPILER" , "-DCMAKE_INSTALL_PREFIX" ] let shouldBeKept item = not $ any ( \toRemove -> SL.stripQuotes toRemove `isPrefixOf` SL.stripQuotes item ) cmakeOptionsRemove' let _ : projectSourceDir : cmakeArguments = map SL.stripQuotes $ -- adding old arguments that are not scheduled for -- removal ( filter shouldBeKept . -- removing those that should be removed SL.parseString . -- getting the strings drop 1 . -- we have a colon left dropWhile (/= ':') . -- remove until the colon head $ lines logContent -- taking the first line of the log ) ++ -- adding the user-specified arguments cmakeOptionsAdd ++ -- adding compiler specification [ "-DCMAKE_CXX_COMPILER=" ++ cxxCompiler, "-DCMAKE_C_COMPILER=" ++ cCompiler ] ++ -- and the install prefix, if specified map (\x -> "-DCMAKE_INSTALL_PREFIX=" ++ x) (maybeToList installDir) unless (sourceDir `isPrefixOf` SL.stripQuotes projectSourceDir) $ fatalError [ "The configured src-dir is not a parent of the project's source directory.", "Configured src-dir: " ++ sourceDir, "Project source director: " ++ projectSourceDir ] -- creating the build directory let projectBuildDir = replace sourceDir buildDir $ SL.stripQuotes projectSourceDir createDirectoryIfMissing True projectBuildDir let getLogFile = logFileForProjct profileName logDir project return ProjectInfo { .. } let runCMake :: ProjectInfo -> IO (ProjectInfo, Bool) runCMake info@ProjectInfo { .. } = do result <- executeCommand project "cmake" (projectSourceDir : cmakeArguments) projectBuildDir (getLogFile "cmake") return (info, result) let runMake :: ProjectInfo -> IO (ProjectInfo, Bool) runMake info@ProjectInfo { .. } = if not no_build then do let (makeCommand : makeArguments) = if null overrideMakeCommand then "make" : makeOptions else overrideMakeCommand result <- executeCommand project makeCommand makeArguments projectBuildDir (getLogFile "build") return (info, result) else return (info, True) let runMakeInstall :: ProjectInfo -> IO (ProjectInfo, Bool) runMakeInstall info@ProjectInfo { .. } = if not no_install && isJust installDir then do result <- executeCommand project "make" ("install" : makeOptions) projectBuildDir (getLogFile "install") return (info, result) else return (info, True) buildResults <- forM projectsToBuild $ getProjectInfo >=> (runCMake |>> runMake |>> runMakeInstall) let successfulBuilds = map (project . fst) $ filter snd buildResults let failedBuilds = map (project . fst) $ filter (not . snd) buildResults userMessage [ "" , "Successfully built: " ++ colorOk (unwords successfulBuilds) , "Failed to build: " ++ colorFail (unwords failedBuilds) ] return () (|>>) :: (ProjectInfo -> IO (ProjectInfo, Bool)) -> (ProjectInfo -> IO (ProjectInfo, Bool)) -> ProjectInfo -> IO (ProjectInfo, Bool) command |>> continuation = \ info -> do (_, result) <- command info if not result then return (info, result) else continuation info loadConfigs :: CliOptions -> IO () loadConfigs cliOptions@CliOptions{..} = do -- First, we are going to check whether we -- got the valid arguments -- -- let asd = length verbosity verbosityLevel <- getVerbosity let ?debug = verbosityLevel == Loud debugMessage [ "These are the pased command-line options:", " no-build " ++ show no_build, " no-install " ++ show no_install, " pretend " ++ show pretend, " rc-file " ++ show rc_file, " extra-rc-file " ++ show extra_rc_file, " reconfigure " ++ show reconfigure, " " ++ show otherArgs ] when (null otherArgs) $ fatalError [ "No build configuration specified, " ++ "run with --help to see the usage instructions" ] -- Reading the configs let configFile = fromMaybe "kdesrc-buildrc" rc_file let extraConfigFile = fromMaybe "kdesrc-build-extrarc" extra_rc_file config <- C.getConfig configFile extraConfigFile let profileName = head otherArgs when (profileName `notElem` C.availableProfiles config) $ fatalError [ "Unknown build configuration: " ++ profileName ] profile <- C.getProfile config profileName -- And starting the actual work run cliOptions config profile -- | Debugging output debugMessage :: (?debug :: Bool) => [String] -> IO () debugMessage message = when ?debug $ putStr $ unlines message -- | Messages to the user userMessage :: [String] -> IO () userMessage = putStr . unlines -- | Colourize the ok mesages colorOk :: String -> String colorOk msg = setSGRCode [ SetConsoleIntensity BoldIntensity , SetColor Foreground Vivid Green ] ++ msg ++ setSGRCode [] colorHl :: String -> String colorHl msg = setSGRCode [ SetConsoleIntensity BoldIntensity , SetColor Foreground Vivid Yellow ] ++ msg ++ setSGRCode [] colorFail :: String -> String colorFail msg = setSGRCode [ SetConsoleIntensity BoldIntensity , SetColor Foreground Vivid Red ] ++ msg ++ setSGRCode [] logFileForProjct :: String -> String -> String -> String -> String logFileForProjct profileName logDir project suffix = logDir ++ "/latest/" ++ project ++ "/" ++ profileName ++ "-" ++ suffix ++ ".log" -- | Sending error messages fatalError :: [String] -> IO () fatalError messages = do setSGR [ SetConsoleIntensity BoldIntensity , SetColor Foreground Vivid Red ] putStrLn $ "Error: " ++ unlines messages setSGR [] error "Execution terminated." -- | Executing an external program executeCommand :: (?debug :: Bool) => String -> String -> [String] -> String -> String -> IO Bool executeCommand project command arguments_unproc directory logfile = do let arguments = map (\ argument -> replace "$CURRENT_PROJECT" project argument) arguments_unproc userMessage [ "Running " ++ colorHl command ++ " " ++ unwords (take 2 arguments) ++ if null (drop 2 arguments) then "" else "..." ] when (length arguments > 2) $ debugMessage [ "All arguments: " ++ show arguments ] logFileH <- openFile logfile WriteMode hPutStrLn logFileH $ "Running: " ++ command ++ " " ++ unwords arguments hPutStrLn logFileH $ "in: " ++ directory hPutStrLn logFileH "---" (_, _, _, pid) <- createProcess ( proc command arguments ) { cwd = Just directory , std_out = UseHandle logFileH , std_err = UseHandle logFileH } exitCode <- waitForProcess pid hClose logFileH unless ?debug $ do cursorUp 1 clearLine userMessage [ case exitCode of ExitFailure _ -> colorFail project ++ ": " ++ colorHl command ++ " finished " ++ colorFail "with errors" ExitSuccess -> colorOk project ++ ": " ++ colorHl command ++ " finished " ++ colorOk "successfully" ++ " (see " ++ logfile ++ ")" ] return $ case exitCode of ExitFailure _ -> False ExitSuccess -> True main :: IO() main = do -- Getting the command-line options getCliOptions >>= loadConfigs return ()