Main.hs


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

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