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