FindBin (empty) → 0.0.1

raw patch · 5 files changed

+104/−0 lines, 5 filesdep +basedep +directorydep +filepathsetup-changed

Dependencies added: base, directory, filepath

Files

• FindBin.cabal +20/−0
• LICENSE +18/−0
• README +5/−0
• Setup.lhs +5/−0
• src/System/Environment/FindBin.hs +56/−0

@@ -0,0 +1,20 @@+name:               FindBin+version:            0.0.1+copyright:          2008 Audrey Tang+license:            BSD3+license-file:       LICENSE+author:             Audrey Tang <audreyt@audreyt.org>+maintainer:         Audrey Tang <audreyt@audreyt.org>+synopsis:           Locate directory of original program+description:        This module locates the full directory to the running program,+                    to allow the use of paths relative to it.+                    FindBin supports invocation of Haskell programs via "ghci",+                    via "runhaskell/runghc", as well as compiled as an executable.+stability:          experimental+build-type:         Simple+extensions:         ForeignFunctionInterface+exposed-modules:    System.Environment.FindBin+build-depends:      base, directory, filepath+extra-source-files: README+hs-source-dirs:     src+category:           System

@@ -0,0 +1,18 @@+Copyright 2008 by Audrey Tang++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to+deal in the Software without restriction, including without limitation the+rights to use, copy, modify, merge, publish, distribute, sublicense, and/or+sell copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:+  +The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.+   +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL+THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER +IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,5 @@+This module locates the full directory to the running program,+to allow the use of paths relative to it.++FindBin supports invocation of Haskell programs via "ghci",+via "runhaskell/runghc", as well as compiled as an executable.

@@ -0,0 +1,5 @@+#!/usr/bin/env runhaskell+> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMain

@@ -0,0 +1,56 @@+{-# LANGUAGE ForeignFunctionInterface #-}++module System.Environment.FindBin+    ( __Bin__+    , getProgPath+    ) where++import Foreign+import Foreign.C+import System.Directory+import System.FilePath+import System.IO.Unsafe++{-# NOINLINE __Bin__ #-}++-- | Unsafe (/constant/) version of 'getProgPath'.+__Bin__ :: String+__Bin__ = let path = unsafePerformIO getProgPath+    in length path `seq` path++-- | Get the full directory to the running program.+getProgPath :: IO String+getProgPath = alloca $ \p_argc -> alloca $ \p_argv -> do+    getProgArgv p_argc p_argv+    argv <- peek p_argv+    findBin =<< peekCString =<< peekElemOff argv 0+    where+    directoryOf x = do+        x' <- canonicalizePath x+        let path = takeDirectory x'+        return (length path `seq` path)+    findBin s = case takeDirectory s of+        ""  -> do+            -- This should work for ghci as well, as long as nobody name+            -- their executable file "<interactive>"...+            rv <- findExecutable s+            case rv of+                Just fullName   -> directoryOf fullName+                _               -> alloca $ \p_argc' -> alloca $ \p_argv' -> do+                    -- Here we are in the "runghc"/"runhaskell" land.  Fun!+                    getFullProgArgv p_argc' p_argv'+                    argc'   <- peek p_argc'+                    argv'   <- peek p_argv'+                    s'      <- peekCString =<< peekElemOff argv' (fromEnum argc'-1)+                    canon   <- canonicalizePath s+                    canon'  <- canonicalizePath s'+                    if canon == canon'+                        then findBin canon+                        else findBin s'+        _   -> directoryOf s++foreign import ccall unsafe "getFullProgArgv"+  getFullProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()++foreign import ccall unsafe "getProgArgv"+  getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()