cabal-testsuite/Setup.hs

   1 {-# LANGUAGE Haskell2010 #-}
   2 module Main (main) where
   3
   4 import Distribution.Backpack
   5 import Distribution.Simple
   6 import Distribution.Simple.BuildPaths
   7 import Distribution.Simple.LocalBuildInfo
   8 import Distribution.Simple.Setup
   9 import Distribution.Simple.Utils
  10 import Distribution.Types.LocalBuildInfo
  11 import Distribution.Types.ModuleRenaming
  12 import Distribution.Types.UnqualComponentName
  13
  14 import System.Directory
  15 import System.FilePath
  16
  17 main :: IO ()
  18 main = defaultMainWithHooks simpleUserHooks
  19     { buildHook = \pkg lbi hooks flags -> do
  20         generateScriptEnvModule lbi flags
  21         buildHook simpleUserHooks pkg lbi hooks flags
  22     }
  23
  24 generateScriptEnvModule :: LocalBuildInfo -> BuildFlags -> IO ()
  25 generateScriptEnvModule lbi flags = do
  26     lbiPackageDbStack <- mapM canonicalizePackageDB (withPackageDB lbi)
  27
  28     createDirectoryIfMissing True moduledir
  29     rewriteFileEx verbosity (moduledir </> "ScriptEnv0.hs") $ unlines
  30       [ "module Test.Cabal.ScriptEnv0 where"
  31       , ""
  32       , "import Distribution.Simple"
  33       , "import Distribution.System (Platform(..), Arch(..), OS(..))"
  34       , "import Distribution.Types.ModuleRenaming"
  35       , "import Distribution.Simple.Program.Db"
  36       , "import Distribution.Backpack (OpenUnitId)"
  37       , "import Data.Map (fromList)"
  38       , ""
  39       , "lbiPackageDbStack :: PackageDBStack"
  40       , "lbiPackageDbStack = " ++ show lbiPackageDbStack
  41       , ""
  42       , "lbiPlatform :: Platform"
  43       , "lbiPlatform = " ++ show (hostPlatform lbi)
  44       , ""
  45       , "lbiCompiler :: Compiler"
  46       , "lbiCompiler = " ++ show (compiler lbi)
  47       , ""
  48       , "lbiPackages :: [(OpenUnitId, ModuleRenaming)]"
  49       , "lbiPackages = read " ++ show (show (cabalTestsPackages lbi))
  50       , ""
  51       , "lbiProgramDb :: ProgramDb"
  52       , "lbiProgramDb = read " ++ show (show (withPrograms lbi))
  53       , ""
  54       , "lbiWithSharedLib :: Bool"
  55       , "lbiWithSharedLib = " ++ show (withSharedLib lbi)
  56       ]
  57   where
  58     verbosity = fromFlagOrDefault minBound (buildVerbosity flags)
  59     moduledir = libAutogenDir </> "Test" </> "Cabal"
  60     -- fixme: use component-specific folder
  61     libAutogenDir = autogenPackageModulesDir lbi
  62
  63 -- | Convert package database into absolute path, so that
  64 -- if we change working directories in a subprocess we get the correct database.
  65 canonicalizePackageDB :: PackageDB -> IO PackageDB
  66 canonicalizePackageDB (SpecificPackageDB path)
  67     = SpecificPackageDB `fmap` canonicalizePath path
  68 canonicalizePackageDB x = return x
  69
  70 -- | Compute the set of @-package-id@ flags which would be passed when
  71 -- building the public library.  Assumes that the public library is
  72 -- non-Backpack.
  73 cabalTestsPackages :: LocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
  74 cabalTestsPackages lbi =
  75     case componentNameCLBIs lbi (CExeName (mkUnqualComponentName "cabal-tests")) of
  76         [clbi] -> -- [ (unUnitId $ unDefUnitId duid,rn) | (DefiniteUnitId duid, rn) <- componentIncludes clbi ]
  77                   componentIncludes clbi
  78         _ -> error "cabalTestsPackages"