From 54468d1e60cb10093120137766cfc9dd91671c98 Mon Sep 17 00:00:00 2001
From: Sylvain Henry <sylvain@haskus.fr>
Date: Wed, 12 Aug 2020 10:56:32 +0200
Subject: Remove Ord FastString instance

---
 haddock-api/src/Haddock/Backends/Hyperlinker.hs |  4 ++--
 haddock-api/src/Haddock/Interface/Specialize.hs | 16 +++++++++++-----
 2 files changed, 13 insertions(+), 7 deletions(-)

(limited to 'haddock-api/src/Haddock')

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 =
-- 
cgit v1.2.3