{-# LANGUAGE CPP #-}
module System.Environment.Executable
( getExecutablePath
, splitExecutablePath
#ifdef mingw32_HOST_OS
, getModulePath
#endif
#ifdef darwin_HOST_OS
, getApplicationBundlePath
#endif
#ifdef WE_HAVE_GHC
, ScriptPath(..)
, getScriptPath
#endif
)
where
import Control.Monad (liftM)
import System.FilePath (splitFileName)
import System.Directory (canonicalizePath)
import Data.Char (toLower)
import Data.List (find,findIndex)
#ifdef WE_HAVE_GHC
import GHC.Environment
#endif
#ifdef mingw32_HOST_OS
#define SUPPORTED_OS
import System.Environment.Executable.Win32
#endif
#ifdef darwin_HOST_OS
#define SUPPORTED_OS
import System.Environment.Executable.MacOSX
#endif
#ifdef linux_HOST_OS
#define SUPPORTED_OS
import System.Environment.Executable.Linux
#endif
#ifdef freebsd_HOST_OS
#define SUPPORTED_OS
import System.Environment.Executable.FreeBSD
#endif
#ifdef netbsd_HOST_OS
#define SUPPORTED_OS
import System.Environment.Executable.BSD
#endif
#ifdef openbsd_HOST_OS
#define SUPPORTED_OS
import System.Environment.Executable.BSD
#endif
#ifdef solaris_HOST_OS
#define SUPPORTED_OS
import System.Environment.Executable.Solaris
#endif
splitExecutablePath :: IO (FilePath,FilePath)
splitExecutablePath :: IO (FilePath, FilePath)
splitExecutablePath = (FilePath -> (FilePath, FilePath))
-> IO FilePath -> IO (FilePath, FilePath)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM FilePath -> (FilePath, FilePath)
splitFileName IO FilePath
getExecutablePath
#ifndef SUPPORTED_OS
{-# WARNING getExecutablePath "the host OS is not supported!" #-}
getExecutablePath :: IO String
getExecutablePath = error "host OS not supported"
#endif
#ifdef WE_HAVE_GHC
getScriptPath :: IO ScriptPath
getScriptPath :: IO ScriptPath
getScriptPath = do
[FilePath]
fargs <- IO [FilePath]
getFullArgs
FilePath
exec <- IO FilePath
getExecutablePath
let (FilePath
pt,FilePath
fn) = FilePath -> (FilePath, FilePath)
splitFileName FilePath
exec
case [FilePath]
fargs of
[] -> ScriptPath -> IO ScriptPath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> ScriptPath
Executable FilePath
exec)
[FilePath]
_ -> case (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
fn of
#ifdef mingw32_HOST_OS
"ghc.exe" -> do
#else
FilePath
"ghc" -> do
#endif
case (FilePath -> Bool) -> [FilePath] -> Maybe FilePath
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find FilePath -> Bool
f1 [FilePath]
fargs of
Just FilePath
s -> do
FilePath
path <- FilePath -> IO FilePath
canonicalizePath (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. HasCallStack => [a] -> [a]
init (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
n1 FilePath
s)
ScriptPath -> IO ScriptPath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptPath -> IO ScriptPath) -> ScriptPath -> IO ScriptPath
forall a b. (a -> b) -> a -> b
$ FilePath -> ScriptPath
RunGHC FilePath
path
Maybe FilePath
Nothing -> case (FilePath -> Bool) -> [FilePath] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex FilePath -> Bool
f2 [FilePath]
fargs of
Just Int
i -> ScriptPath -> IO ScriptPath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ScriptPath
Interactive
Maybe Int
Nothing -> ScriptPath -> IO ScriptPath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> ScriptPath
Executable FilePath
exec)
FilePath
_ -> ScriptPath -> IO ScriptPath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> ScriptPath
Executable FilePath
exec)
where
f1 :: FilePath -> Bool
f1 FilePath
xs = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
n1 FilePath
xs FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
s1
s1 :: FilePath
s1 = FilePath
":set prog \""
n1 :: Int
n1 = FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
s1
f2 :: FilePath -> Bool
f2 FilePath
xs = FilePath
xs FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"--interactive"
data ScriptPath
= Executable FilePath
| RunGHC FilePath
| Interactive
deriving Int -> ScriptPath -> FilePath -> FilePath
[ScriptPath] -> FilePath -> FilePath
ScriptPath -> FilePath
(Int -> ScriptPath -> FilePath -> FilePath)
-> (ScriptPath -> FilePath)
-> ([ScriptPath] -> FilePath -> FilePath)
-> Show ScriptPath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> ScriptPath -> FilePath -> FilePath
showsPrec :: Int -> ScriptPath -> FilePath -> FilePath
$cshow :: ScriptPath -> FilePath
show :: ScriptPath -> FilePath
$cshowList :: [ScriptPath] -> FilePath -> FilePath
showList :: [ScriptPath] -> FilePath -> FilePath
Show
#endif