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