From f57e800a1d1a8e9f2bed34428f7f58a375f178fb Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Sun, 11 Jul 2021 17:56:34 +0200 Subject: WIP splitting of Target module and towards parallel builds --- Main.hs | 57 +++++++++++++++++++++++++++++---------------------------- 1 file changed, 29 insertions(+), 28 deletions(-) (limited to 'Main.hs') 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 -- cgit v1.2.3-70-g09d2