{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Simple.GHC.Build.Utils where
import Distribution.Compat.Prelude
import Prelude ()
import Control.Monad (msum)
import Data.Char (isLower)
import Distribution.ModuleName (ModuleName)
import qualified Distribution.ModuleName as ModuleName
import Distribution.PackageDescription as PD
import Distribution.PackageDescription.Utils (cabalBug)
import Distribution.Simple.BuildPaths
import Distribution.Simple.BuildWay
import Distribution.Simple.Compiler
import qualified Distribution.Simple.GHC.Internal as Internal
import Distribution.Simple.Program.GHC
import Distribution.Simple.Setup.Common
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Types.LocalBuildInfo
( LocalBuildInfo (hostPlatform)
)
import Distribution.Utils.Path
import Distribution.Verbosity
import System.FilePath
( replaceExtension
, takeExtension
)
findExecutableMain
:: Verbosity
-> Maybe (SymbolicPath CWD (Dir Pkg))
-> SymbolicPath Pkg (Dir build)
-> (BuildInfo, RelativePath Source File)
-> IO (SymbolicPath Pkg File)
findExecutableMain :: forall build.
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg ('Dir build)
-> (BuildInfo, RelativePath Source 'File)
-> IO (SymbolicPath Pkg 'File)
findExecutableMain Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg ('Dir build)
buildDir (BuildInfo
bnfo, RelativePath Source 'File
modPath) =
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> RelativePath Source 'File
-> IO (SymbolicPath Pkg 'File)
forall searchDir (allowAbsolute :: AllowAbsolute).
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPathX allowAbsolute Pkg ('Dir searchDir)]
-> RelativePath searchDir 'File
-> IO (SymbolicPathX allowAbsolute Pkg 'File)
findFileCwd Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir (SymbolicPath Pkg ('Dir build)
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
forall (allowAbsolute :: AllowAbsolute) from (to1 :: FileOrDir)
(to2 :: FileOrDir).
SymbolicPathX allowAbsolute from to1
-> SymbolicPathX allowAbsolute from to2
coerceSymbolicPath SymbolicPath Pkg ('Dir build)
buildDir SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
forall a. a -> [a] -> [a]
: BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
hsSourceDirs BuildInfo
bnfo) RelativePath Source 'File
modPath
supportsDynamicToo :: Compiler -> Bool
supportsDynamicToo :: Compiler -> Bool
supportsDynamicToo = [Char] -> Compiler -> Bool
Internal.ghcLookupProperty [Char]
"Support dynamic-too"
compilerBuildWay :: Compiler -> BuildWay
compilerBuildWay :: Compiler -> BuildWay
compilerBuildWay Compiler
c =
case (Compiler -> Bool
isDynamic Compiler
c, Compiler -> Bool
isProfiled Compiler
c) of
(Bool
True, Bool
True) -> BuildWay
ProfDynWay
(Bool
True, Bool
False) -> BuildWay
DynWay
(Bool
False, Bool
True) -> BuildWay
ProfWay
(Bool
False, Bool
False) -> BuildWay
StaticWay
isDynamic :: Compiler -> Bool
isDynamic :: Compiler -> Bool
isDynamic = [Char] -> Compiler -> Bool
Internal.ghcLookupProperty [Char]
"GHC Dynamic"
isProfiled :: Compiler -> Bool
isProfiled :: Compiler -> Bool
isProfiled = [Char] -> Compiler -> Bool
Internal.ghcLookupProperty [Char]
"GHC Profiled"
withDynFLib :: ForeignLib -> Bool
withDynFLib :: ForeignLib -> Bool
withDynFLib ForeignLib
flib =
case ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib of
ForeignLibType
ForeignLibNativeShared ->
ForeignLibOption
ForeignLibStandalone ForeignLibOption -> [ForeignLibOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ForeignLib -> [ForeignLibOption]
foreignLibOptions ForeignLib
flib
ForeignLibType
ForeignLibNativeStatic ->
Bool
False
ForeignLibType
ForeignLibTypeUnknown ->
[Char] -> Bool
forall a. [Char] -> a
cabalBug [Char]
"unknown foreign lib type"
isCxx :: FilePath -> Bool
isCxx :: [Char] -> Bool
isCxx [Char]
fp = [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ([Char] -> [Char]
takeExtension [Char]
fp) [[Char]
".cpp", [Char]
".cxx", [Char]
".c++"]
isC :: FilePath -> Bool
isC :: [Char] -> Bool
isC [Char]
fp = [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ([Char] -> [Char]
takeExtension [Char]
fp) [[Char]
".c"]
isHaskell :: FilePath -> Bool
isHaskell :: [Char] -> Bool
isHaskell [Char]
fp = [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ([Char] -> [Char]
takeExtension [Char]
fp) [[Char]
".hs", [Char]
".lhs"]
checkNeedsRecompilation
:: Maybe (SymbolicPath CWD (Dir Pkg))
-> SymbolicPath Pkg File
-> GhcOptions
-> IO Bool
checkNeedsRecompilation :: Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File -> GhcOptions -> IO Bool
checkNeedsRecompilation Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg 'File
filename GhcOptions
opts =
SymbolicPath Pkg 'File -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
i SymbolicPath Pkg 'File
filename [Char] -> [Char] -> IO Bool
`moreRecentFile` [Char]
oname
where
oname :: [Char]
oname = Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File -> GhcOptions -> [Char]
getObjectFileName Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg 'File
filename GhcOptions
opts
i :: SymbolicPathX allowAbsolute Pkg to -> [Char]
i = Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX allowAbsolute Pkg to -> [Char]
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> [Char]
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir
getObjectFileName
:: Maybe (SymbolicPath CWD (Dir Pkg))
-> SymbolicPath Pkg File
-> GhcOptions
-> FilePath
getObjectFileName :: Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File -> GhcOptions -> [Char]
getObjectFileName Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg 'File
filename GhcOptions
opts = [Char]
oname
where
i :: SymbolicPathX allowAbsolute Pkg to -> [Char]
i = Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX allowAbsolute Pkg to -> [Char]
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> [Char]
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir
odir :: [Char]
odir = SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts) -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
i (SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts) -> [Char])
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts) -> [Char]
forall a b. (a -> b) -> a -> b
$ Flag (SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts))
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts)
forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions
-> Flag (SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts))
ghcOptObjDir GhcOptions
opts)
oext :: [Char]
oext = [Char] -> Flag [Char] -> [Char]
forall a. a -> Flag a -> a
fromFlagOrDefault [Char]
"o" (GhcOptions -> Flag [Char]
ghcOptObjSuffix GhcOptions
opts)
oname :: [Char]
oname = [Char]
odir [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char] -> [Char] -> [Char]
replaceExtension (SymbolicPath Pkg 'File -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath SymbolicPath Pkg 'File
filename) [Char]
oext
flibTargetName :: LocalBuildInfo -> ForeignLib -> String
flibTargetName :: LocalBuildInfo -> ForeignLib -> [Char]
flibTargetName LocalBuildInfo
lbi ForeignLib
flib =
case (OS
os, ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib) of
(OS
Windows, ForeignLibType
ForeignLibNativeShared) -> [Char]
nm [Char] -> [Char] -> [Char]
forall p. FileLike p => p -> [Char] -> p
<.> [Char]
"dll"
(OS
Windows, ForeignLibType
ForeignLibNativeStatic) -> [Char]
nm [Char] -> [Char] -> [Char]
forall p. FileLike p => p -> [Char] -> p
<.> [Char]
"lib"
(OS
Linux, ForeignLibType
ForeignLibNativeShared) -> [Char]
"lib" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
nm [Char] -> [Char] -> [Char]
forall p. FileLike p => p -> [Char] -> p
<.> [Char]
versionedExt
(OS
_other, ForeignLibType
ForeignLibNativeShared) ->
[Char]
"lib" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
nm [Char] -> [Char] -> [Char]
forall p. FileLike p => p -> [Char] -> p
<.> Platform -> [Char]
dllExtension (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi)
(OS
_other, ForeignLibType
ForeignLibNativeStatic) ->
[Char]
"lib" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
nm [Char] -> [Char] -> [Char]
forall p. FileLike p => p -> [Char] -> p
<.> Platform -> [Char]
staticLibExtension (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi)
(OS
_any, ForeignLibType
ForeignLibTypeUnknown) -> [Char] -> [Char]
forall a. [Char] -> a
cabalBug [Char]
"unknown foreign lib type"
where
nm :: String
nm :: [Char]
nm = UnqualComponentName -> [Char]
unUnqualComponentName (UnqualComponentName -> [Char]) -> UnqualComponentName -> [Char]
forall a b. (a -> b) -> a -> b
$ ForeignLib -> UnqualComponentName
foreignLibName ForeignLib
flib
os :: OS
Platform Arch
_ OS
os = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
versionedExt :: String
versionedExt :: [Char]
versionedExt =
let nums :: [Int]
nums = ForeignLib -> OS -> [Int]
foreignLibVersion ForeignLib
flib OS
os
in ([Char] -> [Char] -> [Char]) -> [Char] -> [[Char]] -> [Char]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Char] -> [Char] -> [Char]
forall p. FileLike p => p -> [Char] -> p
(<.>) [Char]
"so" ((Int -> [Char]) -> [Int] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Int -> [Char]
forall a. Show a => a -> [Char]
show [Int]
nums)
flibBuildName :: LocalBuildInfo -> ForeignLib -> String
flibBuildName :: LocalBuildInfo -> ForeignLib -> [Char]
flibBuildName LocalBuildInfo
lbi ForeignLib
flib
| (OS
os, ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib)
(OS, ForeignLibType) -> (OS, ForeignLibType) -> Bool
forall a. Eq a => a -> a -> Bool
== (OS
Linux, ForeignLibType
ForeignLibNativeShared) =
let nums :: [Int]
nums = ForeignLib -> OS -> [Int]
foreignLibVersion ForeignLib
flib OS
os
in [Char]
"lib" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
nm [Char] -> [Char] -> [Char]
forall p. FileLike p => p -> [Char] -> p
<.> ([Char] -> [Char] -> [Char]) -> [Char] -> [[Char]] -> [Char]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Char] -> [Char] -> [Char]
forall p. FileLike p => p -> [Char] -> p
(<.>) [Char]
"so" ((Int -> [Char]) -> [Int] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
1 [Int]
nums))
| Bool
otherwise = LocalBuildInfo -> ForeignLib -> [Char]
flibTargetName LocalBuildInfo
lbi ForeignLib
flib
where
os :: OS
Platform Arch
_ OS
os = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
nm :: String
nm :: [Char]
nm = UnqualComponentName -> [Char]
unUnqualComponentName (UnqualComponentName -> [Char]) -> UnqualComponentName -> [Char]
forall a b. (a -> b) -> a -> b
$ ForeignLib -> UnqualComponentName
foreignLibName ForeignLib
flib
exeTargetName :: Platform -> UnqualComponentName -> String
exeTargetName :: Platform -> UnqualComponentName -> [Char]
exeTargetName Platform
platform UnqualComponentName
name = UnqualComponentName -> [Char]
unUnqualComponentName UnqualComponentName
name [Char] -> [Char] -> [Char]
`withExt` Platform -> [Char]
exeExtension Platform
platform
where
withExt :: FilePath -> String -> FilePath
withExt :: [Char] -> [Char] -> [Char]
withExt [Char]
fp [Char]
ext = [Char]
fp [Char] -> [Char] -> [Char]
forall p. FileLike p => p -> [Char] -> p
<.> if [Char] -> [Char]
takeExtension [Char]
fp [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= (Char
'.' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
ext) then [Char]
ext else [Char]
""
exeMainModuleName
:: BuildInfo
-> ModuleName
exeMainModuleName :: BuildInfo -> ModuleName
exeMainModuleName BuildInfo
bnfo =
ModuleName -> Maybe ModuleName -> ModuleName
forall a. a -> Maybe a -> a
fromMaybe ModuleName
ModuleName.main (Maybe ModuleName -> ModuleName) -> Maybe ModuleName -> ModuleName
forall a b. (a -> b) -> a -> b
$ [Maybe ModuleName] -> Maybe ModuleName
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe ModuleName] -> Maybe ModuleName)
-> [Maybe ModuleName] -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ [Maybe ModuleName] -> [Maybe ModuleName]
forall a. [a] -> [a]
reverse ([Maybe ModuleName] -> [Maybe ModuleName])
-> [Maybe ModuleName] -> [Maybe ModuleName]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Maybe ModuleName) -> [[Char]] -> [Maybe ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Maybe ModuleName
decodeMainIsArg ([[Char]] -> [Maybe ModuleName]) -> [[Char]] -> [Maybe ModuleName]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
findIsMainArgs [[Char]]
ghcopts
where
ghcopts :: [[Char]]
ghcopts = CompilerFlavor -> BuildInfo -> [[Char]]
hcOptions CompilerFlavor
GHC BuildInfo
bnfo
findIsMainArgs :: [[Char]] -> [[Char]]
findIsMainArgs [] = []
findIsMainArgs ([Char]
"-main-is" : [Char]
arg : [[Char]]
rest) = [Char]
arg [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]]
findIsMainArgs [[Char]]
rest
findIsMainArgs ([Char]
_ : [[Char]]
rest) = [[Char]] -> [[Char]]
findIsMainArgs [[Char]]
rest
decodeMainIsArg :: String -> Maybe ModuleName
decodeMainIsArg :: [Char] -> Maybe ModuleName
decodeMainIsArg [Char]
arg
| [Char] -> (Char -> Bool) -> Bool
headOf [Char]
main_fn Char -> Bool
isLower =
ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ([Char] -> ModuleName
forall a. IsString a => [Char] -> a
ModuleName.fromString [Char]
main_mod)
| [Char] -> (Char -> Bool) -> Bool
headOf [Char]
arg Char -> Bool
isUpper
=
ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ([Char] -> ModuleName
forall a. IsString a => [Char] -> a
ModuleName.fromString [Char]
arg)
| Bool
otherwise
=
Maybe ModuleName
forall a. Maybe a
Nothing
where
headOf :: String -> (Char -> Bool) -> Bool
headOf :: [Char] -> (Char -> Bool) -> Bool
headOf [Char]
str Char -> Bool
pred' = (Char -> Bool) -> Maybe Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
pred' ([Char] -> Maybe Char
forall a. [a] -> Maybe a
safeHead [Char]
str)
([Char]
main_mod, [Char]
main_fn) = [Char] -> (Char -> Bool) -> ([Char], [Char])
splitLongestPrefix [Char]
arg (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')
splitLongestPrefix :: String -> (Char -> Bool) -> (String, String)
splitLongestPrefix :: [Char] -> (Char -> Bool) -> ([Char], [Char])
splitLongestPrefix [Char]
str Char -> Bool
pred'
| [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
r_pre = ([Char]
str, [])
| Bool
otherwise = ([Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]
forall a. [a] -> [a]
safeTail [Char]
r_pre), [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
r_suf)
where
([Char]
r_suf, [Char]
r_pre) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
pred' ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
str)