diff options
Diffstat (limited to 'src/Haddock/Utils.hs')
-rw-r--r-- | src/Haddock/Utils.hs | 50 |
1 files changed, 19 insertions, 31 deletions
diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs index 3c0b302c..b9795376 100644 --- a/src/Haddock/Utils.hs +++ b/src/Haddock/Utils.hs @@ -43,7 +43,10 @@ module Haddock.Utils ( -- * Logging parseVerbosity, - out + out, + + -- * System tools + getProcessID ) where @@ -69,6 +72,13 @@ import System.FilePath import Distribution.Verbosity import Distribution.ReadE +#ifndef mingw32_HOST_OS +import qualified System.Posix.Internals +#else /* Must be Win32 */ +import Foreign +import Foreign.C.String +#endif + import MonadUtils ( MonadIO(..) ) @@ -368,36 +378,14 @@ idMarkup = Markup { } ------------------------------------------------------------------------------ --- put here temporarily - - -newtype FormatVersion = FormatVersion Int deriving (Eq,Ord) - - -nullFormatVersion :: FormatVersion -nullFormatVersion = mkFormatVersion 0 - +-- ----------------------------------------------------------------------------- +-- System tools -mkFormatVersion :: Int -> FormatVersion -mkFormatVersion = FormatVersion +#ifdef mingw32_HOST_OS +foreign import ccall unsafe "_getpid" getProcessID :: IO Int -- relies on Int == Int32 on Windows +#else +getProcessID :: IO Int +getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral +#endif -instance Binary FormatVersion where - put_ bh (FormatVersion i) = - case compare i 0 of - EQ -> return () - GT -> put_ bh (-i) - LT -> error ( - "Binary.hs: negative FormatVersion " ++ show i - ++ " is not allowed") - get bh = - do - (w8 :: Word8) <- get bh - if testBit w8 7 - then - do - i <- get bh - return (FormatVersion (-i)) - else - return nullFormatVersion |