{-# LINE 1 "libraries/base/System/Environment/ExecutablePath.hsc" #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE CPP #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  System.Environment.ExecutablePath
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- Function to retrieve the absolute filepath of the current executable.
--
-- @since 4.6.0.0
-----------------------------------------------------------------------------

module System.Environment.ExecutablePath
  ( getExecutablePath
  , executablePath
  ) where

-- The imports are purposely kept completely disjoint to prevent edits
-- to one OS implementation from breaking another.


{-# LINE 28 "libraries/base/System/Environment/ExecutablePath.hsc" #-}
import Control.Exception (catch, throw)
import Data.Word
import Foreign.C
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
import System.IO.Error (isDoesNotExistError)
import System.Posix.Internals

{-# LINE 69 "libraries/base/System/Environment/ExecutablePath.hsc" #-}

-- The exported function is defined outside any if-guard to make sure
-- every OS implements it with the same type.

-- | Returns the absolute pathname of the current executable,
-- or @argv[0]@ if the operating system does not provide a reliable
-- way query the current executable.
--
-- Note that for scripts and interactive sessions, this is the path to
-- the interpreter (e.g. ghci.)
--
-- Since base 4.11.0.0, 'getExecutablePath' resolves symlinks on Windows.
-- If an executable is launched through a symlink, 'getExecutablePath'
-- returns the absolute path of the original executable.
--
-- If the executable has been deleted, behaviour is ill-defined and
-- varies by operating system.  See 'executablePath' for a more
-- reliable way to query the current executable.
--
-- @since 4.6.0.0
getExecutablePath :: IO FilePath

-- | Get an action to query the absolute pathname of the current executable.
--
-- If the operating system provides a reliable way to determine the current
-- executable, return the query action, otherwise return @Nothing@.  The action
-- is defined on FreeBSD, Linux, MacOS, NetBSD, and Windows.
--
-- Even where the query action is defined, there may be situations where no
-- result is available, e.g. if the executable file was deleted while the
-- program is running.  Therefore the result of the query action is a @Maybe
-- FilePath@.
--
-- Note that for scripts and interactive sessions, the result is the path to
-- the interpreter (e.g. ghci.)
--
-- @since 4.17.0.0
executablePath :: Maybe (IO (Maybe FilePath))


--------------------------------------------------------------------------------
-- Mac OS X


{-# LINE 113 "libraries/base/System/Environment/ExecutablePath.hsc" #-}

type UInt32 = Word32

foreign import ccall unsafe "mach-o/dyld.h _NSGetExecutablePath"
    c__NSGetExecutablePath :: CString -> Ptr UInt32 -> IO CInt

-- | Returns the path of the main executable. The path may be a
-- symbolic link and not the real file.
--
-- See dyld(3)
_NSGetExecutablePath :: IO FilePath
_NSGetExecutablePath :: IO FilePath
_NSGetExecutablePath =
    Int -> (Ptr CChar -> IO FilePath) -> IO FilePath
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
1024 ((Ptr CChar -> IO FilePath) -> IO FilePath)
-> (Ptr CChar -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
buf ->  -- PATH_MAX is 1024 on OS X
    (Ptr UInt32 -> IO FilePath) -> IO FilePath
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr UInt32 -> IO FilePath) -> IO FilePath)
-> (Ptr UInt32 -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \ Ptr UInt32
bufsize -> do
        Ptr UInt32 -> UInt32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr UInt32
bufsize UInt32
1024
        CInt
status <- Ptr CChar -> Ptr UInt32 -> IO CInt
c__NSGetExecutablePath Ptr CChar
buf Ptr UInt32
bufsize
        if CInt
status CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
            then Ptr CChar -> IO FilePath
peekFilePath Ptr CChar
buf
            else do Int
reqBufsize <- UInt32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt32 -> Int) -> IO UInt32 -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr UInt32 -> IO UInt32
forall a. Storable a => Ptr a -> IO a
peek Ptr UInt32
bufsize
                    Int -> (Ptr CChar -> IO FilePath) -> IO FilePath
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
reqBufsize ((Ptr CChar -> IO FilePath) -> IO FilePath)
-> (Ptr CChar -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
newBuf -> do
                        CInt
status2 <- Ptr CChar -> Ptr UInt32 -> IO CInt
c__NSGetExecutablePath Ptr CChar
newBuf Ptr UInt32
bufsize
                        if CInt
status2 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
                             then Ptr CChar -> IO FilePath
peekFilePath Ptr CChar
newBuf
                             else FilePath -> IO FilePath
forall a. FilePath -> a
errorWithoutStackTrace FilePath
"_NSGetExecutablePath: buffer too small"

foreign import ccall unsafe "stdlib.h realpath"
    c_realpath :: CString -> CString -> IO CString

-- | Resolves all symbolic links, extra \/ characters, and references
-- to \/.\/ and \/..\/. Returns an absolute pathname.
--
-- See realpath(3)
realpath :: FilePath -> IO FilePath
realpath :: FilePath -> IO FilePath
realpath FilePath
path =
    FilePath -> (Ptr CChar -> IO FilePath) -> IO FilePath
forall a. FilePath -> (Ptr CChar -> IO a) -> IO a
withFilePath FilePath
path ((Ptr CChar -> IO FilePath) -> IO FilePath)
-> (Ptr CChar -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
fileName ->
    Int -> (Ptr CChar -> IO FilePath) -> IO FilePath
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
1024 ((Ptr CChar -> IO FilePath) -> IO FilePath)
-> (Ptr CChar -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
resolvedName -> do
        Ptr CChar
_ <- FilePath -> IO (Ptr CChar) -> IO (Ptr CChar)
forall a. FilePath -> IO (Ptr a) -> IO (Ptr a)
throwErrnoIfNull FilePath
"realpath" (IO (Ptr CChar) -> IO (Ptr CChar))
-> IO (Ptr CChar) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Ptr CChar -> Ptr CChar -> IO (Ptr CChar)
c_realpath Ptr CChar
fileName Ptr CChar
resolvedName
        Ptr CChar -> IO FilePath
peekFilePath Ptr CChar
resolvedName

getExecutablePath :: IO FilePath
getExecutablePath = IO FilePath
_NSGetExecutablePath IO FilePath -> (FilePath -> IO FilePath) -> IO FilePath
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO FilePath
realpath

-- realpath(3) fails with ENOENT file does not exist (e.g. was deleted)
executablePath :: Maybe (IO (Maybe FilePath))
executablePath = IO (Maybe FilePath) -> Maybe (IO (Maybe FilePath))
forall a. a -> Maybe a
Just ((FilePath -> Maybe FilePath) -> IO FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just IO FilePath
getExecutablePath IO (Maybe FilePath)
-> (IOError -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO (Maybe FilePath)
forall {f :: * -> *} {a}. Applicative f => IOError -> f (Maybe a)
f)
  where
  f :: IOError -> f (Maybe a)
f IOError
e | IOError -> Bool
isDoesNotExistError IOError
e = Maybe a -> f (Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
      | Bool
otherwise             = IOError -> f (Maybe a)
forall a e. Exception e => e -> a
throw IOError
e

--------------------------------------------------------------------------------
-- Linux


{-# LINE 371 "libraries/base/System/Environment/ExecutablePath.hsc" #-}