    {- |

    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
      fargs <- IO [FilePath]
    getFullArgs
      exec  <- getExecutablePath
      let (pt,fn) = splitFileName exec
      case 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
                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)
                return $ RunGHC 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

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