git.iko.soy/Idris-dev
on ca34dec help sign in
Idris-dev/Setup.hs
360 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
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 lookupFlagAssignment (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 lookupFlagAssignment (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 lookupFlagAssignment (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 lookupFlagAssignment (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#if !(MIN_VERSION_Cabal(2,2,0))
101lookupFlagAssignment :: FlagName -> FlagAssignment -> Maybe Bool
102lookupFlagAssignment = lookup
103#endif
105-- -----------------------------------------------------------------------------
106-- Clean
108idrisClean _ flags _ _ = cleanStdLib
109 where
110 verbosity = S.fromFlag $ S.cleanVerbosity flags
112 cleanStdLib = makeClean "libs"
114 makeClean dir = make verbosity [ "-C", dir, "clean", "IDRIS=idris" ]
116-- -----------------------------------------------------------------------------
117-- Configure
119gitHash :: IO String
120gitHash = do h <- Control.Exception.catch (readProcess "git" ["rev-parse", "--short", "HEAD"] "")
121 (\e -> let e' = (e :: SomeException) in return "PRE")
122 return $ takeWhile (/= '\n') h
124-- Generate a module that contains extra library directories passed
125-- via command-line to cabal
126generateBuildFlagsModule :: Verbosity -> FilePath -> [String] -> IO ()
127generateBuildFlagsModule verbosity dir libdirs = do
128 let buildFlagsModulePath = dir </> "BuildFlags_idris" Px.<.> "hs"
129 putStrLn $ "Generating " ++ buildFlagsModulePath
130 createDirectoryIfMissingVerbose verbosity True dir
131 rewriteFileEx verbosity buildFlagsModulePath contents
132 where contents = "module BuildFlags_idris where \n\n" ++
133 "extraLibDirs :: [String]\n" ++
134 "extraLibDirs = " ++ show libdirs
136-- Put the Git hash into a module for use in the program
137-- For release builds, just put the empty string in the module
138generateVersionModule verbosity dir release = do
139 hash <- gitHash
140 let versionModulePath = dir </> "Version_idris" Px.<.> "hs"
141 putStrLn $ "Generating " ++ versionModulePath ++
142 if release then " for release" else " for prerelease " ++ hash
143 createDirectoryIfMissingVerbose verbosity True dir
144 rewriteFileEx verbosity versionModulePath (versionModuleContents hash)
146 where versionModuleContents h = "module Version_idris where\n\n" ++
147 "gitHash :: String\n" ++
148 if release
149 then "gitHash = \"\"\n"
150 else "gitHash = \"git:" ++ h ++ "\"\n"
152-- Generate a module that contains the lib path for a freestanding Idris
153generateTargetModule verbosity dir targetDir = do
154 let absPath = isAbsolute targetDir
155 let targetModulePath = dir </> "Target_idris" Px.<.> "hs"
156 putStrLn $ "Generating " ++ targetModulePath
157 createDirectoryIfMissingVerbose verbosity True dir
158 rewriteFileEx verbosity targetModulePath (versionModuleContents absPath targetDir)
159 where versionModuleContents absolute td = "module Target_idris where\n\n" ++
160 "import System.FilePath\n" ++
161 "import System.Environment\n" ++
162 "getDataDir :: IO String\n" ++
163 if absolute
164 then "getDataDir = return \"" ++ td ++ "\"\n"
165 else "getDataDir = do \n" ++
166 " expath <- getExecutablePath\n" ++
167 " execDir <- return $ dropFileName expath\n" ++
168 " return $ execDir ++ \"" ++ td ++ "\"\n"
169 ++ "getDataFileName :: FilePath -> IO FilePath\n"
170 ++ "getDataFileName name = do\n"
171 ++ " dir <- getDataDir\n"
172 ++ " return (dir ++ \"/\" ++ name)"
174-- a module that has info about existence and location of a bundled toolchain
175generateToolchainModule verbosity srcDir toolDir = do
176 let commonContent = "module Tools_idris where\n\n"
177 let toolContent = case toolDir of
178 Just dir -> "hasBundledToolchain = True\n" ++
179 "getToolchainDir = \"" ++ dir ++ "\"\n"
180 Nothing -> "hasBundledToolchain = False\n" ++
181 "getToolchainDir = \"\""
182 let toolPath = srcDir </> "Tools_idris" Px.<.> "hs"
183 createDirectoryIfMissingVerbose verbosity True srcDir
184 rewriteFileEx verbosity toolPath (commonContent ++ toolContent)
186idrisConfigure _ flags pkgdesc local = do
187 configureRTS
188 withLibLBI pkgdesc local $ \lib libcfg -> do
189 let libAutogenDir = autogenComponentModulesDir local libcfg
190 let libDirs = extraLibDirs $ libBuildInfo lib
191 generateBuildFlagsModule verbosity libAutogenDir libDirs
192 generateVersionModule verbosity libAutogenDir (isRelease (configFlags local))
193 if isFreestanding $ configFlags local
194 then do
195 toolDir <- lookupEnv "IDRIS_TOOLCHAIN_DIR"
196 generateToolchainModule verbosity libAutogenDir toolDir
197 targetDir <- lookupEnv "IDRIS_LIB_DIR"
198 case targetDir of
199 Just d -> generateTargetModule verbosity libAutogenDir d
200 Nothing -> error $ "Trying to build freestanding without a target directory."
201 ++ " Set it by defining IDRIS_LIB_DIR."
202 else
203 generateToolchainModule verbosity libAutogenDir Nothing
204 where
205 verbosity = S.fromFlag $ S.configVerbosity flags
206 version = pkgVersion . package $ localPkgDescr local
208 -- This is a hack. I don't know how to tell cabal that a data file needs
209 -- installing but shouldn't be in the distribution. And it won't make the
210 -- distribution if it's not there, so instead I just delete
211 -- the file after configure.
212 configureRTS = make verbosity ["-C", "rts", "clean"]
214#if !(MIN_VERSION_Cabal(2,0,0))
215 autogenComponentModulesDir lbi _ = autogenModulesDir lbi
216#endif
218idrisPreSDist args flags = do
219 let dir = S.fromFlag (S.sDistDirectory flags)
220 let verb = S.fromFlag (S.sDistVerbosity flags)
221 generateVersionModule verb "src" True
222 generateBuildFlagsModule verb "src" []
223 generateTargetModule verb "src" "./libs"
224 generateToolchainModule verb "src" Nothing
225 preSDist simpleUserHooks args flags
227idrisSDist sdist pkgDesc bi hooks flags = do
228 pkgDesc' <- addGitFiles pkgDesc
229 sdist pkgDesc' bi hooks flags
230 where
231 addGitFiles :: PackageDescription -> IO PackageDescription
232 addGitFiles pkgDesc = do
233 files <- gitFiles
234 return $ pkgDesc { extraSrcFiles = extraSrcFiles pkgDesc ++ files}
235 gitFiles :: IO [FilePath]
236 gitFiles = liftM lines (readProcess "git" ["ls-files"] "")
238idrisPostSDist args flags desc lbi = do
239 Control.Exception.catch (do let file = "src" </> "Version_idris" Px.<.> "hs"
240 let targetFile = "src" </> "Target_idris" Px.<.> "hs"
241 putStrLn $ "Removing generated modules:\n "
242 ++ file ++ "\n" ++ targetFile
243 removeFile file
244 removeFile targetFile)
245 (\e -> let e' = (e :: SomeException) in return ())
246 postSDist simpleUserHooks args flags desc lbi
248#if !(MIN_VERSION_Cabal(2,0,0))
249rewriteFileEx :: Verbosity -> FilePath -> String -> IO ()
250rewriteFileEx _ = rewriteFile
251#endif
253-- -----------------------------------------------------------------------------
254-- Build
256getVersion :: Args -> S.BuildFlags -> IO HookedBuildInfo
257getVersion args flags = do
258 hash <- gitHash
259 let buildinfo = (emptyBuildInfo { cppOptions = ["-DVERSION="++hash] }) :: BuildInfo
260 return (Just buildinfo, [])
263#if !(MIN_VERSION_Cabal(2,0,0))
264mkUnqualComponentName = id
265#endif
267idrisPreBuild args flags = do
268#ifdef mingw32_HOST_OS
269 createDirectoryIfMissingVerbose verbosity True dir
270 windres verbosity ["icons/idris_icon.rc","-o", dir++"/idris_icon.o"]
271 return (Nothing, [(mkUnqualComponentName "idris", emptyBuildInfo { ldOptions = [dir ++ "/idris_icon.o"] })])
272 where
273 verbosity = S.fromFlag $ S.buildVerbosity flags
274 dir = S.fromFlagOrDefault "dist" $ S.buildDistPref flags
275#else
276 return (Nothing, [])
277#endif
279idrisBuild _ flags _ local
280 = if (execOnly (configFlags local)) then buildRTS
281 else do buildStdLib
282 buildRTS
283 where
284 verbosity = S.fromFlag $ S.buildVerbosity flags
286 buildStdLib = do
287 putStrLn "Building libraries..."
288 makeBuild "libs"
289 where
290 makeBuild dir = make verbosity [ "-C", dir, "build" , "IDRIS=" ++ idrisCmd local]
292 buildRTS = make verbosity (["-C", "rts", "build"] ++
293 gmpflag (usesGMP (configFlags local)))
295 gmpflag False = []
296 gmpflag True = ["GMP=-DIDRIS_GMP"]
298-- -----------------------------------------------------------------------------
299-- Copy/Install
301idrisInstall verbosity copy pkg local
302 = if (execOnly (configFlags local)) then installRTS
303 else do installStdLib
304 installRTS
305 installManPage
306 where
307 target = datadir $ L.absoluteInstallDirs pkg local copy
309 installStdLib = do
310 let target' = target -- </> "libs"
311 putStrLn $ "Installing libraries in " ++ target'
312 makeInstall "libs" target'
314 installRTS = do
315 let target' = target </> "rts"
316 putStrLn $ "Installing run time system in " ++ target'
317 makeInstall "rts" target'
319 installManPage = do
320 let mandest = mandir (L.absoluteInstallDirs pkg local copy) ++ "/man1"
321 notice verbosity $ unwords ["Copying man page to", mandest]
322 installOrdinaryFiles verbosity mandest [("man", "idris.1")]
324 makeInstall src target =
325 make verbosity [ "-C", src, "install" , "TARGET=" ++ target, "IDRIS=" ++ idrisCmd local]
327-- -----------------------------------------------------------------------------
328-- Test
330-- There are two "dataDir" in cabal, and they don't relate to each other.
331-- When fetching modules, idris uses the second path (in the pkg record),
332-- which by default is the root folder of the project.
333-- We want it to be the install directory where we put the idris libraries.
334fixPkg pkg target = pkg { dataDir = target }
336idrisTestHook args pkg local hooks flags = do
337 let target = datadir $ L.absoluteInstallDirs pkg local NoCopyDest
338 testHook simpleUserHooks args (fixPkg pkg target) local hooks flags
340-- -----------------------------------------------------------------------------
341-- Main
343-- Install libraries during both copy and install
344-- See https://github.com/haskell/cabal/issues/709
345main = defaultMainWithHooks $ simpleUserHooks
346 { postClean = idrisClean
347 , postConf = idrisConfigure
348 , preBuild = idrisPreBuild
349 , postBuild = idrisBuild
350 , postCopy = \_ flags pkg local ->
351 idrisInstall (S.fromFlag $ S.copyVerbosity flags)
352 (S.fromFlag $ S.copyDest flags) pkg local
353 , postInst = \_ flags pkg local ->
354 idrisInstall (S.fromFlag $ S.installVerbosity flags)
355 NoCopyDest pkg local
356 , preSDist = idrisPreSDist
357 , sDistHook = idrisSDist (sDistHook simpleUserHooks)
358 , postSDist = idrisPostSDist
359 , testHook = idrisTestHook
360 }