git.iko.soy/Idris-dev
on 6db256a help sign in
Idris-dev/Setup.hs
284 lines 11 kB history raw
1{-# LANGUAGE CPP #-}
2import Control.Monad
3import Data.IORef
4import Control.Exception (SomeException, catch)
6import Distribution.Simple
7import Distribution.Simple.BuildPaths (autogenModulesDir)
8import Distribution.Simple.InstallDirs as I
9import Distribution.Simple.LocalBuildInfo as L
10import qualified Distribution.Simple.Setup as S
11import qualified Distribution.Simple.Program as P
12import Distribution.Simple.Utils (createDirectoryIfMissingVerbose, rewriteFile, notice, installOrdinaryFiles)
13import Distribution.Compiler
14import Distribution.PackageDescription
15import Distribution.Text
17import System.Environment
18import System.Exit
19import System.FilePath ((</>), splitDirectories,isAbsolute)
20import System.Directory
21import qualified System.FilePath.Posix as Px
22import System.Process
24-- After Idris is built, we need to check and install the prelude and other libs
26-- -----------------------------------------------------------------------------
27-- Idris Command Path
29-- make on mingw32 exepects unix style separators
30#ifdef mingw32_HOST_OS
31(<//>) = (Px.</>)
32idrisCmd local = Px.joinPath $ splitDirectories $ ".." <//> ".." <//> buildDir local <//> "idris" <//> "idris"
33#else
34idrisCmd local = ".." </> ".." </> buildDir local </> "idris" </> "idris"
35#endif
37-- -----------------------------------------------------------------------------
38-- Make Commands
40-- use GNU make on FreeBSD
41#if defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS)\
42 || defined(openbsd_HOST_OS) || defined(netbsd_HOST_OS)
43mymake = "gmake"
44#else
45mymake = "make"
46#endif
47make verbosity =
48 P.runProgramInvocation verbosity . P.simpleProgramInvocation mymake
50#ifdef mingw32_HOST_OS
51windres verbosity = P.runProgramInvocation verbosity . P.simpleProgramInvocation "windres"
52#endif
53-- -----------------------------------------------------------------------------
54-- Flags
56usesGMP :: S.ConfigFlags -> Bool
57usesGMP flags =
58 case lookup (FlagName "gmp") (S.configConfigurationsFlags flags) of
59 Just True -> True
60 Just False -> False
61 Nothing -> False
63execOnly :: S.ConfigFlags -> Bool
64execOnly flags =
65 case lookup (FlagName "execonly") (S.configConfigurationsFlags flags) of
66 Just True -> True
67 Just False -> False
68 Nothing -> False
70isRelease :: S.ConfigFlags -> Bool
71isRelease flags =
72 case lookup (FlagName "release") (S.configConfigurationsFlags flags) of
73 Just True -> True
74 Just False -> False
75 Nothing -> False
77isFreestanding :: S.ConfigFlags -> Bool
78isFreestanding flags =
79 case lookup (FlagName "freestanding") (S.configConfigurationsFlags flags) of
80 Just True -> True
81 Just False -> False
82 Nothing -> False
83-- -----------------------------------------------------------------------------
84-- Clean
86idrisClean _ flags _ _ = cleanStdLib
87 where
88 verbosity = S.fromFlag $ S.cleanVerbosity flags
90 cleanStdLib = makeClean "libs"
92 makeClean dir = make verbosity [ "-C", dir, "clean", "IDRIS=idris" ]
95-- -----------------------------------------------------------------------------
96-- Configure
98gitHash :: IO String
99gitHash = do h <- Control.Exception.catch (readProcess "git" ["rev-parse", "--short", "HEAD"] "")
100 (\e -> let e' = (e :: SomeException) in return "PRE")
101 return $ takeWhile (/= '\n') h
103-- Put the Git hash into a module for use in the program
104-- For release builds, just put the empty string in the module
105generateVersionModule verbosity dir release = do
106 hash <- gitHash
107 let versionModulePath = dir </> "Version_idris" Px.<.> "hs"
108 putStrLn $ "Generating " ++ versionModulePath ++
109 if release then " for release" else " for prerelease " ++ hash
110 createDirectoryIfMissingVerbose verbosity True dir
111 rewriteFile versionModulePath (versionModuleContents hash)
113 where versionModuleContents h = "module Version_idris where\n\n" ++
114 "gitHash :: String\n" ++
115 if release
116 then "gitHash = \"\"\n"
117 else "gitHash = \"git:" ++ h ++ "\"\n"
119-- Generate a module that contains the lib path for a freestanding Idris
120generateTargetModule verbosity dir targetDir = do
121 let absPath = isAbsolute targetDir
122 let targetModulePath = dir </> "Target_idris" Px.<.> "hs"
123 putStrLn $ "Generating " ++ targetModulePath
124 createDirectoryIfMissingVerbose verbosity True dir
125 rewriteFile targetModulePath (versionModuleContents absPath targetDir)
126 where versionModuleContents absolute td = "module Target_idris where\n\n" ++
127 "import System.FilePath\n" ++
128 "import System.Environment\n" ++
129 "getDataDir :: IO String\n" ++
130 if absolute
131 then "getDataDir = return \"" ++ td ++ "\"\n"
132 else "getDataDir = do \n" ++
133 " expath <- getExecutablePath\n" ++
134 " execDir <- return $ dropFileName expath\n" ++
135 " return $ execDir ++ \"" ++ td ++ "\"\n"
136 ++ "getDataFileName :: FilePath -> IO FilePath\n"
137 ++ "getDataFileName name = do\n"
138 ++ " dir <- getDataDir\n"
139 ++ " return (dir ++ \"/\" ++ name)"
141-- a module that has info about existence and location of a bundled toolchain
142generateToolchainModule verbosity srcDir toolDir = do
143 let commonContent = "module Tools_idris where\n\n"
144 let toolContent = case toolDir of
145 Just dir -> "hasBundledToolchain = True\n" ++
146 "getToolchainDir = \"" ++ dir ++ "\"\n"
147 Nothing -> "hasBundledToolchain = False\n" ++
148 "getToolchainDir = \"\""
149 let toolPath = srcDir </> "Tools_idris" Px.<.> "hs"
150 createDirectoryIfMissingVerbose verbosity True srcDir
151 rewriteFile toolPath (commonContent ++ toolContent)
153idrisConfigure _ flags _ local = do
154 configureRTS
155 generateVersionModule verbosity (autogenModulesDir local) (isRelease (configFlags local))
156 if isFreestanding $ configFlags local
157 then do
158 toolDir <- lookupEnv "IDRIS_TOOLCHAIN_DIR"
159 generateToolchainModule verbosity (autogenModulesDir local) toolDir
160 targetDir <- lookupEnv "IDRIS_LIB_DIR"
161 case targetDir of
162 Just d -> generateTargetModule verbosity (autogenModulesDir local) d
163 Nothing -> error $ "Trying to build freestanding without a target directory."
164 ++ " Set it by defining IDRIS_LIB_DIR."
165 else
166 generateToolchainModule verbosity (autogenModulesDir local) Nothing
167 where
168 verbosity = S.fromFlag $ S.configVerbosity flags
169 version = pkgVersion . package $ localPkgDescr local
171 -- This is a hack. I don't know how to tell cabal that a data file needs
172 -- installing but shouldn't be in the distribution. And it won't make the
173 -- distribution if it's not there, so instead I just delete
174 -- the file after configure.
175 configureRTS = make verbosity ["-C", "rts", "clean"]
177idrisPreSDist args flags = do
178 let dir = S.fromFlag (S.sDistDirectory flags)
179 let verb = S.fromFlag (S.sDistVerbosity flags)
180 generateVersionModule verb "src" True
181 generateTargetModule verb "src" "./libs"
182 generateToolchainModule verb "src" Nothing
183 preSDist simpleUserHooks args flags
185idrisPostSDist args flags desc lbi = do
186 Control.Exception.catch (do let file = "src" </> "Version_idris" Px.<.> "hs"
187 let targetFile = "src" </> "Target_idris" Px.<.> "hs"
188 putStrLn $ "Removing generated modules:\n "
189 ++ file ++ "\n" ++ targetFile
190 removeFile file
191 removeFile targetFile)
192 (\e -> let e' = (e :: SomeException) in return ())
193 postSDist simpleUserHooks args flags desc lbi
195-- -----------------------------------------------------------------------------
196-- Build
198getVersion :: Args -> S.BuildFlags -> IO HookedBuildInfo
199getVersion args flags = do
200 hash <- gitHash
201 let buildinfo = (emptyBuildInfo { cppOptions = ["-DVERSION="++hash] }) :: BuildInfo
202 return (Just buildinfo, [])
206idrisPreBuild args flags = do
207#ifdef mingw32_HOST_OS
208 createDirectoryIfMissingVerbose verbosity True dir
209 windres verbosity ["icons/idris_icon.rc","-o", dir++"idris_icon.o"]
210 return (Nothing, [("idris", emptyBuildInfo { ldOptions = [dir ++ "idris_icon.o"] })])
211 where
212 verbosity = S.fromFlag $ S.buildVerbosity flags
213 dir = S.fromFlagOrDefault "dist" $ S.buildDistPref flags
214#else
215 return (Nothing, [])
216#endif
218idrisBuild _ flags _ local = unless (execOnly (configFlags local)) $ do
219 buildStdLib
220 buildRTS
221 where
222 verbosity = S.fromFlag $ S.buildVerbosity flags
224 buildStdLib = do
225 putStrLn "Building libraries..."
226 makeBuild "libs"
227 where
228 makeBuild dir = make verbosity [ "-C", dir, "build" , "IDRIS=" ++ idrisCmd local]
230 buildRTS = make verbosity (["-C", "rts", "build"] ++
231 gmpflag (usesGMP (configFlags local)))
233 gmpflag False = []
234 gmpflag True = ["GMP=-DIDRIS_GMP"]
238-- -----------------------------------------------------------------------------
239-- Copy/Install
241idrisInstall verbosity copy pkg local = unless (execOnly (configFlags local)) $ do
242 installStdLib
243 installRTS
244 installManPage
245 where
246 target = datadir $ L.absoluteInstallDirs pkg local copy
248 installStdLib = do
249 putStrLn $ "Installing libraries in " ++ target
250 makeInstall "libs" target
252 installRTS = do
253 let target' = target </> "rts"
254 putStrLn $ "Installing run time system in " ++ target'
255 makeInstall "rts" target'
257 installManPage = do
258 let mandest = mandir (L.absoluteInstallDirs pkg local copy) ++ "/man1"
259 notice verbosity $ unwords ["Copying man page to", mandest]
260 installOrdinaryFiles verbosity mandest [("man", "idris.1")]
263 makeInstall src target =
264 make verbosity [ "-C", src, "install" , "TARGET=" ++ target, "IDRIS=" ++ idrisCmd local]
266-- -----------------------------------------------------------------------------
267-- Main
269-- Install libraries during both copy and install
270-- See https://github.com/haskell/cabal/issues/709
271main = defaultMainWithHooks $ simpleUserHooks
272 { postClean = idrisClean
273 , postConf = idrisConfigure
274 , preBuild = idrisPreBuild
275 , postBuild = idrisBuild
276 , postCopy = \_ flags pkg local ->
277 idrisInstall (S.fromFlag $ S.copyVerbosity flags)
278 (S.fromFlag $ S.copyDest flags) pkg local
279 , postInst = \_ flags pkg local ->
280 idrisInstall (S.fromFlag $ S.installVerbosity flags)
281 NoCopyDest pkg local
282 , preSDist = idrisPreSDist
283 , postSDist = idrisPostSDist
284 }