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       [ "{-# LANGUAGE OverloadedStrings #-}"
  34       , "{-# LANGUAGE FlexibleInstances #-}"
  35       , "{-# OPTIONS_GHC -Wno-orphans   #-}"
  36       , "module Test.Cabal.ScriptEnv0 where"
  37       , ""
  38       , "import Distribution.Simple"
  39       , "import Distribution.System (Platform(..), Arch(..), OS(..))"
  40       , "import Distribution.Types.ModuleRenaming"
  41       , "import Distribution.Simple.Program.Db"
  42       , "import Distribution.Backpack (OpenUnitId)"
  43       , "import Data.Map (fromList)"
  44       , "import Data.String (IsString(..))"
  45       , "import Distribution.Utils.Path"
  46       , ""
  47       , "lbiPackageDbStack :: PackageDBStackCWD"
  48       , "lbiPackageDbStack = " ++ show lbiPackageDbStack
  49       , ""
  50       , "lbiPlatform :: Platform"
  51       , "lbiPlatform = " ++ show (hostPlatform lbi)
  52       , ""
  53       , "lbiCompiler :: Compiler"
  54       , "lbiCompiler = " ++ show (compiler lbi)
  55       , ""
  56       , "lbiPackages :: [(OpenUnitId, ModuleRenaming)]"
  57       , "lbiPackages = read " ++ show (show (cabalTestsPackages lbi))
  58       , ""
  59       , "lbiProgramDb :: ProgramDb"
  60       , "lbiProgramDb = read " ++ show (show (withPrograms lbi))
  61       , ""
  62       , "lbiWithSharedLib :: Bool"
  63       , "lbiWithSharedLib = " ++ show (withSharedLib lbi)
  64       , ""
  65       , "instance IsString (SymbolicPath from to) where"
  66       , "  fromString = makeSymbolicPath"
  67       ]
  68   where
  69     moduledir = libAutogenDir </> "Test" </> "Cabal"
  70     -- fixme: use component-specific folder
  71     libAutogenDir = autogenPackageModulesDir lbi
  72
  73 -- | Convert package database into absolute path, so that
  74 -- if we change working directories in a subprocess we get the correct database.
  75 canonicalizePackageDB :: PackageDB -> IO PackageDB
  76 canonicalizePackageDB (SpecificPackageDB path)
  77     = SpecificPackageDB `fmap` canonicalizePath path
  78 canonicalizePackageDB x = return x
  79
  80 -- | Compute the set of @-package-id@ flags which would be passed when
  81 -- building the public library.  Assumes that the public library is
  82 -- non-Backpack.
  83 cabalTestsPackages :: LocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
  84 cabalTestsPackages lbi =
  85     case componentNameCLBIs lbi (CExeName (mkUnqualComponentName "test-runtime-deps")) of
  86         [clbi] -> -- [ (unUnitId $ unDefUnitId duid,rn) | (DefiniteUnitId duid, rn) <- componentIncludes clbi ]
  87                   componentIncludes clbi
  88         _ -> error "cabalTestsPackages"