{-# 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,
    haddockDirName, hscolourPref, haddockPref,
    autogenPackageModulesDir,
    autogenComponentModulesDir,

    autogenPathsModuleName,
    cppHeaderName,
    haddockName,

    mkGenericStaticLibName,
    mkLibName,
    mkProfLibName,
    mkGenericSharedLibName,
    mkSharedLibName,
    mkStaticLibName,
    mkGenericSharedBundledLibName,

    exeExtension,
    objExtension,
    dllExtension,
    staticLibExtension,
    -- * Source files & build directories
    getSourceFiles, getLibSourceFiles, getExeSourceFiles,
    getFLibSourceFiles, exeBuildDir, flibBuildDir,
  ) where

import Prelude ()
import Distribution.Compat.Prelude

import Distribution.Types.ForeignLib
import Distribution.Types.UnqualComponentName (unUnqualComponentName)
import Distribution.Package
import Distribution.ModuleName as ModuleName
import Distribution.Compiler
import Distribution.PackageDescription
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Setup
import Distribution.Pretty
import Distribution.System
import Distribution.Verbosity
import Distribution.Simple.Utils

import Data.List (stripPrefix)
import System.FilePath ((</>), (<.>), normalise)

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

srcPref :: FilePath -> FilePath
srcPref :: [Char] -> [Char]
srcPref [Char]
distPref = [Char]
distPref [Char] -> [Char] -> [Char]
</> [Char]
"src"

hscolourPref :: HaddockTarget -> FilePath -> PackageDescription -> FilePath
hscolourPref :: HaddockTarget -> [Char] -> PackageDescription -> [Char]
hscolourPref = HaddockTarget -> [Char] -> PackageDescription -> [Char]
haddockPref

-- | This is the name of the directory in which the generated haddocks
-- should be stored. It does not include the @<dist>/doc/html@ prefix.
haddockDirName :: HaddockTarget -> PackageDescription -> FilePath
haddockDirName :: HaddockTarget -> PackageDescription -> [Char]
haddockDirName HaddockTarget
ForDevelopment = PackageName -> [Char]
forall a. Pretty a => a -> [Char]
External instance of the constraint type Pretty PackageName
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
External instance of the constraint type Package PackageDescription
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]
External instance of the constraint type Pretty PackageIdentifier
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
External instance of the constraint type Package PackageDescription
packageId

-- | The directory to which generated haddock documentation should be written.
haddockPref :: HaddockTarget -> FilePath -> PackageDescription -> FilePath
haddockPref :: HaddockTarget -> [Char] -> PackageDescription -> [Char]
haddockPref HaddockTarget
haddockTarget [Char]
distPref PackageDescription
pkg_descr
    = [Char]
distPref [Char] -> [Char] -> [Char]
</> [Char]
"doc" [Char] -> [Char] -> [Char]
</> [Char]
"html" [Char] -> [Char] -> [Char]
</> 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 -> String
autogenPackageModulesDir :: LocalBuildInfo -> [Char]
autogenPackageModulesDir LocalBuildInfo
lbi = LocalBuildInfo -> [Char]
buildDir LocalBuildInfo
lbi [Char] -> [Char] -> [Char]
</> [Char]
"global-autogen"

-- | The directory in which we put auto-generated modules for a
-- particular component.
autogenComponentModulesDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> [Char]
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi = LocalBuildInfo -> ComponentLocalBuildInfo -> [Char]
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi [Char] -> [Char] -> [Char]
</> [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
External instance of the constraint type IsString ModuleName
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]
External instance of the constraint type Pretty PackageName
prettyShow (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
External instance of the constraint type Package PackageDescription
packageName PackageDescription
pkg_descr))
  where fixchar :: Char -> Char
fixchar Char
'-' = Char
'_'
        fixchar Char
c   = Char
c

haddockName :: PackageDescription -> FilePath
haddockName :: PackageDescription -> [Char]
haddockName PackageDescription
pkg_descr = PackageName -> [Char]
forall a. Pretty a => a -> [Char]
External instance of the constraint type Pretty PackageName
prettyShow (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
External instance of the constraint type Package PackageDescription
packageName PackageDescription
pkg_descr) [Char] -> [Char] -> [Char]
<.> [Char]
"haddock"

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

getLibSourceFiles :: Verbosity
                     -> LocalBuildInfo
                     -> Library
                     -> ComponentLocalBuildInfo
                     -> IO [(ModuleName.ModuleName, FilePath)]
getLibSourceFiles :: Verbosity
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO [(ModuleName, [Char])]
getLibSourceFiles Verbosity
verbosity LocalBuildInfo
lbi Library
lib ComponentLocalBuildInfo
clbi = Verbosity -> [[Char]] -> [ModuleName] -> IO [(ModuleName, [Char])]
getSourceFiles Verbosity
verbosity [[Char]]
searchpaths [ModuleName]
modules
  where
    bi :: BuildInfo
bi               = Library -> BuildInfo
libBuildInfo Library
lib
    modules :: [ModuleName]
modules          = Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi
    searchpaths :: [[Char]]
searchpaths      = LocalBuildInfo -> ComponentLocalBuildInfo -> [Char]
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: BuildInfo -> [[Char]]
hsSourceDirs BuildInfo
bi [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
                     [ LocalBuildInfo -> ComponentLocalBuildInfo -> [Char]
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                     , LocalBuildInfo -> [Char]
autogenPackageModulesDir LocalBuildInfo
lbi ]

getExeSourceFiles :: Verbosity
                     -> LocalBuildInfo
                     -> Executable
                     -> ComponentLocalBuildInfo
                     -> IO [(ModuleName.ModuleName, FilePath)]
getExeSourceFiles :: Verbosity
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO [(ModuleName, [Char])]
getExeSourceFiles Verbosity
verbosity LocalBuildInfo
lbi Executable
exe ComponentLocalBuildInfo
clbi = do
    [(ModuleName, [Char])]
moduleFiles <- Verbosity -> [[Char]] -> [ModuleName] -> IO [(ModuleName, [Char])]
getSourceFiles Verbosity
verbosity [[Char]]
searchpaths [ModuleName]
modules
    [Char]
srcMainPath <- Verbosity -> [[Char]] -> [Char] -> IO [Char]
findFileEx Verbosity
verbosity (BuildInfo -> [[Char]]
hsSourceDirs BuildInfo
bi) (Executable -> [Char]
modulePath Executable
exe)
    [(ModuleName, [Char])] -> IO [(ModuleName, [Char])]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ((ModuleName
ModuleName.main, [Char]
srcMainPath) (ModuleName, [Char])
-> [(ModuleName, [Char])] -> [(ModuleName, [Char])]
forall a. a -> [a] -> [a]
: [(ModuleName, [Char])]
moduleFiles)
  where
    bi :: BuildInfo
bi          = Executable -> BuildInfo
buildInfo Executable
exe
    modules :: [ModuleName]
modules     = BuildInfo -> [ModuleName]
otherModules BuildInfo
bi
    searchpaths :: [[Char]]
searchpaths = LocalBuildInfo -> ComponentLocalBuildInfo -> [Char]
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: LocalBuildInfo -> [Char]
autogenPackageModulesDir LocalBuildInfo
lbi
                [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: LocalBuildInfo -> Executable -> [Char]
exeBuildDir LocalBuildInfo
lbi Executable
exe [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: BuildInfo -> [[Char]]
hsSourceDirs BuildInfo
bi

getFLibSourceFiles :: Verbosity
                   -> LocalBuildInfo
                   -> ForeignLib
                   -> ComponentLocalBuildInfo
                   -> IO [(ModuleName.ModuleName, FilePath)]
getFLibSourceFiles :: Verbosity
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO [(ModuleName, [Char])]
getFLibSourceFiles Verbosity
verbosity LocalBuildInfo
lbi ForeignLib
flib ComponentLocalBuildInfo
clbi = Verbosity -> [[Char]] -> [ModuleName] -> IO [(ModuleName, [Char])]
getSourceFiles Verbosity
verbosity [[Char]]
searchpaths [ModuleName]
modules
  where
    bi :: BuildInfo
bi          = ForeignLib -> BuildInfo
foreignLibBuildInfo ForeignLib
flib
    modules :: [ModuleName]
modules     = BuildInfo -> [ModuleName]
otherModules BuildInfo
bi
    searchpaths :: [[Char]]
searchpaths = LocalBuildInfo -> ComponentLocalBuildInfo -> [Char]
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: LocalBuildInfo -> [Char]
autogenPackageModulesDir LocalBuildInfo
lbi
                [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: LocalBuildInfo -> ForeignLib -> [Char]
flibBuildDir LocalBuildInfo
lbi ForeignLib
flib [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: BuildInfo -> [[Char]]
hsSourceDirs BuildInfo
bi

getSourceFiles :: Verbosity -> [FilePath]
                  -> [ModuleName.ModuleName]
                  -> IO [(ModuleName.ModuleName, FilePath)]
getSourceFiles :: Verbosity -> [[Char]] -> [ModuleName] -> IO [(ModuleName, [Char])]
getSourceFiles Verbosity
verbosity [[Char]]
dirs [ModuleName]
modules = ((ModuleName -> IO (ModuleName, [Char]))
 -> [ModuleName] -> IO [(ModuleName, [Char])])
-> [ModuleName]
-> (ModuleName -> IO (ModuleName, [Char]))
-> IO [(ModuleName, [Char])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ModuleName -> IO (ModuleName, [Char]))
-> [ModuleName] -> IO [(ModuleName, [Char])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
External instance of the constraint type Applicative IO
External instance of the constraint type Traversable []
traverse [ModuleName]
modules ((ModuleName -> IO (ModuleName, [Char]))
 -> IO [(ModuleName, [Char])])
-> (ModuleName -> IO (ModuleName, [Char]))
-> IO [(ModuleName, [Char])]
forall a b. (a -> b) -> a -> b
$ \ModuleName
m -> ([Char] -> (ModuleName, [Char]))
-> IO [Char] -> IO (ModuleName, [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap ((,) ModuleName
m) (IO [Char] -> IO (ModuleName, [Char]))
-> IO [Char] -> IO (ModuleName, [Char])
forall a b. (a -> b) -> a -> b
$
    [[Char]] -> [[Char]] -> [Char] -> NoCallStackIO (Maybe [Char])
findFileWithExtension [[Char]
"hs", [Char]
"lhs", [Char]
"hsig", [Char]
"lhsig"] [[Char]]
dirs (ModuleName -> [Char]
ModuleName.toFilePath ModuleName
m)
      NoCallStackIO (Maybe [Char])
-> (Maybe [Char] -> IO [Char]) -> IO [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
External instance of the constraint type Monad IO
>>= IO [Char] -> ([Char] -> IO [Char]) -> Maybe [Char] -> IO [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ModuleName -> IO [Char]
forall {a} {a}. Pretty a => a -> IO a
External instance of the constraint type Pretty ModuleName
notFound ModuleName
m) ([Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ([Char] -> IO [Char]) -> ([Char] -> [Char]) -> [Char] -> IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
normalise)
  where
    notFound :: a -> IO a
notFound a
module_ = Verbosity -> [Char] -> IO a
forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity ([Char] -> IO a) -> [Char] -> IO a
forall a b. (a -> b) -> a -> b
$ [Char]
"can't find source for module " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Pretty a => a -> [Char]
Evidence bound by a type signature of the constraint type Pretty a
prettyShow a
module_

-- | The directory where we put build results for an executable
exeBuildDir :: LocalBuildInfo -> Executable -> FilePath
exeBuildDir :: LocalBuildInfo -> Executable -> [Char]
exeBuildDir LocalBuildInfo
lbi Executable
exe = LocalBuildInfo -> [Char]
buildDir LocalBuildInfo
lbi [Char] -> [Char] -> [Char]
</> [Char]
nm [Char] -> [Char] -> [Char]
</> [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 -> FilePath
flibBuildDir :: LocalBuildInfo -> ForeignLib -> [Char]
flibBuildDir LocalBuildInfo
lbi ForeignLib
flib = LocalBuildInfo -> [Char]
buildDir LocalBuildInfo
lbi [Char] -> [Char] -> [Char]
</> [Char]
nm [Char] -> [Char] -> [Char]
</> [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

-- ---------------------------------------------------------------------------
-- 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]
<.> [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
External instance of the constraint type forall a. Monoid [a]
mconcat [ [Char]
"lib", [Char]
lib, [Char]
"-", [Char]
comp [Char] -> [Char] -> [Char]
<.> Platform -> [Char]
dllExtension Platform
platform ]
  where comp :: [Char]
comp = CompilerFlavor -> [Char]
forall a. Pretty a => a -> [Char]
External instance of the constraint type Pretty CompilerFlavor
prettyShow CompilerFlavor
compilerFlavor [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
forall a. Pretty a => a -> [Char]
External instance of the constraint type Pretty Version
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)

-- 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]
<.> Platform -> [Char]
staticLibExtension Platform
platform
  where comp :: [Char]
comp = CompilerFlavor -> [Char]
forall a. Pretty a => a -> [Char]
External instance of the constraint type Pretty CompilerFlavor
prettyShow CompilerFlavor
compilerFlavor [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
forall a. Pretty a => a -> [Char]
External instance of the constraint type Pretty Version
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
External instance of the constraint type Eq Char
`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]
External instance of the constraint type Eq Char
stripPrefix [Char]
"C" [Char]
lib
    = [Char]
"lib" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
lib' [Char] -> [Char] -> [Char]
<.> 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 Arch
_arch OS
os) = case OS
os of
                   OS
Windows -> [Char]
"exe"
                   OS
_       -> [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"