[Git][ghc/ghc][master] 3 commits: haddock: Re-organise cross-OS compatibility layer
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Sep 10 23:20:02 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
949ebced by Hécate Kleidukos at 2024-09-10T19:19:40-04:00
haddock: Re-organise cross-OS compatibility layer
- - - - -
84ac9a99 by Hécate Kleidukos at 2024-09-10T19:19:40-04:00
haddock: Remove CPP for obsolete GHC and Cabal versions
- - - - -
370d1599 by Hécate Kleidukos at 2024-09-10T19:19:40-04:00
haddock: Move the changelog file to the 'extra-doc-files' section in the cabal file
- - - - -
8 changed files:
- + utils/haddock/haddock-api/compat/posix/Haddock/Compat.hs
- + utils/haddock/haddock-api/compat/windows/Haddock/Compat.hs
- utils/haddock/haddock-api/haddock-api.cabal
- utils/haddock/haddock-api/src/Haddock.hs
- utils/haddock/haddock-api/src/Haddock/Interface.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
- utils/haddock/haddock-api/src/Haddock/Utils.hs
- utils/haddock/haddock-test/src/Test/Haddock/Config.hs
Changes:
=====================================
utils/haddock/haddock-api/compat/posix/Haddock/Compat.hs
=====================================
@@ -0,0 +1,14 @@
+module Haddock.Compat
+ ( getProcessID
+ , setEncoding
+ ) where
+
+import System.Posix.Types (ProcessID)
+import qualified System.Posix.Process as Posix
+
+-- | Windows-only failsafe, not applicable on POSIX plateforms
+setEncoding :: IO ()
+setEncoding = pure ()
+
+getProcessID :: IO Int
+getProcessID = fromIntegral @ProcessID @Int <$> Posix.getProcessID
=====================================
utils/haddock/haddock-api/compat/windows/Haddock/Compat.hs
=====================================
@@ -0,0 +1,19 @@
+module Haddock.Compat
+ ( getProcessID
+ , setEncoding
+ ) where
+
+import GHC.IO.Encoding.CodePage (mkLocaleEncoding)
+import GHC.IO.Encoding.Failure (CodingFailureMode(TransliterateCodingFailure))
+import System.IO (hSetEncoding, stdout, stderr)
+import System.Win32.Process (ProcessId)
+import qualified System.Win32.Process as Windows
+
+-- | Avoid internal error: <stderr>: hPutChar: invalid argument (invalid character)' non UTF-8 Windows
+setEncoding :: IO ()
+setEncoding = do
+ hSetEncoding stdout $ mkLocaleEncoding TransliterateCodingFailure
+ hSetEncoding stderr $ mkLocaleEncoding TransliterateCodingFailure
+
+getProcessID :: IO Int
+getProcessID = fromIntegral @ProcessId @Int <$> Windows.getCurrentProcessId
=====================================
utils/haddock/haddock-api/haddock-api.cabal
=====================================
@@ -14,7 +14,7 @@ copyright: (c) Simon Marlow, David Waern
category: Documentation
build-type: Simple
-extra-source-files:
+extra-doc-files:
CHANGES.md
data-dir:
@@ -99,6 +99,16 @@ library
, transformers
hs-source-dirs: src
+
+ if os(windows)
+ hs-source-dirs: compat/windows/
+ build-depends:
+ Win32
+ else
+ hs-source-dirs: compat/posix/
+ build-depends:
+ unix
+
exposed-modules:
Documentation.Haddock
@@ -142,6 +152,7 @@ library
Haddock.Options
Haddock.GhcUtils
Haddock.Convert
+ Haddock.Compat
Paths_haddock_api
autogen-modules:
=====================================
utils/haddock/haddock-api/src/Haddock.hs
=====================================
@@ -83,6 +83,7 @@ import Haddock.InterfaceFile
import Haddock.Options
import Haddock.Utils
import Haddock.GhcUtils (modifySessionDynFlags, setOutputDir, getSupportedLanguagesAndExtensions)
+import Haddock.Compat (getProcessID)
--------------------------------------------------------------------------------
-- * Exception handling
=====================================
utils/haddock/haddock-api/src/Haddock/Interface.hs
=====================================
@@ -78,12 +78,6 @@ import GHC.Utils.Outputable (Outputable, (<+>), pprModuleName, text)
import GHC.Utils.Error (withTiming)
import GHC.Utils.Monad (mapMaybeM)
-#if defined(mingw32_HOST_OS)
-import System.IO
-import GHC.IO.Encoding.CodePage (mkLocaleEncoding)
-import GHC.IO.Encoding.Failure (CodingFailureMode(TransliterateCodingFailure))
-#endif
-
import Haddock.GhcUtils (moduleString, pretty)
import Haddock.Interface.AttachInstances (attachInstances)
import Haddock.Interface.Create (createInterface1, createInterface1')
@@ -92,6 +86,7 @@ import Haddock.InterfaceFile (InterfaceFile, ifInstalledIfaces, ifLinkEnv)
import Haddock.Options hiding (verbosity)
import Haddock.Types
import Haddock.Utils (Verbosity (..), normal, out, verbose)
+import qualified Haddock.Compat as Compat
-- | Create 'Interface's and a link environment by typechecking the list of
-- modules using the GHC API and processing the resulting syntax trees.
@@ -104,12 +99,7 @@ processModules
-> Ghc ([Interface], LinkEnv) -- ^ Resulting list of interfaces and renaming
-- environment
processModules verbosity modules flags extIfaces = do
-#if defined(mingw32_HOST_OS)
- -- Avoid internal error: <stderr>: hPutChar: invalid argument (invalid character)' non UTF-8 Windows
- liftIO $ hSetEncoding stdout $ mkLocaleEncoding TransliterateCodingFailure
- liftIO $ hSetEncoding stderr $ mkLocaleEncoding TransliterateCodingFailure
-#endif
-
+ liftIO Compat.setEncoding
dflags <- getDynFlags
-- Map from a module to a corresponding installed interface
=====================================
utils/haddock/haddock-api/src/Haddock/Types.hs
=====================================
@@ -605,13 +605,6 @@ instance
DocHeader a -> a `deepseq` ()
DocTable a -> a `deepseq` ()
-#if !MIN_VERSION_ghc(8,0,2)
--- These were added to GHC itself in 8.0.2
-instance NFData Name where rnf x = seq x ()
-instance NFData OccName where rnf x = seq x ()
-instance NFData ModuleName where rnf x = seq x ()
-#endif
-
instance NFData id => NFData (Header id) where
rnf (Header a b) = a `deepseq` b `deepseq` ()
=====================================
utils/haddock/haddock-api/src/Haddock/Utils.hs
=====================================
@@ -62,9 +62,6 @@ module Haddock.Utils
, verbose
, deafening
, out
-
- -- * System tools
- , getProcessID
) where
import Control.Monad.Catch (MonadMask, bracket_)
@@ -84,10 +81,6 @@ import qualified System.FilePath.Posix as HtmlPath
import System.IO (IOMode (..), hPutStr, hSetEncoding, utf8, withFile)
import System.IO.Unsafe (unsafePerformIO)
-#ifndef mingw32_HOST_OS
-import qualified System.Posix.Internals
-#endif
-
import Documentation.Haddock.Doc (emptyMetaDoc)
import Haddock.Types
@@ -345,16 +338,3 @@ spanWith _ [] = ([], [])
spanWith p xs@(a : as)
| Just b <- p a = let (bs, cs) = spanWith p as in (b : bs, cs)
| otherwise = ([], xs)
-
------------------------------------------------------------------------------
-
--- * System tools
-
------------------------------------------------------------------------------
-
-#ifdef mingw32_HOST_OS
-foreign import ccall unsafe "_getpid" getProcessID :: IO Int -- relies on Int == Int32 on Windows
-#else
-getProcessID :: IO Int
-getProcessID = fmap fromIntegral System.Posix.Internals.c_getpid
-#endif
=====================================
utils/haddock/haddock-test/src/Test/Haddock/Config.hs
=====================================
@@ -257,11 +257,7 @@ baseDependencies ghcPath = do
(comp, _, cfg) <- configure normal (Just ghcPath) Nothing
defaultProgramDb
-#if MIN_VERSION_Cabal(1,23,0)
pkgIndex <- getInstalledPackages normal comp [GlobalPackageDB] cfg
-#else
- pkgIndex <- getInstalledPackages normal [GlobalPackageDB] cfg
-#endif
let
pkgs =
[ "array"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/057159947ae88f6bad703cc357913d8ca60384d0...370d1599ac2c68fc305cef4c29b4b4ecbf8e7969
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/057159947ae88f6bad703cc357913d8ca60384d0...370d1599ac2c68fc305cef4c29b4b4ecbf8e7969
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240910/6b1a15a1/attachment-0001.html>
More information about the ghc-commits
mailing list