From 1a7c345d3d530c566840c72f59a932f292cefd09 Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom@tomsmeding.com>
Date: Wed, 17 Feb 2021 16:01:53 +0100
Subject: Initial

---
 Main.hs | 78 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 78 insertions(+)
 create mode 100644 Main.hs

(limited to 'Main.hs')

diff --git a/Main.hs b/Main.hs
new file mode 100644
index 0000000..0ed4f4c
--- /dev/null
+++ b/Main.hs
@@ -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
-- 
cgit v1.2.3-70-g09d2