{-# 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
  ( takeExtension
  )

-- | Find the path to the entry point of an executable (typically specified in
-- @main-is@, and found in @hs-source-dirs@ -- yes, even when @main-is@ is not a Haskell file).
findExecutableMain
  :: Verbosity
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -> SymbolicPath Pkg (Dir build)
  -- ^ Build directory
  -> (BuildInfo, RelativePath Source File)
  -- ^ The build info and module path of an executable-like component (Exe, Test, Bench)
  -> IO (SymbolicPath Pkg File)
  -- ^ The path to the main source file.
findExecutableMain :: forall build.
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg ('Dir build)
-> (BuildInfo, RelativePath Source 'File)
-> IO (SymbolicPathX 'AllowAbsolute 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 (SymbolicPathX 'AllowAbsolute 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

-- | Does this compiler support the @-dynamic-too@ option
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

-- | Is this compiler's RTS dynamically linked?
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"

-- | Should we dynamically link the foreign library, based on its 'foreignLibType'?
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"

-- | Is the extension of the file in the list of extensions?
extensionIn :: [String] -> FilePath -> Bool
extensionIn :: [[Char]] -> [Char] -> Bool
extensionIn [[Char]]
exts [Char]
fp = [Char] -> [Char]
takeExtension [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]]
exts

-- | Is this file a C++ source file, i.e. ends with .cpp, .cxx, or .c++?
isCxx :: FilePath -> Bool
isCxx :: [Char] -> Bool
isCxx = [[Char]] -> [Char] -> Bool
extensionIn [[Char]
".cpp", [Char]
".cxx", [Char]
".c++"]

-- | Is this a C source file, i.e. ends with .c?
isC :: FilePath -> Bool
isC :: [Char] -> Bool
isC = [[Char]] -> [Char] -> Bool
extensionIn [[Char]
".c"]

-- | FilePath has a Haskell extension: .hs or .lhs
isHaskell :: FilePath -> Bool
isHaskell :: [Char] -> Bool
isHaskell = [[Char]] -> [Char] -> Bool
extensionIn [[Char]
".hs", [Char]
".lhs"]

-- | Returns True if the modification date of the given source file is newer than
-- the object file we last compiled for it, or if no object file exists yet.
checkNeedsRecompilation
  :: Maybe (SymbolicPath CWD (Dir Pkg))
  -> SymbolicPath Pkg File
  -> GhcOptions
  -> IO Bool
checkNeedsRecompilation :: Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX 'AllowAbsolute Pkg 'File -> GhcOptions -> IO Bool
checkNeedsRecompilation Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPathX 'AllowAbsolute Pkg 'File
filename GhcOptions
opts =
  SymbolicPathX 'AllowAbsolute Pkg 'File -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
i SymbolicPathX 'AllowAbsolute Pkg 'File
filename [Char] -> [Char] -> IO Bool
`moreRecentFile` [Char]
oname
  where
    oname :: [Char]
oname = Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX 'AllowAbsolute Pkg 'File -> GhcOptions -> [Char]
getObjectFileName Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPathX 'AllowAbsolute 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 -- See Note [Symbolic paths] in Distribution.Utils.Path

-- | Finds the object file name of the given source file
getObjectFileName
  :: Maybe (SymbolicPath CWD (Dir Pkg))
  -- ^ Package directory
  -> SymbolicPath Pkg File
  -- ^ Symbolic path to the source file
  -> GhcOptions
  -- ^ GHC compilation options
  -> FilePath
  -- ^ Path to the object file
getObjectFileName :: Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX 'AllowAbsolute Pkg 'File -> GhcOptions -> [Char]
getObjectFileName Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPathX 'AllowAbsolute 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 -- See Note [Symbolic paths] in Distribution.Utils.Path
    odir :: SymbolicPath Pkg ('Dir Artifacts)
odir = Flag (SymbolicPath Pkg ('Dir Artifacts))
-> SymbolicPath Pkg ('Dir Artifacts)
forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag (SymbolicPath 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)
    -- NB: the filepath might be absolute, e.g. if it is the path to
    -- an autogenerated .hs file.
    oname :: [Char]
oname = SymbolicPathX 'AllowAbsolute Pkg 'File -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
i (SymbolicPathX 'AllowAbsolute Pkg 'File -> [Char])
-> SymbolicPathX 'AllowAbsolute Pkg 'File -> [Char]
forall a b. (a -> b) -> a -> b
$ SymbolicPath Pkg ('Dir Artifacts)
-> [Char]
-> SymbolicPathX 'AllowAbsolute Pkg 'File
-> SymbolicPathX 'AllowAbsolute Pkg 'File
objectFilePath SymbolicPath Pkg ('Dir Artifacts)
odir [Char]
oext SymbolicPathX 'AllowAbsolute Pkg 'File
filename

-- | Given the path to a source file (Haskell, C, JS...), return the corresponding
-- object file path (input to the linker).
objectFilePath
  :: SymbolicPath Pkg (Dir Artifacts)
  -- ^ Objects build directory (@-odir@)
  -> String
  -- ^ Object file extension
  -> SymbolicPath Pkg File
  -- ^ Source file path (relative or absolute)
  -> SymbolicPath Pkg File
  -- ^ Resulting object file path
objectFilePath :: SymbolicPath Pkg ('Dir Artifacts)
-> [Char]
-> SymbolicPathX 'AllowAbsolute Pkg 'File
-> SymbolicPathX 'AllowAbsolute Pkg 'File
objectFilePath SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir [Char]
objExt SymbolicPathX 'AllowAbsolute Pkg 'File
src =
  case SymbolicPathX 'AllowAbsolute Pkg 'File
-> Maybe (SymbolicPathX 'OnlyRelative Pkg 'File)
forall from (to :: FileOrDir).
SymbolicPath from to -> Maybe (RelativePath from to)
symbolicPathRelative_maybe SymbolicPathX 'AllowAbsolute Pkg 'File
objPath of
    Just SymbolicPathX 'OnlyRelative Pkg 'File
relObjPath ->
      -- For a relative input file, the output object file is placed under the -odir.
      SymbolicPath Pkg ('Dir Artifacts)
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Pkg)
forall (allowAbsolute :: AllowAbsolute) from (to1 :: FileOrDir)
       (to2 :: FileOrDir).
SymbolicPathX allowAbsolute from to1
-> SymbolicPathX allowAbsolute from to2
coerceSymbolicPath SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir SymbolicPathX 'AllowAbsolute Pkg ('Dir Pkg)
-> SymbolicPathX 'OnlyRelative Pkg 'File
-> SymbolicPathX 'AllowAbsolute Pkg 'File
forall p q r. PathLike p q r => p -> q -> r
</> SymbolicPathX 'OnlyRelative Pkg 'File
relObjPath
    Maybe (SymbolicPathX 'OnlyRelative Pkg 'File)
Nothing ->
      -- For an absolute input file, the object file is placed next to the input file
      -- and not within -odir.
      SymbolicPathX 'AllowAbsolute Pkg 'File
objPath
  where
    objPath :: SymbolicPathX 'AllowAbsolute Pkg 'File
objPath = SymbolicPathX 'AllowAbsolute Pkg 'File
src SymbolicPathX 'AllowAbsolute Pkg 'File
-> [Char] -> SymbolicPathX 'AllowAbsolute Pkg 'File
forall (allowAbsolute :: AllowAbsolute) from.
SymbolicPathX allowAbsolute from 'File
-> [Char] -> SymbolicPathX allowAbsolute from 'File
`replaceExtensionSymbolicPath` [Char]
objExt

-- | Target name for a foreign library (the actual file name)
--
-- We do not use mkLibName and co here because the naming for foreign libraries
-- is slightly different (we don't use "_p" or compiler version suffices, and we
-- don't want the "lib" prefix on Windows).
--
-- TODO: We do use `dllExtension` and co here, but really that's wrong: they
-- use the OS used to build cabal to determine which extension to use, rather
-- than the target OS (but this is wrong elsewhere in Cabal as well).
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

    -- If a foreign lib foo has lib-version-info 5:1:2 or
    -- lib-version-linux 3.2.1, it should be built as libfoo.so.3.2.1
    -- Libtool's version-info data is translated into library versions in a
    -- nontrivial way: so refer to libtool documentation.
    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)

-- | Name for the library when building.
--
-- If the `lib-version-info` field or the `lib-version-linux` field of
-- a foreign library target is set, we need to incorporate that
-- version into the SONAME field.
--
-- If a foreign library foo has lib-version-info 5:1:2, it should be
-- built as libfoo.so.3.2.1.  We want it to get soname libfoo.so.3.
-- However, GHC does not allow overriding soname by setting linker
-- options, as it sets a soname of its own (namely the output
-- filename), after the user-supplied linker options.  Hence, we have
-- to compile the library with the soname as its filename.  We rename
-- the compiled binary afterwards.
--
-- This method allows to adjust the name of the library at build time
-- such that the correct soname can be set.
flibBuildName :: LocalBuildInfo -> ForeignLib -> String
flibBuildName :: LocalBuildInfo -> ForeignLib -> [Char]
flibBuildName LocalBuildInfo
lbi ForeignLib
flib
  -- On linux, if a foreign-library has version data, the first digit is used
  -- to produce the SONAME.
  | (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

-- | Gets the target name (name of actual executable file) from the name of an
-- executable-like component ('Executable', 'TestSuite', 'Benchmark').
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]
""

-- | "Main" module name when overridden by @ghc-options: -main-is ...@
-- or 'Nothing' if no @-main-is@ flag could be found.
--
-- In case of 'Nothing', 'Distribution.ModuleName.main' can be assumed.
exeMainModuleName
  :: BuildInfo
  -- ^ The build info of the executable-like component (Exe, Test, Bench)
  -> ModuleName
exeMainModuleName :: BuildInfo -> ModuleName
exeMainModuleName BuildInfo
bnfo =
  -- GHC honors the last occurrence of a module name updated via -main-is
  --
  -- Moreover, -main-is when parsed left-to-right can update either
  -- the "Main" module name, or the "main" function name, or both,
  -- see also 'decodeMainIsArg'.
  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

-- | Decode argument to '-main-is'
--
-- Returns 'Nothing' if argument set only the function name.
--
-- This code has been stolen/refactored from GHC's DynFlags.setMainIs
-- function. The logic here is deliberately imperfect as it is
-- intended to be bug-compatible with GHC's parser. See discussion in
-- https://github.com/haskell/cabal/pull/4539#discussion_r118981753.
decodeMainIsArg :: String -> Maybe ModuleName
decodeMainIsArg :: [Char] -> Maybe ModuleName
decodeMainIsArg [Char]
arg
  | [Char] -> (Char -> Bool) -> Bool
headOf [Char]
main_fn Char -> Bool
isLower =
      -- The arg looked like "Foo.Bar.baz"
      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 -- The arg looked like "Foo" or "Foo.Bar"
    =
      ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ([Char] -> ModuleName
forall a. IsString a => [Char] -> a
ModuleName.fromString [Char]
arg)
  | Bool
otherwise -- The arg looked like "baz"
    =
      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
        -- 'safeTail' drops the char satisfying 'pred'
        ([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)