on bc018b1 help sign in
Idris-dev/Setup.hs
350 lines 14 kB history raw
1{-# LANGUAGE CPP #-}
3#if !defined(MIN_VERSION_Cabal)
4# define MIN_VERSION_Cabal(x,y,z) 0
5#endif
7import Control.Monad
8import Data.IORef
9import Control.Exception (SomeException, catch)
11import Distribution.Simple
12import Distribution.Simple.BuildPaths
13import Distribution.Simple.InstallDirs as I
14import Distribution.Simple.LocalBuildInfo as L
15import qualified Distribution.Simple.Setup as S
16import qualified Distribution.Simple.Program as P
17import Distribution.Simple.Utils (createDirectoryIfMissingVerbose, rewriteFile, notice, installOrdinaryFiles)
18import Distribution.Compiler
19import Distribution.PackageDescription
20import Distribution.Text
21import Distribution.Verbosity
23import System.Environment
24import System.Exit
25import System.FilePath ((</>), splitDirectories,isAbsolute)
26import System.Directory
27import qualified System.FilePath.Posix as Px
28import System.Process
30#if (MIN_VERSION_Cabal(2,0,0))
31import Distribution.Types.UnqualComponentName
32#endif
35-- After Idris is built, we need to check and install the prelude and other libs
37-- -----------------------------------------------------------------------------
38-- Idris Command Path
40-- make on mingw32 exepects unix style separators
41#ifdef mingw32_HOST_OS
42(<//>) = (Px.</>)
43idrisCmd local = Px.joinPath $ splitDirectories $ ".." <//> ".." <//> buildDir local <//> "idris" <//> "idris"
44#else
45idrisCmd local = ".." </> ".." </> buildDir local </> "idris" </> "idris"
46#endif
48-- -----------------------------------------------------------------------------
49-- Make Commands
51-- use GNU make on FreeBSD
52#if defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS)\
53 || defined(openbsd_HOST_OS) || defined(netbsd_HOST_OS)
54mymake = "gmake"
55#else
56mymake = "make"
57#endif
58make verbosity =
59 P.runProgramInvocation verbosity . P.simpleProgramInvocation mymake
61#ifdef mingw32_HOST_OS
62windres verbosity = P.runProgramInvocation verbosity . P.simpleProgramInvocation "windres"
63#endif
64-- -----------------------------------------------------------------------------
65-- Flags
67usesGMP :: S.ConfigFlags -> Bool
68usesGMP flags =
69 case lookup (mkFlagName "gmp") (S.configConfigurationsFlags flags) of
70 Just True -> True
71 Just False -> False
72 Nothing -> False
74execOnly :: S.ConfigFlags -> Bool
75execOnly flags =
76 case lookup (mkFlagName "execonly") (S.configConfigurationsFlags flags) of
77 Just True -> True
78 Just False -> False
79 Nothing -> False
81isRelease :: S.ConfigFlags -> Bool
82isRelease flags =
83 case lookup (mkFlagName "release") (S.configConfigurationsFlags flags) of
84 Just True -> True
85 Just False -> False
86 Nothing -> False
88isFreestanding :: S.ConfigFlags -> Bool
89isFreestanding flags =
90 case lookup (mkFlagName "freestanding") (S.configConfigurationsFlags flags) of
91 Just True -> True
92 Just False -> False
93 Nothing -> False
95#if !(MIN_VERSION_Cabal(2,0,0))
96mkFlagName :: String -> FlagName
97mkFlagName = FlagName
98#endif
100-- -----------------------------------------------------------------------------
101-- Clean
103idrisClean _ flags _ _ = cleanStdLib
104 where
105 verbosity = S.fromFlag $ S.cleanVerbosity flags
107 cleanStdLib = makeClean "libs"
109 makeClean dir = make verbosity [ "-C", dir, "clean", "IDRIS=idris" ]
111-- -----------------------------------------------------------------------------
112-- Configure
114gitHash :: IO String
115gitHash = do h <- Control.Exception.catch (readProcess "git" ["rev-parse", "--short", "HEAD"] "")
116 (\e -> let e' = (e :: SomeException) in return "PRE")
117 return $ takeWhile (/= '\n') h
119-- Generate a module that contains extra library directories passed
120-- via command-line to cabal
121generateBuildFlagsModule :: Verbosity -> FilePath -> [String] -> IO ()
122generateBuildFlagsModule verbosity dir libdirs = do
123 let buildFlagsModulePath = dir </> "BuildFlags_idris" Px.<.> "hs"
124 putStrLn $ "Generating " ++ buildFlagsModulePath
125 createDirectoryIfMissingVerbose verbosity True dir
126 rewriteFile buildFlagsModulePath contents
127 where contents = "module BuildFlags_idris where \n\n" ++
128 "extraLibDirs :: [String]\n" ++
129 "extraLibDirs = " ++ show libdirs
131-- Put the Git hash into a module for use in the program
132-- For release builds, just put the empty string in the module
133generateVersionModule verbosity dir release = do
134 hash <- gitHash
135 let versionModulePath = dir </> "Version_idris" Px.<.> "hs"
136 putStrLn $ "Generating " ++ versionModulePath ++
137 if release then " for release" else " for prerelease " ++ hash
138 createDirectoryIfMissingVerbose verbosity True dir
139 rewriteFile versionModulePath (versionModuleContents hash)
141 where versionModuleContents h = "module Version_idris where\n\n" ++
142 "gitHash :: String\n" ++
143 if release
144 then "gitHash = \"\"\n"
145 else "gitHash = \"git:" ++ h ++ "\"\n"
147-- Generate a module that contains the lib path for a freestanding Idris
148generateTargetModule verbosity dir targetDir = do
149 let absPath = isAbsolute targetDir
150 let targetModulePath = dir </> "Target_idris" Px.<.> "hs"
151 putStrLn $ "Generating " ++ targetModulePath
152 createDirectoryIfMissingVerbose verbosity True dir
153 rewriteFile targetModulePath (versionModuleContents absPath targetDir)
154 where versionModuleContents absolute td = "module Target_idris where\n\n" ++
155 "import System.FilePath\n" ++
156 "import System.Environment\n" ++
157 "getDataDir :: IO String\n" ++
158 if absolute
159 then "getDataDir = return \"" ++ td ++ "\"\n"
160 else "getDataDir = do \n" ++
161 " expath <- getExecutablePath\n" ++
162 " execDir <- return $ dropFileName expath\n" ++
163 " return $ execDir ++ \"" ++ td ++ "\"\n"
164 ++ "getDataFileName :: FilePath -> IO FilePath\n"
165 ++ "getDataFileName name = do\n"
166 ++ " dir <- getDataDir\n"
167 ++ " return (dir ++ \"/\" ++ name)"
169-- a module that has info about existence and location of a bundled toolchain
170generateToolchainModule verbosity srcDir toolDir = do
171 let commonContent = "module Tools_idris where\n\n"
172 let toolContent = case toolDir of
173 Just dir -> "hasBundledToolchain = True\n" ++
174 "getToolchainDir = \"" ++ dir ++ "\"\n"
175 Nothing -> "hasBundledToolchain = False\n" ++
176 "getToolchainDir = \"\""
177 let toolPath = srcDir </> "Tools_idris" Px.<.> "hs"
178 createDirectoryIfMissingVerbose verbosity True srcDir
179 rewriteFile toolPath (commonContent ++ toolContent)
181idrisConfigure _ flags pkgdesc local = do
182 configureRTS
183 withLibLBI pkgdesc local $ \lib libcfg -> do
184 let libAutogenDir = autogenComponentModulesDir local libcfg
185 let libDirs = extraLibDirs $ libBuildInfo lib
186 generateBuildFlagsModule verbosity libAutogenDir libDirs
187 generateVersionModule verbosity libAutogenDir (isRelease (configFlags local))
188 if isFreestanding $ configFlags local
189 then do
190 toolDir <- lookupEnv "IDRIS_TOOLCHAIN_DIR"
191 generateToolchainModule verbosity libAutogenDir toolDir
192 targetDir <- lookupEnv "IDRIS_LIB_DIR"
193 case targetDir of
194 Just d -> generateTargetModule verbosity libAutogenDir d
195 Nothing -> error $ "Trying to build freestanding without a target directory."
196 ++ " Set it by defining IDRIS_LIB_DIR."
197 else
198 generateToolchainModule verbosity libAutogenDir Nothing
199 where
200 verbosity = S.fromFlag $ S.configVerbosity flags
201 version = pkgVersion . package $ localPkgDescr local
203 -- This is a hack. I don't know how to tell cabal that a data file needs
204 -- installing but shouldn't be in the distribution. And it won't make the
205 -- distribution if it's not there, so instead I just delete
206 -- the file after configure.
207 configureRTS = make verbosity ["-C", "rts", "clean"]
209#if !(MIN_VERSION_Cabal(2,0,0))
210 autogenComponentModulesDir lbi _ = autogenModulesDir lbi
211#endif
213idrisPreSDist args flags = do
214 let dir = S.fromFlag (S.sDistDirectory flags)
215 let verb = S.fromFlag (S.sDistVerbosity flags)
216 generateVersionModule verb "src" True
217 generateBuildFlagsModule verb "src" []
218 generateTargetModule verb "src" "./libs"
219 generateToolchainModule verb "src" Nothing
220 preSDist simpleUserHooks args flags
222idrisSDist sdist pkgDesc bi hooks flags = do
223 pkgDesc' <- addGitFiles pkgDesc
224 sdist pkgDesc' bi hooks flags
225 where
226 addGitFiles :: PackageDescription -> IO PackageDescription
227 addGitFiles pkgDesc = do
228 files <- gitFiles
229 return $ pkgDesc { extraSrcFiles = extraSrcFiles pkgDesc ++ files}
230 gitFiles :: IO [FilePath]
231 gitFiles = liftM lines (readProcess "git" ["ls-files"] "")
233idrisPostSDist args flags desc lbi = do
234 Control.Exception.catch (do let file = "src" </> "Version_idris" Px.<.> "hs"
235 let targetFile = "src" </> "Target_idris" Px.<.> "hs"
236 putStrLn $ "Removing generated modules:\n "
237 ++ file ++ "\n" ++ targetFile
238 removeFile file
239 removeFile targetFile)
240 (\e -> let e' = (e :: SomeException) in return ())
241 postSDist simpleUserHooks args flags desc lbi
243-- -----------------------------------------------------------------------------
244-- Build
246getVersion :: Args -> S.BuildFlags -> IO HookedBuildInfo
247getVersion args flags = do
248 hash <- gitHash
249 let buildinfo = (emptyBuildInfo { cppOptions = ["-DVERSION="++hash] }) :: BuildInfo
250 return (Just buildinfo, [])
253#if !(MIN_VERSION_Cabal(2,0,0))
254mkUnqualComponentName = id
255#endif
257idrisPreBuild args flags = do
258#ifdef mingw32_HOST_OS
259 createDirectoryIfMissingVerbose verbosity True dir
260 windres verbosity ["icons/idris_icon.rc","-o", dir++"/idris_icon.o"]
261 return (Nothing, [(mkUnqualComponentName "idris", emptyBuildInfo { ldOptions = [dir ++ "/idris_icon.o"] })])
262 where
263 verbosity = S.fromFlag $ S.buildVerbosity flags
264 dir = S.fromFlagOrDefault "dist" $ S.buildDistPref flags
265#else
266 return (Nothing, [])
267#endif
269idrisBuild _ flags _ local
270 = if (execOnly (configFlags local)) then buildRTS
271 else do buildStdLib
272 buildRTS
273 where
274 verbosity = S.fromFlag $ S.buildVerbosity flags
276 buildStdLib = do
277 putStrLn "Building libraries..."
278 makeBuild "libs"
279 where
280 makeBuild dir = make verbosity [ "-C", dir, "build" , "IDRIS=" ++ idrisCmd local]
282 buildRTS = make verbosity (["-C", "rts", "build"] ++
283 gmpflag (usesGMP (configFlags local)))
285 gmpflag False = []
286 gmpflag True = ["GMP=-DIDRIS_GMP"]
288-- -----------------------------------------------------------------------------
289-- Copy/Install
291idrisInstall verbosity copy pkg local
292 = if (execOnly (configFlags local)) then installRTS
293 else do installStdLib
294 installRTS
295 installManPage
296 where
297 target = datadir $ L.absoluteInstallDirs pkg local copy
299 installStdLib = do
300 let target' = target -- </> "libs"
301 putStrLn $ "Installing libraries in " ++ target'
302 makeInstall "libs" target'
304 installRTS = do
305 let target' = target </> "rts"
306 putStrLn $ "Installing run time system in " ++ target'
307 makeInstall "rts" target'
309 installManPage = do
310 let mandest = mandir (L.absoluteInstallDirs pkg local copy) ++ "/man1"
311 notice verbosity $ unwords ["Copying man page to", mandest]
312 installOrdinaryFiles verbosity mandest [("man", "idris.1")]
314 makeInstall src target =
315 make verbosity [ "-C", src, "install" , "TARGET=" ++ target, "IDRIS=" ++ idrisCmd local]
317-- -----------------------------------------------------------------------------
318-- Test
320-- There are two "dataDir" in cabal, and they don't relate to each other.
321-- When fetching modules, idris uses the second path (in the pkg record),
322-- which by default is the root folder of the project.
323-- We want it to be the install directory where we put the idris libraries.
324fixPkg pkg target = pkg { dataDir = target }
326idrisTestHook args pkg local hooks flags = do
327 let target = datadir $ L.absoluteInstallDirs pkg local NoCopyDest
328 testHook simpleUserHooks args (fixPkg pkg target) local hooks flags
330-- -----------------------------------------------------------------------------
331-- Main
333-- Install libraries during both copy and install
334-- See https://github.com/haskell/cabal/issues/709
335main = defaultMainWithHooks $ simpleUserHooks
336 { postClean = idrisClean
337 , postConf = idrisConfigure
338 , preBuild = idrisPreBuild
339 , postBuild = idrisBuild
340 , postCopy = \_ flags pkg local ->
341 idrisInstall (S.fromFlag $ S.copyVerbosity flags)
342 (S.fromFlag $ S.copyDest flags) pkg local
343 , postInst = \_ flags pkg local ->
344 idrisInstall (S.fromFlag $ S.installVerbosity flags)
345 NoCopyDest pkg local
346 , preSDist = idrisPreSDist
347 , sDistHook = idrisSDist (sDistHook simpleUserHooks)
348 , postSDist = idrisPostSDist
349 , testHook = idrisTestHook
350 }