summaryrefslogtreecommitdiff
path: root/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Main.hs')
-rw-r--r--Main.hs78
1 files changed, 55 insertions, 23 deletions
diff --git a/Main.hs b/Main.hs
index 0ed4f4c..5cbf592 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,19 +1,22 @@
module Main where
-import Data.List (intercalate)
-import qualified Data.Map.Strict as Map
-import Data.Maybe (catMaybes)
+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)
+import Data.Ord (comparing)
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.Directory (createDirectoryIfMissing, removeDirectoryRecursive)
import System.Exit (die)
import System.FilePath ((</>))
import Coolbal.CabalPlan
import Coolbal.Configure (configure)
-import Coolbal.FindSpec
+import Coolbal.FindRoot
import Coolbal.Options
import Coolbal.Target
import Coolbal.Target.Executable (makeExeTarget)
@@ -27,7 +30,7 @@ checkCompatibleSpec pd
compatibleTargets :: PackageDescription -> CabalPlan -> [AnyTarget]
compatibleTargets pd plan =
- catMaybes (map (\e -> AnyTarget <$> makeExeTarget e plan) (PD.executables pd))
+ catMaybes (map (\e -> AnyTargetExe <$> makeExeTarget e plan) (PD.executables pd))
parseCabalPlan' :: FoundCabalSpec -> IO CabalPlan
parseCabalPlan' foundSpec =
@@ -35,6 +38,26 @@ parseCabalPlan' foundSpec =
>>= maybe (die "Cabal plan.json not found; make sure to run 'cabal build' beforehand")
return
+readCachedTargets :: (AnyTarget -> Bool) -> IO (FilePath, [AnyTarget], [(String, [AnyTarget])])
+readCachedTargets predicate = do
+ FoundRootDir rootdir <- findDist
+ allTargets <- B.decodeFile (rootdir </> "dist-coolbal/targets.bin")
+ let targets = filter predicate allTargets
+ targetsForName = map ((,) <$> fst . head <*> map snd)
+ $ groupBy ((==) `on` fst)
+ $ sortBy (comparing fst)
+ $ concat
+ [[(useAnyTarget targetName t, t), (useAnyTarget targetNameQualified t, t)]
+ | t <- targets]
+ return (rootdir, targets, targetsForName)
+
+targetsToBuild :: [(String, [AnyTarget])] -> String -> IO [AnyTarget]
+targetsToBuild targetsForName name =
+ case lookup name targetsForName of
+ Nothing -> die ("Target not found: '" ++ name ++ "'")
+ Just [t] -> return [t]
+ Just _ -> die ("Ambiguous target name: '" ++ name ++ "'")
+
doConfigure :: IO ()
doConfigure = do
foundSpec <- findCabalSpec
@@ -42,10 +65,13 @@ doConfigure = do
checkCompatibleSpec pd
plan <- parseCabalPlan' foundSpec
-- print pd
- let names = map (useAnyTarget (\t -> targetName t ++ " (" ++ targetNameQualified t ++ ")"))
- (compatibleTargets pd plan)
+ let targets = compatibleTargets pd plan
+ names = map (useAnyTarget (\t -> targetName t ++ " (" ++ targetNameQualified t ++ ")")) targets
putStrLn ("Supported targets: " ++ intercalate ", " names)
+ createDirectoryIfMissing True (foundcsRootDir foundSpec </> "dist-coolbal")
+ B.encodeFile (foundcsRootDir foundSpec </> "dist-coolbal/targets.bin") targets
+
doClean :: IO ()
doClean = do
foundSpec <- findCabalSpec
@@ -53,21 +79,26 @@ doClean = do
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
+ (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
+
+doRun :: RunOptions -> IO ()
+doRun (RunOptions mtarget args) = do
+ (rootdir, targets, targetsForName) <- readCachedTargets (isJust . useAnyTarget targetExecute)
+ 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 (not old) $ putStrLn "Up to date"
+ fromJust (targetExecute tg') rootdir args)
+ tg
+
+ _ -> do
+ die "Cannot determine which target to run, multiple executables found"
main :: IO ()
main = do
@@ -76,3 +107,4 @@ main = do
Configure -> doConfigure
Clean -> doClean
Build opts -> doBuild opts
+ Run opts -> doRun opts