module Main where import Data.List (intercalate) import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes) import qualified Distribution.Types.PackageDescription as PD import Distribution.Types.PackageDescription (PackageDescription) import Distribution.Types.BuildType (BuildType(Simple)) import Options.Applicative (execParser) import System.Directory (removeDirectoryRecursive) import System.Exit (die) import System.FilePath (()) import Coolbal.CabalPlan import Coolbal.Configure (configure) import Coolbal.FindSpec import Coolbal.Options import Coolbal.Target import Coolbal.Target.Executable (makeExeTarget) checkCompatibleSpec :: PackageDescription -> IO () checkCompatibleSpec pd | PD.buildType pd /= Simple = die ("Only build type Simple is supported; package uses " ++ show (PD.buildType pd)) | not (null (PD.setupBuildInfo pd)) = die "Custom setup build info unsupported" | otherwise = return () compatibleTargets :: PackageDescription -> CabalPlan -> [AnyTarget] compatibleTargets pd plan = catMaybes (map (\e -> AnyTarget <$> makeExeTarget e plan) (PD.executables pd)) parseCabalPlan' :: FoundCabalSpec -> IO CabalPlan parseCabalPlan' foundSpec = parseCabalPlan (foundcsRootDir foundSpec "dist-newstyle/cache/plan.json") >>= maybe (die "Cabal plan.json not found; make sure to run 'cabal build' beforehand") return doConfigure :: IO () doConfigure = do foundSpec <- findCabalSpec pd <- configure (foundcsCabal foundSpec) checkCompatibleSpec pd plan <- parseCabalPlan' foundSpec -- print pd let names = map (useAnyTarget (\t -> targetName t ++ " (" ++ targetNameQualified t ++ ")")) (compatibleTargets pd plan) putStrLn ("Supported targets: " ++ intercalate ", " names) doClean :: IO () doClean = do foundSpec <- findCabalSpec removeDirectoryRecursive (foundcsRootDir foundSpec "dist-coolbal") doBuild :: BuildOptions -> IO () doBuild (BuildOptions mtarget) = do foundSpec <- findCabalSpec pd <- configure (foundcsCabal foundSpec) checkCompatibleSpec pd plan <- parseCabalPlan' foundSpec let targets = compatibleTargets pd plan targetsForName = Map.fromListWith (++) $ concat [[(targetName t, [at]), (targetNameQualified t, [at])] | at@(AnyTarget t) <- targets] toBuild <- case mtarget of Nothing -> return targets Just name -> case Map.lookup name targetsForName of Nothing -> die ("Target not found: '" ++ name ++ "'") Just [t] -> return [t] Just _ -> die ("Ambiguous target name: '" ++ name ++ "'") mapM_ (useAnyTarget (targetBuild (foundcsRootDir foundSpec))) toBuild main :: IO () main = do options <- execParser optionParser case options of Configure -> doConfigure Clean -> doClean Build opts -> doBuild opts