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