WIP splitting of Target module and towards parallel buildsHEADmaster

1 files changed, 29 insertions, 28 deletions

diff --git a/Main.hs b/Main.hs
index 463a33b..3d2cf7a 100644
--- a/Main.hs
+++ b/Main.hs
@@ -2,7 +2,6 @@
 module Main where
 
 import Control.Monad (forM_, when)
-import qualified Data.Binary as B
 import Data.Function (on)
 import Data.List (intercalate, groupBy, sortBy)
 import Data.Maybe (catMaybes, fromJust, isJust)
@@ -18,10 +17,12 @@ import System.IO (hPutStrLn, stderr)
 
 import Coolbal.CabalPlan
 import Coolbal.Configure (configure)
+import qualified Coolbal.EnvBinary as B
 import Coolbal.FindRoot
 import Coolbal.Options
 import Coolbal.Target
-import Coolbal.Target.Executable (makeExeTarget)
+import Coolbal.Target.Class
+import Coolbal.Target.Executable.Make (makeExeTarget)
 
 
 checkCompatibleSpec :: PackageDescription -> IO ()
@@ -30,21 +31,21 @@ checkCompatibleSpec pd
   | not (null (PD.setupBuildInfo pd)) = die "Custom setup build info unsupported"
   | otherwise = return ()
 
-compatibleTargets :: PackageDescription -> CabalPlan -> [AnyTarget]
-compatibleTargets pd plan =
-    catMaybes (map (\e -> AnyTargetExe <$> makeExeTarget e plan) (PD.executables pd))
+compatibleTargets :: Flags -> FilePath -> PackageDescription -> CabalPlan -> IO [AnyTarget]
+compatibleTargets flags projdir pd plan =
+    catMaybes <$> mapM (\e -> fmap AnyTargetExe <$> makeExeTarget flags projdir e plan) (PD.executables pd)
 
 parseCabalPlan' :: FoundCabalSpec -> IO CabalPlan
 parseCabalPlan' foundSpec = 
     parseCabalPlan (foundcsRootDir foundSpec </> "dist-newstyle/cache/plan.json")
-        >>= \case NotFound -> die "Cabal plan.json not found; make sure to run 'cabal build' beforehand"
+        >>= \case NotFound -> die "Cabal plan.json not found; make sure to run 'cabal configure' beforehand"
                   ParseError e -> die ("Error when parsing Cabal plan.json: " ++ e)
                   Parsed plan -> return plan
 
 readCachedTargets :: (AnyTarget -> Bool) -> IO (FilePath, [AnyTarget], [(String, [AnyTarget])])
 readCachedTargets predicate = do
     FoundRootDir rootdir <- findDist
-    allTargets <- B.decodeFile (rootdir </> "dist-coolbal/targets.bin")
+    allTargets <- B.decodeFile (RestoreEnv { reProjDir = rootdir }) (rootdir </> "dist-coolbal/targets.bin")
     let targets = filter predicate allTargets
         targetsForName = map ((,) <$> fst . head <*> map snd)
                          $ groupBy ((==) `on` fst)
@@ -61,15 +62,15 @@ targetsToBuild targetsForName name =
       Just [t] -> return [t]
       Just _ -> die ("Ambiguous target name: '" ++ name ++ "'")
 
-doConfigure :: IO ()
-doConfigure = do
+doConfigure :: Flags -> IO ()
+doConfigure flags= do
     foundSpec <- findCabalSpec
     pd <- configure (foundcsCabal foundSpec)
     checkCompatibleSpec pd
     plan <- parseCabalPlan' foundSpec
     -- print pd
-    let targets = compatibleTargets pd plan
-        names = map (useAnyTarget (\t -> targetName t ++ " (" ++ targetNameQualified t ++ ")")) targets
+    targets <- compatibleTargets flags (foundcsRootDir foundSpec) pd plan
+    let names = map (useAnyTarget (\t -> targetName t ++ " (" ++ targetNameQualified t ++ ")")) targets
     hPutStrLn stderr ("Supported targets: " ++ intercalate ", " names)
 
     createDirectoryIfMissing True (foundcsRootDir foundSpec </> "dist-coolbal")
@@ -80,32 +81,32 @@ doClean = do
     foundSpec <- findCabalSpec
     removeDirectoryRecursive (foundcsRootDir foundSpec </> "dist-coolbal")
 
-doBuild :: BuildOptions -> IO ()
-doBuild (BuildOptions mtarget) = do
+doBuild :: Flags -> BuildOptions -> IO ()
+doBuild flags (BuildOptions mtarget) = do
     (rootdir, targets, targetsForName) <- readCachedTargets (const True)
     toBuild <- maybe (return targets) (targetsToBuild targetsForName) mtarget
     forM_ toBuild $ useAnyTarget $ \tg -> do
         old <- targetCheckOld rootdir tg
-        when old $ targetBuild rootdir tg
+        when old $ targetBuild flags tg
 
-doRebuild :: BuildOptions -> IO ()
-doRebuild (BuildOptions mtarget) = do
+doRebuild :: Flags -> BuildOptions -> IO ()
+doRebuild flags (BuildOptions mtarget) = do
     (rootdir, targets, targetsForName) <- readCachedTargets (const True)
     toBuild <- maybe (return targets) (targetsToBuild targetsForName) mtarget
     forM_ toBuild $ useAnyTarget $ \tg -> do
         targetRemoveBuildArtifacts rootdir tg
-        targetBuild rootdir tg
+        targetBuild flags tg
 
-doRun :: RunOptions -> IO ()
-doRun (RunOptions mtarget args) = do
-    (rootdir, targets, targetsForName) <- readCachedTargets (isJust . useAnyTarget targetExecute)
+doRun :: Flags -> RunOptions -> IO ()
+doRun flags (RunOptions mtarget args) = do
+    (rootdir, targets, targetsForName) <- readCachedTargets (isJust . useAnyTarget (targetExecute flags))
     toBuild <- maybe (return targets) (targetsToBuild targetsForName) mtarget
     case toBuild of
       [tg] -> do
           useAnyTarget (\tg' -> do old <- targetCheckOld rootdir tg'
-                                   when old $ targetBuild rootdir tg'
+                                   when old $ targetBuild flags tg'
                                    -- when (not old) $ putStrLn "Up to date"
-                                   fromJust (targetExecute tg') rootdir args)
+                                   fromJust (targetExecute flags tg') args)
                        tg
 
       _ -> do
@@ -113,10 +114,10 @@ doRun (RunOptions mtarget args) = do
 
 main :: IO ()
 main = do
-    options <- execParser optionParser
-    case options of
-      Configure -> doConfigure
+    Options flags command <- execParser optionParser
+    case command of
+      Configure -> doConfigure flags
       Clean -> doClean
-      Build opts -> doBuild opts
-      Rebuild opts -> doRebuild opts
-      Run opts -> doRun opts
+      Build opts -> doBuild flags opts
+      Rebuild opts -> doRebuild flags opts
+      Run opts -> doRun flags opts