{-# LANGUAGE MultiWayIf #-}
module GHC.Linker.Static.Utils where
import GHC.Prelude
import GHC.Platform
import System.FilePath
exeFileName :: ArchOS -> Bool -> Maybe FilePath -> FilePath
exeFileName :: ArchOS -> Bool -> Maybe FilePath -> FilePath
exeFileName (ArchOS Arch
arch OS
os) Bool
staticLink Maybe FilePath
output_fn
| Just FilePath
s <- Maybe FilePath
output_fn = if
| OS
OSMinGW32 <- OS
os -> FilePath
s FilePath -> FilePath -> FilePath
<?.> FilePath
"exe"
| Arch
ArchJavaScript <- Arch
arch -> FilePath
s FilePath -> FilePath -> FilePath
<?.> FilePath
"jsexe"
| Arch
ArchWasm32 <- Arch
arch -> FilePath
s FilePath -> FilePath -> FilePath
<?.> FilePath
"wasm"
| Bool
staticLink -> FilePath
s FilePath -> FilePath -> FilePath
<?.> FilePath
"a"
| Bool
otherwise -> FilePath
s
| Bool
otherwise = if
| OS
OSMinGW32 <- OS
os -> FilePath
"main.exe"
| Arch
ArchJavaScript <- Arch
arch -> FilePath
"main.jsexe"
| Bool
staticLink -> FilePath
"liba.a"
| Bool
otherwise -> FilePath
"a.out"
where FilePath
s <?.> :: FilePath -> FilePath -> FilePath
<?.> FilePath
ext | FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> FilePath
takeExtension FilePath
s) = FilePath
s FilePath -> FilePath -> FilePath
<.> FilePath
ext
| Bool
otherwise = FilePath
s