{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Distribution.Extra.Doctest (
defaultMainWithDoctests,
defaultMainAutoconfWithDoctests,
addDoctestsUserHook,
doctestsUserHooks,
generateBuildModule,
) where
#if MIN_VERSION_Cabal(1,24,0)
#define InstalledPackageId UnitId
#endif
import Control.Monad
(when)
import Data.IORef
(modifyIORef, newIORef, readIORef)
import Data.List
(nub)
import Data.Maybe
(mapMaybe, maybeToList)
import Data.String
(fromString)
import Distribution.Package
(InstalledPackageId, Package (..))
import Distribution.PackageDescription
(BuildInfo (..), Executable (..), GenericPackageDescription,
Library (..), PackageDescription, TestSuite (..))
import Distribution.Simple
(UserHooks (..), autoconfUserHooks, defaultMainWithHooks,
simpleUserHooks)
import Distribution.Simple.Compiler
(CompilerFlavor (GHC), CompilerId (..), PackageDB (..), compilerId)
import Distribution.Simple.LocalBuildInfo
(ComponentLocalBuildInfo (componentPackageDeps), LocalBuildInfo,
compiler, withExeLBI, withLibLBI, withPackageDB, withTestLBI)
import Distribution.Simple.Setup
(BuildFlags (buildDistPref, buildVerbosity),
HaddockFlags (haddockDistPref, haddockVerbosity), emptyBuildFlags,
fromFlag)
import Distribution.Simple.Utils
(createDirectoryIfMissingVerbose, info)
import Distribution.Text
(display)
import System.FilePath
((</>))
import qualified Data.Foldable as F
(for_)
import qualified Data.Traversable as T
(traverse)
#if MIN_VERSION_Cabal(1,25,0)
import Distribution.Simple.BuildPaths
(autogenComponentModulesDir)
#else
import Distribution.Simple.BuildPaths
(autogenModulesDir)
#endif
#if MIN_VERSION_Cabal(2,0,0)
import Distribution.Types.MungedPackageId
(MungedPackageId)
import Distribution.Types.UnqualComponentName
(unUnqualComponentName)
import Distribution.PackageDescription
(CondTree (..))
import Distribution.Types.GenericPackageDescription
(GenericPackageDescription (condTestSuites))
import Distribution.Version
(mkVersion)
#else
import Data.Version
(Version (..))
import Distribution.Package
(PackageId)
#endif
#if MIN_VERSION_Cabal(3,0,0)
import Distribution.Simple.Utils
(findFileEx)
#else
import Distribution.Simple.Utils
(findFile)
#endif
#if MIN_VERSION_Cabal(3,0,0)
import Distribution.Types.LibraryName
(libraryNameString)
#endif
#if MIN_VERSION_Cabal(3,6,0)
import Distribution.Utils.Path
(getSymbolicPath)
#endif
#if MIN_VERSION_directory(1,2,2)
import System.Directory
(makeAbsolute)
#else
import System.Directory
(getCurrentDirectory)
import System.FilePath
(isAbsolute)
makeAbsolute :: FilePath -> IO FilePath
makeAbsolute p | isAbsolute p = return p
| otherwise = do
cwd <- getCurrentDirectory
return $ cwd </> p
#endif
#if !MIN_VERSION_Cabal(3,0,0)
findFileEx :: verbosity -> [FilePath] -> FilePath -> IO FilePath
findFileEx _ = findFile
#endif
#if !MIN_VERSION_Cabal(2,0,0)
mkVersion :: [Int] -> Version
mkVersion ds = Version ds []
#endif
defaultMainWithDoctests
:: String
-> IO ()
defaultMainWithDoctests :: String -> IO ()
defaultMainWithDoctests = UserHooks -> IO ()
defaultMainWithHooks forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UserHooks
doctestsUserHooks
defaultMainAutoconfWithDoctests
:: String
-> IO ()
defaultMainAutoconfWithDoctests :: String -> IO ()
defaultMainAutoconfWithDoctests String
n =
UserHooks -> IO ()
defaultMainWithHooks (String -> UserHooks -> UserHooks
addDoctestsUserHook String
n UserHooks
autoconfUserHooks)
doctestsUserHooks
:: String
-> UserHooks
doctestsUserHooks :: String -> UserHooks
doctestsUserHooks String
testsuiteName =
String -> UserHooks -> UserHooks
addDoctestsUserHook String
testsuiteName UserHooks
simpleUserHooks
addDoctestsUserHook :: String -> UserHooks -> UserHooks
addDoctestsUserHook :: String -> UserHooks -> UserHooks
addDoctestsUserHook String
testsuiteName UserHooks
uh = UserHooks
uh
{ buildHook :: PackageDescription
-> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
buildHook = \PackageDescription
pkg LocalBuildInfo
lbi UserHooks
hooks BuildFlags
flags -> do
String
-> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
generateBuildModule String
testsuiteName BuildFlags
flags PackageDescription
pkg LocalBuildInfo
lbi
UserHooks
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> BuildFlags
-> IO ()
buildHook UserHooks
uh PackageDescription
pkg LocalBuildInfo
lbi UserHooks
hooks BuildFlags
flags
, confHook :: (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
confHook = \(GenericPackageDescription
gpd, HookedBuildInfo
hbi) ConfigFlags
flags ->
UserHooks
-> (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags
-> IO LocalBuildInfo
confHook UserHooks
uh (String -> GenericPackageDescription -> GenericPackageDescription
amendGPD String
testsuiteName GenericPackageDescription
gpd, HookedBuildInfo
hbi) ConfigFlags
flags
, haddockHook :: PackageDescription
-> LocalBuildInfo -> UserHooks -> HaddockFlags -> IO ()
haddockHook = \PackageDescription
pkg LocalBuildInfo
lbi UserHooks
hooks HaddockFlags
flags -> do
String
-> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
generateBuildModule String
testsuiteName (HaddockFlags -> BuildFlags
haddockToBuildFlags HaddockFlags
flags) PackageDescription
pkg LocalBuildInfo
lbi
UserHooks
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> HaddockFlags
-> IO ()
haddockHook UserHooks
uh PackageDescription
pkg LocalBuildInfo
lbi UserHooks
hooks HaddockFlags
flags
}
haddockToBuildFlags :: HaddockFlags -> BuildFlags
haddockToBuildFlags :: HaddockFlags -> BuildFlags
haddockToBuildFlags HaddockFlags
f = BuildFlags
emptyBuildFlags
{ buildVerbosity :: Flag Verbosity
buildVerbosity = HaddockFlags -> Flag Verbosity
haddockVerbosity HaddockFlags
f
, buildDistPref :: Flag String
buildDistPref = HaddockFlags -> Flag String
haddockDistPref HaddockFlags
f
}
data Name = NameLib (Maybe String) | NameExe String deriving (Name -> Name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show)
nameToString :: Name -> String
nameToString :: Name -> String
nameToString Name
n = case Name
n of
NameLib Maybe String
x -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String
"_lib_" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
fixchar) Maybe String
x
NameExe String
x -> String
"_exe_" forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
fixchar String
x
where
fixchar :: Char -> Char
fixchar :: Char -> Char
fixchar Char
'-' = Char
'_'
fixchar Char
c = Char
c
data Component = Component Name [String] [String] [String]
deriving Int -> Component -> ShowS
[Component] -> ShowS
Component -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Component] -> ShowS
$cshowList :: [Component] -> ShowS
show :: Component -> String
$cshow :: Component -> String
showsPrec :: Int -> Component -> ShowS
$cshowsPrec :: Int -> Component -> ShowS
Show
generateBuildModule
:: String
-> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
generateBuildModule :: String
-> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
generateBuildModule String
testSuiteName BuildFlags
flags PackageDescription
pkg LocalBuildInfo
lbi = do
let verbosity :: Verbosity
verbosity = forall a. WithCallStack (Flag a -> a)
fromFlag (BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
flags)
let distPref :: String
distPref = forall a. WithCallStack (Flag a -> a)
fromFlag (BuildFlags -> Flag String
buildDistPref BuildFlags
flags)
let dbStack :: [PackageDB]
dbStack = LocalBuildInfo -> [PackageDB]
withPackageDB LocalBuildInfo
lbi forall a. [a] -> [a] -> [a]
++ [ String -> PackageDB
SpecificPackageDB forall a b. (a -> b) -> a -> b
$ String
distPref String -> ShowS
</> String
"package.conf.inplace" ]
let dbFlags :: [String]
dbFlags = String
"-hide-all-packages" forall a. a -> [a] -> [a]
: [PackageDB] -> [String]
packageDbArgs [PackageDB]
dbStack
let envFlags :: [String]
envFlags
| Bool
ghcCanBeToldToIgnorePkgEnvs = [ String
"-package-env=-" ]
| Bool
otherwise = []
PackageDescription
-> LocalBuildInfo
-> (TestSuite -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withTestLBI PackageDescription
pkg LocalBuildInfo
lbi forall a b. (a -> b) -> a -> b
$ \TestSuite
suite ComponentLocalBuildInfo
suitecfg -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TestSuite -> UnqualComponentName
testName TestSuite
suite forall a. Eq a => a -> a -> Bool
== forall a. IsString a => String -> a
fromString String
testSuiteName) forall a b. (a -> b) -> a -> b
$ do
#if MIN_VERSION_Cabal(1,25,0)
let testAutogenDir :: String
testAutogenDir = LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
suitecfg
#else
let testAutogenDir = autogenModulesDir lbi
#endif
Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
testAutogenDir
let buildDoctestsFile :: String
buildDoctestsFile = String
testAutogenDir String -> ShowS
</> String
"Build_doctests.hs"
Verbosity -> String -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"cabal-doctest: writing Build_doctests to " forall a. [a] -> [a] -> [a]
++ String
buildDoctestsFile
String -> String -> IO ()
writeFile String
buildDoctestsFile forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"module Build_doctests where"
, String
""
, String
"import Prelude"
, String
""
, String
"data Name = NameLib (Maybe String) | NameExe String deriving (Eq, Show)"
, String
"data Component = Component Name [String] [String] [String] deriving (Eq, Show)"
, String
""
]
IORef [Component]
componentsRef <- forall a. a -> IO (IORef a)
newIORef []
let testBI :: BuildInfo
testBI = TestSuite -> BuildInfo
testBuildInfo TestSuite
suite
let additionalFlags :: [String]
additionalFlags = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] String -> [String]
words
forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"x-doctest-options"
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [(String, String)]
customFieldsBI BuildInfo
testBI
let additionalModules :: [String]
additionalModules = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] String -> [String]
words
forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"x-doctest-modules"
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [(String, String)]
customFieldsBI BuildInfo
testBI
let additionalDirs' :: [String]
additionalDirs' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] String -> [String]
words
forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"x-doctest-source-dirs"
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [(String, String)]
customFieldsBI BuildInfo
testBI
[String]
additionalDirs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
"-i" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
makeAbsolute) [String]
additionalDirs'
let getBuildDoctests :: (PackageDescription
-> LocalBuildInfo -> (t -> ComponentLocalBuildInfo -> IO ()) -> b)
-> (t -> Name)
-> (t -> [ModuleName])
-> (t -> Maybe String)
-> (t -> BuildInfo)
-> b
getBuildDoctests PackageDescription
-> LocalBuildInfo -> (t -> ComponentLocalBuildInfo -> IO ()) -> b
withCompLBI t -> Name
mbCompName t -> [ModuleName]
compExposedModules t -> Maybe String
compMainIs t -> BuildInfo
compBuildInfo =
PackageDescription
-> LocalBuildInfo -> (t -> ComponentLocalBuildInfo -> IO ()) -> b
withCompLBI PackageDescription
pkg LocalBuildInfo
lbi forall a b. (a -> b) -> a -> b
$ \t
comp ComponentLocalBuildInfo
compCfg -> do
let compBI :: BuildInfo
compBI = t -> BuildInfo
compBuildInfo t
comp
let modules :: [ModuleName]
modules = t -> [ModuleName]
compExposedModules t
comp forall a. [a] -> [a] -> [a]
++ BuildInfo -> [ModuleName]
otherModules BuildInfo
compBI
let module_sources :: [ModuleName]
module_sources = [ModuleName]
modules
#if MIN_VERSION_Cabal(1,25,0)
let compAutogenDir :: String
compAutogenDir = LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
compCfg
#else
let compAutogenDir = autogenModulesDir lbi
#endif
[String]
iArgsNoPrefix
<- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO String
makeAbsolute
forall a b. (a -> b) -> a -> b
$ String
compAutogenDir
forall a. a -> [a] -> [a]
: (String
distPref forall a. [a] -> [a] -> [a]
++ String
"/build")
#if MIN_VERSION_Cabal(3,6,0)
forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
compBI)
#else
: hsSourceDirs compBI
#endif
[String]
includeArgs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
"-I"forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
makeAbsolute) forall a b. (a -> b) -> a -> b
$ BuildInfo -> [String]
includeDirs BuildInfo
compBI
let iArgs' :: [String]
iArgs' = forall a b. (a -> b) -> [a] -> [b]
map (String
"-i"forall a. [a] -> [a] -> [a]
++) [String]
iArgsNoPrefix
iArgs :: [String]
iArgs = String
"-i" forall a. a -> [a] -> [a]
: [String]
iArgs'
let extensionArgs :: [String]
extensionArgs = forall a b. (a -> b) -> [a] -> [b]
map ((String
"-X"forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
display) forall a b. (a -> b) -> a -> b
$ BuildInfo -> [Extension]
defaultExtensions BuildInfo
compBI
let cppFlags :: [String]
cppFlags = forall a b. (a -> b) -> [a] -> [b]
map (String
"-optP"forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$
[ String
"-include", String
compAutogenDir forall a. [a] -> [a] -> [a]
++ String
"/cabal_macros.h" ]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
cppOptions BuildInfo
compBI
Maybe String
mainIsPath <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse (Verbosity -> [String] -> String -> IO String
findFileEx Verbosity
verbosity [String]
iArgsNoPrefix) (t -> Maybe String
compMainIs t
comp)
let all_sources :: [String]
all_sources = forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
display [ModuleName]
module_sources
forall a. [a] -> [a] -> [a]
++ [String]
additionalModules
forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe String
mainIsPath
let component :: Component
component = Name -> [String] -> [String] -> [String] -> Component
Component
(t -> Name
mbCompName t
comp)
([(UnitId, MungedPackageId)] -> [String]
formatDeps forall a b. (a -> b) -> a -> b
$ ComponentLocalBuildInfo
-> ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
testDeps ComponentLocalBuildInfo
compCfg ComponentLocalBuildInfo
suitecfg)
(forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [String]
iArgs
, [String]
additionalDirs
, [String]
includeArgs
, [String]
envFlags
, [String]
dbFlags
, [String]
cppFlags
, [String]
extensionArgs
, [String]
additionalFlags
])
[String]
all_sources
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [Component]
componentsRef (\[Component]
cs -> [Component]
cs forall a. [a] -> [a] -> [a]
++ [Component
component])
forall {t} {b}.
(PackageDescription
-> LocalBuildInfo -> (t -> ComponentLocalBuildInfo -> IO ()) -> b)
-> (t -> Name)
-> (t -> [ModuleName])
-> (t -> Maybe String)
-> (t -> BuildInfo)
-> b
getBuildDoctests PackageDescription
-> LocalBuildInfo
-> (Library -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withLibLBI Library -> Name
mbLibraryName Library -> [ModuleName]
exposedModules (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) Library -> BuildInfo
libBuildInfo
forall {t} {b}.
(PackageDescription
-> LocalBuildInfo -> (t -> ComponentLocalBuildInfo -> IO ()) -> b)
-> (t -> Name)
-> (t -> [ModuleName])
-> (t -> Maybe String)
-> (t -> BuildInfo)
-> b
getBuildDoctests PackageDescription
-> LocalBuildInfo
-> (Executable -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withExeLBI (String -> Name
NameExe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> String
executableName) (forall a b. a -> b -> a
const []) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> String
modulePath) Executable -> BuildInfo
buildInfo
[Component]
components <- forall a. IORef a -> IO a
readIORef IORef [Component]
componentsRef
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
F.for_ [Component]
components forall a b. (a -> b) -> a -> b
$ \(Component Name
cmpName [String]
cmpPkgs [String]
cmpFlags [String]
cmpSources) -> do
let compSuffix :: String
compSuffix = Name -> String
nameToString Name
cmpName
pkgs_comp :: String
pkgs_comp = String
"pkgs" forall a. [a] -> [a] -> [a]
++ String
compSuffix
flags_comp :: String
flags_comp = String
"flags" forall a. [a] -> [a] -> [a]
++ String
compSuffix
module_sources_comp :: String
module_sources_comp = String
"module_sources" forall a. [a] -> [a] -> [a]
++ String
compSuffix
String -> String -> IO ()
appendFile String
buildDoctestsFile forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[
String
pkgs_comp forall a. [a] -> [a] -> [a]
++ String
" :: [String]"
, String
pkgs_comp forall a. [a] -> [a] -> [a]
++ String
" = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [String]
cmpPkgs
, String
""
, String
flags_comp forall a. [a] -> [a] -> [a]
++ String
" :: [String]"
, String
flags_comp forall a. [a] -> [a] -> [a]
++ String
" = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [String]
cmpFlags
, String
""
, String
module_sources_comp forall a. [a] -> [a] -> [a]
++ String
" :: [String]"
, String
module_sources_comp forall a. [a] -> [a] -> [a]
++ String
" = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [String]
cmpSources
, String
""
]
let enabledComponents :: [Name]
enabledComponents = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Maybe String -> Name
NameLib forall a. Maybe a
Nothing] (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe Name
parseComponentName forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words)
forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"x-doctest-components"
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [(String, String)]
customFieldsBI BuildInfo
testBI
let components' :: [Component]
components' =
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Component Name
n [String]
_ [String]
_ [String]
_) -> Name
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
enabledComponents) [Component]
components
String -> String -> IO ()
appendFile String
buildDoctestsFile forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"-- " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [Name]
enabledComponents
, String
"components :: [Component]"
, String
"components = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [Component]
components'
]
where
parseComponentName :: String -> Maybe Name
parseComponentName :: String -> Maybe Name
parseComponentName String
"lib" = forall a. a -> Maybe a
Just (Maybe String -> Name
NameLib forall a. Maybe a
Nothing)
parseComponentName (Char
'l' : Char
'i' : Char
'b' : Char
':' : String
x) = forall a. a -> Maybe a
Just (Maybe String -> Name
NameLib (forall a. a -> Maybe a
Just String
x))
parseComponentName (Char
'e' : Char
'x' : Char
'e' : Char
':' : String
x) = forall a. a -> Maybe a
Just (String -> Name
NameExe String
x)
parseComponentName String
_ = forall a. Maybe a
Nothing
isNewCompiler :: Bool
isNewCompiler = case Compiler -> CompilerId
compilerId forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi of
CompilerId CompilerFlavor
GHC Version
v -> Version
v forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
7,Int
6]
CompilerId
_ -> Bool
False
ghcCanBeToldToIgnorePkgEnvs :: Bool
ghcCanBeToldToIgnorePkgEnvs :: Bool
ghcCanBeToldToIgnorePkgEnvs = case Compiler -> CompilerId
compilerId forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi of
CompilerId CompilerFlavor
GHC Version
v -> Version
v forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8,Int
4,Int
4]
CompilerId
_ -> Bool
False
formatDeps :: [(UnitId, MungedPackageId)] -> [String]
formatDeps = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. (Pretty a, Pretty a) => (a, a) -> String
formatOne
formatOne :: (a, a) -> String
formatOne (a
installedPkgId, a
pkgId)
| forall a. Pretty a => a -> String
display (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg) forall a. Eq a => a -> a -> Bool
== forall a. Pretty a => a -> String
display a
pkgId = String
"-package=" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
display a
pkgId
| Bool
otherwise = String
"-package-id=" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
display a
installedPkgId
packageDbArgs :: [PackageDB] -> [String]
packageDbArgs :: [PackageDB] -> [String]
packageDbArgs | Bool
isNewCompiler = [PackageDB] -> [String]
packageDbArgsDb
| Bool
otherwise = [PackageDB] -> [String]
packageDbArgsConf
packageDbArgsConf :: [PackageDB] -> [String]
packageDbArgsConf :: [PackageDB] -> [String]
packageDbArgsConf [PackageDB]
dbstack = case [PackageDB]
dbstack of
(PackageDB
GlobalPackageDB:PackageDB
UserPackageDB:[PackageDB]
dbs) -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDB -> [String]
specific [PackageDB]
dbs
(PackageDB
GlobalPackageDB:[PackageDB]
dbs) -> (String
"-no-user-package-conf")
forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDB -> [String]
specific [PackageDB]
dbs
[PackageDB]
_ -> forall {a}. a
ierror
where
specific :: PackageDB -> [String]
specific (SpecificPackageDB String
db) = [ String
"-package-conf=" forall a. [a] -> [a] -> [a]
++ String
db ]
specific PackageDB
_ = forall {a}. a
ierror
ierror :: a
ierror = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"internal error: unexpected package db stack: "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [PackageDB]
dbstack
packageDbArgsDb :: [PackageDB] -> [String]
packageDbArgsDb :: [PackageDB] -> [String]
packageDbArgsDb [PackageDB]
dbstack = case [PackageDB]
dbstack of
(PackageDB
GlobalPackageDB:PackageDB
UserPackageDB:[PackageDB]
dbs)
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all PackageDB -> Bool
isSpecific [PackageDB]
dbs -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDB -> [String]
single [PackageDB]
dbs
(PackageDB
GlobalPackageDB:[PackageDB]
dbs)
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all PackageDB -> Bool
isSpecific [PackageDB]
dbs -> String
"-no-user-package-db"
forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDB -> [String]
single [PackageDB]
dbs
[PackageDB]
dbs -> String
"-clear-package-db"
forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDB -> [String]
single [PackageDB]
dbs
where
single :: PackageDB -> [String]
single (SpecificPackageDB String
db) = [ String
"-package-db=" forall a. [a] -> [a] -> [a]
++ String
db ]
single PackageDB
GlobalPackageDB = [ String
"-global-package-db" ]
single PackageDB
UserPackageDB = [ String
"-user-package-db" ]
isSpecific :: PackageDB -> Bool
isSpecific (SpecificPackageDB String
_) = Bool
True
isSpecific PackageDB
_ = Bool
False
mbLibraryName :: Library -> Name
#if MIN_VERSION_Cabal(3,0,0)
mbLibraryName :: Library -> Name
mbLibraryName = Maybe String -> Name
NameLib forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnqualComponentName -> String
unUnqualComponentName forall b c a. (b -> c) -> (a -> b) -> a -> c
. LibraryName -> Maybe UnqualComponentName
libraryNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName
#elif MIN_VERSION_Cabal(2,0,0)
mbLibraryName = NameLib . fmap unUnqualComponentName . libName
#else
mbLibraryName _ = NameLib Nothing
#endif
executableName :: Executable -> String
#if MIN_VERSION_Cabal(2,0,0)
executableName :: Executable -> String
executableName = UnqualComponentName -> String
unUnqualComponentName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> UnqualComponentName
exeName
#else
executableName = exeName
#endif
testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo
#if MIN_VERSION_Cabal(2,0,0)
-> [(InstalledPackageId, MungedPackageId)]
#else
-> [(InstalledPackageId, PackageId)]
#endif
testDeps :: ComponentLocalBuildInfo
-> ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
testDeps ComponentLocalBuildInfo
xs ComponentLocalBuildInfo
ys = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
componentPackageDeps ComponentLocalBuildInfo
xs forall a. [a] -> [a] -> [a]
++ ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
componentPackageDeps ComponentLocalBuildInfo
ys
amendGPD
:: String
-> GenericPackageDescription
-> GenericPackageDescription
#if !(MIN_VERSION_Cabal(2,0,0))
amendGPD _ gpd = gpd
#else
amendGPD :: String -> GenericPackageDescription -> GenericPackageDescription
amendGPD String
testSuiteName GenericPackageDescription
gpd = GenericPackageDescription
gpd
{ condTestSuites :: [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {v} {c}.
(Eq a, IsString a) =>
(a, CondTree v c TestSuite) -> (a, CondTree v c TestSuite)
f (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites GenericPackageDescription
gpd)
}
where
f :: (a, CondTree v c TestSuite) -> (a, CondTree v c TestSuite)
f (a
name, CondTree v c TestSuite
condTree)
| a
name forall a. Eq a => a -> a -> Bool
== forall a. IsString a => String -> a
fromString String
testSuiteName = (a
name, CondTree v c TestSuite
condTree')
| Bool
otherwise = (a
name, CondTree v c TestSuite
condTree)
where
testSuite :: TestSuite
testSuite = forall v c a. CondTree v c a -> a
condTreeData CondTree v c TestSuite
condTree
bi :: BuildInfo
bi = TestSuite -> BuildInfo
testBuildInfo TestSuite
testSuite
om :: [ModuleName]
om = BuildInfo -> [ModuleName]
otherModules BuildInfo
bi
am :: [ModuleName]
am = BuildInfo -> [ModuleName]
autogenModules BuildInfo
bi
om' :: [ModuleName]
om' = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ ModuleName
mn forall a. a -> [a] -> [a]
: [ModuleName]
om
am' :: [ModuleName]
am' = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ ModuleName
mn forall a. a -> [a] -> [a]
: [ModuleName]
am
mn :: ModuleName
mn = forall a. IsString a => String -> a
fromString String
"Build_doctests"
bi' :: BuildInfo
bi' = BuildInfo
bi { otherModules :: [ModuleName]
otherModules = [ModuleName]
om', autogenModules :: [ModuleName]
autogenModules = [ModuleName]
am' }
testSuite' :: TestSuite
testSuite' = TestSuite
testSuite { testBuildInfo :: BuildInfo
testBuildInfo = BuildInfo
bi' }
condTree' :: CondTree v c TestSuite
condTree' = CondTree v c TestSuite
condTree { condTreeData :: TestSuite
condTreeData = TestSuite
testSuite' }
#endif