{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
#if MIN_VERSION_Cabal(3,14,0)
{-# LANGUAGE DataKinds #-}
#endif
{-# LANGUAGE MultiParamTypeClasses #-}

-- | See cabal-doctest README for full-fledged recipes & caveats.
--
-- The provided 'generateBuildModule' generates a @Build_{suffix}@ module, with
-- caller-chosen @suffix@ that is usually @"doctests"@ -- module @Build_doctests@.
--
-- That module exports just enough compiler flags, so that doctest could be simply
--
-- @
-- module Main where
--
-- import Build_doctests (flags, pkgs, module_sources)
-- import Test.Doctest (doctest)
--
-- main :: IO ()
-- main = doctest args
--   where
--     args = flags ++ pkgs ++ module_sources
-- @
--
-- As this module-generation is done at build-time, 'generateBuildModule' must be
-- invoked from @Setup.hs@, which also necessarily means @build-type: Custom@.
--
-- @Setup.hs@ can use libraries, but they must be declared as dependencies in the
-- @custom-setup@ stanza of the user's cabal file. To use @cabal-doctest@ then:
--
-- @
-- custom-setup
--  setup-depends:
--    base >= 4 && <5,
--    cabal-doctest >= 1 && <1.1
-- @
--
-- Finally, simple shortcuts are provided to avoid an explicit dependency on @Cabal@
-- from @setup-depends@: 'defaultMainWithDoctests' and 'defaultMainAutoconfWithDoctests'.
--
module Distribution.Extra.Doctest (
    defaultMainWithDoctests,
    defaultMainAutoconfWithDoctests,
    addDoctestsUserHook,
    doctestsUserHooks,
    generateBuildModule,
    ) where

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
       (UnitId, Package (..))
import Distribution.PackageDescription
       (BuildInfo (..), Executable (..), GenericPackageDescription,
       Library (..), PackageDescription, TestSuite (..))
import Distribution.Simple
       (UserHooks (..), autoconfUserHooks, defaultMainWithHooks,
       simpleUserHooks)
import Distribution.Simple.Compiler
       (CompilerFlavor (GHC), CompilerId (..), compilerId)
import Distribution.Simple.LocalBuildInfo
       (ComponentLocalBuildInfo (componentPackageDeps), LocalBuildInfo,
       compiler, withExeLBI, withLibLBI, withPackageDB, withTestLBI)
import Distribution.Simple.Setup
       (BuildFlags (..),
       emptyBuildFlags,
       fromFlag)
import Distribution.Simple.Utils
       (createDirectoryIfMissingVerbose, info)
import Distribution.Text
       (display)

import qualified Data.Foldable    as F
                 (for_)
import qualified Data.Traversable as T
                 (traverse)
import qualified System.FilePath ((</>))

#if MIN_VERSION_base(4,11,0)
import Data.Functor ((<&>))
#endif

#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)

-- For amendGPD
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,5,0)
import Distribution.Utils.Path
       (getSymbolicPath)
#endif

#if MIN_VERSION_Cabal(3,14,0)
-- https://github.com/haskell/cabal/issues/10559
import Distribution.Simple.Compiler
       (PackageDB, PackageDBX (GlobalPackageDB, UserPackageDB, SpecificPackageDB))
import Distribution.Simple.LocalBuildInfo
       (absoluteWorkingDirLBI, interpretSymbolicPathLBI)
import Distribution.Simple.Setup
       (HaddockFlags, haddockCommonFlags)
import Distribution.Utils.Path
       (FileOrDir(..), SymbolicPath, interpretSymbolicPathAbsolute, makeRelativePathEx, makeSymbolicPath)
import qualified Distribution.Utils.Path as SymPath ((</>))
#else
import Distribution.Simple.Compiler
       (PackageDB (GlobalPackageDB, UserPackageDB, SpecificPackageDB))
import Distribution.Simple.Setup
       (HaddockFlags (haddockDistPref, haddockVerbosity))
#endif

#if MIN_VERSION_directory(1,2,2)
import System.Directory
       (makeAbsolute)
#else
import System.Directory
       (getCurrentDirectory)
import System.FilePath
       (isAbsolute)
#endif

{- HLINT ignore "Use fewer imports" -}

-------------------------------------------------------------------------------
-- Compat
-------------------------------------------------------------------------------

#if !MIN_VERSION_base(4,11,0)
(<&>) :: Functor f => f a -> (a -> b) -> f b
(<&>) = flip fmap
infixl 1 <&>
#endif

class CompatSymPath p q where
  (</>) :: p -> FilePath -> q
infixr 5 </>
instance CompatSymPath FilePath FilePath where
  </> :: String -> String -> String
(</>) = String -> String -> String
(System.FilePath.</>)
#if MIN_VERSION_Cabal(3,14,0)
instance CompatSymPath (SymbolicPath allowAbs ('Dir loc1))
                       (SymbolicPath allowAbs ('Dir loc2)) where
  dir </> name = dir SymPath.</> makeRelativePathEx name
#endif

#if MIN_VERSION_Cabal(3,14,0)
unsymbolizePath = getSymbolicPath
#else
makeSymbolicPath :: FilePath -> FilePath
makeSymbolicPath :: String -> String
makeSymbolicPath = String -> String
forall a. a -> a
id
unsymbolizePath :: FilePath -> FilePath
unsymbolizePath :: String -> String
unsymbolizePath = String -> String
forall a. a -> a
id
#endif


#if !MIN_VERSION_directory(1,2,2)
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

-------------------------------------------------------------------------------
-- Mains
-------------------------------------------------------------------------------

-- | A default @Setup.hs@ main with doctests:
--
-- @
-- import Distribution.Extra.Doctest
--        (defaultMainWithDoctests)
--
-- main :: IO ()
-- main = defaultMainWithDoctests "doctests"
-- @
defaultMainWithDoctests
    :: String  -- ^ doctests test-suite name
    -> IO ()
defaultMainWithDoctests :: String -> IO ()
defaultMainWithDoctests = UserHooks -> IO ()
defaultMainWithHooks (UserHooks -> IO ()) -> (String -> UserHooks) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UserHooks
doctestsUserHooks

-- | Like 'defaultMainWithDoctests', but for packages with @build-type: Configure@.
--
-- @since 1.0.2
defaultMainAutoconfWithDoctests
    :: String  -- ^ doctests test-suite name
    -> IO ()
defaultMainAutoconfWithDoctests :: String -> IO ()
defaultMainAutoconfWithDoctests String
n =
    UserHooks -> IO ()
defaultMainWithHooks (String -> UserHooks -> UserHooks
addDoctestsUserHook String
n UserHooks
autoconfUserHooks)

-- | 'simpleUserHooks' with 'generateBuildModule' already wired-in.
doctestsUserHooks
    :: String  -- ^ doctests test-suite name
    -> UserHooks
doctestsUserHooks :: String -> UserHooks
doctestsUserHooks String
testsuiteName =
    String -> UserHooks -> UserHooks
addDoctestsUserHook String
testsuiteName UserHooks
simpleUserHooks

-- | Compose 'generateBuildModule' into Cabal's 'UserHooks' (prepending the action).
--
-- This is exported for advanced custom Setup-s.
--
-- @since 1.0.2
addDoctestsUserHook :: String -> UserHooks -> UserHooks
addDoctestsUserHook :: String -> UserHooks -> UserHooks
addDoctestsUserHook String
testsuiteName UserHooks
uh = UserHooks
uh
    { 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
    -- We use confHook to add "Build_doctests" to otherModules and autogenModules.
    --
    -- We cannot use HookedBuildInfo as it lets alter only the library and executables.
    , 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
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
    }

-- | Convert only flags used by 'generateBuildModule'.
haddockToBuildFlags :: HaddockFlags -> BuildFlags
haddockToBuildFlags :: HaddockFlags -> BuildFlags
haddockToBuildFlags HaddockFlags
f =
#if MIN_VERSION_Cabal(3,14,0)
  emptyBuildFlags
    { buildCommonFlags = haddockCommonFlags f }
#else
   BuildFlags
emptyBuildFlags
    { buildVerbosity = haddockVerbosity f
    , buildDistPref  = haddockDistPref f
    }
#endif

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
$c== :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
/= :: Name -> Name -> Bool
Eq, Int -> Name -> String -> String
[Name] -> String -> String
Name -> String
(Int -> Name -> String -> String)
-> (Name -> String) -> ([Name] -> String -> String) -> Show Name
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Name -> String -> String
showsPrec :: Int -> Name -> String -> String
$cshow :: Name -> String
show :: Name -> String
$cshowList :: [Name] -> String -> String
showList :: [Name] -> String -> String
Show)

nameToString :: Name -> String
nameToString :: Name -> String
nameToString Name
n = case Name
n of
  NameLib Maybe String
x -> String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String
"_lib_" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
fixchar) Maybe String
x
  NameExe String
x -> String
"_exe_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
fixchar String
x
  where
    -- Taken from Cabal:
    -- https://github.com/haskell/cabal/blob/20de0bfea72145ba1c37e3f500cee5258cc18e51/Cabal/Distribution/Simple/Build/Macros.hs#L156-L158
    --
    -- Needed to fix component names with hyphens in them, as hyphens aren't
    -- allowed in Haskell identifier names.
    fixchar :: Char -> Char
    fixchar :: Char -> Char
fixchar Char
'-' = Char
'_'
    fixchar Char
c   = Char
c

data Component = Component Name [String] [String] [String]
  deriving Int -> Component -> String -> String
[Component] -> String -> String
Component -> String
(Int -> Component -> String -> String)
-> (Component -> String)
-> ([Component] -> String -> String)
-> Show Component
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Component -> String -> String
showsPrec :: Int -> Component -> String -> String
$cshow :: Component -> String
show :: Component -> String
$cshowList :: [Component] -> String -> String
showList :: [Component] -> String -> String
Show

-- | Generate a build module for the test suite.
--
-- @
-- import Distribution.Simple
--        (defaultMainWithHooks, UserHooks(..), simpleUserHooks)
-- import Distribution.Extra.Doctest
--        (generateBuildModule)
--
-- main :: IO ()
-- main = defaultMainWithHooks simpleUserHooks
--     { buildHook = \pkg lbi hooks flags -> do
--         generateBuildModule "doctests" flags pkg lbi
--         buildHook simpleUserHooks pkg lbi hooks flags
--     }
-- @
generateBuildModule
    :: String -- ^ doctests test-suite name
    -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
generateBuildModule :: String
-> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
generateBuildModule String
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 :: String
distPref = Flag String -> String
forall a. WithCallStack (Flag a -> a)
fromFlag (BuildFlags -> Flag String
buildDistPref BuildFlags
flags)

  -- Package DBs & environments
  let dbStack :: [PackageDB]
dbStack = LocalBuildInfo -> [PackageDB]
withPackageDB LocalBuildInfo
lbi [PackageDB] -> [PackageDB] -> [PackageDB]
forall a. [a] -> [a] -> [a]
++ [ String -> PackageDB
SpecificPackageDB (String -> PackageDB) -> String -> PackageDB
forall a b. (a -> b) -> a -> b
$ String
distPref String -> String -> String
forall p q. CompatSymPath p q => p -> String -> q
</> String
"package.conf.inplace" ]
  let dbFlags :: [String]
dbFlags = String
"-hide-all-packages" String -> [String] -> [String]
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 ((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
== String -> UnqualComponentName
forall a. IsString a => String -> a
fromString String
testSuiteName) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do

    -- Locate autogen dir, to put our output into.
#if MIN_VERSION_Cabal(3,14,0)
    let testAutogenDir = interpretSymbolicPathLBI lbi
                       $ autogenComponentModulesDir lbi suitecfg
#elif 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 -> String -> String
forall p q. CompatSymPath p q => p -> String -> q
</> String
"Build_doctests.hs"

    -- First, we create the autogen'd module Build_doctests.
    -- Initially populate Build_doctests with a simple preamble.
    Verbosity -> String -> IO ()
info Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"cabal-doctest: writing Build_doctests to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
buildDoctestsFile
    String -> String -> IO ()
writeFile String
buildDoctestsFile (String -> IO ()) -> String -> IO ()
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
""
      ]

    -- we cannot traverse, only traverse_
    -- so we use IORef to collect components
    IORef [Component]
componentsRef <- [Component] -> IO (IORef [Component])
forall a. a -> IO (IORef a)
newIORef []

    let testBI :: BuildInfo
testBI = TestSuite -> BuildInfo
testBuildInfo TestSuite
suite

    -- TODO: `words` is not proper parser (no support for quotes)
    let additionalFlags :: [String]
additionalFlags = [String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] String -> [String]
words
          (Maybe String -> [String]) -> Maybe String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"x-doctest-options"
          ([(String, String)] -> Maybe String)
-> [(String, String)] -> Maybe String
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [(String, String)]
customFieldsBI BuildInfo
testBI

    let additionalModules :: [String]
additionalModules = [String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] String -> [String]
words
          (Maybe String -> [String]) -> Maybe String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"x-doctest-modules"
          ([(String, String)] -> Maybe String)
-> [(String, String)] -> Maybe String
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [(String, String)]
customFieldsBI BuildInfo
testBI

    let additionalDirs' :: [String]
additionalDirs' = [String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] String -> [String]
words
          (Maybe String -> [String]) -> Maybe String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"x-doctest-source-dirs"
          ([(String, String)] -> Maybe String)
-> [(String, String)] -> Maybe String
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [(String, String)]
customFieldsBI BuildInfo
testBI

    [String]
additionalDirs <- (String -> IO String) -> [String] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((String -> String) -> IO String -> IO String
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
"-i" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (IO String -> IO String)
-> (String -> IO String) -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
makeAbsolute) [String]
additionalDirs'

    -- Next, for each component (library or executable), we get to Build_doctests
    -- the sets of flags needed to run doctest on that component.
    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 ((t -> ComponentLocalBuildInfo -> IO ()) -> b)
-> (t -> ComponentLocalBuildInfo -> IO ()) -> b
forall a b. (a -> b) -> a -> b
$ \t
comp ComponentLocalBuildInfo
compCfg -> do
           let compBI :: BuildInfo
compBI = t -> BuildInfo
compBuildInfo t
comp

           -- modules
           let modules :: [ModuleName]
modules = t -> [ModuleName]
compExposedModules t
comp [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [ModuleName]
otherModules BuildInfo
compBI
           -- it seems that doctest is happy to take in module names, not actual files!
           let module_sources :: [ModuleName]
module_sources = [ModuleName]
modules

           -- We need the directory with the component's cabal_macros.h!
#if MIN_VERSION_Cabal(3,14,0)
           let compAutogenDir = interpretSymbolicPathLBI lbi
                              $ autogenComponentModulesDir lbi compCfg
#elif MIN_VERSION_Cabal(1,25,0)
           let compAutogenDir :: String
compAutogenDir = LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
compCfg
#else
           let compAutogenDir = autogenModulesDir lbi
#endif

           -- Lib sources and includes
           let iArgsSymbolic :: [String]
iArgsSymbolic =
                  String -> String
makeSymbolicPath String
compAutogenDir -- autogen dir
                -- preprocessed files (.hsc -> .hs); "build" is hardcoded in Cabal.
                String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String
distPref String -> String -> String
forall p q. CompatSymPath p q => p -> String -> q
</> String
"build")
#if MIN_VERSION_Cabal(3,14,0)
                : hsSourceDirs compBI
#elif MIN_VERSION_Cabal(3,5,0)
                String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
compBI [SymbolicPath PackageDir SourceDir]
-> (SymbolicPath PackageDir SourceDir -> String) -> [String]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> SymbolicPath PackageDir SourceDir -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath)
#else
                : hsSourceDirs compBI
#endif
#if MIN_VERSION_Cabal(3,14,0)
           pkgWorkdir <- absoluteWorkingDirLBI lbi
           let iArgsNoPrefix = iArgsSymbolic <&> interpretSymbolicPathAbsolute pkgWorkdir
           let includeArgs = includeDirs compBI <&> ("-I"++) . interpretSymbolicPathAbsolute pkgWorkdir
#else
           [String]
iArgsNoPrefix <- (String -> IO String) -> [String] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO String
makeAbsolute [String]
iArgsSymbolic
           [String]
includeArgs <- (String -> IO String) -> [String] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((String -> String) -> IO String -> IO String
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
"-I"String -> String -> String
forall a. [a] -> [a] -> [a]
++) (IO String -> IO String)
-> (String -> IO String) -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
makeAbsolute) ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [String]
includeDirs BuildInfo
compBI
#endif
           -- We clear all includes, so the CWD isn't used.
           let iArgs' :: [String]
iArgs' = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"-i"String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
iArgsNoPrefix
               iArgs :: [String]
iArgs  = String
"-i" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
iArgs'

           -- default-extensions
           let extensionArgs :: [String]
extensionArgs = (Extension -> String) -> [Extension] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
"-X"String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Extension -> String) -> Extension -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> String
forall a. Pretty a => a -> String
display) ([Extension] -> [String]) -> [Extension] -> [String]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [Extension]
defaultExtensions BuildInfo
compBI

           -- CPP includes, i.e. include cabal_macros.h
           let cppFlags :: [String]
cppFlags = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"-optP"String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
                   [ String
"-include", String
compAutogenDir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/cabal_macros.h" ]
                   [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
cppOptions BuildInfo
compBI

           -- Unlike other modules, the main-is module of an executable is not
           -- guaranteed to share a module name with its filepath name. That is,
           -- even though the main-is module is named Main, its filepath might
           -- actually be Something.hs. To account for this possibility, we simply
           -- pass the full path to the main-is module instead.
           Maybe String
mainIsPath <- (String -> IO String) -> Maybe String -> IO (Maybe String)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
T.traverse (Verbosity -> [String] -> String -> IO String
findFileEx Verbosity
verbosity [String]
iArgsSymbolic) (t -> Maybe String
compMainIs t
comp)

           let all_sources :: [String]
all_sources = (ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
forall a. Pretty a => a -> String
display [ModuleName]
module_sources
                             [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
additionalModules
                             [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (Maybe String
mainIsPath Maybe String -> (String -> String) -> Maybe String
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> String
unsymbolizePath)

           let component :: Component
component = Name -> [String] -> [String] -> [String] -> Component
Component
                (t -> Name
mbCompName t
comp)
                ([(UnitId, MungedPackageId)] -> [String]
formatDeps ([(UnitId, MungedPackageId)] -> [String])
-> [(UnitId, MungedPackageId)] -> [String]
forall a b. (a -> b) -> a -> b
$ ComponentLocalBuildInfo
-> ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
testDeps ComponentLocalBuildInfo
compCfg ComponentLocalBuildInfo
suitecfg)
                ([[String]] -> [String]
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

           -- modify IORef, append component
           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])

    -- For now, we only check for doctests in libraries and executables.
    (PackageDescription
 -> LocalBuildInfo
 -> (Library -> ComponentLocalBuildInfo -> IO ())
 -> IO ())
-> (Library -> Name)
-> (Library -> [ModuleName])
-> (Library -> Maybe String)
-> (Library -> BuildInfo)
-> IO ()
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 (Maybe String -> Library -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing)     Library -> BuildInfo
libBuildInfo
    (PackageDescription
 -> LocalBuildInfo
 -> (Executable -> ComponentLocalBuildInfo -> IO ())
 -> IO ())
-> (Executable -> Name)
-> (Executable -> [ModuleName])
-> (Executable -> Maybe String)
-> (Executable -> BuildInfo)
-> IO ()
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 (String -> Name) -> (Executable -> String) -> Executable -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> String
executableName) ([ModuleName] -> Executable -> [ModuleName]
forall a b. a -> b -> a
const [])     (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (Executable -> String) -> Executable -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> String
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 [String]
cmpPkgs [String]
cmpFlags [String]
cmpSources) -> do
       let compSuffix :: String
compSuffix          = Name -> String
nameToString Name
cmpName
           pkgs_comp :: String
pkgs_comp           = String
"pkgs"           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
compSuffix
           flags_comp :: String
flags_comp          = String
"flags"          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
compSuffix
           module_sources_comp :: String
module_sources_comp = String
"module_sources" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
compSuffix

       -- write autogen'd file
       String -> String -> IO ()
appendFile String
buildDoctestsFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
         [ -- -package-id etc. flags
           String
pkgs_comp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" :: [String]"
         , String
pkgs_comp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
cmpPkgs
         , String
""
         , String
flags_comp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" :: [String]"
         , String
flags_comp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
cmpFlags
         , String
""
         , String
module_sources_comp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" :: [String]"
         , String
module_sources_comp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
cmpSources
         , String
""
         ]

    -- write enabled components, i.e. x-doctest-components
    -- if none enabled, pick library
    let enabledComponents :: [Name]
enabledComponents = [Name] -> (String -> [Name]) -> Maybe String -> [Name]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Maybe String -> Name
NameLib Maybe String
forall a. Maybe a
Nothing] ((String -> Maybe Name) -> [String] -> [Name]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe Name
parseComponentName ([String] -> [Name]) -> (String -> [String]) -> String -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words)
           (Maybe String -> [Name]) -> Maybe String -> [Name]
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"x-doctest-components"
           ([(String, String)] -> Maybe String)
-> [(String, String)] -> Maybe String
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [(String, String)]
customFieldsBI BuildInfo
testBI

    let components' :: [Component]
components' =
         (Component -> Bool) -> [Component] -> [Component]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Component Name
n [String]
_ [String]
_ [String]
_) -> Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
enabledComponents) [Component]
components
    String -> String -> IO ()
appendFile String
buildDoctestsFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
      [ String
"-- " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Name] -> String
forall a. Show a => a -> String
show [Name]
enabledComponents
      , String
"components :: [Component]"
      , String
"components = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Component] -> String
forall a. Show a => a -> String
show [Component]
components'
      ]

  where
    parseComponentName :: String -> Maybe Name
    parseComponentName :: String -> Maybe Name
parseComponentName String
"lib"                       = Name -> Maybe Name
forall a. a -> Maybe a
Just (Maybe String -> Name
NameLib Maybe String
forall a. Maybe a
Nothing)
    parseComponentName (Char
'l' : Char
'i' : Char
'b' : Char
':' : String
x) = Name -> Maybe Name
forall a. a -> Maybe a
Just (Maybe String -> Name
NameLib (String -> Maybe String
forall a. a -> Maybe a
Just String
x))
    parseComponentName (Char
'e' : Char
'x' : Char
'e' : Char
':' : String
x) = Name -> Maybe Name
forall a. a -> Maybe a
Just (String -> Name
NameExe String
x)
    parseComponentName String
_ = Maybe Name
forall a. Maybe a
Nothing

    -- we do this check in Setup, as then doctests don't need to depend on Cabal
    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)] -> [String]
formatDeps = ((UnitId, MungedPackageId) -> String)
-> [(UnitId, MungedPackageId)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (UnitId, MungedPackageId) -> String
forall {a} {a}. (Pretty a, Pretty a) => (a, a) -> String
formatOne
    formatOne :: (a, a) -> String
formatOne (a
installedPkgId, a
pkgId)
      -- The problem is how different cabal executables handle package databases
      -- when doctests depend on the library
      --
      -- If the pkgId is current package, we don't output the full package-id
      -- but only the name
      --
      -- Because of MungedPackageId we compare display version of identifiers
      -- not the identifiers themfselves.
      | PackageIdentifier -> String
forall a. Pretty a => a -> String
display (PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== a -> String
forall a. Pretty a => a -> String
display a
pkgId = String
"-package=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Pretty a => a -> String
display a
pkgId
      | Bool
otherwise              = String
"-package-id=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Pretty a => a -> String
display a
installedPkgId

    -- From Distribution.Simple.Program.GHC
    packageDbArgs :: [PackageDB] -> [String]
    packageDbArgs :: [PackageDB] -> [String]
packageDbArgs | Bool
isNewCompiler = [PackageDB] -> [String]
packageDbArgsDb
                  | Bool
otherwise     = [PackageDB] -> [String]
packageDbArgsConf

    -- GHC <7.6 uses '-package-conf' instead of '-package-db'.
    packageDbArgsConf :: [PackageDB] -> [String]
    packageDbArgsConf :: [PackageDB] -> [String]
packageDbArgsConf [PackageDB]
dbstack = case [PackageDB]
dbstack of
      (PackageDB
GlobalPackageDB:PackageDB
UserPackageDB:[PackageDB]
dbs) -> (PackageDB -> [String]) -> [PackageDB] -> [String]
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"
                                           String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (PackageDB -> [String]) -> [PackageDB] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDB -> [String]
specific [PackageDB]
dbs
      [PackageDB]
_ -> [String]
forall {a}. a
ierror
      where
        specific :: PackageDB -> [String]
specific (SpecificPackageDB String
db) = [ String
"-package-conf=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
unsymbolizePath String
db ]
        specific PackageDB
_                      = [String]
forall {a}. a
ierror
        ierror :: a
ierror = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"internal error: unexpected package db stack: "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ [PackageDB] -> String
forall a. Show a => a -> String
show [PackageDB]
dbstack

    -- GHC >= 7.6 uses the '-package-db' flag. See
    -- https://ghc.haskell.org/trac/ghc/ticket/5977.
    packageDbArgsDb :: [PackageDB] -> [String]
    -- special cases to make arguments prettier in common scenarios
    packageDbArgsDb :: [PackageDB] -> [String]
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 -> [String]) -> [PackageDB] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDB -> [String]
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              -> String
"-no-user-package-db"
                                           String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (PackageDB -> [String]) -> [PackageDB] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageDB -> [String]
single [PackageDB]
dbs
      [PackageDB]
dbs                                 -> String
"-clear-package-db"
                                           String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (PackageDB -> [String]) -> [PackageDB] -> [String]
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=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
unsymbolizePath 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 (Maybe String -> Name)
-> (Library -> Maybe String) -> Library -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName -> String)
-> Maybe UnqualComponentName -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnqualComponentName -> String
unUnqualComponentName (Maybe UnqualComponentName -> Maybe String)
-> (Library -> Maybe UnqualComponentName)
-> Library
-> Maybe String
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)
    -- Cabal-2.0 introduced internal libraries, which are named.
    mbLibraryName = NameLib . fmap unUnqualComponentName . libName
#else
    -- Before that, there was only ever at most one library per
    -- .cabal file, which has no name.
    mbLibraryName _ = NameLib Nothing
#endif

    executableName :: Executable -> String
#if MIN_VERSION_Cabal(2,0,0)
    executableName :: Executable -> String
executableName = UnqualComponentName -> String
unUnqualComponentName (UnqualComponentName -> String)
-> (Executable -> UnqualComponentName) -> Executable -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> UnqualComponentName
exeName
#else
    executableName = exeName
#endif

-- | In compat settings it's better to omit the type-signature
testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo
#if MIN_VERSION_Cabal(2,0,0)
         -> [(UnitId, MungedPackageId)]
#else
         -> [(UnitId, 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 -- ^ doctests test-suite name
    -> 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 = map f (condTestSuites 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
== String -> a
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
        -- I miss 'lens'
        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

        -- Cons the module to both other-modules and autogen-modules.
        -- At the moment, cabal-spec-2.0 and cabal-spec-2.2 don't have
        -- "all autogen-modules are other-modules if they aren't exposed-modules"
        -- rule. Hopefully cabal-spec-3.0 will have.
        --
        -- Note: we `nub`, because it's unclear if that's ok to have duplicate
        -- modules in the lists.
        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 = String -> ModuleName
forall a. IsString a => String -> a
fromString String
"Build_doctests"

        bi' :: BuildInfo
bi' = BuildInfo
bi { otherModules = om', autogenModules = am' }
        testSuite' :: TestSuite
testSuite' = TestSuite
testSuite { testBuildInfo = bi' }
        condTree' :: CondTree v c TestSuite
condTree' = CondTree v c TestSuite
condTree { condTreeData = testSuite' }
#endif