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

-- | 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 (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

-- | Does this compiler support the @-dynamic-too@ option
supportsDynamicToo :: Compiler -> Bool
supportsDynamicToo :: Compiler -> Bool
supportsDynamicToo = FilePath -> Compiler -> Bool
Internal.ghcLookupProperty FilePath
"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 = FilePath -> Compiler -> Bool
Internal.ghcLookupProperty FilePath
"GHC Dynamic"

isProfiled :: Compiler -> Bool
isProfiled :: Compiler -> Bool
isProfiled = FilePath -> Compiler -> Bool
Internal.ghcLookupProperty FilePath
"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 ->
      FilePath -> Bool
forall a. FilePath -> a
cabalBug FilePath
"unknown foreign lib type"

-- | Is this file a C++ source file, i.e. ends with .cpp, .cxx, or .c++?
isCxx :: FilePath -> Bool
isCxx :: FilePath -> Bool
isCxx FilePath
fp = FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (FilePath -> FilePath
takeExtension FilePath
fp) [FilePath
".cpp", FilePath
".cxx", FilePath
".c++"]

-- | Is this a C source file, i.e. ends with .c?
isC :: FilePath -> Bool
isC :: FilePath -> Bool
isC FilePath
fp = FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (FilePath -> FilePath
takeExtension FilePath
fp) [FilePath
".c"]

-- | FilePath has a Haskell extension: .hs or .lhs
isHaskell :: FilePath -> Bool
isHaskell :: FilePath -> Bool
isHaskell FilePath
fp = FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (FilePath -> FilePath
takeExtension FilePath
fp) [FilePath
".hs", FilePath
".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))
-> SymbolicPath Pkg 'File -> GhcOptions -> IO Bool
checkNeedsRecompilation Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg 'File
filename GhcOptions
opts =
  SymbolicPath Pkg 'File -> FilePath
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> FilePath
i SymbolicPath Pkg 'File
filename FilePath -> FilePath -> IO Bool
`moreRecentFile` FilePath
oname
  where
    oname :: FilePath
oname = Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File -> GhcOptions -> FilePath
getObjectFileName Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg 'File
filename GhcOptions
opts
    i :: SymbolicPathX allowAbsolute Pkg to -> FilePath
i = Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX allowAbsolute Pkg to -> FilePath
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> FilePath
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))
  -> SymbolicPath Pkg File
  -> GhcOptions
  -> FilePath
getObjectFileName :: Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File -> GhcOptions -> FilePath
getObjectFileName Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg 'File
filename GhcOptions
opts = FilePath
oname
  where
    i :: SymbolicPathX allowAbsolute Pkg to -> FilePath
i = Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX allowAbsolute Pkg to -> FilePath
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> FilePath
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
    odir :: FilePath
odir = SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts) -> FilePath
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> FilePath
i (SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts) -> FilePath)
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts) -> FilePath
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 :: FilePath
oext = FilePath -> Flag FilePath -> FilePath
forall a. a -> Flag a -> a
fromFlagOrDefault FilePath
"o" (GhcOptions -> Flag FilePath
ghcOptObjSuffix GhcOptions
opts)
    -- NB: the filepath might be absolute, e.g. if it is the path to
    -- an autogenerated .hs file.
    oname :: FilePath
oname = FilePath
odir FilePath -> FilePath -> FilePath
forall p q r. PathLike p q r => p -> q -> r
</> FilePath -> FilePath -> FilePath
replaceExtension (SymbolicPath Pkg 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath SymbolicPath Pkg 'File
filename) FilePath
oext

-- | 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 -> FilePath
flibTargetName LocalBuildInfo
lbi ForeignLib
flib =
  case (OS
os, ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib) of
    (OS
Windows, ForeignLibType
ForeignLibNativeShared) -> FilePath
nm FilePath -> FilePath -> FilePath
forall p. FileLike p => p -> FilePath -> p
<.> FilePath
"dll"
    (OS
Windows, ForeignLibType
ForeignLibNativeStatic) -> FilePath
nm FilePath -> FilePath -> FilePath
forall p. FileLike p => p -> FilePath -> p
<.> FilePath
"lib"
    (OS
Linux, ForeignLibType
ForeignLibNativeShared) -> FilePath
"lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
nm FilePath -> FilePath -> FilePath
forall p. FileLike p => p -> FilePath -> p
<.> FilePath
versionedExt
    (OS
_other, ForeignLibType
ForeignLibNativeShared) ->
      FilePath
"lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
nm FilePath -> FilePath -> FilePath
forall p. FileLike p => p -> FilePath -> p
<.> Platform -> FilePath
dllExtension (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi)
    (OS
_other, ForeignLibType
ForeignLibNativeStatic) ->
      FilePath
"lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
nm FilePath -> FilePath -> FilePath
forall p. FileLike p => p -> FilePath -> p
<.> Platform -> FilePath
staticLibExtension (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi)
    (OS
_any, ForeignLibType
ForeignLibTypeUnknown) -> FilePath -> FilePath
forall a. FilePath -> a
cabalBug FilePath
"unknown foreign lib type"
  where
    nm :: String
    nm :: FilePath
nm = UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
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 :: FilePath
versionedExt =
      let nums :: [Int]
nums = ForeignLib -> OS -> [Int]
foreignLibVersion ForeignLib
flib OS
os
       in (FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl FilePath -> FilePath -> FilePath
forall p. FileLike p => p -> FilePath -> p
(<.>) FilePath
"so" ((Int -> FilePath) -> [Int] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Int -> FilePath
forall a. Show a => a -> FilePath
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 -> FilePath
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 FilePath
"lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
nm FilePath -> FilePath -> FilePath
forall p. FileLike p => p -> FilePath -> p
<.> (FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl FilePath -> FilePath -> FilePath
forall p. FileLike p => p -> FilePath -> p
(<.>) FilePath
"so" ((Int -> FilePath) -> [Int] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
1 [Int]
nums))
  | Bool
otherwise = LocalBuildInfo -> ForeignLib -> FilePath
flibTargetName LocalBuildInfo
lbi ForeignLib
flib
  where
    os :: OS
    Platform Arch
_ OS
os = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi

    nm :: String
    nm :: FilePath
nm = UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
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 -> FilePath
exeTargetName Platform
platform UnqualComponentName
name = UnqualComponentName -> FilePath
unUnqualComponentName UnqualComponentName
name FilePath -> FilePath -> FilePath
`withExt` Platform -> FilePath
exeExtension Platform
platform
  where
    withExt :: FilePath -> String -> FilePath
    withExt :: FilePath -> FilePath -> FilePath
withExt FilePath
fp FilePath
ext = FilePath
fp FilePath -> FilePath -> FilePath
forall p. FileLike p => p -> FilePath -> p
<.> if FilePath -> FilePath
takeExtension FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= (Char
'.' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
ext) then FilePath
ext else FilePath
""

-- | "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
$ (FilePath -> Maybe ModuleName) -> [FilePath] -> [Maybe ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Maybe ModuleName
decodeMainIsArg ([FilePath] -> [Maybe ModuleName])
-> [FilePath] -> [Maybe ModuleName]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
findIsMainArgs [FilePath]
ghcopts
  where
    ghcopts :: [FilePath]
ghcopts = CompilerFlavor -> BuildInfo -> [FilePath]
hcOptions CompilerFlavor
GHC BuildInfo
bnfo

    findIsMainArgs :: [FilePath] -> [FilePath]
findIsMainArgs [] = []
    findIsMainArgs (FilePath
"-main-is" : FilePath
arg : [FilePath]
rest) = FilePath
arg FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath]
findIsMainArgs [FilePath]
rest
    findIsMainArgs (FilePath
_ : [FilePath]
rest) = [FilePath] -> [FilePath]
findIsMainArgs [FilePath]
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 :: FilePath -> Maybe ModuleName
decodeMainIsArg FilePath
arg
  | FilePath -> (Char -> Bool) -> Bool
headOf FilePath
main_fn Char -> Bool
isLower =
      -- The arg looked like "Foo.Bar.baz"
      ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (FilePath -> ModuleName
forall a. IsString a => FilePath -> a
ModuleName.fromString FilePath
main_mod)
  | FilePath -> (Char -> Bool) -> Bool
headOf FilePath
arg Char -> Bool
isUpper -- The arg looked like "Foo" or "Foo.Bar"
    =
      ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (FilePath -> ModuleName
forall a. IsString a => FilePath -> a
ModuleName.fromString FilePath
arg)
  | Bool
otherwise -- The arg looked like "baz"
    =
      Maybe ModuleName
forall a. Maybe a
Nothing
  where
    headOf :: String -> (Char -> Bool) -> Bool
    headOf :: FilePath -> (Char -> Bool) -> Bool
headOf FilePath
str Char -> Bool
pred' = (Char -> Bool) -> Maybe Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
pred' (FilePath -> Maybe Char
forall a. [a] -> Maybe a
safeHead FilePath
str)

    (FilePath
main_mod, FilePath
main_fn) = FilePath -> (Char -> Bool) -> (FilePath, FilePath)
splitLongestPrefix FilePath
arg (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')

    splitLongestPrefix :: String -> (Char -> Bool) -> (String, String)
    splitLongestPrefix :: FilePath -> (Char -> Bool) -> (FilePath, FilePath)
splitLongestPrefix FilePath
str Char -> Bool
pred'
      | FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
r_pre = (FilePath
str, [])
      | Bool
otherwise = (FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath
forall a. [a] -> [a]
safeTail FilePath
r_pre), FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
r_suf)
      where
        -- 'safeTail' drops the char satisfying 'pred'
        (FilePath
r_suf, FilePath
r_pre) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
pred' (FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
str)