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