[Git][ghc/ghc][master] haddock: Remove unused pragmata, qualify usages of Data.List functions, add...
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Jun 20 23:29:07 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
c872e09b by Hécate Kleidukos at 2024-06-20T19:28:36-04:00
haddock: Remove unused pragmata, qualify usages of Data.List functions, add more sanity checking flags by default
This commit enables some extensions and GHC flags in the cabal file in a way
that allows us to reduce the amount of prologuing on top of each file.
We also prefix the usage of some List functions that removes ambiguity
when they are also exported from the Prelude, like foldl'.
In general, this has the effect of pointing out more explicitly
that a linked list is used.
Metric Increase:
haddock.Cabal
haddock.base
haddock.compiler
- - - - -
15 changed files:
- utils/haddock/haddock-api/haddock-api.cabal
- utils/haddock/haddock-api/src/Haddock.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
- utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
- utils/haddock/haddock-api/src/Haddock/Interface.hs
- utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
- utils/haddock/haddock-api/src/Haddock/Options.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
- utils/haddock/haddock-library/fixtures/Fixtures.hs
- utils/haddock/haddock-library/haddock-library.cabal
- utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs
- utils/haddock/haddock-library/src/Documentation/Haddock/Parser/Monad.hs
- utils/haddock/haddock.cabal
Changes:
=====================================
utils/haddock/haddock-api/haddock-api.cabal
=====================================
@@ -43,8 +43,29 @@ source-repository head
location: https://gitlab.haskell.org/ghc/ghc.git
subdir: utils/haddock/haddock-api
+common extensions
+ default-extensions:
+ LambdaCase
+ NoStarIsType
+ OverloadedRecordDot
+ StrictData
+ TypeApplications
+ TypeOperators
+
+ default-language: Haskell2010
+
+common ghc-options
+ ghc-options:
+ -Wall -Wcompat -Widentities -Wincomplete-record-updates
+ -Wincomplete-uni-patterns -Wredundant-constraints
+ -fhide-source-paths -Wno-unused-do-bind -fshow-hole-constraints
+ -Wno-unticked-promoted-constructors -Werror=unused-imports
+ -fdicts-strict -Wunused-packages -funbox-strict-fields
+ -Wnoncanonical-monad-instances -Wmissing-home-modules
+
library
- default-language: Haskell2010
+ import: extensions
+ import: ghc-options
-- this package typically supports only single major versions
build-depends: base >= 4.16 && < 4.21
@@ -69,19 +90,6 @@ library
, transformers
hs-source-dirs: src
-
- ghc-options: -funbox-strict-fields -O2
- -Wall
- -Wcompat
- -Wcompat-unqualified-imports
- -Widentities
- -Wredundant-constraints
- -Wnoncanonical-monad-instances
- -Wmissing-home-modules
- -Wincomplete-uni-patterns
- -Wincomplete-record-updates
-
-
exposed-modules:
Documentation.Haddock
@@ -131,10 +139,10 @@ library
Paths_haddock_api
test-suite spec
+ import: extensions
+ import: ghc-options
type: exitcode-stdio-1.0
- default-language: Haskell2010
main-is: Spec.hs
- ghc-options: -Wall
hs-source-dirs:
test
@@ -201,7 +209,6 @@ test-suite spec
, exceptions
, filepath
, ghc-boot
- , ghc-boot-th
, mtl
, transformers
=====================================
utils/haddock/haddock-api/src/Haddock.hs
=====================================
@@ -5,7 +5,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
-{-# OPTIONS_GHC -Wwarn #-}
-----------------------------------------------------------------------------
-- |
-- Module : Haddock
@@ -50,9 +49,9 @@ import Control.DeepSeq (force)
import Control.Monad hiding (forM_)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Bifunctor (second)
-import Data.Foldable (forM_, foldl')
+import Data.Foldable (forM_)
import Data.Traversable (for)
-import Data.List (find, isPrefixOf, nub)
+import qualified Data.List as List
import Control.Exception
import Data.Maybe
import Data.IORef
@@ -256,7 +255,7 @@ withTempOutputDir action = do
-- | Create warnings about potential misuse of -optghc
optGhcWarnings :: [String] -> [String]
-optGhcWarnings = map format . filter (isPrefixOf "-optghc")
+optGhcWarnings = map format . filter (List.isPrefixOf "-optghc")
where
format arg = concat ["Warning: `", arg, "' means `-o ", drop 2 arg, "', did you mean `-", arg, "'?"]
@@ -449,7 +448,7 @@ render log' dflags unit_state flags sinceQual qual ifaces packages extSrcMap = d
let withQuickjump = Flag_QuickJumpIndex `elem` flags
withBaseURL = isJust
- . find (\flag -> case flag of
+ . List.find (\flag -> case flag of
Flag_BaseURL base_url ->
base_url /= "." && base_url /= "./"
_ -> False
@@ -481,7 +480,7 @@ render log' dflags unit_state flags sinceQual qual ifaces packages extSrcMap = d
ppJsonIndex odir sourceUrls' opt_wiki_urls
unicode Nothing qual
ifaces
- ( nub
+ ( List.nub
. map fst
. filter ((== Visible) . piVisibility . snd)
$ packages)
@@ -612,7 +611,7 @@ withGhc' libDir needHieFiles flags ghcActs = runGhc (Just libDir) $ do
++ if needHieFiles
then [Opt_WriteHie] -- Generate .hie-files
else []
- dynflags' = (foldl' gopt_set dynflags extra_opts)
+ dynflags' = (List.foldl' gopt_set dynflags extra_opts)
{ backend = noBackend
, ghcMode = CompManager
, ghcLink = NoLink
@@ -626,7 +625,7 @@ withGhc' libDir needHieFiles flags ghcActs = runGhc (Just libDir) $ do
unsetPatternMatchWarnings :: DynFlags -> DynFlags
unsetPatternMatchWarnings dflags =
- foldl' wopt_unset dflags pattern_match_warnings
+ List.foldl' wopt_unset dflags pattern_match_warnings
where
pattern_match_warnings =
[ Opt_WarnIncompletePatterns
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs
=====================================
@@ -50,9 +50,10 @@ import Control.DeepSeq (force)
import Control.Monad (unless, when)
import Data.Bifunctor (bimap)
import qualified Data.ByteString.Builder as Builder
+import qualified Data.List as List
import Data.Char (isSpace, toUpper)
import Data.Either (partitionEithers)
-import Data.Foldable (foldl', traverse_)
+import Data.Foldable (traverse_)
import Data.List (intersperse, isPrefixOf, sortBy)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
@@ -305,12 +306,15 @@ bodyHtml
body
<< [ divPackageHeader
<< [ nonEmptySectionName << doctitle
- , unordList (catMaybes [
- srcButton maybe_source_url iface,
- wikiButton maybe_wiki_url (ifaceMod <$> iface),
- contentsButton maybe_contents_url,
- indexButton maybe_index_url])
- ! [theclass "links", identifier "page-menu"]
+ , unordList
+ ( catMaybes
+ [ srcButton maybe_source_url iface
+ , wikiButton maybe_wiki_url (ifaceMod <$> iface)
+ , contentsButton maybe_contents_url
+ , indexButton maybe_index_url
+ ]
+ )
+ ! [theclass "links", identifier "page-menu"]
]
, divContent << pageContent
, divFooter
@@ -777,7 +781,7 @@ ppHtmlIndex
-- that export that entity. Each of the modules exports the entity
-- in a visible or invisible way (hence the Bool).
full_index :: Map String (Map GHC.Name [(Module, Bool)])
- full_index = foldl' f Map.empty ifaces
+ full_index = List.foldl' f Map.empty ifaces
where
f
:: Map String (Map Name [(Module, Bool)])
@@ -791,7 +795,7 @@ ppHtmlIndex
getIfaceIndex :: InstalledInterface -> Map String (Map Name [(Module, Bool)])
getIfaceIndex iface =
- foldl' f Map.empty (instExports iface)
+ List.foldl' f Map.empty (instExports iface)
where
f
:: Map String (Map Name [(Module, Bool)])
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
=====================================
@@ -54,6 +54,8 @@ module Haddock.Backends.Xhtml.Layout
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
+import GHC hiding (anchor)
+import GHC.Types.Name (nameOccName)
import Haddock.Backends.Xhtml.DocMarkup
import Haddock.Backends.Xhtml.Types
import Haddock.Backends.Xhtml.Utils
@@ -61,9 +63,6 @@ import Haddock.Types
import Haddock.Utils (makeAnchorId, nameAnchorId)
import Text.XHtml hiding (name, quote, title)
-import GHC hiding (anchor)
-import GHC.Types.Name (nameOccName)
-
--------------------------------------------------------------------------------
-- * Sections of the document
=====================================
utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
=====================================
@@ -31,10 +31,11 @@ module Haddock.GhcUtils where
import Control.Arrow
import Data.Char (isSpace)
-import Data.Foldable (foldl', toList)
+import Data.Foldable (toList)
import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (fromMaybe, mapMaybe)
import qualified Data.Set as Set
+import qualified Data.List as List
import Haddock.Types (DocName, DocNameI, XRecCond)
@@ -771,7 +772,7 @@ typeNames ty = go ty Set.empty
TyVarTy{} -> acc
AppTy t1 t2 -> go t2 $ go t1 acc
FunTy _ _ t1 t2 -> go t2 $ go t1 acc
- TyConApp tcon args -> foldl' (\s t' -> go t' s) (Set.insert (getName tcon) acc) args
+ TyConApp tcon args -> List.foldl' (\s t' -> go t' s) (Set.insert (getName tcon) acc) args
ForAllTy bndr t' -> go t' $ go (tyVarKind (binderVar bndr)) acc
LitTy _ -> acc
CastTy t' _ -> go t' acc
=====================================
utils/haddock/haddock-api/src/Haddock/Interface.hs
=====================================
@@ -1,8 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE TupleSections #-}
-----------------------------------------------------------------------------
-- |
-- Module : Haddock.Interface
@@ -47,7 +45,7 @@ import Haddock.Types
import Haddock.Utils (Verbosity (..), normal, out, verbose)
import Control.Monad
-import Data.List (foldl', isPrefixOf)
+import Data.List (isPrefixOf)
import Data.Traversable (for)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
@@ -71,11 +69,11 @@ import GHC.Types.Name.Occurrence (emptyOccEnv)
import GHC.Unit.Module.Graph (ModuleGraphNode (..))
import GHC.Unit.Module.ModDetails
import GHC.Unit.Module.ModSummary (isBootSummary)
-import GHC.Utils.Outputable ((<+>), pprModuleName)
+import GHC.Utils.Outputable (Outputable, (<+>), pprModuleName)
import GHC.Utils.Error (withTiming)
import GHC.Unit.Home.ModInfo
import GHC.Tc.Utils.Env (lookupGlobal_maybe)
-import GHC.Utils.Outputable (Outputable)
+import qualified Data.List as List
#if defined(mingw32_HOST_OS)
import System.IO
@@ -327,15 +325,15 @@ processModule verbosity modSummary flags ifaceMap instIfaceMap = do
-- The interfaces are passed in in topologically sorted order, but we start
-- by reversing the list so we can do a foldl.
buildHomeLinks :: [Interface] -> LinkEnv
-buildHomeLinks ifaces = foldl' upd Map.empty (reverse ifaces)
+buildHomeLinks ifaces = List.foldl' upd Map.empty (reverse ifaces)
where
upd old_env iface
| OptHide `elem` ifaceOptions iface =
old_env
| OptNotHome `elem` ifaceOptions iface =
- foldl' keep_old old_env exported_names
+ List.foldl' keep_old old_env exported_names
| otherwise =
- foldl' keep_new old_env exported_names
+ List.foldl' keep_new old_env exported_names
where
exported_names = ifaceVisibleExports iface ++ map getName (ifaceInstances iface)
mdl = ifaceMod iface
=====================================
utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs
=====================================
@@ -1,8 +1,5 @@
{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
@@ -31,13 +28,13 @@ import Haddock.Types
import Control.Applicative ((<|>))
import Control.Arrow hiding ((<+>))
import Control.DeepSeq (force)
-import Data.Foldable (foldl', toList)
-import Data.List (sortBy)
+import Data.Foldable (toList)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe, mapMaybe, maybeToList)
import Data.Ord (comparing)
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
+import qualified Data.List as List
import GHC
import GHC.Builtin.Types (unrestrictedFunTyConName)
@@ -168,7 +165,7 @@ attachOrphanInstances
attachOrphanInstances expInfo getInstDoc cls_instances fam_index =
[ (synifyInstHead i famInsts, getInstDoc n, (L (getSrcSpan n) n), nameModule_maybe n)
| let is = [(instanceSig i, getName i) | i <- cls_instances, isOrphan (is_orphan i)]
- , (i@(_, _, cls, tys), n) <- sortBy (comparing $ first instHead) is
+ , (i@(_, _, cls, tys), n) <- List.sortBy (comparing $ first instHead) is
, not $ isInstanceHidden expInfo (getName cls) tys
, let famInsts = getFamInsts expInfo fam_index getInstDoc cls tys
]
@@ -205,7 +202,7 @@ attachToExportItem cls_index fam_index index expInfo getInstDoc getFixity export
, spanNameE n synFamInst (L (locA eSpan) (tcdName d))
, mb_mdl
)
- | i <- sortBy (comparing instFam) fam_instances
+ | i <- List.sortBy (comparing instFam) fam_instances
, let n = getName i
, not $ isNameHidden expInfo (fi_fam i)
, not $ any (isTypeHidden expInfo) (fi_tys i)
@@ -220,7 +217,7 @@ attachToExportItem cls_index fam_index index expInfo getInstDoc getFixity export
, mb_mdl
)
| let is = [(instanceSig i, getName i) | i <- cls_instances]
- , (i@(_, _, cls, tys), n) <- sortBy (comparing $ first instHead) is
+ , (i@(_, _, cls, tys), n) <- List.sortBy (comparing $ first instHead) is
, not $ isInstanceHidden expInfo (getName cls) tys
, let synClsInst = synifyInstHead i famInsts
famInsts = getFamInsts expInfo fam_index getInstDoc cls tys
@@ -251,7 +248,7 @@ attachToExportItem cls_index fam_index index expInfo getInstDoc getFixity export
}
where
fixities :: [(Name, Fixity)]
- !fixities = force . Map.toList $ foldl' f Map.empty all_names
+ !fixities = force . Map.toList $ List.foldl' f Map.empty all_names
f :: Map.Map Name Fixity -> Name -> Map.Map Name Fixity
f !fs n = Map.alter (<|> getFixity n) n fs
=====================================
utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
=====================================
@@ -2,17 +2,13 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
-{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wwarn #-}
-----------------------------------------------------------------------------
=====================================
utils/haddock/haddock-api/src/Haddock/Options.hs
=====================================
@@ -563,10 +563,12 @@ readIfaceArgs flags = [parseIfaceOption s | Flag_ReadInterface s <- flags]
(src, ',' : rest') ->
let src' = case src of
"" -> Nothing
- _ -> Just src
- docPaths = DocPaths { docPathsHtml = fpath
- , docPathsSources = src'
- }
+ _ -> Just src
+ docPaths =
+ DocPaths
+ { docPathsHtml = fpath
+ , docPathsSources = src'
+ }
in case break (== ',') rest' of
(visibility, ',' : file)
| visibility == "hidden" ->
=====================================
utils/haddock/haddock-api/src/Haddock/Types.hs
=====================================
@@ -1,4 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
@@ -78,9 +77,12 @@ type SubMap = Map Name [Name]
type DeclMap = Map Name DeclMapEntry
type InstMap = Map RealSrcSpan Name
type FixMap = Map Name Fixity
-data DocPaths = DocPaths { docPathsHtml :: FilePath -- ^ path to HTML Haddocks
- , docPathsSources :: Maybe FilePath -- ^ path to hyperlinked sources
- }
+data DocPaths = DocPaths
+ { docPathsHtml :: FilePath
+ -- ^ path to HTML Haddocks
+ , docPathsSources :: Maybe FilePath
+ -- ^ path to hyperlinked sources
+ }
type WarningMap = Map Name (Doc Name)
-----------------------------------------------------------------------------
=====================================
utils/haddock/haddock-library/fixtures/Fixtures.hs
=====================================
@@ -8,7 +8,7 @@ import Control.Applicative ((<|>))
import Control.Exception (IOException, catch)
import Control.Monad (when)
import Data.Foldable (traverse_)
-import Data.List (foldl')
+import qualified Data.List as List
import Data.Traversable (for)
import GHC.Generics (Generic)
import System.Directory (getDirectoryContents)
@@ -86,7 +86,7 @@ runFixtures fixtures = do
input <- readFile i
return (parseString input)
ediffGolden goldenFixture name o readDoc
- case foldl' combineResults (Result 0 0) results of
+ case List.foldl' combineResults (Result 0 0) results of
Result s t -> do
putStrLn $ "Fixtures: success " ++ show s ++ "; total " ++ show t
when (s /= t) exitFailure
=====================================
utils/haddock/haddock-library/haddock-library.cabal
=====================================
@@ -29,8 +29,21 @@ source-repository head
location: https://gitlab.haskell.org/ghc/ghc.git
subdir: utils/haddock/haddock-library
-common lib-defaults
- default-language: Haskell2010
+common extensions
+ default-extensions:
+ NoStarIsType
+ StrictData
+
+ default-language: Haskell2010
+
+common ghc-options
+ ghc-options:
+ -Wall -Wcompat -Widentities -Wincomplete-record-updates
+ -Wincomplete-uni-patterns -Wredundant-constraints
+ -fhide-source-paths -Wno-unused-do-bind -fshow-hole-constraints
+ -Wno-unticked-promoted-constructors -Werror=unused-imports
+ -fdicts-strict -Wunused-packages -funbox-strict-fields
+ -Wnoncanonical-monad-instances -Wmissing-home-modules
build-depends:
, base >= 4.10 && < 4.21
@@ -38,13 +51,9 @@ common lib-defaults
, text ^>= 1.2.3.0 || ^>= 2.0 || ^>= 2.1
, parsec ^>= 3.1.13.0
- ghc-options: -funbox-strict-fields
- -Wall
- -Wcompat
- -Wnoncanonical-monad-instances
-
library
- import: lib-defaults
+ import: extensions
+ import: ghc-options
hs-source-dirs: src
@@ -60,7 +69,8 @@ library
Documentation.Haddock.Parser.Identifier
test-suite spec
- import: lib-defaults
+ import: extensions
+ import: ghc-options
type: exitcode-stdio-1.0
main-is: Spec.hs
hs-source-dirs:
@@ -94,10 +104,10 @@ test-suite spec
, hspec-discover:hspec-discover >= 2.4.4 && < 2.12
test-suite fixtures
+ import: extensions
+ import: ghc-options
type: exitcode-stdio-1.0
- default-language: Haskell2010
main-is: Fixtures.hs
- ghc-options: -Wall
hs-source-dirs: fixtures
build-depends:
-- intra-package dependency
=====================================
utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs
=====================================
@@ -28,7 +28,7 @@ import Control.Applicative
import Control.Arrow (first)
import Control.Monad
import Data.Char (chr, isAlpha, isSpace, isUpper)
-import Data.List (elemIndex, intercalate, unfoldr, intersperse)
+import Data.List (elemIndex, intercalate, intersperse, unfoldr)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Monoid
import qualified Data.Set as Set
=====================================
utils/haddock/haddock-library/src/Documentation/Haddock/Parser/Monad.hs
=====================================
@@ -34,7 +34,7 @@ import Control.Applicative as App
import Control.Monad (mfilter)
import Data.Bits (Bits (..))
import Data.Char (ord)
-import Data.List (foldl')
+import qualified Data.List as List
import Data.String (IsString (..))
import Documentation.Haddock.Types (MetaSince (..))
@@ -146,13 +146,13 @@ scan f st = do
-- | Parse a decimal number.
decimal :: Integral a => Parser a
-decimal = foldl' step 0 `fmap` Parsec.many1 Parsec.digit
+decimal = List.foldl' step 0 `fmap` Parsec.many1 Parsec.digit
where
step a c = a * 10 + fromIntegral (ord c - 48)
-- | Parse a hexadecimal number.
hexadecimal :: (Integral a, Bits a) => Parser a
-hexadecimal = foldl' step 0 `fmap` Parsec.many1 Parsec.hexDigit
+hexadecimal = List.foldl' step 0 `fmap` Parsec.many1 Parsec.hexDigit
where
step a c
| w >= 48 && w <= 57 = (a `shiftL` 4) .|. fromIntegral (w - 48)
=====================================
utils/haddock/haddock.cabal
=====================================
@@ -69,11 +69,28 @@ source-repository head
location: https://gitlab.haskell.org/ghc/ghc.git
subdir: utils/haddock
+common extensions
+ default-extensions:
+ NoStarIsType
+ OverloadedRecordDot
+ StrictData
+
+ default-language: Haskell2010
+
+common ghc-options
+ ghc-options:
+ -Wall -Wcompat -Widentities -Wincomplete-record-updates
+ -Wincomplete-uni-patterns -Wredundant-constraints
+ -fhide-source-paths -Wno-unused-do-bind -fshow-hole-constraints
+ -Wno-unticked-promoted-constructors -Werror=unused-imports
+ -fdicts-strict -Wunused-packages -funbox-strict-fields
+ -Wnoncanonical-monad-instances -Wmissing-home-modules
+
executable haddock
- default-language: Haskell2010
+ import: extensions
+ import: ghc-options
main-is: Main.hs
hs-source-dirs: driver
- ghc-options: -funbox-strict-fields -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -O2
if flag(threaded)
ghc-options: -threaded
@@ -93,7 +110,6 @@ executable haddock
array,
xhtml >= 3000.2 && < 3000.3,
ghc-boot,
- ghc-boot-th,
ghc == 9.11.*,
bytestring,
parsec,
@@ -162,38 +178,41 @@ executable haddock
build-depends: haddock-api == 2.30.0
test-suite html-test
+ import: extensions
+ import: ghc-options
type: exitcode-stdio-1.0
-- This tells cabal that this test depends on the executable
-- component 'haddock' from this very same package, as well
-- as adding the build-folder where the `haddock`
-- executable can be found in front of $PATH
build-tool-depends: haddock:haddock
- default-language: Haskell2010
main-is: Main.hs
hs-source-dirs: html-test
build-depends: base, filepath, haddock-test == 0.0.1
test-suite hypsrc-test
+ import: extensions
+ import: ghc-options
type: exitcode-stdio-1.0
build-tool-depends: haddock:haddock
- default-language: Haskell2010
main-is: Main.hs
hs-source-dirs: hypsrc-test
build-depends: base, filepath, haddock-test == 0.0.1
- ghc-options: -Wall -fwarn-tabs
test-suite latex-test
+ import: extensions
+ import: ghc-options
type: exitcode-stdio-1.0
build-tool-depends: haddock:haddock
- default-language: Haskell2010
main-is: Main.hs
hs-source-dirs: latex-test
build-depends: base, filepath, haddock-test == 0.0.1
test-suite hoogle-test
+ import: extensions
+ import: ghc-options
type: exitcode-stdio-1.0
build-tool-depends: haddock:haddock
- default-language: Haskell2010
main-is: Main.hs
hs-source-dirs: hoogle-test
build-depends: base, filepath, haddock-test == 0.0.1
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c872e09b41629b442ed7a0c0a52835068fa205a3
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c872e09b41629b442ed7a0c0a52835068fa205a3
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/20240620/71f9d654/attachment-0001.html>
More information about the ghc-commits
mailing list