diff options
Diffstat (limited to 'Coolbal/Target/Executable.hs')
-rw-r--r-- | Coolbal/Target/Executable.hs | 254 |
1 files changed, 212 insertions, 42 deletions
diff --git a/Coolbal/Target/Executable.hs b/Coolbal/Target/Executable.hs index 725b057..0f856c6 100644 --- a/Coolbal/Target/Executable.hs +++ b/Coolbal/Target/Executable.hs @@ -1,42 +1,212 @@ -module Coolbal.Target.Executable (makeExeTarget) where - -import Data.List (find) -import Distribution.Compiler (perCompilerFlavorToList, CompilerFlavor(GHC)) -import qualified Distribution.ModuleName as Module -import Distribution.Types.BuildInfo (BuildInfo(..)) -import Distribution.Types.Executable (Executable(..)) -import Distribution.Types.ExecutableScope (ExecutableScope(ExecutablePublic)) -import Distribution.Types.UnqualComponentName (unUnqualComponentName) -import Language.Haskell.Extension (knownLanguages) - -import Coolbal.CabalPlan -import Coolbal.Directory -import Coolbal.Target - - -makeExeTarget :: Executable -> CabalPlan -> Maybe ExeTarget -makeExeTarget exe plan - | exeScope exe == ExecutablePublic - , let bi = buildInfo exe - , buildable bi - , all (null . ($ bi)) [asmSources, cmmSources, cSources, cxxSources, jsSources] - , all (null . ($ bi)) [virtualModules, autogenModules] - , null (defaultExtensions bi) - , all (null . ($ bi)) [extraLibs, extraBundledLibs] - , let name = unUnqualComponentName (exeName exe) - , Just planpkg@Configured{} <- find ((== name) . ppName) (planPackages plan) - , Just language <- defaultLanguage bi - , True <- language `elem` knownLanguages - , Just flags <- lookup GHC (perCompilerFlavorToList (options bi)) - , Just deps <- ppDepends planpkg - = Just (ExeTarget - { exeTargetName = unUnqualComponentName (exeName exe) - , exeTargetPkgDbDir = currentHomeDirectory ++ "/.cabal/store/" ++ planCompiler plan ++ "/package.db" - , exeTargetDeps = deps - , exeTargetLanguage = show language - , exeTargetMain = modulePath exe - , exeTargetSrcDirs = hsSourceDirs bi - , exeTargetModules = map Module.components (otherModules bi) - , exeTargetFlags = flags - }) - | otherwise = Nothing +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} +module Coolbal.Target.Executable where + +import Control.DeepSeq (deepseq) +import Data.Binary +import Data.List (intercalate) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import GHC.Generics (Generic) +import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive) +import System.Exit (die, exitWith) +import System.FilePath ((</>), makeRelative) +import System.IO.Error (catchIOError) +import System.IO.Temp + +import Coolbal.Options (Flags) +import Coolbal.DataVersionTag +import Coolbal.EnvBinary +import Coolbal.Log +import Coolbal.MakeParse +import Coolbal.Process +import Coolbal.Target.Class +import Coolbal.Target.Utils + + +data ExeTarget = ExeTarget + { etName :: String + -- ^ Target name, and name of output executable file + , etPkgDbDir :: FilePath + -- ^ Absolute path to the package.db directory + , etDeps :: [String] + -- ^ Package identifiers of dependencies (for -package-id flags) + , etLanguage :: String + -- ^ Haskell language (e.g. Haskell2010) + , etMain :: FilePath + -- ^ Main file + , etSrcDirs :: [FilePath] + -- ^ Source directories + , etFlags :: [String] + -- ^ User-specified compiler flags + , etModGraph :: Map [String] [[String]] + -- ^ Dependency graph of other modules in the target + + , etModules :: [[String]] + -- ^ List of other modules in the target + , etProjDir :: FilePath + -- ^ Project root directory (absolute path) + , etBuildDir :: FilePath + -- ^ Build directory (absolute path) + , etBinDir :: FilePath + -- ^ Binary target directory (absolute path) + , etBinFile :: FilePath + -- ^ Target executable file path (absolute path) + , etBaseFlags :: [String] + -- ^ Base flags for GHC (excluding --make, module/file list, -c/-o) + } + deriving (Show) + +data ExeTargetStore' mods = ExeTargetStore + { _etsVersionTag :: DataVersionTag 1 + , etsName :: String + -- ^ Target name, and name of output executable file + , etsPkgDbDir :: FilePath + -- ^ Absolute path to the package.db directory + , etsDeps :: [String] + -- ^ Package identifiers of dependencies (for -package-id flags) + , etsLanguage :: String + -- ^ Haskell language (e.g. Haskell2010) + , etsMain :: FilePath + -- ^ Main file + , etsSrcDirs :: [FilePath] + -- ^ Source directories + , etsFlags :: [String] + -- ^ User-specified compiler flags + , etsModules :: mods + -- ^ Dependency graph of other modules in the target + } + +type ExeTargetStorePre = ExeTargetStore' [[String]] +type ExeTargetStore = ExeTargetStore' (Map [String] [[String]]) + +deriving instance Generic ExeTargetStore + +instance Binary ExeTargetStore + +instance EnvBinary RestoreEnv ExeTarget where + envget renv = elaborateExeTarget renv <$> get + envput = put . unelabExeTarget + +elaborateExeTargetWithEBS :: ExeBuildSetup -> ExeTargetStore -> ExeTarget +elaborateExeTargetWithEBS ebs tg = ExeTarget + { etName = etsName tg + , etPkgDbDir = etsPkgDbDir tg + , etDeps = etsDeps tg + , etLanguage = etsLanguage tg + , etMain = etsMain tg + , etSrcDirs = etsSrcDirs tg + , etFlags = etsFlags tg + , etModGraph = etsModules tg + + , etModules = Map.keys (etsModules tg) + , etProjDir = ebsProjDir ebs + , etBuildDir = ebsBuildDir ebs + , etBinDir = ebsBinDir ebs + , etBinFile = ebsBinFile ebs + , etBaseFlags = ebsBaseFlags ebs + } + +elaborateExeTarget :: RestoreEnv -> ExeTargetStore -> ExeTarget +elaborateExeTarget RestoreEnv{reProjDir=projdir} tg = + let ebs = exeBuildSetup projdir (tg { etsModules = Map.keys (etsModules tg) }) + in elaborateExeTargetWithEBS ebs tg + +unelabExeTarget :: ExeTarget -> ExeTargetStore +unelabExeTarget tg = ExeTargetStore + { _etsVersionTag = DataVersionTag + , etsName = etName tg + , etsPkgDbDir = etPkgDbDir tg + , etsDeps = etDeps tg + , etsLanguage = etLanguage tg + , etsMain = etMain tg + , etsSrcDirs = etSrcDirs tg + , etsFlags = etFlags tg + , etsModules = etModGraph tg + } + +instance IsTarget ExeTarget where + targetName = etName + targetPrefix _ = "exe" + + targetCheckOld projdir tg = do + mbinTm <- maybeModificationTime (projdir </> "dist-coolbal/bin" </> escapeFileName (etName tg)) + case mbinTm of + Just binTm -> do + anyNewerThan binTm (findFile' (etSrcDirs tg) (etMain tg) + : [findSourceFile' (etSrcDirs tg) m | m <- etModules tg]) + Nothing -> + return True + + targetBuild flags tg = do + createDirectoryIfMissing True (etBinDir tg) + -- To build only a single module instead of the whole executable: remove etMain and add only the right module of etModules; add -c; remove -o. + runCommand flags "ghc" (concat + [["--make"] + ,etBaseFlags tg + ,[etMain tg] + ,map (intercalate ".") (etModules tg) + ,["-o", etBinFile tg]]) + >>= checkExitCode + + targetExecute flags tg = Just $ \args -> do + let filename = escapeFileName (etName tg) + runCommand flags (etProjDir tg </> "dist-coolbal/bin" </> filename) args + >>= exitWith + + targetRemoveBuildArtifacts projdir tg = + removeDirectoryRecursive + (projdir </> "dist-coolbal/build" + </> escapeFileName (targetNameQualifiedFilename tg)) + `catchIOError` (\_ -> return ()) + +data ExeBuildSetup = ExeBuildSetup + { ebsProjDir :: FilePath + , ebsBuildDir :: FilePath + , ebsBinDir :: FilePath + , ebsBinFile :: FilePath + , ebsBaseFlags :: [String] + } + +exeBuildSetup :: FilePath -> ExeTargetStorePre -> ExeBuildSetup +exeBuildSetup projdir tg = + let buildDir = projdir </> "dist-coolbal/build" + </> escapeFileName (buildQualifiedName "exe" (etsName tg)) + binDir = projdir </> "dist-coolbal/bin" + in ExeBuildSetup + { ebsProjDir = projdir + , ebsBuildDir = buildDir + , ebsBinDir = binDir + , ebsBinFile = binDir </> escapeFileName (etsName tg) + , ebsBaseFlags = concat + [["-static"] + ,concat [[flag, buildDir] + | flag <- ["-outputdir", "-odir", "-hidir", "-stubdir"]] + ,["-i" ++ dir | dir <- etsSrcDirs tg] + ,["-hide-all-packages", "-Wmissing-home-modules", "-no-user-package-db"] + ,["-package-db", etsPkgDbDir tg] + ,concat [["-package-id", dep] | dep <- etsDeps tg] + ,["-X" ++ etsLanguage tg] + ,etsFlags tg] + } + +exeDepGraph :: Flags -> ExeTargetStorePre -> ExeBuildSetup -> IO (Map [String] [[String]]) +exeDepGraph flags tg ebs = do + output <- withSystemTempDirectory "coolbal-make" $ \tmpdir -> do + let fname = tmpdir </> "Makefile" + runCommand flags "ghc" (concat + [ebsBaseFlags ebs + ,[etsMain tg] + ,map (intercalate ".") (etsModules tg) + ,["-M", "-dep-suffix", "", "-dep-makefile", fname]]) + >>= checkExitCode + output <- readFile fname + output `deepseq` return output + case parseGHCmake (ebsProjDir ebs) (makeRelative (ebsProjDir ebs) (ebsBuildDir ebs)) output of + Left err -> die err + Right m -> logVerbose flags "depgraph:graph" (show m) >> return m |