executable-path (empty) → 0.0

raw patch · 9 files changed

+552/−0 lines, 9 filesdep +basedep +filepathdep +unixsetup-changed

Dependencies added: base, filepath, unix

Files

• LICENSE +32/−0
• Setup.lhs +4/−0
• System/Environment/Executable.hs +100/−0
• System/Environment/Executable/BSD.hs +51/−0
• System/Environment/Executable/Linux.hs +51/−0
• System/Environment/Executable/MacOSX.hs +152/−0
• System/Environment/Executable/Solaris.hs +51/−0
• System/Environment/Executable/Win32.hs +55/−0
• executable-path.cabal +56/−0

@@ -0,0 +1,32 @@+http://creativecommons.org/licenses/publicdomain/+-------------------------------------------------++Copyright-Only Dedication (based on United States law) or +Public Domain Certification++The person or persons who have associated work with this document (the +"Dedicator" or "Certifier") hereby either (a) certifies that, to the best of +his knowledge, the work of authorship identified is in the public domain +of the country from which the work is published, or (b) hereby dedicates +whatever copyright the dedicators holds in the work of authorship identified +below (the "Work") to the public domain. A certifier, moreover, dedicates any +copyright interest he may have in the associated work, and for these purposes, +is described as a "dedicator" below.++A certifier has taken reasonable steps to verify the copyright status of this +work. Certifier recognizes that his good faith efforts may not shield him +from liability if in fact the work certified is not in the public domain.++Dedicator makes this dedication for the benefit of the public at large and +to the detriment of the Dedicator's heirs and successors. Dedicator intends +this dedication to be an overt act of relinquishment in perpetuity of all +present and future rights under copyright law, whether vested or contingent, +in the Work. Dedicator understands that such relinquishment of all rights +includes the relinquishment of all rights to enforce (by lawsuit or otherwise) +those copyrights in the Work.++Dedicator recognizes that, once placed in the public domain, the Work may +be freely reproduced, distributed, transmitted, used, modified, built upon, +or otherwise exploited by anyone for any purpose, commercial or non-commercial, +and in any way, including by methods that have not yet been invented or +conceived.

@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell+ +> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,100 @@++{- |++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 XP \/ x86 only)+ + * Mac OS X (tested on Leopard \/ x86 only)+ + * Linux++ * \*BSD (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+  +  )+  where++import Control.Monad (liftM)+import System.FilePath (splitFileName)++--------------------------------------------------------------------------------++#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.BSD+#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 = liftM splitFileName getExecutablePath++--------------------------------------------------------------------------------++#ifndef SUPPORTED_OS+{-# WARNING getExecutablePath "the host OS is not supported!" #-}+getExecutablePath :: IO String+getExecutablePath = error "host OS not supported"+#endif++--------------------------------------------------------------------------------

@@ -0,0 +1,51 @@+++{-+symbolic links to the executable:++Linux:+/proc/<pid>/exe++Solaris: (Solaris 10 only???)+/proc/<pid>/object/a.out (filename only)+/proc/<pid>/path/a.out (complete pathname)++*BSD:+/proc/<pid>/file+-}++{-# LANGUAGE ForeignFunctionInterface #-}++module System.Environment.Executable.BSD+  ( getExecutablePath  +  , getPID+  )+  where++import Data.Bits+import Data.Word+import Data.Int++import Control.Monad++import Foreign+import Foreign.C++import System.Posix+--import System.FilePath++--------------------------------------------------------------------------------++getPID :: IO Int+getPID = liftM fromIntegral $ getProcessID++getExecutablePath :: IO FilePath+getExecutablePath = do+  pid <- getPID+  fname <- readSymbolicLink $ "/proc/" ++ show pid ++ "/file"+  --let (path,exename) = splitFileName fname+  --return path+  return fname++--------------------------------------------------------------------------------+  

@@ -0,0 +1,51 @@+++{-+symbolic links to the executable:++Linux:+/proc/<pid>/exe++Solaris: (Solaris 10 only???)+/proc/<pid>/object/a.out (filename only)+/proc/<pid>/path/a.out (complete pathname)++*BSD:+/proc/<pid>/file+-}++{-# LANGUAGE ForeignFunctionInterface #-}++module System.Environment.Executable.Linux+  ( getExecutablePath  +  , getPID+  )+  where++import Data.Bits+import Data.Word+import Data.Int++import Control.Monad++import Foreign+import Foreign.C++import System.Posix+--import System.FilePath++--------------------------------------------------------------------------------++getPID :: IO Int+getPID = liftM fromIntegral $ getProcessID++getExecutablePath :: IO FilePath+getExecutablePath = do+  pid <- getPID+  fname <- readSymbolicLink $ "/proc/" ++ show pid ++ "/exe"+  --let (path,exename) = splitFileName fname+  --return path+  return fname+  +--------------------------------------------------------------------------------+  

@@ -0,0 +1,152 @@++{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}++module System.Environment.Executable.MacOSX+  ( getExecutablePath +  , getApplicationBundlePath+  )+  where++import Data.Bits+import Data.Word+import Data.Int++import Control.Monad++import Foreign+import Foreign.C+ +--import System.FilePath+  +--------------------------------------------------------------------------------++type UInt8    = Word8+type UInt16   = Word16+type UInt32   = Word32+type UInt64   = Word64++type SInt8    = Int8+type SInt16   = Int16+type SInt32   = Int32+type SInt64   = Int64++type OSErr    = SInt16+type OSStatus = SInt32++type Boolean  = Bool+type Float32  = Float+type Float64  = Double++type UniChar   = Char+type CFIndex   = SInt32+type ItemCount = UInt32+type ByteCount = UInt32++data CFData+data CFString+data CFAllocator++type CFDataRef      = Ptr CFData    +type CFStringRef    = Ptr CFString+type CFAllocatorRef = Ptr CFAllocator++--------------------------------------------------------------------------------++kCFAllocatorDefault :: CFAllocatorRef+kCFAllocatorDefault = nullPtr++osStatusString :: OSStatus -> String+osStatusString osstatus = "OSStatus = " ++ show osstatus++osStatusError :: OSStatus -> IO a+osStatusError osstatus = fail $ osStatusString osstatus++foreign import ccall unsafe "CFBase.h CFRelease" +  c_CFRelease :: Ptr a -> IO ()++foreign import ccall unsafe "CFString.h CFStringGetLength" +  c_CFStringGetLength :: CFStringRef -> IO CFIndex++foreign import ccall unsafe "CFString.h CFStringGetCharactersPtr"+  c_CFStringGetCharactersPtr :: CFStringRef -> IO (Ptr UniChar)  ++foreign import ccall unsafe "CFString.h CFStringGetCharacterAtIndex"+  c_CFStringGetCharacterAtIndex :: CFStringRef -> CFIndex -> IO UniChar ++foreign import ccall unsafe "CFString.h CFStringCreateWithCharacters"+  c_CFStringCreateWithCharacters :: CFAllocatorRef -> Ptr UniChar -> CFIndex -> IO CFStringRef++-- | Manually releasing a CFString.+releaseCFString :: CFStringRef -> IO ()+releaseCFString = c_CFRelease++-- | Peeks a CFString.+peekCFString :: CFStringRef -> IO String+peekCFString cfstring = do+  n <- c_CFStringGetLength cfstring+  p <- c_CFStringGetCharactersPtr cfstring+  if p /= nullPtr +    then forM [0..n-1] $ \i -> peekElemOff p (fromIntegral i)+    else forM [0..n-1] $ \i -> c_CFStringGetCharacterAtIndex cfstring i+ +-- | Creates a new CFString. You have to release it manually.+newCFString :: String -> IO CFStringRef+newCFString string = +  let n = length string in allocaArray n $ \p ->+  c_CFStringCreateWithCharacters kCFAllocatorDefault p (fromIntegral n)+ +-- | Safe passing of a CFString to the OS (releases it afterwards).+withCFString :: String -> (CFStringRef -> IO a) -> IO a+withCFString string action = do+  cfstring <- newCFString string+  x <- action cfstring+  releaseCFString cfstring+  return x++-------------------------------------------------------------------------------- +  +data CFBundle+type CFBundleRef = Ptr CFBundle++data CFURL+type CFURLRef = Ptr CFURL++type OSXEnum = CInt -- ?????????????+type CFURLPathStyle = OSXEnum++foreign import ccall unsafe "CFBundle.h CFBundleGetMainBundle" +  c_CFBundleGetMainBundle :: IO CFBundleRef++foreign import ccall unsafe "CFBundle.h CFBundleCopyBundleURL" +  c_CFBundleCopyBundleURL :: CFBundleRef -> IO CFURLRef++foreign import ccall unsafe "CFBundle.h CFBundleCopyExecutableURL"+  c_CFBundleCopyExecutableURL :: CFBundleRef -> IO CFURLRef++foreign import ccall unsafe "CFURL.h CFURLCopyFileSystemPath" +  c_CFURLCopyFileSystemPath :: CFURLRef -> CFURLPathStyle -> IO CFStringRef++kCFURLPOSIXPathStyle   = 0 :: CFURLPathStyle+kCFURLHFSPathStyle     = 1 :: CFURLPathStyle+kCFURLWindowsPathStyle = 2 :: CFURLPathStyle++-- | Mac OS X only.+getApplicationBundlePath :: IO FilePath+getApplicationBundlePath = do+  bundle <- c_CFBundleGetMainBundle+  url    <- c_CFBundleCopyBundleURL bundle+  cfpath <- c_CFURLCopyFileSystemPath url kCFURLPOSIXPathStyle+  peekCFString cfpath++getExecutablePath :: IO FilePath+getExecutablePath = do +  bundle <- c_CFBundleGetMainBundle+  url    <- c_CFBundleCopyExecutableURL bundle+  cfpath <- c_CFURLCopyFileSystemPath url kCFURLPOSIXPathStyle+  fname <- peekCFString cfpath+--  let (path,exename) = splitFileName fname+--  return path+  return fname+++--------------------------------------------------------------------------------

@@ -0,0 +1,51 @@+++{-+symbolic links to the executable:++Linux:+/proc/<pid>/exe++Solaris: (Solaris 10 only???)+/proc/<pid>/object/a.out (filename only)+/proc/<pid>/path/a.out (complete pathname)++*BSD:+/proc/<pid>/file+-}++{-# LANGUAGE ForeignFunctionInterface #-}++module System.Environment.Executable.Solaris+  ( getExecutablePath  +  , getPID+  )+  where++import Data.Bits+import Data.Word+import Data.Int++import Control.Monad++import Foreign+import Foreign.C++import System.Posix+--import System.FilePath++--------------------------------------------------------------------------------++getPID :: IO Int+getPID = liftM fromIntegral $ getProcessID++getExecutablePath :: IO FilePath+getExecutablePath = do+  pid <- getPID+  fname <- readSymbolicLink $ "/proc/" ++ show pid ++ "/path/a.out"+  --let (path,exename) = splitFileName fname+  --return path+  return fname++--------------------------------------------------------------------------------+  

@@ -0,0 +1,55 @@++{-# LANGUAGE ForeignFunctionInterface #-}++module System.Environment.Executable.Win32+  ( getExecutablePath  +  , getModulePath+  )+  where++import Data.Bits+import Data.Word+import Data.Int++import Control.Monad++import Foreign+import Foreign.C+import Foreign.Marshal++--import System.Win32+--import System.Win32.DLL++--------------------------------------------------------------------------------++foreign import stdcall unsafe "Windows.h GetModuleFileNameW" c_GetModuleFileNameW+  :: HMODULE -> Ptr CWchar -> Word32 -> IO Word32++type HMODULE = Ptr ()++getModulePath :: HMODULE -> IO FilePath+getModulePath = getModulePath' 512++getModulePath' :: Word32 -> HMODULE -> IO FilePath+getModulePath' size hmodule = do+  mpath <- allocaArray0 (fromIntegral size) $ \p -> do+    k <- c_GetModuleFileNameW hmodule p size +    case k of+      0 -> error "getModulePath: unknown error"+      _ -> if k == size+             then return Nothing+             else liftM Just $ peekCWString p+  case mpath of+    Just path -> return path+    Nothing -> getModulePath' (2*size) hmodule+             +{-+-- | Returns the full path + name of the module.+getModulePath :: HMODULE -> IO FilePath+getModulePath hmodule = getModuleFileName hmodule+-}++getExecutablePath :: IO FilePath  +getExecutablePath = getModulePath nullPtr+  +--------------------------------------------------------------------------------

@@ -0,0 +1,56 @@+Name:                executable-path+Version:             0.0+Synopsis:            Finding out the full path of the executable.++Description:         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.\"+                     +                     This library tries to provide the missing path.++License:             PublicDomain+License-file:        LICENSE+Author:              Balazs Komuves+Maintainer:          bkomuves (plus) hackage (at) gmail (dot) com+Homepage:            http://code.haskell.org/~bkomuves/+Stability:           Experimental+Category:            System+Tested-With:         GHC == 6.10.1 +Cabal-Version:       >= 1.2+Build-Type:          Simple++Flag splitBase+  Description: Choose the new smaller, split-up base package.++Library+  if flag(splitBase)+    Build-Depends:       base >=3, filepath+  else+    Build-Depends:       base < 3+    +  Exposed-Modules:     System.Environment.Executable   +  Extensions:          ForeignFunctionInterface, CPP, EmptyDataDecls+  Hs-Source-Dirs:      .+  +  if os(darwin)+    Frameworks:          CoreFoundation  +    Other-Modules:       System.Environment.Executable.MacOSX+   +  if os(windows) +    Extra-Libraries:     kernel32+    Other-Modules:       System.Environment.Executable.Win32+    +  if os(linux) +    Build-Depends:       unix+    Other-Modules:       System.Environment.Executable.Linux+    +  if os(freebsd) || os(openbsd) || os(netbsd)+    Build-Depends:       unix+    Other-Modules:       System.Environment.Executable.BSD++  if os(solaris) +    Build-Depends:       unix+    Other-Modules:       System.Environment.Executable.Solaris+