From cf7d06b8ac0f47d6ff1c2d3decdb6a50a0fd7502 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Tue, 9 Feb 2021 12:42:30 +0100 Subject: Stable sort for (data/newtype) instances --- .../src/Haddock/Interface/AttachInstances.hs | 25 +++++++++++++++------- 1 file changed, 17 insertions(+), 8 deletions(-) (limited to 'haddock-api/src/Haddock/Interface') diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs index 6ef0ed19..d5b80888 100644 --- a/haddock-api/src/Haddock/Interface/AttachInstances.hs +++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs @@ -179,19 +179,28 @@ findFixity iface ifaceMap instIfaceMap = \name -> -- Collecting and sorting instances -------------------------------------------------------------------------------- +-- | Stable name for stable comparisons. GHC's `Name` uses unstable +-- ordering based on their `Unique`'s. +newtype SName = SName Name + +instance Eq SName where + SName n1 == SName n2 = n1 `stableNameCmp` n2 == EQ + +instance Ord SName where + SName n1 `compare` SName n2 = n1 `stableNameCmp` n2 -- | Simplified type for sorting types, ignoring qualification (not visible -- in Haddock output) and unifying special tycons with normal ones. -- For the benefit of the user (looks nice and predictable) and the -- tests (which prefer output to be deterministic). -data SimpleType = SimpleType Name [SimpleType] +data SimpleType = SimpleType SName [SimpleType] | SimpleTyLit TyLit deriving (Eq,Ord) -instHead :: ([TyVar], [PredType], Class, [Type]) -> ([Int], Name, [SimpleType]) +instHead :: ([TyVar], [PredType], Class, [Type]) -> ([Int], SName, [SimpleType]) instHead (_, _, cls, args) - = (map argCount args, className cls, map simplify args) + = (map argCount args, SName (className cls), map simplify args) argCount :: Type -> Int argCount (AppTy t _) = argCount t + 1 @@ -202,12 +211,12 @@ argCount (CastTy t _) = argCount t argCount _ = 0 simplify :: Type -> SimpleType -simplify (FunTy _ _ t1 t2) = SimpleType funTyConName [simplify t1, simplify t2] +simplify (FunTy _ _ t1 t2) = SimpleType (SName funTyConName) [simplify t1, simplify t2] simplify (ForAllTy _ t) = simplify t simplify (AppTy t1 t2) = SimpleType s (ts ++ maybeToList (simplify_maybe t2)) where (SimpleType s ts) = simplify t1 -simplify (TyVarTy v) = SimpleType (tyVarName v) [] -simplify (TyConApp tc ts) = SimpleType (tyConName tc) +simplify (TyVarTy v) = SimpleType (SName (tyVarName v)) [] +simplify (TyConApp tc ts) = SimpleType (SName (tyConName tc)) (mapMaybe simplify_maybe ts) simplify (LitTy l) = SimpleTyLit l simplify (CastTy ty _) = simplify ty @@ -218,9 +227,9 @@ simplify_maybe (CoercionTy {}) = Nothing simplify_maybe ty = Just (simplify ty) -- Used for sorting -instFam :: FamInst -> ([Int], Name, [SimpleType], Int, SimpleType) +instFam :: FamInst -> ([Int], SName, [SimpleType], Int, SimpleType) instFam FamInst { fi_fam = n, fi_tys = ts, fi_rhs = t } - = (map argCount ts, n, map simplify ts, argCount t, simplify t) + = (map argCount ts, SName n, map simplify ts, argCount t, simplify t) -------------------------------------------------------------------------------- -- cgit v1.2.3 From 7e8c7c3491f3e769368b8e6c767c62a33e996c80 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Tue, 9 Feb 2021 12:56:15 +0100 Subject: Also make TyLit deterministic --- haddock-api/src/Haddock/Interface/AttachInstances.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'haddock-api/src/Haddock/Interface') diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs index d5b80888..530c5690 100644 --- a/haddock-api/src/Haddock/Interface/AttachInstances.hs +++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs @@ -28,6 +28,7 @@ import Data.Maybe ( maybeToList, mapMaybe, fromMaybe ) import qualified Data.Map as Map import qualified Data.Set as Set +import GHC.Data.FastString (unpackFS) import GHC.Core.Class import GHC.Driver.Session import GHC.Core (isOrphan) @@ -194,7 +195,9 @@ instance Ord SName where -- For the benefit of the user (looks nice and predictable) and the -- tests (which prefer output to be deterministic). data SimpleType = SimpleType SName [SimpleType] - | SimpleTyLit TyLit + | SimpleIntTyLit Integer + | SimpleStringTyLit String + | SimpleCharTyLit Char deriving (Eq,Ord) @@ -218,7 +221,9 @@ simplify (AppTy t1 t2) = SimpleType s (ts ++ maybeToList (simplify_maybe t2)) simplify (TyVarTy v) = SimpleType (SName (tyVarName v)) [] simplify (TyConApp tc ts) = SimpleType (SName (tyConName tc)) (mapMaybe simplify_maybe ts) -simplify (LitTy l) = SimpleTyLit l +simplify (LitTy (NumTyLit n)) = SimpleIntTyLit n +simplify (LitTy (StrTyLit s)) = SimpleStringTyLit (unpackFS s) +simplify (LitTy (CharTyLit c)) = SimpleCharTyLit c simplify (CastTy ty _) = simplify ty simplify (CoercionTy _) = error "simplify:Coercion" -- cgit v1.2.3 From 23fa3045f14ce0b8e107178e9b7859a66db65910 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 14 Feb 2021 15:28:15 +0200 Subject: Add import list to Data.List in Haddock.Interface.Create --- haddock-api/haddock-api.cabal | 1 + haddock-api/src/Haddock/Interface/Create.hs | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) (limited to 'haddock-api/src/Haddock/Interface') diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index e6de8b81..e9433d73 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -68,6 +68,7 @@ library ghc-options: -funbox-strict-fields -O2 -Wall -Wcompat + -Wcompat-unqualified-imports -Widentities -Wredundant-constraints -Wnoncanonical-monad-instances diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 9a773b6c..c0b9fd46 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -35,7 +35,7 @@ import Control.Monad.Writer.Strict hiding (tell) import Data.Bitraversable import qualified Data.Map as M import Data.Map (Map) -import Data.List +import Data.List (foldl', find) import Data.Maybe import Data.Traversable import GHC.Stack -- cgit v1.2.3 From af46d073aa254bdede248fa8d2f5deb412968317 Mon Sep 17 00:00:00 2001 From: Hécate Moonlight Date: Mon, 22 Feb 2021 11:53:07 +0100 Subject: Clean-up of Interface and Interface.Create's imports and pragmata --- haddock-api/src/Haddock/Interface.hs | 23 +++++++------ haddock-api/src/Haddock/Interface/Create.hs | 51 +++++++++++++++++------------ 2 files changed, 41 insertions(+), 33 deletions(-) (limited to 'haddock-api/src/Haddock/Interface') diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs index 7cc76953..74dbc9c7 100644 --- a/haddock-api/src/Haddock/Interface.hs +++ b/haddock-api/src/Haddock/Interface.hs @@ -51,26 +51,25 @@ import qualified Data.Map as Map import qualified Data.Set as Set import Text.Printf -import GHC.Unit.Module.Env (mkModuleSet, emptyModuleSet, unionModuleSet, ModuleSet) -import GHC.Unit.Module.ModSummary -import GHC.Unit.Module.Graph -import GHC.Unit.Types -import GHC.Data.Graph.Directed -import GHC.Driver.Session hiding (verbosity) import GHC hiding (verbosity) +import GHC.Data.FastString (unpackFS) +import GHC.Data.Graph.Directed import GHC.Driver.Env import GHC.Driver.Monad -import GHC.Data.FastString (unpackFS) -import GHC.Utils.Error +import GHC.Driver.Session hiding (verbosity) +import GHC.HsToCore.Docs +import GHC.Plugins (Outputable, StaticPlugin(..), Plugin(..), PluginWithArgs(..), defaultPlugin, keepRenamedSource) import GHC.Tc.Types (TcM, TcGblEnv(..)) -import GHC.Tc.Utils.Monad (getTopEnv, setGblEnv) import GHC.Tc.Utils.Env (tcLookupGlobal) +import GHC.Tc.Utils.Monad (getTopEnv, setGblEnv) import GHC.Types.Name (nameIsFromExternalPackage, nameOccName) import GHC.Types.Name.Occurrence (isTcOcc) import GHC.Types.Name.Reader (unQualOK, greMangledName, globalRdrEnvElts) -import GHC.HsToCore.Docs -import GHC.Plugins (Outputable, StaticPlugin(..), Plugin(..), PluginWithArgs(..), - defaultPlugin, keepRenamedSource) +import GHC.Unit.Module.Env (mkModuleSet, emptyModuleSet, unionModuleSet, ModuleSet) +import GHC.Unit.Module.Graph +import GHC.Unit.Module.ModSummary +import GHC.Unit.Types +import GHC.Utils.Error #if defined(mingw32_HOST_OS) import System.IO diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index c0b9fd46..a921342e 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -1,8 +1,17 @@ -{-# LANGUAGE StandaloneDeriving, FlexibleInstances, MultiParamTypeClasses, CPP, TupleSections, BangPatterns, LambdaCase, NamedFieldPuns, ScopedTypeVariables, RecordWildCards #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wwarn #-} ----------------------------------------------------------------------------- -- | @@ -38,33 +47,33 @@ import Data.Map (Map) import Data.List (foldl', find) import Data.Maybe import Data.Traversable -import GHC.Stack -import GHC.Tc.Utils.Monad (finalSafeMode) -import GHC.Types.Avail hiding (avail) -import qualified GHC.Types.Avail as Avail -import qualified GHC.Unit.Module as Module -import GHC.Unit.Module.ModSummary -import qualified GHC.Types.SrcLoc as SrcLoc -import GHC.Types.SourceFile -import GHC.Core.Class -import GHC.Core.ConLike (ConLike(..)) +import GHC.Stack import GHC hiding (lookupName) +import GHC.Core.Class +import GHC.Core.ConLike (ConLike (..)) +import GHC.Data.FastString (bytesFS, unpackFS) import GHC.Driver.Ppr +import GHC.HsToCore.Docs hiding (mkMaps) +import GHC.Parser.Annotation (IsUnicodeSyntax (..)) +import GHC.Tc.Types hiding (IfM) +import GHC.Tc.Utils.Monad (finalSafeMode) +import GHC.Types.Avail hiding (avail) +import qualified GHC.Types.Avail as Avail +import GHC.Types.Basic (PromotionFlag (..)) import GHC.Types.Name -import GHC.Types.Name.Set import GHC.Types.Name.Env -import GHC.Unit.State import GHC.Types.Name.Reader -import GHC.Tc.Types hiding (IfM) -import GHC.Data.FastString ( unpackFS, bytesFS ) -import GHC.Types.Basic ( PromotionFlag(..) ) +import GHC.Types.Name.Set +import GHC.Types.SourceFile import GHC.Types.SourceText +import qualified GHC.Types.SrcLoc as SrcLoc +import qualified GHC.Unit.Module as Module +import GHC.Unit.Module.ModSummary +import GHC.Unit.Module.Warnings +import GHC.Unit.State import qualified GHC.Utils.Outputable as O import GHC.Utils.Panic -import GHC.HsToCore.Docs hiding (mkMaps) -import GHC.Parser.Annotation (IsUnicodeSyntax(..)) -import GHC.Unit.Module.Warnings newtype IfEnv m = IfEnv { -- cgit v1.2.3 From f2bd833fdc6f49bb33ab9df12e18e194453bff03 Mon Sep 17 00:00:00 2001 From: Hécate Moonlight Date: Mon, 22 Feb 2021 18:41:08 +0100 Subject: Explicit imports for Haddock.Interface and Haddock.Interface.Create --- haddock-api/src/Haddock/Interface.hs | 48 ++++++++++++++-------------- haddock-api/src/Haddock/Interface/Create.hs | 49 +++++++++++++++-------------- 2 files changed, 50 insertions(+), 47 deletions(-) (limited to 'haddock-api/src/Haddock/Interface') diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs index 74dbc9c7..fd44e58b 100644 --- a/haddock-api/src/Haddock/Interface.hs +++ b/haddock-api/src/Haddock/Interface.hs @@ -34,42 +34,44 @@ module Haddock.Interface ( ) where -import Haddock.GhcUtils -import Haddock.InterfaceFile -import Haddock.Interface.Create -import Haddock.Interface.AttachInstances -import Haddock.Interface.Rename +import Haddock.GhcUtils (moduleString, pretty) +import Haddock.Interface.AttachInstances (attachInstances) +import Haddock.Interface.Create (createInterface1, runIfM) +import Haddock.Interface.Rename (renameInterface) +import Haddock.InterfaceFile (InterfaceFile, ifInstalledIfaces, ifLinkEnv) import Haddock.Options hiding (verbosity) -import Haddock.Types -import Haddock.Utils - -import Control.Monad -import Control.Monad.IO.Class ( MonadIO ) -import Data.IORef +import Haddock.Types (DocOption (..), Documentation (..), ExportItem (..), IfaceMap, InstIfaceMap, Interface, LinkEnv, + expItemDecl, expItemMbDoc, ifaceDoc, ifaceExportItems, ifaceExports, ifaceHaddockCoverage, + ifaceInstances, ifaceMod, ifaceOptions, ifaceVisibleExports, instMod, runWriter, throwE) +import Haddock.Utils (Verbosity (..), normal, out, verbose) + +import Control.Monad (unless, when) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.IORef (atomicModifyIORef', newIORef, readIORef) import Data.List (foldl', isPrefixOf, nub) +import Text.Printf (printf) import qualified Data.Map as Map import qualified Data.Set as Set -import Text.Printf import GHC hiding (verbosity) import GHC.Data.FastString (unpackFS) -import GHC.Data.Graph.Directed -import GHC.Driver.Env -import GHC.Driver.Monad +import GHC.Data.Graph.Directed (flattenSCCs) +import GHC.Driver.Env (hsc_dflags, hsc_home_unit, hsc_logger, hsc_static_plugins, hsc_units) +import GHC.Driver.Monad (modifySession, withTimingM) import GHC.Driver.Session hiding (verbosity) import GHC.HsToCore.Docs -import GHC.Plugins (Outputable, StaticPlugin(..), Plugin(..), PluginWithArgs(..), defaultPlugin, keepRenamedSource) -import GHC.Tc.Types (TcM, TcGblEnv(..)) +import GHC.Plugins (Outputable, Plugin (..), PluginWithArgs (..), StaticPlugin (..), defaultPlugin, keepRenamedSource) +import GHC.Tc.Types (TcGblEnv (..), TcM) import GHC.Tc.Utils.Env (tcLookupGlobal) import GHC.Tc.Utils.Monad (getTopEnv, setGblEnv) import GHC.Types.Name (nameIsFromExternalPackage, nameOccName) import GHC.Types.Name.Occurrence (isTcOcc) -import GHC.Types.Name.Reader (unQualOK, greMangledName, globalRdrEnvElts) -import GHC.Unit.Module.Env (mkModuleSet, emptyModuleSet, unionModuleSet, ModuleSet) -import GHC.Unit.Module.Graph -import GHC.Unit.Module.ModSummary -import GHC.Unit.Types -import GHC.Utils.Error +import GHC.Types.Name.Reader (globalRdrEnvElts, greMangledName, unQualOK) +import GHC.Unit.Module.Env (ModuleSet, emptyModuleSet, mkModuleSet, unionModuleSet) +import GHC.Unit.Module.Graph (ModuleGraphNode (..)) +import GHC.Unit.Module.ModSummary (emsModSummary, isBootSummary) +import GHC.Unit.Types (IsBootInterface (..)) +import GHC.Utils.Error (withTiming) #if defined(mingw32_HOST_OS) import System.IO diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index a921342e..b039e095 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -32,48 +32,49 @@ module Haddock.Interface.Create (IfM, runIfM, createInterface1) where import Documentation.Haddock.Doc (metaDocAppend) +import Haddock.Convert (PrintRuntimeReps (..), tyThingToLHsDecl) +import Haddock.GhcUtils (addClassContext, filterSigNames, lHsQTyVarsToTypes, mkEmptySigType, moduleString, parents, + pretty, restrictTo, sigName, unL) +import Haddock.Interface.LexParseRn (processDocString, processDocStringParas, processDocStrings, processModuleHeader) +import Haddock.Options (Flag (..), modulePackageInfo) import Haddock.Types hiding (liftErrMsg) -import Haddock.Options -import Haddock.GhcUtils -import Haddock.Utils -import Haddock.Convert -import Haddock.Interface.LexParseRn +import Haddock.Utils (replace) -import Control.Monad.Reader +import Control.Monad.Reader (MonadReader (..), ReaderT, asks, runReaderT) import Control.Monad.Writer.Strict hiding (tell) -import Data.Bitraversable -import qualified Data.Map as M +import Data.Bitraversable (bitraverse) +import Data.List (find, foldl') import Data.Map (Map) -import Data.List (foldl', find) -import Data.Maybe -import Data.Traversable +import qualified Data.Map as M +import Data.Maybe (catMaybes, fromJust, isJust, mapMaybe, maybeToList) +import Data.Traversable (for) -import GHC.Stack import GHC hiding (lookupName) -import GHC.Core.Class +import GHC.Core.Class (ClassMinimalDef, classMinimalDef) import GHC.Core.ConLike (ConLike (..)) import GHC.Data.FastString (bytesFS, unpackFS) -import GHC.Driver.Ppr +import GHC.Driver.Ppr (showSDoc) import GHC.HsToCore.Docs hiding (mkMaps) import GHC.Parser.Annotation (IsUnicodeSyntax (..)) +import GHC.Stack (HasCallStack) import GHC.Tc.Types hiding (IfM) import GHC.Tc.Utils.Monad (finalSafeMode) import GHC.Types.Avail hiding (avail) import qualified GHC.Types.Avail as Avail import GHC.Types.Basic (PromotionFlag (..)) -import GHC.Types.Name -import GHC.Types.Name.Env -import GHC.Types.Name.Reader -import GHC.Types.Name.Set -import GHC.Types.SourceFile -import GHC.Types.SourceText +import GHC.Types.Name (getOccString, getSrcSpan, isDataConName, isValName, nameIsLocalOrFrom, nameOccName) +import GHC.Types.Name.Env (lookupNameEnv) +import GHC.Types.Name.Reader (GlobalRdrEnv, greMangledName, lookupGlobalRdrEnv) +import GHC.Types.Name.Set (elemNameSet, mkNameSet) +import GHC.Types.SourceFile (HscSource (..)) +import GHC.Types.SourceText (SourceText (..), sl_fs) import qualified GHC.Types.SrcLoc as SrcLoc import qualified GHC.Unit.Module as Module -import GHC.Unit.Module.ModSummary -import GHC.Unit.Module.Warnings -import GHC.Unit.State +import GHC.Unit.Module.ModSummary (msHsFilePath) +import GHC.Unit.Module.Warnings (WarningTxt (..), Warnings (..)) +import GHC.Unit.State (PackageName (..), UnitState, lookupModuleInAllUnits) import qualified GHC.Utils.Outputable as O -import GHC.Utils.Panic +import GHC.Utils.Panic (pprPanic) newtype IfEnv m = IfEnv { -- cgit v1.2.3