diff options
Diffstat (limited to 'Main.hs')
| -rw-r--r-- | Main.hs | 57 |
1 files changed, 29 insertions, 28 deletions
@@ -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 |