Cabal-tests/tests/custom-setup/IdrisSetup.hs

   1 -- This is Setup.hs script from idris-1.1.1
   2
   3 {-
   4
   5 Copyright (c) 2011 Edwin Brady
   6     School of Computer Science, University of St Andrews
   7 All rights reserved.
   8
   9 This code is derived from software written by Edwin Brady
  10 (eb@cs.st-andrews.ac.uk).
  11
  12 Redistribution and use in source and binary forms, with or without
  13 modification, are permitted provided that the following conditions
  14 are met:
  15 1. Redistributions of source code must retain the above copyright
  16    notice, this list of conditions and the following disclaimer.
  17 2. Redistributions in binary form must reproduce the above copyright
  18    notice, this list of conditions and the following disclaimer in the
  19    documentation and/or other materials provided with the distribution.
  20 3. None of the names of the copyright holders may be used to endorse
  21    or promote products derived from this software without specific
  22    prior written permission.
  23
  24 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ``AS IS'' AND ANY
  25 EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  26 IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
  27 PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE
  28 LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  29 CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  30 SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  31 BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  32 WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  33 OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  34 IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  35
  36 *** End of disclaimer. ***
  37
  38 -}
  39
  40 {-# LANGUAGE CPP #-}
  41 {-# OPTIONS_GHC -w #-}
  42 module IdrisSetup (main) where
  43
  44 #if !defined(MIN_VERSION_Cabal)
  45 # define MIN_VERSION_Cabal(x,y,z) 0
  46 #endif
  47
  48 import Control.Monad
  49 import Data.IORef
  50 import Control.Exception (SomeException, catch)
  51 import Data.String (fromString)
  52
  53 import Distribution.Simple
  54 import Distribution.Simple.BuildPaths
  55 import Distribution.Simple.InstallDirs as I
  56 import Distribution.Simple.LocalBuildInfo as L
  57 import qualified Distribution.Simple.Setup as S
  58 import qualified Distribution.Simple.Program as P
  59 import Distribution.Simple.Utils (createDirectoryIfMissingVerbose, notice, installOrdinaryFiles)
  60 import Distribution.Simple.Utils (rewriteFileEx)
  61 import Distribution.Compiler
  62 import Distribution.PackageDescription
  63 import Distribution.Text
  64 #if MIN_VERSION_Cabal(3,11,0)
  65 import Distribution.Utils.Path
  66   (getSymbolicPath, makeSymbolicPath)
  67 #endif
  68
  69 import System.Environment
  70 import System.Exit
  71 import System.FilePath ((</>), splitDirectories,isAbsolute)
  72 import System.Directory
  73 import qualified System.FilePath.Posix as Px
  74 import System.Process
  75
  76 -- This is difference from vanilla idris-1.1.1
  77 configConfigurationsFlags :: S.ConfigFlags -> [(FlagName, Bool)]
  78 #if MIN_VERSION_Cabal(2,1,0)
  79 configConfigurationsFlags = unFlagAssignment . S.configConfigurationsFlags
  80 #else
  81 configConfigurationsFlags = S.configConfigurationsFlags
  82 #endif
  83
  84 -- After Idris is built, we need to check and install the prelude and other libs
  85
  86 -- -----------------------------------------------------------------------------
  87 -- Idris Command Path
  88
  89 -- make on mingw32 expects unix style separators
  90 #ifdef mingw32_HOST_OS
  91 idrisCmd local = Px.joinPath $ splitDirectories $ ".." Px.</> ".." Px.</> bd Px.</> "idris" Px.</> "idris"
  92 #else
  93 idrisCmd local = ".." </> ".." </> bd </> "idris" </> "idris"
  94 #endif
  95   where
  96     bd =
  97 #if MIN_VERSION_Cabal(3,11,0)
  98         getSymbolicPath $
  99 #endif
 100         buildDir local
 101
 102 -- -----------------------------------------------------------------------------
 103 -- Make Commands
 104
 105 -- use GNU make on FreeBSD
 106 #if defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS)\
 107     || defined(openbsd_HOST_OS) || defined(netbsd_HOST_OS)
 108 mymake = "gmake"
 109 #else
 110 mymake = "make"
 111 #endif
 112
 113 make verbosity dir args =
 114   P.runProgramInvocation verbosity $ P.simpleProgramInvocation mymake $
 115     [ "-C", dir ] ++ args
 116
 117 #ifdef mingw32_HOST_OS
 118 windres verbosity =
 119   P.runProgramInvocation verbosity . P.simpleProgramInvocation "windres"
 120 #endif
 121 -- -----------------------------------------------------------------------------
 122 -- Flags
 123
 124 usesGMP :: S.ConfigFlags -> Bool
 125 usesGMP flags =
 126   case lookup (mkFlagName "gmp") (configConfigurationsFlags flags) of
 127     Just True -> True
 128     Just False -> False
 129     Nothing -> False
 130
 131 execOnly :: S.ConfigFlags -> Bool
 132 execOnly flags =
 133   case lookup (mkFlagName "execonly") (configConfigurationsFlags flags) of
 134     Just True -> True
 135     Just False -> False
 136     Nothing -> False
 137
 138 isRelease :: S.ConfigFlags -> Bool
 139 isRelease flags =
 140     case lookup (mkFlagName "release") (configConfigurationsFlags flags) of
 141       Just True -> True
 142       Just False -> False
 143       Nothing -> False
 144
 145 isFreestanding :: S.ConfigFlags -> Bool
 146 isFreestanding flags =
 147   case lookup (mkFlagName "freestanding") (configConfigurationsFlags flags) of
 148     Just True -> True
 149     Just False -> False
 150     Nothing -> False
 151
 152 #if !(MIN_VERSION_Cabal(2,0,0))
 153 mkFlagName :: String -> FlagName
 154 mkFlagName = FlagName
 155 #endif
 156
 157 -- -----------------------------------------------------------------------------
 158 -- Clean
 159
 160 idrisClean _ flags _ _ = cleanStdLib
 161    where
 162       verbosity = S.fromFlag $ S.cleanVerbosity flags
 163
 164       cleanStdLib = makeClean "libs"
 165
 166       makeClean dir = make verbosity dir [ "clean", "IDRIS=idris" ]
 167
 168 -- -----------------------------------------------------------------------------
 169 -- Configure
 170
 171 gitHash :: IO String
 172 gitHash = do h <- Control.Exception.catch (readProcess "git" ["rev-parse", "--short", "HEAD"] "")
 173                   (\e -> let e' = (e :: SomeException) in return "PRE")
 174              return $ takeWhile (/= '\n') h
 175
 176 -- Put the Git hash into a module for use in the program
 177 -- For release builds, just put the empty string in the module
 178 generateVersionModule verbosity dir release = do
 179     hash <- gitHash
 180     let versionModulePath = dir </> "Version_idris" Px.<.> "hs"
 181     putStrLn $ "Generating " ++ versionModulePath ++
 182              if release then " for release" else " for prerelease " ++ hash
 183     createDirectoryIfMissingVerbose verbosity True dir
 184     rewriteFileEx verbosity versionModulePath (versionModuleContents hash)
 185
 186   where versionModuleContents h = "module Version_idris where\n\n" ++
 187                                   "gitHash :: String\n" ++
 188                                   if release
 189                                     then "gitHash = \"\"\n"
 190                                     else "gitHash = \"git:" ++ h ++ "\"\n"
 191
 192 -- Generate a module that contains the lib path for a freestanding Idris
 193 generateTargetModule verbosity dir targetDir = do
 194     let absPath = isAbsolute targetDir
 195     let targetModulePath = dir </> "Target_idris" Px.<.> "hs"
 196     putStrLn $ "Generating " ++ targetModulePath
 197     createDirectoryIfMissingVerbose verbosity True dir
 198     rewriteFileEx verbosity targetModulePath (versionModuleContents absPath targetDir)
 199             where versionModuleContents absolute td = "module Target_idris where\n\n" ++
 200                                     "import System.FilePath\n" ++
 201                                     "import System.Environment\n" ++
 202                                     "getDataDir :: IO String\n" ++
 203                                     if absolute
 204                                         then "getDataDir = return \"" ++ td ++ "\"\n"
 205                                         else "getDataDir = do \n" ++
 206                                              "   expath <- getExecutablePath\n" ++
 207                                              "   execDir <- return $ dropFileName expath\n" ++
 208                                              "   return $ execDir ++ \"" ++ td ++ "\"\n"
 209                                     ++ "getDataFileName :: FilePath -> IO FilePath\n"
 210                                     ++ "getDataFileName name = do\n"
 211                                     ++ "   dir <- getDataDir\n"
 212                                     ++ "   return (dir ++ \"/\" ++ name)"
 213
 214 -- a module that has info about existence and location of a bundled toolchain
 215 generateToolchainModule verbosity srcDir toolDir = do
 216     let commonContent = "module Tools_idris where\n\n"
 217     let toolContent = case toolDir of
 218                         Just dir -> "hasBundledToolchain = True\n" ++
 219                                     "getToolchainDir = \"" ++ dir ++ "\"\n"
 220                         Nothing -> "hasBundledToolchain = False\n" ++
 221                                    "getToolchainDir = \"\""
 222     let toolPath = srcDir </> "Tools_idris" Px.<.> "hs"
 223     createDirectoryIfMissingVerbose verbosity True srcDir
 224     rewriteFileEx verbosity toolPath (commonContent ++ toolContent)
 225
 226 idrisConfigure _ flags pkgdesc local = do
 227     configureRTS
 228     withLibLBI pkgdesc local $ \_ libcfg -> do
 229       let libAutogenDir =
 230 #if MIN_VERSION_Cabal(3,11,0)
 231             getSymbolicPath $
 232 #endif
 233             autogenComponentModulesDir local libcfg
 234       generateVersionModule verbosity libAutogenDir (isRelease (configFlags local))
 235       if isFreestanding $ configFlags local
 236           then do
 237                   toolDir <- lookupEnv "IDRIS_TOOLCHAIN_DIR"
 238                   generateToolchainModule verbosity libAutogenDir toolDir
 239                   targetDir <- lookupEnv "IDRIS_LIB_DIR"
 240                   case targetDir of
 241                        Just d -> generateTargetModule verbosity libAutogenDir d
 242                        Nothing -> error $ "Trying to build freestanding without a target directory."
 243                                     ++ " Set it by defining IDRIS_LIB_DIR."
 244           else
 245                   generateToolchainModule verbosity libAutogenDir Nothing
 246     where
 247       verbosity = S.fromFlag $ S.configVerbosity flags
 248       version   = pkgVersion . package $ localPkgDescr local
 249
 250       -- This is a hack. I don't know how to tell cabal that a data file needs
 251       -- installing but shouldn't be in the distribution. And it won't make the
 252       -- distribution if it's not there, so instead I just delete
 253       -- the file after configure.
 254       configureRTS = make verbosity "rts" ["clean"]
 255
 256 #if !(MIN_VERSION_Cabal(2,0,0))
 257       autogenComponentModulesDir lbi _ = autogenModulesDir lbi
 258 #endif
 259
 260 #if !MIN_VERSION_Cabal(3,0,0)
 261 idrisPreSDist args flags = do
 262   let dir = S.fromFlag (S.sDistDirectory flags)
 263   let verb = S.fromFlag (S.sDistVerbosity flags)
 264   generateVersionModule verb "src" True
 265   generateTargetModule verb "src" "./libs"
 266   generateToolchainModule verb "src" Nothing
 267   preSDist simpleUserHooks args flags
 268
 269 idrisSDist sdist pkgDesc bi hooks flags = do
 270   pkgDesc' <- addGitFiles pkgDesc
 271   sdist pkgDesc' bi hooks flags
 272     where
 273       addGitFiles :: PackageDescription -> IO PackageDescription
 274       addGitFiles pkgDesc = do
 275         files <- gitFiles
 276         return $ pkgDesc { extraSrcFiles = extraSrcFiles pkgDesc ++ files}
 277       gitFiles :: IO [FilePath]
 278       gitFiles = liftM lines (readProcess "git" ["ls-files"] "")
 279
 280 idrisPostSDist args flags desc lbi = do
 281   Control.Exception.catch (do let file = "src" </> "Version_idris" Px.<.> "hs"
 282                               let targetFile = "src" </> "Target_idris" Px.<.> "hs"
 283                               putStrLn $ "Removing generated modules:\n "
 284                                         ++ file ++ "\n" ++ targetFile
 285                               removeFile file
 286                               removeFile targetFile)
 287              (\e -> let e' = (e :: SomeException) in return ())
 288   postSDist simpleUserHooks args flags desc lbi
 289 #endif
 290
 291 -- -----------------------------------------------------------------------------
 292 -- Build
 293
 294 getVersion :: Args -> S.BuildFlags -> IO HookedBuildInfo
 295 getVersion args flags = do
 296       hash <- gitHash
 297       let buildinfo = (emptyBuildInfo { cppOptions = ["-DVERSION="++hash] }) :: BuildInfo
 298       return (Just buildinfo, [])
 299
 300 idrisPreBuild args flags = do
 301 #ifdef mingw32_HOST_OS
 302         createDirectoryIfMissingVerbose verbosity True dir
 303         windres verbosity ["icons/idris_icon.rc","-o", dir++"/idris_icon.o"]
 304         return (Nothing, [(fromString "idris", emptyBuildInfo { ldOptions = [dir ++ "/idris_icon.o"] })])
 305      where
 306         verbosity = S.fromFlag $ S.buildVerbosity flags
 307
 308         dir =
 309 #if MIN_VERSION_Cabal(3,11,0)
 310            getSymbolicPath $ S.fromFlagOrDefault (makeSymbolicPath "dist") $
 311 #else
 312            S.fromFlagOrDefault "dist" $
 313 #endif
 314            S.buildDistPref flags
 315 #else
 316         return (Nothing, [])
 317 #endif
 318
 319 idrisBuild _ flags _ local
 320    = if (execOnly (configFlags local)) then buildRTS
 321         else do buildStdLib
 322                 buildRTS
 323    where
 324       verbosity = S.fromFlag $ S.buildVerbosity flags
 325
 326       buildStdLib = do
 327             putStrLn "Building libraries..."
 328             makeBuild "libs"
 329          where
 330             makeBuild dir = make verbosity dir ["IDRIS=" ++ idrisCmd local]
 331
 332       buildRTS = make verbosity "rts" $ gmpflag (usesGMP (configFlags local))
 333
 334       gmpflag False = []
 335       gmpflag True = ["GMP=-DIDRIS_GMP"]
 336
 337 -- -----------------------------------------------------------------------------
 338 -- Copy/Install
 339
 340 idrisInstall verbosity copy pkg local
 341    = if (execOnly (configFlags local)) then installRTS
 342         else do installStdLib
 343                 installRTS
 344                 installManPage
 345    where
 346       target = datadir $ L.absoluteInstallDirs pkg local copy
 347
 348       installStdLib = do
 349         let target' = target -- </> "libs"
 350         putStrLn $ "Installing libraries in " ++ target'
 351         makeInstall "libs" target'
 352
 353       installRTS = do
 354          let target' = target </> "rts"
 355          putStrLn $ "Installing run time system in " ++ target'
 356          makeInstall "rts" target'
 357
 358       installManPage = do
 359          let mandest = mandir (L.absoluteInstallDirs pkg local copy) ++ "/man1"
 360          notice verbosity $ unwords ["Copying man page to", mandest]
 361          installOrdinaryFiles verbosity mandest [("man", "idris.1")]
 362
 363       makeInstall src target =
 364          make verbosity src [ "install", "TARGET=" ++ target, "IDRIS=" ++ idrisCmd local]
 365
 366 -- -----------------------------------------------------------------------------
 367 -- Test
 368
 369 -- There are two "dataDir" in cabal, and they don't relate to each other.
 370 -- When fetching modules, idris uses the second path (in the pkg record),
 371 -- which by default is the root folder of the project.
 372 -- We want it to be the install directory where we put the idris libraries.
 373 fixPkg pkg target = pkg { dataDir = target }
 374
 375 idrisTestHook args pkg local hooks flags = do
 376   let target =
 377 #if MIN_VERSION_Cabal(3,11,0)
 378         makeSymbolicPath $
 379 #endif
 380         datadir $ L.absoluteInstallDirs pkg local NoCopyDest
 381   testHook simpleUserHooks args (fixPkg pkg target) local hooks flags
 382
 383 -- -----------------------------------------------------------------------------
 384 -- Main
 385
 386 -- Install libraries during both copy and install
 387 -- See https://github.com/haskell/cabal/issues/709
 388 main = defaultMainWithHooks $ simpleUserHooks
 389    { postClean = idrisClean
 390    , postConf  = idrisConfigure
 391    , preBuild = idrisPreBuild
 392    , postBuild = idrisBuild
 393    , postCopy = \_ flags pkg local ->
 394                   idrisInstall (S.fromFlag $ S.copyVerbosity flags)
 395                                (S.fromFlag $ S.copyDest flags) pkg local
 396    , postInst = \_ flags pkg local ->
 397                   idrisInstall (S.fromFlag $ S.installVerbosity flags)
 398                                NoCopyDest pkg local
 399 #if !MIN_VERSION_Cabal(3,0,0)
 400    , preSDist = idrisPreSDist
 401    , sDistHook = idrisSDist (sDistHook simpleUserHooks)
 402    , postSDist = idrisPostSDist
 403 #endif
 404    , testHook = idrisTestHook
 405    }