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
|
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
module Coolbal.Target (
IsTarget(..),
AnyTarget(..),
ExeTarget(..),
useAnyTarget,
) where
import Data.Char (ord)
import Data.List (intercalate)
import Numeric (showHex)
import System.Directory (createDirectoryIfMissing)
import System.Exit (ExitCode(..), die)
import System.FilePath ((</>))
import System.Process (rawSystem)
import Coolbal.Util
class IsTarget a where
-- | The name of the target.
targetName :: a -> String
-- | The name of the target, qualified with a cabal-style prefix indicating the kind of target.
targetNameQualified :: a -> String
-- | The name of the target, qualified with a cabal-style prefix indicating
-- the kind of target, except that the ':' is rendered as a '-'.
targetNameQualifiedFilename :: a -> FilePath
targetNameQualifiedFilename tg = case break (== ':') (targetNameQualified tg) of
(pre, ':' : post) -> pre ++ '-' : post
_ -> error "targetNameQualifiedFilename: unexpected form of targetNameQualified"
-- | Check whether the target must be recompiled due to changes on disk.
-- Argument is the root directory of the project.
targetCheckOld :: FilePath -> a -> IO Bool
-- | Recompile the target. Argument is the root directory of the project.
targetBuild :: FilePath -> a -> IO ()
data AnyTarget = forall a. (Show a, IsTarget a) => AnyTarget a
deriving instance Show AnyTarget
useAnyTarget :: (forall a. (Show a, IsTarget a) => a -> r) -> AnyTarget -> r
useAnyTarget f (AnyTarget x) = f x
data ExeTarget = ExeTarget
{ exeTargetName :: String
-- ^ Target name, and name of output executable file
, exeTargetPkgDbDir :: FilePath
-- ^ Absolute path to the package.db directory
, exeTargetDeps :: [String]
-- ^ Package identifiers of dependencies (for -package-id flags)
, exeTargetLanguage :: String
-- ^ Haskell language (e.g. Haskell2010)
, exeTargetMain :: FilePath
-- ^ Main file
, exeTargetModules :: [[String]]
-- ^ Other modules in the target
, exeTargetFlags :: [String]
-- ^ User-specified compiler flags
}
deriving (Show)
instance IsTarget ExeTarget where
targetName = exeTargetName
targetNameQualified e = "exe:" ++ targetName e
targetCheckOld _ _ = return True
targetBuild projdir tg = do
let buildDir = projdir </> "dist-coolbal/build"
</> escapeFileName (targetNameQualifiedFilename tg)
binDir = projdir </> "dist-coolbal/bin"
binName = binDir </> escapeFileName (exeTargetName tg)
createDirectoryIfMissing True binDir
rawSystem "ghc" (concat
[["--make", "-static"]
,concat [[flag, buildDir]
| flag <- ["-outputdir", "-odir", "-hidir", "-stubdir"]]
,["-i" ++ buildDir, "-I" ++ buildDir]
,["-hide-all-packages", "-Wmissing-home-modules", "-no-user-package-db"]
,["-package-db", exeTargetPkgDbDir tg]
,concat [["-package-id", dep] | dep <- exeTargetDeps tg]
,["-X" ++ exeTargetLanguage tg]
,[exeTargetMain tg]
,map (intercalate ".") (exeTargetModules tg)
,["-o", binName]
,exeTargetFlags tg])
>>= checkExitCode "ghc"
checkExitCode :: String -> ExitCode -> IO ()
checkExitCode _ ExitSuccess = return ()
checkExitCode procname (ExitFailure c) =
die (procname ++ " exited with code " ++ show c)
escapeFileName :: String -> FilePath
escapeFileName =
-- NTFS/POSIX not allows: 0x00-0x1F 0x7F- : / " * < > ? \ |
-- We use ! as an escape character, and hence disallow that too.
genericEscapeString
(\c -> let n = ord c
in n <= 0x1F || n >= 0x7F || c `elem` ":/\"*<>?\\|!")
(\c -> case (c, ord c) of
('!', _) -> "!!"
(_, n) | n <= 0xFF -> '!' : showHex n ""
| n <= 0xFFFF -> '!' : 'u' : showHex n ""
| n <= 0xFFFFFF -> '!' : 'U' : showHex n ""
| otherwise -> error "Super-high unicode?")
|
