diff --git a/base-compat.cabal b/base-compat.cabal --- a/base-compat.cabal +++ b/base-compat.cabal @@ -1,5 +1,5 @@ name: base-compat -version: 0.0.0 +version: 0.1.0 license: MIT license-file: LICENSE copyright: (c) 2012 Simon Hengel @@ -8,20 +8,20 @@ build-type: Simple cabal-version: >= 1.8 category: System -synopsis: Provide new additions to base for older versions of base -description: Provide new additions to base for older versions of base, so - that you can use them without sacrificing backward +synopsis: Provides readMaybe, lookupEnv, etc. for older versions of base +description: Provides new additions to base for older versions of base, so + that they can be used without sacrificing backward compatibility. . - Currently the following is covered: + So far the following is covered: . - * Text.Read.readMaybe + * readMaybe . - * Text.Read.readEither + * readEither . - * System.Environment.lookupEnv + * lookupEnv . - * System.Environment.getExecutablePath + * <> source-repository head type: git @@ -33,12 +33,9 @@ hs-source-dirs: src exposed-modules: + Data.Monoid.Compat System.Environment.Compat Text.Read.Compat - other-modules: - -- This is compiled, even if it is not needed (base >= 4.6.0.0). We - -- probably want to prevent this. - System.Environment.ExecutablePath build-depends: base == 4.* diff --git a/src/Data/Monoid/Compat.hs b/src/Data/Monoid/Compat.hs new file mode 100644 --- /dev/null +++ b/src/Data/Monoid/Compat.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE CPP #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid +-- Copyright : (c) Andy Gill 2001, +-- (c) Oregon Graduate Institute of Science and Technology, 2001 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : portable +-- +-- A class for monoids (types with an associative binary operation that +-- has an identity) with various general-purpose instances. +-- +----------------------------------------------------------------------------- +module Data.Monoid.Compat ( + -- * Monoid typeclass + Monoid(..), + (<>), + Dual(..), + Endo(..), + -- * Bool wrappers + All(..), + Any(..), + -- * Num wrappers + Sum(..), + Product(..), + -- * Maybe wrappers + -- $MaybeExamples + First(..), + Last(..) +) where + +import Data.Monoid + +#if !MIN_VERSION_base(4,5,0) +-- | An infix synonym for 'mappend'. +(<>) :: Monoid m => m -> m -> m +(<>) = mappend +{-# INLINE (<>) #-} +#endif + +-- $MaybeExamples +-- To implement @find@ or @findLast@ on any 'Foldable': +-- +-- @ +-- findLast :: Foldable t => (a -> Bool) -> t a -> Maybe a +-- findLast pred = getLast . foldMap (\x -> if pred x +-- then Last (Just x) +-- else Last Nothing) +-- @ +-- +-- Much of Data.Map's interface can be implemented with +-- Data.Map.alter. Some of the rest can be implemented with a new +-- @alterA@ function and either 'First' or 'Last': +-- +-- > alterA :: (Applicative f, Ord k) => +-- > (Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a) +-- > +-- > instance Monoid a => Applicative ((,) a) -- from Control.Applicative +-- +-- @ +-- insertLookupWithKey :: Ord k => (k -> v -> v -> v) -> k -> v +-- -> Map k v -> (Maybe v, Map k v) +-- insertLookupWithKey combine key value = +-- Arrow.first getFirst . alterA doChange key +-- where +-- doChange Nothing = (First Nothing, Just value) +-- doChange (Just oldValue) = +-- (First (Just oldValue), +-- Just (combine key value oldValue)) +-- @ diff --git a/src/System/Environment/Compat.hs b/src/System/Environment/Compat.hs --- a/src/System/Environment/Compat.hs +++ b/src/System/Environment/Compat.hs @@ -3,7 +3,6 @@ module System.Environment.Compat ( getArgs , getProgName -, getExecutablePath , getEnv , lookupEnv , withArgs @@ -12,10 +11,6 @@ ) where import System.Environment - -#if !MIN_VERSION_base(4,6,0) -import System.Environment.ExecutablePath -#endif #if !MIN_VERSION_base(4,6,0) -- | Return the value of the environment variable @var@, or @Nothing@ if diff --git a/src/System/Environment/ExecutablePath.hsc b/src/System/Environment/ExecutablePath.hsc deleted file mode 100644 --- a/src/System/Environment/ExecutablePath.hsc +++ /dev/null @@ -1,172 +0,0 @@ -{-# LANGUAGE Safe #-} -{-# LANGUAGE CPP, ForeignFunctionInterface #-} - ------------------------------------------------------------------------------ --- | --- 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. --- ------------------------------------------------------------------------------ - -module System.Environment.ExecutablePath ( getExecutablePath ) where - --- The imports are purposely kept completely disjoint to prevent edits --- to one OS implementation from breaking another. - -#if defined(darwin_HOST_OS) -import Data.Word -import Foreign.C -import Foreign.Marshal.Alloc -import Foreign.Ptr -import Foreign.Storable -import System.Posix.Internals -#elif defined(linux_HOST_OS) -import Foreign.C -import Foreign.Marshal.Array -import System.Posix.Internals -#elif defined(mingw32_HOST_OS) -import Data.Word -import Foreign.C -import Foreign.Marshal.Array -import Foreign.Ptr -import System.Posix.Internals -#else -import Foreign.C -import Foreign.Marshal.Alloc -import Foreign.Ptr -import Foreign.Storable -import System.Posix.Internals -#endif - --- 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. --- --- Note that for scripts and interactive sessions, this is the path to --- the interpreter (e.g. ghci.) -getExecutablePath :: IO FilePath - --------------------------------------------------------------------------------- --- Mac OS X - -#if defined(darwin_HOST_OS) - -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 = - allocaBytes 1024 $ \ buf -> -- PATH_MAX is 1024 on OS X - alloca $ \ bufsize -> do - poke bufsize 1024 - status <- c__NSGetExecutablePath buf bufsize - if status == 0 - then peekFilePath buf - else do reqBufsize <- fromIntegral `fmap` peek bufsize - allocaBytes reqBufsize $ \ newBuf -> do - status2 <- c__NSGetExecutablePath newBuf bufsize - if status2 == 0 - then peekFilePath newBuf - else error "_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 path = - withFilePath path $ \ fileName -> - allocaBytes 1024 $ \ resolvedName -> do - _ <- throwErrnoIfNull "realpath" $ c_realpath fileName resolvedName - peekFilePath resolvedName - -getExecutablePath = _NSGetExecutablePath >>= realpath - --------------------------------------------------------------------------------- --- Linux - -#elif defined(linux_HOST_OS) - -foreign import ccall unsafe "readlink" - c_readlink :: CString -> CString -> CSize -> IO CInt - --- | Reads the @FilePath@ pointed to by the symbolic link and returns --- it. --- --- See readlink(2) -readSymbolicLink :: FilePath -> IO FilePath -readSymbolicLink file = - allocaArray0 4096 $ \buf -> do - withFilePath file $ \s -> do - len <- throwErrnoPathIfMinus1 "readSymbolicLink" file $ - c_readlink s buf 4096 - peekFilePathLen (buf,fromIntegral len) - -getExecutablePath = readSymbolicLink $ "/proc/self/exe" - --------------------------------------------------------------------------------- --- Windows - -#elif defined(mingw32_HOST_OS) - -# if defined(i386_HOST_ARCH) -## define WINDOWS_CCONV stdcall -# elif defined(x86_64_HOST_ARCH) -## define WINDOWS_CCONV ccall -# else -# error Unknown mingw32 arch -# endif - -foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW" - c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32 - -getExecutablePath = go 2048 -- plenty, PATH_MAX is 512 under Win32 - where - go size = allocaArray (fromIntegral size) $ \ buf -> do - ret <- c_GetModuleFileName nullPtr buf size - case ret of - 0 -> error "getExecutablePath: GetModuleFileNameW returned an error" - _ | ret < size -> peekFilePath buf - | otherwise -> go (size * 2) - --------------------------------------------------------------------------------- --- Fallback to argv[0] - -#else - -foreign import ccall unsafe "getFullProgArgv" - c_getFullProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO () - -getExecutablePath = - alloca $ \ p_argc -> - alloca $ \ p_argv -> do - c_getFullProgArgv p_argc p_argv - argc <- peek p_argc - if argc > 0 - -- If argc > 0 then argv[0] is guaranteed by the standard - -- to be a pointer to a null-terminated string. - then peek p_argv >>= peek >>= peekFilePath - else error $ "getExecutablePath: " ++ msg - where msg = "no OS specific implementation and program name couldn't be " ++ - "found in argv" - --------------------------------------------------------------------------------- - -#endif