{- |

The documentation of "System.Environment.getProgName" says that

\"However, this is hard-to-impossible to implement on some non-Unix OSes, 
so instead, for maximum portability, we just return the leafname 
of the program as invoked. Even then there are some differences 
between platforms: on Windows, for example, a program invoked as 
foo is probably really FOO.EXE, and that is what "getProgName" will 
return.\"

This library tries to fix this issue.
It also provides some platform-specific functions (most notably getting
the path of the application bundle on OSX). Supported operating
systems:
 
 * Win32 (tested on Windows 7)
 
 * Mac OS X
 
 * Linux

 * FreeBSD (tested on FreeBSD 6.4)

 * \*BSD (with procfs mounted, plus fallback for certain shells; untested)
 
 * Solaris (untested, and probably works on Solaris 10 only) 
 
-}

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

-- | An experimental hack which tries to figure out if the program
-- was run with @runghc@ or @runhaskell@ or @ghci@, and then tries to find 
-- out the directory of the /source/ (or object file).
--
-- GHC only.
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  -- ^ it was (probably) a proper compiled executable
  | RunGHC FilePath      -- ^ it was a script run by runghc/runhaskell
  | Interactive          -- ^ we are in GHCi
  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

--------------------------------------------------------------------------------