diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2020-08-31 13:59:34 -0400 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2020-08-31 13:59:34 -0400 |
| commit | 5228394c88e67551e35bae1cab6b2e04eb4382f7 (patch) | |
| tree | e79b847f77107f2ee67933ee4d98080f8a4bd232 /haddock-api | |
| parent | 323aa89cbb4a3e8c8f32295e42a42635f05c849d (diff) | |
| parent | 54468d1e60cb10093120137766cfc9dd91671c98 (diff) | |
Merge pull request #1226 from hsyl20/wip/hsyl20/fs_ord
Remove Ord FastString instance
Diffstat (limited to 'haddock-api')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker.hs | 4 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Specialize.hs | 16 |
2 files changed, 13 insertions, 7 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs index d315ced0..2ae4dcdb 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs @@ -18,7 +18,7 @@ import Data.Maybe import System.Directory import System.FilePath -import GHC.Iface.Ext.Types ( HieFile(..), HieASTs(..) ) +import GHC.Iface.Ext.Types import GHC.Iface.Ext.Binary ( readHieFile, hie_file_result, NameCacheUpdater(..)) import Data.Map as M import GHC.Data.FastString ( mkFastString ) @@ -67,7 +67,7 @@ ppHyperlinkedModuleSource srcdir pretty srcs iface = case ifaceHieFile iface of -- Get the AST and tokens corresponding to the source file we want let mast | M.size asts == 1 = snd <$> M.lookupMin asts - | otherwise = M.lookup (mkFastString file) asts + | otherwise = M.lookup (HiePath (mkFastString file)) asts tokens = parse df file rawSrc -- Produce and write out the hyperlinked sources diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs index 66627c15..28806f04 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -178,19 +178,25 @@ parseTupleArity _ = Nothing -- not converted to 'String' or alike to avoid new allocations. Additionally, -- since it is stored mostly in 'Set', fast comparison of 'FastString' is also -- quite nice. -type NameRep = FastString +newtype NameRep + = NameRep FastString + deriving (Eq) + +instance Ord NameRep where + compare (NameRep fs1) (NameRep fs2) = uniqCompareFS fs1 fs2 + getNameRep :: NamedThing name => name -> NameRep -getNameRep = getOccFS +getNameRep = NameRep . getOccFS nameRepString :: NameRep -> String -nameRepString = unpackFS +nameRepString (NameRep fs) = unpackFS fs stringNameRep :: String -> NameRep -stringNameRep = mkFastString +stringNameRep = NameRep . mkFastString setInternalNameRep :: SetName name => NameRep -> name -> name -setInternalNameRep = setInternalOccName . mkVarOccFS +setInternalNameRep (NameRep fs) = setInternalOccName (mkVarOccFS fs) setInternalOccName :: SetName name => OccName -> name -> name setInternalOccName occ name = |