diff options
author | Tom Smeding <tom@tomsmeding.com> | 2021-02-17 16:01:53 +0100 |
---|---|---|
committer | Tom Smeding <tom@tomsmeding.com> | 2021-02-17 16:01:53 +0100 |
commit | 1a7c345d3d530c566840c72f59a932f292cefd09 (patch) | |
tree | a9a5d4d96b6ae0fcd0f632f427b52ed0c9fe954a /Main.hs |
Initial
Diffstat (limited to 'Main.hs')
-rw-r--r-- | Main.hs | 78 |
1 files changed, 78 insertions, 0 deletions
@@ -0,0 +1,78 @@ +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 |