{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Simple.BuildPaths
-- Copyright   :  Isaac Jones 2003-2004,
--                Duncan Coutts 2008
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- A bunch of dirs, paths and file names used for intermediate build steps.
module Distribution.Simple.BuildPaths
  ( defaultDistPref
  , srcPref
  , buildInfoPref
  , haddockDirName
  , haddockLibraryDirPath
  , haddockTestDirPath
  , haddockBenchmarkDirPath
  , hscolourPref
  , haddockPref
  , autogenPackageModulesDir
  , autogenComponentModulesDir
  , autogenPathsModuleName
  , autogenPackageInfoModuleName
  , cppHeaderName
  , haddockPath
  , haddockPackageLibraryName
  , haddockPackageLibraryName'
  , haddockLibraryName
  , haddockLibraryPath
  , mkGenericStaticLibName
  , mkLibName
  , mkProfLibName
  , mkGenericSharedLibName
  , mkSharedLibName
  , mkProfSharedLibName
  , mkStaticLibName
  , mkGenericSharedBundledLibName
  , exeExtension
  , objExtension
  , dllExtension
  , staticLibExtension

    -- * Source files & build directories
  , getSourceFiles
  , getLibSourceFiles
  , getExeSourceFiles
  , getTestSourceFiles
  , getBenchmarkSourceFiles
  , getFLibSourceFiles
  , exeBuildDir
  , flibBuildDir
  , stubName
  , testBuildDir
  , benchmarkBuildDir
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Data.List (stripPrefix)
import Distribution.Compiler
import Distribution.ModuleName as ModuleName
import Distribution.Package
import Distribution.PackageDescription
import Distribution.Pretty
import Distribution.Simple.Errors
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PreProcess.Types (builtinHaskellSuffixes)
import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Haddock (HaddockTarget (..))
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Utils.Path
import Distribution.Verbosity

-- ---------------------------------------------------------------------------
-- Build directories and files

srcPref :: FilePath -> FilePath
srcPref :: [Char] -> [Char]
srcPref [Char]
distPref = [Char]
distPref [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
"src"

hscolourPref
  :: HaddockTarget
  -> SymbolicPath root (Dir Dist)
  -> PackageDescription
  -> SymbolicPath root (Dir Artifacts)
hscolourPref :: forall root.
HaddockTarget
-> SymbolicPath root ('Dir Dist)
-> PackageDescription
-> SymbolicPath root ('Dir Artifacts)
hscolourPref = HaddockTarget
-> SymbolicPath root ('Dir Dist)
-> PackageDescription
-> SymbolicPath root ('Dir Artifacts)
forall root.
HaddockTarget
-> SymbolicPath root ('Dir Dist)
-> PackageDescription
-> SymbolicPath root ('Dir Artifacts)
haddockPref

-- | Build info json file, generated in every build
buildInfoPref
  :: SymbolicPath root (Dir Dist)
  -> SymbolicPath root File
buildInfoPref :: forall root.
SymbolicPath root ('Dir Dist) -> SymbolicPath root 'File
buildInfoPref SymbolicPath root ('Dir Dist)
distPref = SymbolicPath root ('Dir Dist)
distPref SymbolicPath root ('Dir Dist)
-> RelativePath Dist 'File -> SymbolicPath root 'File
forall p q r. PathLike p q r => p -> q -> r
</> [Char] -> RelativePath Dist 'File
forall from (to :: FileOrDir).
HasCallStack =>
[Char] -> RelativePath from to
makeRelativePathEx [Char]
"build-info.json"

-- | This is the name of the directory in which the generated haddocks
-- should be stored. It does not include the @<dist>/doc/html@ prefix.
--
-- It is also used by `haddock-project` when constructing its output directory.
haddockDirName :: HaddockTarget -> PackageDescription -> FilePath
haddockDirName :: HaddockTarget -> PackageDescription -> [Char]
haddockDirName HaddockTarget
ForDevelopment = PackageName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (PackageName -> [Char])
-> (PackageDescription -> PackageName)
-> PackageDescription
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName
haddockDirName HaddockTarget
ForHackage = ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-docs") ([Char] -> [Char])
-> (PackageDescription -> [Char]) -> PackageDescription -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (PackageIdentifier -> [Char])
-> (PackageDescription -> PackageIdentifier)
-> PackageDescription
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId

-- | This is the name of the directory in which the generated haddocks for
-- a (sub)library should be stored. It does not include the @<dist>/doc/html@
-- prefix.
--
-- It is also used by `haddock-project` when constructing its output directory.
haddockLibraryDirPath
  :: HaddockTarget
  -> PackageDescription
  -> Library
  -> FilePath
haddockLibraryDirPath :: HaddockTarget -> PackageDescription -> Library -> [Char]
haddockLibraryDirPath HaddockTarget
haddockTarget PackageDescription
pkg_descr Library
lib =
  case Library -> LibraryName
libName Library
lib of
    LSubLibName UnqualComponentName
sublib_name ->
      HaddockTarget -> PackageDescription -> [Char]
haddockDirName HaddockTarget
haddockTarget PackageDescription
pkg_descr [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> UnqualComponentName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow UnqualComponentName
sublib_name
    LibraryName
_ -> HaddockTarget -> PackageDescription -> [Char]
haddockDirName HaddockTarget
haddockTarget PackageDescription
pkg_descr

haddockTestDirPath
  :: HaddockTarget
  -> PackageDescription
  -> TestSuite
  -> FilePath
haddockTestDirPath :: HaddockTarget -> PackageDescription -> TestSuite -> [Char]
haddockTestDirPath HaddockTarget
haddockTarget PackageDescription
pkg_descr TestSuite
test =
  HaddockTarget -> PackageDescription -> [Char]
haddockDirName HaddockTarget
haddockTarget PackageDescription
pkg_descr [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> UnqualComponentName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (TestSuite -> UnqualComponentName
testName TestSuite
test)

haddockBenchmarkDirPath
  :: HaddockTarget
  -> PackageDescription
  -> Benchmark
  -> FilePath
haddockBenchmarkDirPath :: HaddockTarget -> PackageDescription -> Benchmark -> [Char]
haddockBenchmarkDirPath HaddockTarget
haddockTarget PackageDescription
pkg_descr Benchmark
bench =
  HaddockTarget -> PackageDescription -> [Char]
haddockDirName HaddockTarget
haddockTarget PackageDescription
pkg_descr [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> UnqualComponentName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (Benchmark -> UnqualComponentName
benchmarkName Benchmark
bench)

-- | The directory to which generated haddock documentation should be written.
haddockPref
  :: HaddockTarget
  -> SymbolicPath root (Dir Dist)
  -> PackageDescription
  -> SymbolicPath root (Dir Artifacts)
haddockPref :: forall root.
HaddockTarget
-> SymbolicPath root ('Dir Dist)
-> PackageDescription
-> SymbolicPath root ('Dir Artifacts)
haddockPref HaddockTarget
haddockTarget SymbolicPath root ('Dir Dist)
distPref PackageDescription
pkg_descr =
  SymbolicPath root ('Dir Dist)
distPref SymbolicPath root ('Dir Dist)
-> RelativePath Dist ('Dir Artifacts)
-> SymbolicPath root ('Dir Artifacts)
forall p q r. PathLike p q r => p -> q -> r
</> [Char] -> RelativePath Dist ('Dir Artifacts)
forall from (to :: FileOrDir).
HasCallStack =>
[Char] -> RelativePath from to
makeRelativePathEx ([Char]
"doc" [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
"html" [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> HaddockTarget -> PackageDescription -> [Char]
haddockDirName HaddockTarget
haddockTarget PackageDescription
pkg_descr)

-- | The directory in which we put auto-generated modules for EVERY
-- component in the package.
autogenPackageModulesDir :: LocalBuildInfo -> SymbolicPath Pkg (Dir Source)
autogenPackageModulesDir :: LocalBuildInfo -> SymbolicPath Pkg ('Dir Source)
autogenPackageModulesDir LocalBuildInfo
lbi = LocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
buildDir LocalBuildInfo
lbi SymbolicPath Pkg ('Dir Build)
-> RelativePath Build ('Dir Source)
-> SymbolicPath Pkg ('Dir Source)
forall p q r. PathLike p q r => p -> q -> r
</> [Char] -> RelativePath Build ('Dir Source)
forall from (to :: FileOrDir).
HasCallStack =>
[Char] -> RelativePath from to
makeRelativePathEx [Char]
"global-autogen"

-- | The directory in which we put auto-generated modules for a
-- particular component.
autogenComponentModulesDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> SymbolicPath Pkg (Dir Source)
autogenComponentModulesDir :: LocalBuildInfo
-> ComponentLocalBuildInfo -> SymbolicPath Pkg ('Dir Source)
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi = LocalBuildInfo
-> ComponentLocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi SymbolicPath Pkg ('Dir Build)
-> RelativePath Build ('Dir Source)
-> SymbolicPath Pkg ('Dir Source)
forall p q r. PathLike p q r => p -> q -> r
</> [Char] -> RelativePath Build ('Dir Source)
forall from (to :: FileOrDir).
HasCallStack =>
[Char] -> RelativePath from to
makeRelativePathEx [Char]
"autogen"

-- NB: Look at 'checkForeignDeps' for where a simplified version of this
-- has been copy-pasted.

cppHeaderName :: String
cppHeaderName :: [Char]
cppHeaderName = [Char]
"cabal_macros.h"

-- | The name of the auto-generated Paths_* module associated with a package
autogenPathsModuleName :: PackageDescription -> ModuleName
autogenPathsModuleName :: PackageDescription -> ModuleName
autogenPathsModuleName PackageDescription
pkg_descr =
  [Char] -> ModuleName
forall a. IsString a => [Char] -> a
ModuleName.fromString ([Char] -> ModuleName) -> [Char] -> ModuleName
forall a b. (a -> b) -> a -> b
$
    [Char]
"Paths_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
fixchar (PackageName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg_descr))
  where
    fixchar :: Char -> Char
fixchar Char
'-' = Char
'_'
    fixchar Char
c = Char
c

-- | The name of the auto-generated PackageInfo_* module associated with a package
autogenPackageInfoModuleName :: PackageDescription -> ModuleName
autogenPackageInfoModuleName :: PackageDescription -> ModuleName
autogenPackageInfoModuleName PackageDescription
pkg_descr =
  [Char] -> ModuleName
forall a. IsString a => [Char] -> a
ModuleName.fromString ([Char] -> ModuleName) -> [Char] -> ModuleName
forall a b. (a -> b) -> a -> b
$
    [Char]
"PackageInfo_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
fixchar (PackageName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg_descr))
  where
    fixchar :: Char -> Char
fixchar Char
'-' = Char
'_'
    fixchar Char
c = Char
c

haddockPath :: PackageDescription -> FilePath
haddockPath :: PackageDescription -> [Char]
haddockPath PackageDescription
pkg_descr = PackageName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg_descr) [Char] -> [Char] -> [Char]
forall p. FileLike p => p -> [Char] -> p
<.> [Char]
"haddock"

-- | A name of a (sub)library used by haddock, in the form
-- `<package>:<library>` if it is a sublibrary, or `<package>` if it is the
-- main library.
--
-- Used by `haddock-project` and `Distribution.Simple.Haddock`.
haddockPackageLibraryName :: PackageDescription -> Library -> String
haddockPackageLibraryName :: PackageDescription -> Library -> [Char]
haddockPackageLibraryName PackageDescription
pkg_descr Library
lib =
  PackageName -> LibraryName -> [Char]
haddockPackageLibraryName' (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg_descr) (Library -> LibraryName
libName Library
lib)

haddockPackageLibraryName' :: PackageName -> LibraryName -> String
haddockPackageLibraryName' :: PackageName -> LibraryName -> [Char]
haddockPackageLibraryName' PackageName
pkg_name LibraryName
lib_name =
  case LibraryName
lib_name of
    LSubLibName UnqualComponentName
sublib_name ->
      PackageName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow PackageName
pkg_name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow UnqualComponentName
sublib_name
    LibraryName
LMainLibName -> PackageName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow PackageName
pkg_name

-- | A name of a (sub)library used by haddock.
haddockLibraryName :: PackageDescription -> Library -> String
haddockLibraryName :: PackageDescription -> Library -> [Char]
haddockLibraryName PackageDescription
pkg_descr Library
lib =
  case Library -> LibraryName
libName Library
lib of
    LSubLibName UnqualComponentName
sublib_name -> UnqualComponentName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow UnqualComponentName
sublib_name
    LibraryName
LMainLibName -> PackageName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg_descr)

-- | File path of the ".haddock" file.
haddockLibraryPath :: PackageDescription -> Library -> FilePath
haddockLibraryPath :: PackageDescription -> Library -> [Char]
haddockLibraryPath PackageDescription
pkg_descr Library
lib = PackageDescription -> Library -> [Char]
haddockLibraryName PackageDescription
pkg_descr Library
lib [Char] -> [Char] -> [Char]
forall p. FileLike p => p -> [Char] -> p
<.> [Char]
"haddock"

-- -----------------------------------------------------------------------------
-- Source File helper

getLibSourceFiles
  :: Verbosity
  -> LocalBuildInfo
  -> Library
  -> ComponentLocalBuildInfo
  -> IO [(ModuleName.ModuleName, SymbolicPath Pkg File)]
getLibSourceFiles :: Verbosity
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO [(ModuleName, SymbolicPath Pkg 'File)]
getLibSourceFiles Verbosity
verbosity LocalBuildInfo
lbi Library
lib ComponentLocalBuildInfo
clbi =
  Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPath Pkg ('Dir Source)]
-> [ModuleName]
-> IO [(ModuleName, SymbolicPath Pkg 'File)]
forall (allowAbsolute :: AllowAbsolute).
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPathX allowAbsolute Pkg ('Dir Source)]
-> [ModuleName]
-> IO [(ModuleName, SymbolicPathX allowAbsolute Pkg 'File)]
getSourceFiles Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir [SymbolicPath Pkg ('Dir Source)]
searchpaths [ModuleName]
modules
  where
    bi :: BuildInfo
bi = Library -> BuildInfo
libBuildInfo Library
lib
    modules :: [ModuleName]
modules = Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi
    mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi
    searchpaths :: [SymbolicPath Pkg ('Dir Source)]
searchpaths =
      SymbolicPath Pkg ('Dir Build) -> SymbolicPath Pkg ('Dir Source)
forall (allowAbsolute :: AllowAbsolute) from (to1 :: FileOrDir)
       (to2 :: FileOrDir).
SymbolicPathX allowAbsolute from to1
-> SymbolicPathX allowAbsolute from to2
coerceSymbolicPath (LocalBuildInfo
-> ComponentLocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi)
        SymbolicPath Pkg ('Dir Source)
-> [SymbolicPath Pkg ('Dir Source)]
-> [SymbolicPath Pkg ('Dir Source)]
forall a. a -> [a] -> [a]
: BuildInfo -> [SymbolicPath Pkg ('Dir Source)]
hsSourceDirs BuildInfo
bi
        [SymbolicPath Pkg ('Dir Source)]
-> [SymbolicPath Pkg ('Dir Source)]
-> [SymbolicPath Pkg ('Dir Source)]
forall a. [a] -> [a] -> [a]
++ [ LocalBuildInfo
-> ComponentLocalBuildInfo -> SymbolicPath Pkg ('Dir Source)
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
           , LocalBuildInfo -> SymbolicPath Pkg ('Dir Source)
autogenPackageModulesDir LocalBuildInfo
lbi
           ]

getExeSourceFiles
  :: Verbosity
  -> LocalBuildInfo
  -> Executable
  -> ComponentLocalBuildInfo
  -> IO [(ModuleName.ModuleName, SymbolicPath Pkg 'File)]
getExeSourceFiles :: Verbosity
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO [(ModuleName, SymbolicPath Pkg 'File)]
getExeSourceFiles Verbosity
verbosity LocalBuildInfo
lbi Executable
exe ComponentLocalBuildInfo
clbi = do
  moduleFiles <- Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPath Pkg ('Dir Source)]
-> [ModuleName]
-> IO [(ModuleName, SymbolicPath Pkg 'File)]
forall (allowAbsolute :: AllowAbsolute).
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPathX allowAbsolute Pkg ('Dir Source)]
-> [ModuleName]
-> IO [(ModuleName, SymbolicPathX allowAbsolute Pkg 'File)]
getSourceFiles Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir [SymbolicPath Pkg ('Dir Source)]
searchpaths [ModuleName]
modules
  srcMainPath <- findFileCwd verbosity mbWorkDir (hsSourceDirs bi) (modulePath exe)
  return ((ModuleName.main, srcMainPath) : moduleFiles)
  where
    mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi
    bi :: BuildInfo
bi = Executable -> BuildInfo
buildInfo Executable
exe
    modules :: [ModuleName]
modules = BuildInfo -> [ModuleName]
otherModules BuildInfo
bi
    searchpaths :: [SymbolicPath Pkg ('Dir Source)]
searchpaths =
      LocalBuildInfo
-> ComponentLocalBuildInfo -> SymbolicPath Pkg ('Dir Source)
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
        SymbolicPath Pkg ('Dir Source)
-> [SymbolicPath Pkg ('Dir Source)]
-> [SymbolicPath Pkg ('Dir Source)]
forall a. a -> [a] -> [a]
: LocalBuildInfo -> SymbolicPath Pkg ('Dir Source)
autogenPackageModulesDir LocalBuildInfo
lbi
        SymbolicPath Pkg ('Dir Source)
-> [SymbolicPath Pkg ('Dir Source)]
-> [SymbolicPath Pkg ('Dir Source)]
forall a. a -> [a] -> [a]
: SymbolicPath Pkg ('Dir Build) -> SymbolicPath Pkg ('Dir Source)
forall (allowAbsolute :: AllowAbsolute) from (to1 :: FileOrDir)
       (to2 :: FileOrDir).
SymbolicPathX allowAbsolute from to1
-> SymbolicPathX allowAbsolute from to2
coerceSymbolicPath (LocalBuildInfo -> Executable -> SymbolicPath Pkg ('Dir Build)
exeBuildDir LocalBuildInfo
lbi Executable
exe)
        SymbolicPath Pkg ('Dir Source)
-> [SymbolicPath Pkg ('Dir Source)]
-> [SymbolicPath Pkg ('Dir Source)]
forall a. a -> [a] -> [a]
: BuildInfo -> [SymbolicPath Pkg ('Dir Source)]
hsSourceDirs BuildInfo
bi

getTestSourceFiles
  :: Verbosity
  -> LocalBuildInfo
  -> TestSuite
  -> ComponentLocalBuildInfo
  -> IO [(ModuleName.ModuleName, SymbolicPath Pkg 'File)]
getTestSourceFiles :: Verbosity
-> LocalBuildInfo
-> TestSuite
-> ComponentLocalBuildInfo
-> IO [(ModuleName, SymbolicPath Pkg 'File)]
getTestSourceFiles Verbosity
verbosity LocalBuildInfo
lbi test :: TestSuite
test@TestSuite{testInterface :: TestSuite -> TestSuiteInterface
testInterface = TestSuiteExeV10 Version
_ RelativePath Source 'File
path} ComponentLocalBuildInfo
clbi = do
  moduleFiles <- Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPath Pkg ('Dir Source)]
-> [ModuleName]
-> IO [(ModuleName, SymbolicPath Pkg 'File)]
forall (allowAbsolute :: AllowAbsolute).
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPathX allowAbsolute Pkg ('Dir Source)]
-> [ModuleName]
-> IO [(ModuleName, SymbolicPathX allowAbsolute Pkg 'File)]
getSourceFiles Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir [SymbolicPath Pkg ('Dir Source)]
searchpaths [ModuleName]
modules
  srcMainPath <- findFileCwd verbosity mbWorkDir (hsSourceDirs bi) path
  return ((ModuleName.main, srcMainPath) : moduleFiles)
  where
    mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi
    bi :: BuildInfo
bi = TestSuite -> BuildInfo
testBuildInfo TestSuite
test
    modules :: [ModuleName]
modules = BuildInfo -> [ModuleName]
otherModules BuildInfo
bi
    searchpaths :: [SymbolicPath Pkg ('Dir Source)]
searchpaths =
      LocalBuildInfo
-> ComponentLocalBuildInfo -> SymbolicPath Pkg ('Dir Source)
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
        SymbolicPath Pkg ('Dir Source)
-> [SymbolicPath Pkg ('Dir Source)]
-> [SymbolicPath Pkg ('Dir Source)]
forall a. a -> [a] -> [a]
: LocalBuildInfo -> SymbolicPath Pkg ('Dir Source)
autogenPackageModulesDir LocalBuildInfo
lbi
        SymbolicPath Pkg ('Dir Source)
-> [SymbolicPath Pkg ('Dir Source)]
-> [SymbolicPath Pkg ('Dir Source)]
forall a. a -> [a] -> [a]
: SymbolicPath Pkg ('Dir Build) -> SymbolicPath Pkg ('Dir Source)
forall (allowAbsolute :: AllowAbsolute) from (to1 :: FileOrDir)
       (to2 :: FileOrDir).
SymbolicPathX allowAbsolute from to1
-> SymbolicPathX allowAbsolute from to2
coerceSymbolicPath (LocalBuildInfo -> TestSuite -> SymbolicPath Pkg ('Dir Build)
testBuildDir LocalBuildInfo
lbi TestSuite
test)
        SymbolicPath Pkg ('Dir Source)
-> [SymbolicPath Pkg ('Dir Source)]
-> [SymbolicPath Pkg ('Dir Source)]
forall a. a -> [a] -> [a]
: BuildInfo -> [SymbolicPath Pkg ('Dir Source)]
hsSourceDirs BuildInfo
bi
getTestSourceFiles Verbosity
_ LocalBuildInfo
_ TestSuite
_ ComponentLocalBuildInfo
_ = [(ModuleName, SymbolicPath Pkg 'File)]
-> IO [(ModuleName, SymbolicPath Pkg 'File)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []

getBenchmarkSourceFiles
  :: Verbosity
  -> LocalBuildInfo
  -> Benchmark
  -> ComponentLocalBuildInfo
  -> IO [(ModuleName.ModuleName, SymbolicPath Pkg 'File)]
getBenchmarkSourceFiles :: Verbosity
-> LocalBuildInfo
-> Benchmark
-> ComponentLocalBuildInfo
-> IO [(ModuleName, SymbolicPath Pkg 'File)]
getBenchmarkSourceFiles Verbosity
verbosity LocalBuildInfo
lbi bench :: Benchmark
bench@Benchmark{benchmarkInterface :: Benchmark -> BenchmarkInterface
benchmarkInterface = BenchmarkExeV10 Version
_ RelativePath Source 'File
path} ComponentLocalBuildInfo
clbi = do
  moduleFiles <- Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPath Pkg ('Dir Source)]
-> [ModuleName]
-> IO [(ModuleName, SymbolicPath Pkg 'File)]
forall (allowAbsolute :: AllowAbsolute).
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPathX allowAbsolute Pkg ('Dir Source)]
-> [ModuleName]
-> IO [(ModuleName, SymbolicPathX allowAbsolute Pkg 'File)]
getSourceFiles Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir [SymbolicPath Pkg ('Dir Source)]
searchpaths [ModuleName]
modules
  srcMainPath <- findFileCwd verbosity mbWorkDir (hsSourceDirs bi) path
  return ((ModuleName.main, srcMainPath) : moduleFiles)
  where
    mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi
    bi :: BuildInfo
bi = Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
bench
    modules :: [ModuleName]
modules = BuildInfo -> [ModuleName]
otherModules BuildInfo
bi
    searchpaths :: [SymbolicPath Pkg ('Dir Source)]
searchpaths =
      LocalBuildInfo
-> ComponentLocalBuildInfo -> SymbolicPath Pkg ('Dir Source)
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
        SymbolicPath Pkg ('Dir Source)
-> [SymbolicPath Pkg ('Dir Source)]
-> [SymbolicPath Pkg ('Dir Source)]
forall a. a -> [a] -> [a]
: LocalBuildInfo -> SymbolicPath Pkg ('Dir Source)
autogenPackageModulesDir LocalBuildInfo
lbi
        SymbolicPath Pkg ('Dir Source)
-> [SymbolicPath Pkg ('Dir Source)]
-> [SymbolicPath Pkg ('Dir Source)]
forall a. a -> [a] -> [a]
: SymbolicPath Pkg ('Dir Build) -> SymbolicPath Pkg ('Dir Source)
forall (allowAbsolute :: AllowAbsolute) from (to1 :: FileOrDir)
       (to2 :: FileOrDir).
SymbolicPathX allowAbsolute from to1
-> SymbolicPathX allowAbsolute from to2
coerceSymbolicPath (LocalBuildInfo -> Benchmark -> SymbolicPath Pkg ('Dir Build)
benchmarkBuildDir LocalBuildInfo
lbi Benchmark
bench)
        SymbolicPath Pkg ('Dir Source)
-> [SymbolicPath Pkg ('Dir Source)]
-> [SymbolicPath Pkg ('Dir Source)]
forall a. a -> [a] -> [a]
: BuildInfo -> [SymbolicPath Pkg ('Dir Source)]
hsSourceDirs BuildInfo
bi
getBenchmarkSourceFiles Verbosity
_ LocalBuildInfo
_ Benchmark
_ ComponentLocalBuildInfo
_ = [(ModuleName, SymbolicPath Pkg 'File)]
-> IO [(ModuleName, SymbolicPath Pkg 'File)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []

getFLibSourceFiles
  :: Verbosity
  -> LocalBuildInfo
  -> ForeignLib
  -> ComponentLocalBuildInfo
  -> IO [(ModuleName.ModuleName, SymbolicPath Pkg File)]
getFLibSourceFiles :: Verbosity
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO [(ModuleName, SymbolicPath Pkg 'File)]
getFLibSourceFiles Verbosity
verbosity LocalBuildInfo
lbi ForeignLib
flib ComponentLocalBuildInfo
clbi =
  Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPath Pkg ('Dir Source)]
-> [ModuleName]
-> IO [(ModuleName, SymbolicPath Pkg 'File)]
forall (allowAbsolute :: AllowAbsolute).
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPathX allowAbsolute Pkg ('Dir Source)]
-> [ModuleName]
-> IO [(ModuleName, SymbolicPathX allowAbsolute Pkg 'File)]
getSourceFiles Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir [SymbolicPath Pkg ('Dir Source)]
searchpaths [ModuleName]
modules
  where
    bi :: BuildInfo
bi = ForeignLib -> BuildInfo
foreignLibBuildInfo ForeignLib
flib
    modules :: [ModuleName]
modules = BuildInfo -> [ModuleName]
otherModules BuildInfo
bi
    mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi
    searchpaths :: [SymbolicPath Pkg ('Dir Source)]
searchpaths =
      LocalBuildInfo
-> ComponentLocalBuildInfo -> SymbolicPath Pkg ('Dir Source)
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
        SymbolicPath Pkg ('Dir Source)
-> [SymbolicPath Pkg ('Dir Source)]
-> [SymbolicPath Pkg ('Dir Source)]
forall a. a -> [a] -> [a]
: LocalBuildInfo -> SymbolicPath Pkg ('Dir Source)
autogenPackageModulesDir LocalBuildInfo
lbi
        SymbolicPath Pkg ('Dir Source)
-> [SymbolicPath Pkg ('Dir Source)]
-> [SymbolicPath Pkg ('Dir Source)]
forall a. a -> [a] -> [a]
: SymbolicPath Pkg ('Dir Build) -> SymbolicPath Pkg ('Dir Source)
forall (allowAbsolute :: AllowAbsolute) from (to1 :: FileOrDir)
       (to2 :: FileOrDir).
SymbolicPathX allowAbsolute from to1
-> SymbolicPathX allowAbsolute from to2
coerceSymbolicPath (LocalBuildInfo -> ForeignLib -> SymbolicPath Pkg ('Dir Build)
flibBuildDir LocalBuildInfo
lbi ForeignLib
flib)
        SymbolicPath Pkg ('Dir Source)
-> [SymbolicPath Pkg ('Dir Source)]
-> [SymbolicPath Pkg ('Dir Source)]
forall a. a -> [a] -> [a]
: BuildInfo -> [SymbolicPath Pkg ('Dir Source)]
hsSourceDirs BuildInfo
bi

getSourceFiles
  :: Verbosity
  -> Maybe (SymbolicPath CWD ('Dir Pkg))
  -> [SymbolicPathX allowAbsolute Pkg (Dir Source)]
  -> [ModuleName.ModuleName]
  -> IO [(ModuleName.ModuleName, SymbolicPathX allowAbsolute Pkg File)]
getSourceFiles :: forall (allowAbsolute :: AllowAbsolute).
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPathX allowAbsolute Pkg ('Dir Source)]
-> [ModuleName]
-> IO [(ModuleName, SymbolicPathX allowAbsolute Pkg 'File)]
getSourceFiles Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir [SymbolicPathX allowAbsolute Pkg ('Dir Source)]
dirs [ModuleName]
modules = ((ModuleName
  -> IO (ModuleName, SymbolicPathX allowAbsolute Pkg 'File))
 -> [ModuleName]
 -> IO [(ModuleName, SymbolicPathX allowAbsolute Pkg 'File)])
-> [ModuleName]
-> (ModuleName
    -> IO (ModuleName, SymbolicPathX allowAbsolute Pkg 'File))
-> IO [(ModuleName, SymbolicPathX allowAbsolute Pkg 'File)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ModuleName
 -> IO (ModuleName, SymbolicPathX allowAbsolute Pkg 'File))
-> [ModuleName]
-> IO [(ModuleName, SymbolicPathX allowAbsolute Pkg 'File)]
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) -> [a] -> f [b]
traverse [ModuleName]
modules ((ModuleName
  -> IO (ModuleName, SymbolicPathX allowAbsolute Pkg 'File))
 -> IO [(ModuleName, SymbolicPathX allowAbsolute Pkg 'File)])
-> (ModuleName
    -> IO (ModuleName, SymbolicPathX allowAbsolute Pkg 'File))
-> IO [(ModuleName, SymbolicPathX allowAbsolute Pkg 'File)]
forall a b. (a -> b) -> a -> b
$ \ModuleName
m ->
  (SymbolicPathX allowAbsolute Pkg 'File
 -> (ModuleName, SymbolicPathX allowAbsolute Pkg 'File))
-> IO (SymbolicPathX allowAbsolute Pkg 'File)
-> IO (ModuleName, SymbolicPathX allowAbsolute Pkg 'File)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) ModuleName
m) (IO (SymbolicPathX allowAbsolute Pkg 'File)
 -> IO (ModuleName, SymbolicPathX allowAbsolute Pkg 'File))
-> IO (SymbolicPathX allowAbsolute Pkg 'File)
-> IO (ModuleName, SymbolicPathX allowAbsolute Pkg 'File)
forall a b. (a -> b) -> a -> b
$
    Maybe (SymbolicPath CWD ('Dir Pkg))
-> [Suffix]
-> [SymbolicPathX allowAbsolute Pkg ('Dir Source)]
-> RelativePath Source 'File
-> IO (Maybe (SymbolicPathX allowAbsolute Pkg 'File))
forall searchDir (allowAbsolute :: AllowAbsolute).
Maybe (SymbolicPath CWD ('Dir Pkg))
-> [Suffix]
-> [SymbolicPathX allowAbsolute Pkg ('Dir searchDir)]
-> RelativePath searchDir 'File
-> IO (Maybe (SymbolicPathX allowAbsolute Pkg 'File))
findFileCwdWithExtension
      Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir
      [Suffix]
builtinHaskellSuffixes
      [SymbolicPathX allowAbsolute Pkg ('Dir Source)]
dirs
      (ModuleName -> RelativePath Source 'File
forall (allowAbsolute :: AllowAbsolute).
ModuleName -> SymbolicPathX allowAbsolute Source 'File
moduleNameSymbolicPath ModuleName
m)
      IO (Maybe (SymbolicPathX allowAbsolute Pkg 'File))
-> (Maybe (SymbolicPathX allowAbsolute Pkg 'File)
    -> IO (SymbolicPathX allowAbsolute Pkg 'File))
-> IO (SymbolicPathX allowAbsolute Pkg 'File)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (SymbolicPathX allowAbsolute Pkg 'File)
-> (SymbolicPathX allowAbsolute Pkg 'File
    -> IO (SymbolicPathX allowAbsolute Pkg 'File))
-> Maybe (SymbolicPathX allowAbsolute Pkg 'File)
-> IO (SymbolicPathX allowAbsolute Pkg 'File)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ModuleName -> IO (SymbolicPathX allowAbsolute Pkg 'File)
forall {a}. ModuleName -> IO a
notFound ModuleName
m) (SymbolicPathX allowAbsolute Pkg 'File
-> IO (SymbolicPathX allowAbsolute Pkg 'File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SymbolicPathX allowAbsolute Pkg 'File
 -> IO (SymbolicPathX allowAbsolute Pkg 'File))
-> (SymbolicPathX allowAbsolute Pkg 'File
    -> SymbolicPathX allowAbsolute Pkg 'File)
-> SymbolicPathX allowAbsolute Pkg 'File
-> IO (SymbolicPathX allowAbsolute Pkg 'File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathX allowAbsolute Pkg 'File
-> SymbolicPathX allowAbsolute Pkg 'File
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to
-> SymbolicPathX allowAbsolute from to
normaliseSymbolicPath)
  where
    notFound :: ModuleName -> IO a
notFound ModuleName
module_ =
      Verbosity -> CabalException -> IO a
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO a) -> CabalException -> IO a
forall a b. (a -> b) -> a -> b
$ ModuleName -> CabalException
CantFindSourceModule ModuleName
module_

-- | The directory where we put build results for an executable
exeBuildDir :: LocalBuildInfo -> Executable -> SymbolicPath Pkg (Dir Build)
exeBuildDir :: LocalBuildInfo -> Executable -> SymbolicPath Pkg ('Dir Build)
exeBuildDir LocalBuildInfo
lbi Executable
exe = LocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
buildDir LocalBuildInfo
lbi SymbolicPath Pkg ('Dir Build)
-> RelativePath Build ('Dir Build) -> SymbolicPath Pkg ('Dir Build)
forall p q r. PathLike p q r => p -> q -> r
</> [Char] -> RelativePath Build ('Dir Build)
forall from (to :: FileOrDir).
HasCallStack =>
[Char] -> RelativePath from to
makeRelativePathEx ([Char]
nm [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
nm [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-tmp")
  where
    nm :: [Char]
nm = UnqualComponentName -> [Char]
unUnqualComponentName (UnqualComponentName -> [Char]) -> UnqualComponentName -> [Char]
forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
exe

-- | The directory where we put build results for a foreign library
flibBuildDir :: LocalBuildInfo -> ForeignLib -> SymbolicPath Pkg (Dir Build)
flibBuildDir :: LocalBuildInfo -> ForeignLib -> SymbolicPath Pkg ('Dir Build)
flibBuildDir LocalBuildInfo
lbi ForeignLib
flib = LocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
buildDir LocalBuildInfo
lbi SymbolicPath Pkg ('Dir Build)
-> RelativePath Build ('Dir Build) -> SymbolicPath Pkg ('Dir Build)
forall p q r. PathLike p q r => p -> q -> r
</> [Char] -> RelativePath Build ('Dir Build)
forall from (to :: FileOrDir).
HasCallStack =>
[Char] -> RelativePath from to
makeRelativePathEx ([Char]
nm [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
nm [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-tmp")
  where
    nm :: [Char]
nm = UnqualComponentName -> [Char]
unUnqualComponentName (UnqualComponentName -> [Char]) -> UnqualComponentName -> [Char]
forall a b. (a -> b) -> a -> b
$ ForeignLib -> UnqualComponentName
foreignLibName ForeignLib
flib

-- | The name of the stub executable associated with a library 'TestSuite'.
stubName :: TestSuite -> FilePath
stubName :: TestSuite -> [Char]
stubName TestSuite
t = UnqualComponentName -> [Char]
unUnqualComponentName (TestSuite -> UnqualComponentName
testName TestSuite
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Stub"

-- | The directory where we put build results for a test suite
testBuildDir :: LocalBuildInfo -> TestSuite -> SymbolicPath Pkg (Dir Build)
testBuildDir :: LocalBuildInfo -> TestSuite -> SymbolicPath Pkg ('Dir Build)
testBuildDir LocalBuildInfo
lbi TestSuite
tst =
  LocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
buildDir LocalBuildInfo
lbi SymbolicPath Pkg ('Dir Build)
-> RelativePath Build ('Dir Build) -> SymbolicPath Pkg ('Dir Build)
forall p q r. PathLike p q r => p -> q -> r
</> [Char] -> RelativePath Build ('Dir Build)
forall from (to :: FileOrDir).
HasCallStack =>
[Char] -> RelativePath from to
makeRelativePathEx [Char]
testDir
  where
    testDir :: [Char]
testDir = case TestSuite -> TestSuiteInterface
testInterface TestSuite
tst of
      TestSuiteLibV09{} ->
        TestSuite -> [Char]
stubName TestSuite
tst [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> TestSuite -> [Char]
stubName TestSuite
tst [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-tmp"
      TestSuiteInterface
_ -> [Char]
nm [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
nm [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-tmp"
    nm :: [Char]
nm = UnqualComponentName -> [Char]
unUnqualComponentName (UnqualComponentName -> [Char]) -> UnqualComponentName -> [Char]
forall a b. (a -> b) -> a -> b
$ TestSuite -> UnqualComponentName
testName TestSuite
tst

-- | The directory where we put build results for a benchmark suite
benchmarkBuildDir :: LocalBuildInfo -> Benchmark -> SymbolicPath Pkg (Dir Build)
benchmarkBuildDir :: LocalBuildInfo -> Benchmark -> SymbolicPath Pkg ('Dir Build)
benchmarkBuildDir LocalBuildInfo
lbi Benchmark
bm =
  LocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
buildDir LocalBuildInfo
lbi SymbolicPath Pkg ('Dir Build)
-> RelativePath Build ('Dir Build) -> SymbolicPath Pkg ('Dir Build)
forall p q r. PathLike p q r => p -> q -> r
</> [Char] -> RelativePath Build ('Dir Build)
forall from (to :: FileOrDir).
HasCallStack =>
[Char] -> RelativePath from to
makeRelativePathEx ([Char]
nm [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
nm [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-tmp")
  where
    nm :: [Char]
nm = UnqualComponentName -> [Char]
unUnqualComponentName (UnqualComponentName -> [Char]) -> UnqualComponentName -> [Char]
forall a b. (a -> b) -> a -> b
$ Benchmark -> UnqualComponentName
benchmarkName Benchmark
bm

-- ---------------------------------------------------------------------------
-- Library file names

-- | Create a library name for a static library from a given name.
-- Prepends @lib@ and appends the static library extension (@.a@).
mkGenericStaticLibName :: String -> String
mkGenericStaticLibName :: [Char] -> [Char]
mkGenericStaticLibName [Char]
lib = [Char]
"lib" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
lib [Char] -> [Char] -> [Char]
forall p. FileLike p => p -> [Char] -> p
<.> [Char]
"a"

mkLibName :: UnitId -> String
mkLibName :: UnitId -> [Char]
mkLibName UnitId
lib = [Char] -> [Char]
mkGenericStaticLibName (UnitId -> [Char]
getHSLibraryName UnitId
lib)

mkProfLibName :: UnitId -> String
mkProfLibName :: UnitId -> [Char]
mkProfLibName UnitId
lib = [Char] -> [Char]
mkGenericStaticLibName (UnitId -> [Char]
getHSLibraryName UnitId
lib [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_p")

-- | Create a library name for a shared library from a given name.
-- Prepends @lib@ and appends the @-\<compilerFlavour\>\<compilerVersion\>@
-- as well as the shared library extension.
mkGenericSharedLibName :: Platform -> CompilerId -> String -> String
mkGenericSharedLibName :: Platform -> CompilerId -> [Char] -> [Char]
mkGenericSharedLibName Platform
platform (CompilerId CompilerFlavor
compilerFlavor Version
compilerVersion) [Char]
lib =
  [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat [[Char]
"lib", [Char]
lib, [Char]
"-", [Char]
comp [Char] -> [Char] -> [Char]
forall p. FileLike p => p -> [Char] -> p
<.> Platform -> [Char]
dllExtension Platform
platform]
  where
    comp :: [Char]
comp = CompilerFlavor -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow CompilerFlavor
compilerFlavor [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow Version
compilerVersion

-- Implement proper name mangling for dynamical shared objects
-- @libHS\<packagename\>-\<compilerFlavour\>\<compilerVersion\>@
-- e.g. @libHSbase-2.1-ghc6.6.1.so@
mkSharedLibName :: Platform -> CompilerId -> UnitId -> String
mkSharedLibName :: Platform -> CompilerId -> UnitId -> [Char]
mkSharedLibName Platform
platform CompilerId
comp UnitId
lib =
  Platform -> CompilerId -> [Char] -> [Char]
mkGenericSharedLibName Platform
platform CompilerId
comp (UnitId -> [Char]
getHSLibraryName UnitId
lib)

mkProfSharedLibName :: Platform -> CompilerId -> UnitId -> String
mkProfSharedLibName :: Platform -> CompilerId -> UnitId -> [Char]
mkProfSharedLibName Platform
platform CompilerId
comp UnitId
lib =
  Platform -> CompilerId -> [Char] -> [Char]
mkGenericSharedLibName Platform
platform CompilerId
comp (UnitId -> [Char]
getHSLibraryName UnitId
lib [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_p")

-- Static libs are named the same as shared libraries, only with
-- a different extension.
mkStaticLibName :: Platform -> CompilerId -> UnitId -> String
mkStaticLibName :: Platform -> CompilerId -> UnitId -> [Char]
mkStaticLibName Platform
platform (CompilerId CompilerFlavor
compilerFlavor Version
compilerVersion) UnitId
lib =
  [Char]
"lib" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UnitId -> [Char]
getHSLibraryName UnitId
lib [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
comp [Char] -> [Char] -> [Char]
forall p. FileLike p => p -> [Char] -> p
<.> Platform -> [Char]
staticLibExtension Platform
platform
  where
    comp :: [Char]
comp = CompilerFlavor -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow CompilerFlavor
compilerFlavor [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow Version
compilerVersion

-- | Create a library name for a bundled shared library from a given name.
-- This matches the naming convention for shared libraries as implemented in
-- GHC's packageHsLibs function in the Packages module.
-- If the given name is prefixed with HS, then this prepends 'lib' and appends
-- the compiler flavour/version and shared library extension e.g.:
--     "HSrts-1.0" -> "libHSrts-1.0-ghc8.7.20190109.so"
-- Otherwise the given name should be prefixed with 'C', then this strips the
-- 'C', prepends 'lib' and appends the shared library extension e.g.:
--     "Cffi" -> "libffi.so"
mkGenericSharedBundledLibName :: Platform -> CompilerId -> String -> String
mkGenericSharedBundledLibName :: Platform -> CompilerId -> [Char] -> [Char]
mkGenericSharedBundledLibName Platform
platform CompilerId
comp [Char]
lib
  | [Char]
"HS" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
lib =
      Platform -> CompilerId -> [Char] -> [Char]
mkGenericSharedLibName Platform
platform CompilerId
comp [Char]
lib
  | Just [Char]
lib' <- [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
"C" [Char]
lib =
      [Char]
"lib" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
lib' [Char] -> [Char] -> [Char]
forall p. FileLike p => p -> [Char] -> p
<.> Platform -> [Char]
dllExtension Platform
platform
  | Bool
otherwise =
      [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char]
"Don't understand library name " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
lib)

-- ------------------------------------------------------------

-- * Platform file extensions

-- ------------------------------------------------------------

-- | Default extension for executable files on the current platform.
-- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
exeExtension :: Platform -> String
exeExtension :: Platform -> [Char]
exeExtension Platform
platform = case Platform
platform of
  Platform Arch
_ OS
Windows -> [Char]
"exe"
  Platform Arch
Wasm32 OS
_ -> [Char]
"wasm"
  Platform
_ -> [Char]
""

-- | Extension for object files. For GHC the extension is @\"o\"@.
objExtension :: String
objExtension :: [Char]
objExtension = [Char]
"o"

-- | Extension for dynamically linked (or shared) libraries
-- (typically @\"so\"@ on Unix and @\"dll\"@ on Windows)
dllExtension :: Platform -> String
dllExtension :: Platform -> [Char]
dllExtension (Platform Arch
_arch OS
os) = case OS
os of
  OS
Windows -> [Char]
"dll"
  OS
OSX -> [Char]
"dylib"
  OS
_ -> [Char]
"so"

-- | Extension for static libraries
--
-- TODO: Here, as well as in dllExtension, it's really the target OS that we're
-- interested in, not the build OS.
staticLibExtension :: Platform -> String
staticLibExtension :: Platform -> [Char]
staticLibExtension (Platform Arch
_arch OS
os) = case OS
os of
  OS
Windows -> [Char]
"lib"
  OS
_ -> [Char]
"a"