1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
{-# LANGUAGE LambdaCase #-}
module Main where
import Control.Monad (forM_, when)
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 (createDirectoryIfMissing, removeDirectoryRecursive)
import System.Exit (die)
import System.FilePath ((</>))
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.Class
import Coolbal.Target.Executable.Make (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 :: 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 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 (RestoreEnv { reProjDir = rootdir }) (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 :: Flags -> IO ()
doConfigure flags= do
foundSpec <- findCabalSpec
pd <- configure (foundcsCabal foundSpec)
checkCompatibleSpec pd
plan <- parseCabalPlan' foundSpec
-- print pd
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")
B.encodeFile (foundcsRootDir foundSpec </> "dist-coolbal/targets.bin") targets
doClean :: IO ()
doClean = do
foundSpec <- findCabalSpec
removeDirectoryRecursive (foundcsRootDir foundSpec </> "dist-coolbal")
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 flags tg
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 flags tg
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 flags tg'
-- when (not old) $ putStrLn "Up to date"
fromJust (targetExecute flags tg') args)
tg
_ -> do
die "Cannot determine which target to run, multiple executables found"
main :: IO ()
main = do
Options flags command <- execParser optionParser
case command of
Configure -> doConfigure flags
Clean -> doClean
Build opts -> doBuild flags opts
Rebuild opts -> doRebuild flags opts
Run opts -> doRun flags opts
|