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 #if !defined(MIN_VERSION_base)
  49 # define MIN_VERSION_base(x,y,z) 0
  50 #endif
  51
  52 import Control.Monad
  53 import Data.IORef
  54 import Control.Exception (SomeException, catch)
  55 import Data.String (fromString)
  56
  57 import Distribution.Simple
  58 import Distribution.Simple.BuildPaths
  59 import Distribution.Simple.InstallDirs as I
  60 import Distribution.Simple.LocalBuildInfo as L
  61 import qualified Distribution.Simple.Setup as S
  62 import qualified Distribution.Simple.Program as P
  63 import Distribution.Simple.Utils (createDirectoryIfMissingVerbose, notice, installOrdinaryFiles)
  64 import Distribution.Simple.Utils (rewriteFileEx)
  65 import Distribution.Compiler
  66 import Distribution.PackageDescription
  67 import Distribution.Text
  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 #if !MIN_VERSION_base(4,6,0)
  85 lookupEnv :: String -> IO (Maybe String)
  86 lookupEnv v = lookup v `fmap` getEnvironment
  87 #endif
  88
  89 -- After Idris is built, we need to check and install the prelude and other libs
  90
  91 -- -----------------------------------------------------------------------------
  92 -- Idris Command Path
  93
  94 -- make on mingw32 expects unix style separators
  95 #ifdef mingw32_HOST_OS
  96 (<//>) = (Px.</>)
  97 idrisCmd local = Px.joinPath $ splitDirectories $ ".." <//> ".." <//> buildDir local <//> "idris" <//> "idris"
  98 #else
  99 idrisCmd local = ".." </> ".." </>  buildDir local </>  "idris" </>  "idris"
 100 #endif
 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 make verbosity =
 113    P.runProgramInvocation verbosity . P.simpleProgramInvocation mymake
 114
 115 #ifdef mingw32_HOST_OS
 116 windres verbosity = P.runProgramInvocation verbosity . P.simpleProgramInvocation "windres"
 117 #endif
 118 -- -----------------------------------------------------------------------------
 119 -- Flags
 120
 121 usesGMP :: S.ConfigFlags -> Bool
 122 usesGMP flags =
 123   case lookup (mkFlagName "gmp") (configConfigurationsFlags flags) of
 124     Just True -> True
 125     Just False -> False
 126     Nothing -> False
 127
 128 execOnly :: S.ConfigFlags -> Bool
 129 execOnly flags =
 130   case lookup (mkFlagName "execonly") (configConfigurationsFlags flags) of
 131     Just True -> True
 132     Just False -> False
 133     Nothing -> False
 134
 135 isRelease :: S.ConfigFlags -> Bool
 136 isRelease flags =
 137     case lookup (mkFlagName "release") (configConfigurationsFlags flags) of
 138       Just True -> True
 139       Just False -> False
 140       Nothing -> False
 141
 142 isFreestanding :: S.ConfigFlags -> Bool
 143 isFreestanding flags =
 144   case lookup (mkFlagName "freestanding") (configConfigurationsFlags flags) of
 145     Just True -> True
 146     Just False -> False
 147     Nothing -> False
 148
 149 #if !(MIN_VERSION_Cabal(2,0,0))
 150 mkFlagName :: String -> FlagName
 151 mkFlagName = FlagName
 152 #endif
 153
 154 -- -----------------------------------------------------------------------------
 155 -- Clean
 156
 157 idrisClean _ flags _ _ = cleanStdLib
 158    where
 159       verbosity = S.fromFlag $ S.cleanVerbosity flags
 160
 161       cleanStdLib = makeClean "libs"
 162
 163       makeClean dir = make verbosity [ "-C", dir, "clean", "IDRIS=idris" ]
 164
 165 -- -----------------------------------------------------------------------------
 166 -- Configure
 167
 168 gitHash :: IO String
 169 gitHash = do h <- Control.Exception.catch (readProcess "git" ["rev-parse", "--short", "HEAD"] "")
 170                   (\e -> let e' = (e :: SomeException) in return "PRE")
 171              return $ takeWhile (/= '\n') h
 172
 173 -- Put the Git hash into a module for use in the program
 174 -- For release builds, just put the empty string in the module
 175 generateVersionModule verbosity dir release = do
 176     hash <- gitHash
 177     let versionModulePath = dir </> "Version_idris" Px.<.> "hs"
 178     putStrLn $ "Generating " ++ versionModulePath ++
 179              if release then " for release" else " for prerelease " ++ hash
 180     createDirectoryIfMissingVerbose verbosity True dir
 181     rewriteFileEx verbosity versionModulePath (versionModuleContents hash)
 182
 183   where versionModuleContents h = "module Version_idris where\n\n" ++
 184                                   "gitHash :: String\n" ++
 185                                   if release
 186                                     then "gitHash = \"\"\n"
 187                                     else "gitHash = \"git:" ++ h ++ "\"\n"
 188
 189 -- Generate a module that contains the lib path for a freestanding Idris
 190 generateTargetModule verbosity dir targetDir = do
 191     let absPath = isAbsolute targetDir
 192     let targetModulePath = dir </> "Target_idris" Px.<.> "hs"
 193     putStrLn $ "Generating " ++ targetModulePath
 194     createDirectoryIfMissingVerbose verbosity True dir
 195     rewriteFileEx verbosity targetModulePath (versionModuleContents absPath targetDir)
 196             where versionModuleContents absolute td = "module Target_idris where\n\n" ++
 197                                     "import System.FilePath\n" ++
 198                                     "import System.Environment\n" ++
 199                                     "getDataDir :: IO String\n" ++
 200                                     if absolute
 201                                         then "getDataDir = return \"" ++ td ++ "\"\n"
 202                                         else "getDataDir = do \n" ++
 203                                              "   expath <- getExecutablePath\n" ++
 204                                              "   execDir <- return $ dropFileName expath\n" ++
 205                                              "   return $ execDir ++ \"" ++ td ++ "\"\n"
 206                                     ++ "getDataFileName :: FilePath -> IO FilePath\n"
 207                                     ++ "getDataFileName name = do\n"
 208                                     ++ "   dir <- getDataDir\n"
 209                                     ++ "   return (dir ++ \"/\" ++ name)"
 210
 211 -- a module that has info about existence and location of a bundled toolchain
 212 generateToolchainModule verbosity srcDir toolDir = do
 213     let commonContent = "module Tools_idris where\n\n"
 214     let toolContent = case toolDir of
 215                         Just dir -> "hasBundledToolchain = True\n" ++
 216                                     "getToolchainDir = \"" ++ dir ++ "\"\n"
 217                         Nothing -> "hasBundledToolchain = False\n" ++
 218                                    "getToolchainDir = \"\""
 219     let toolPath = srcDir </> "Tools_idris" Px.<.> "hs"
 220     createDirectoryIfMissingVerbose verbosity True srcDir
 221     rewriteFileEx verbosity toolPath (commonContent ++ toolContent)
 222
 223 idrisConfigure _ flags pkgdesc local = do
 224     configureRTS
 225     withLibLBI pkgdesc local $ \_ libcfg -> do
 226       let libAutogenDir = autogenComponentModulesDir local libcfg
 227       generateVersionModule verbosity libAutogenDir (isRelease (configFlags local))
 228       if isFreestanding $ configFlags local
 229           then do
 230                   toolDir <- lookupEnv "IDRIS_TOOLCHAIN_DIR"
 231                   generateToolchainModule verbosity libAutogenDir toolDir
 232                   targetDir <- lookupEnv "IDRIS_LIB_DIR"
 233                   case targetDir of
 234                        Just d -> generateTargetModule verbosity libAutogenDir d
 235                        Nothing -> error $ "Trying to build freestanding without a target directory."
 236                                     ++ " Set it by defining IDRIS_LIB_DIR."
 237           else
 238                   generateToolchainModule verbosity libAutogenDir Nothing
 239     where
 240       verbosity = S.fromFlag $ S.configVerbosity flags
 241       version   = pkgVersion . package $ localPkgDescr local
 242
 243       -- This is a hack. I don't know how to tell cabal that a data file needs
 244       -- installing but shouldn't be in the distribution. And it won't make the
 245       -- distribution if it's not there, so instead I just delete
 246       -- the file after configure.
 247       configureRTS = make verbosity ["-C", "rts", "clean"]
 248
 249 #if !(MIN_VERSION_Cabal(2,0,0))
 250       autogenComponentModulesDir lbi _ = autogenModulesDir lbi
 251 #endif
 252
 253 #if !MIN_VERSION_Cabal(3,0,0)
 254 idrisPreSDist args flags = do
 255   let dir = S.fromFlag (S.sDistDirectory flags)
 256   let verb = S.fromFlag (S.sDistVerbosity flags)
 257   generateVersionModule verb "src" True
 258   generateTargetModule verb "src" "./libs"
 259   generateToolchainModule verb "src" Nothing
 260   preSDist simpleUserHooks args flags
 261
 262 idrisSDist sdist pkgDesc bi hooks flags = do
 263   pkgDesc' <- addGitFiles pkgDesc
 264   sdist pkgDesc' bi hooks flags
 265     where
 266       addGitFiles :: PackageDescription -> IO PackageDescription
 267       addGitFiles pkgDesc = do
 268         files <- gitFiles
 269         return $ pkgDesc { extraSrcFiles = extraSrcFiles pkgDesc ++ files}
 270       gitFiles :: IO [FilePath]
 271       gitFiles = liftM lines (readProcess "git" ["ls-files"] "")
 272
 273 idrisPostSDist args flags desc lbi = do
 274   Control.Exception.catch (do let file = "src" </> "Version_idris" Px.<.> "hs"
 275                               let targetFile = "src" </> "Target_idris" Px.<.> "hs"
 276                               putStrLn $ "Removing generated modules:\n "
 277                                         ++ file ++ "\n" ++ targetFile
 278                               removeFile file
 279                               removeFile targetFile)
 280              (\e -> let e' = (e :: SomeException) in return ())
 281   postSDist simpleUserHooks args flags desc lbi
 282 #endif
 283
 284 -- -----------------------------------------------------------------------------
 285 -- Build
 286
 287 getVersion :: Args -> S.BuildFlags -> IO HookedBuildInfo
 288 getVersion args flags = do
 289       hash <- gitHash
 290       let buildinfo = (emptyBuildInfo { cppOptions = ["-DVERSION="++hash] }) :: BuildInfo
 291       return (Just buildinfo, [])
 292
 293 idrisPreBuild args flags = do
 294 #ifdef mingw32_HOST_OS
 295         createDirectoryIfMissingVerbose verbosity True dir
 296         windres verbosity ["icons/idris_icon.rc","-o", dir++"/idris_icon.o"]
 297         return (Nothing, [(fromString "idris", emptyBuildInfo { ldOptions = [dir ++ "/idris_icon.o"] })])
 298      where
 299         verbosity = S.fromFlag $ S.buildVerbosity flags
 300         dir = S.fromFlagOrDefault "dist" $ S.buildDistPref flags
 301 #else
 302         return (Nothing, [])
 303 #endif
 304
 305 idrisBuild _ flags _ local
 306    = if (execOnly (configFlags local)) then buildRTS
 307         else do buildStdLib
 308                 buildRTS
 309    where
 310       verbosity = S.fromFlag $ S.buildVerbosity flags
 311
 312       buildStdLib = do
 313             putStrLn "Building libraries..."
 314             makeBuild "libs"
 315          where
 316             makeBuild dir = make verbosity [ "-C", dir, "build" , "IDRIS=" ++ idrisCmd local]
 317
 318       buildRTS = make verbosity (["-C", "rts", "build"] ++
 319                                    gmpflag (usesGMP (configFlags local)))
 320
 321       gmpflag False = []
 322       gmpflag True = ["GMP=-DIDRIS_GMP"]
 323
 324 -- -----------------------------------------------------------------------------
 325 -- Copy/Install
 326
 327 idrisInstall verbosity copy pkg local
 328    = if (execOnly (configFlags local)) then installRTS
 329         else do installStdLib
 330                 installRTS
 331                 installManPage
 332    where
 333       target = datadir $ L.absoluteInstallDirs pkg local copy
 334
 335       installStdLib = do
 336         let target' = target -- </> "libs"
 337         putStrLn $ "Installing libraries in " ++ target'
 338         makeInstall "libs" target'
 339
 340       installRTS = do
 341          let target' = target </> "rts"
 342          putStrLn $ "Installing run time system in " ++ target'
 343          makeInstall "rts" target'
 344
 345       installManPage = do
 346          let mandest = mandir (L.absoluteInstallDirs pkg local copy) ++ "/man1"
 347          notice verbosity $ unwords ["Copying man page to", mandest]
 348          installOrdinaryFiles verbosity mandest [("man", "idris.1")]
 349
 350       makeInstall src target =
 351          make verbosity [ "-C", src, "install" , "TARGET=" ++ target, "IDRIS=" ++ idrisCmd local]
 352
 353 -- -----------------------------------------------------------------------------
 354 -- Test
 355
 356 -- There are two "dataDir" in cabal, and they don't relate to each other.
 357 -- When fetching modules, idris uses the second path (in the pkg record),
 358 -- which by default is the root folder of the project.
 359 -- We want it to be the install directory where we put the idris libraries.
 360 fixPkg pkg target = pkg { dataDir = target }
 361
 362 idrisTestHook args pkg local hooks flags = do
 363   let target = datadir $ L.absoluteInstallDirs pkg local NoCopyDest
 364   testHook simpleUserHooks args (fixPkg pkg target) local hooks flags
 365
 366 -- -----------------------------------------------------------------------------
 367 -- Main
 368
 369 -- Install libraries during both copy and install
 370 -- See https://github.com/haskell/cabal/issues/709
 371 main = defaultMainWithHooks $ simpleUserHooks
 372    { postClean = idrisClean
 373    , postConf  = idrisConfigure
 374    , preBuild = idrisPreBuild
 375    , postBuild = idrisBuild
 376    , postCopy = \_ flags pkg local ->
 377                   idrisInstall (S.fromFlag $ S.copyVerbosity flags)
 378                                (S.fromFlag $ S.copyDest flags) pkg local
 379    , postInst = \_ flags pkg local ->
 380                   idrisInstall (S.fromFlag $ S.installVerbosity flags)
 381                                NoCopyDest pkg local
 382 #if !MIN_VERSION_Cabal(3,0,0)
 383    , preSDist = idrisPreSDist
 384    , sDistHook = idrisSDist (sDistHook simpleUserHooks)
 385    , postSDist = idrisPostSDist
 386 #endif
 387    , testHook = idrisTestHook
 388    }