fixed ghcutils except warnings

1 files changed, 34 insertions, 45 deletions

diff --git a/src/HaskellCodeExplorer/GhcUtils.hs b/src/HaskellCodeExplorer/GhcUtils.hs
index 65244e9..fdf46d7 100644
--- a/src/HaskellCodeExplorer/GhcUtils.hs
+++ b/src/HaskellCodeExplorer/GhcUtils.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns #-}
@@ -73,7 +74,6 @@ import qualified Data.ByteString as BS
 import Data.Hashable (Hashable,hash)
 import qualified Data.ByteString.Internal as BSI
 import Data.Char (isAlpha, isAlphaNum, isAscii, ord)
-import Data.Either (either)
 import Data.Generics (Data)
 import Data.Generics.SYB (everything, everywhere, mkQ, mkT)
 import qualified Data.Generics.Uniplate.Data()
@@ -82,7 +82,7 @@ import qualified Data.List as L
 import Data.Maybe (fromMaybe, isJust, mapMaybe)
 import qualified Data.Text as T
 -- import DataCon (dataConWorkId, flSelector)
-import GHC.Core.DataCon (dataConWorkId, flSelector)
+import GHC.Core.DataCon (dataConWorkId)
 import Documentation.Haddock.Parser (overIdentifier, parseParas)
 import Documentation.Haddock.Types
   ( DocH(..)
@@ -91,9 +91,12 @@ import Documentation.Haddock.Types
   , Namespace
  )
 -- import DynFlags ()
-import GHC.Driver.Session (DynFlags)
 -- import FastString (mkFastString, unpackFS)
-import GHC.Data.FastString (mkFastString, unpackFS)
+import GHC.Data.FastString
+  ( mkFastString
+  , unpackFS
+  , FastString
+  )
 import GHC
   ( DynFlags
   , CollectFlag(..)
@@ -110,12 +113,13 @@ import GHC
   , HsDocString (..)
 #endif
   , InstDecl(..)
-  , ModuleName
   , Name
   , SrcSpan(..)
+  , srcSpanStart
+  , srcSpanEnd
+  , SrcLoc(..)
   , RealSrcSpan(..)
   , SrcSpanAnnA
-  , Anno
   , ClsInstDecl(..)
   , TyClDecl(..)
   , HsDataDefn(..)
@@ -134,7 +138,6 @@ import GHC
   , TyThing(..)
   , LHsDecl
   , HsDecl(..)
-  , DocDecl(..)
   , ConDecl(..)
   , HsConDetails(..)
   , ConDeclField(..)
@@ -145,7 +148,6 @@ import GHC
   , FixitySig(..)
   , tcdName
   , collectHsBindBinders
-  , getLoc
   , getLocA
 --  , hsSigType
   , getConNames
@@ -161,9 +163,7 @@ import GHC
   , selectorFieldOcc
 #endif
 #if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
-  , tyClGroupTyClDecls
   , LIEWrappedName
-  , hsGroupInstDecls
   , ieLWrappedName
 #else
   , tyClGroupConcat
@@ -179,7 +179,6 @@ import GHC
   , srcSpanStartCol
   , srcSpanEndCol
   , isExternalName
-  , moduleNameString
 --  , recordPatSynSelectorId
   , recordPatSynPatVar
   , isGoodSrcSpan
@@ -219,7 +218,6 @@ import GHC.Parser.Lexer
   , unP
   )
 -- import Module (Module(..))
-import GHC.Unit.Types (Module(..))
 -- import Name
 import GHC.Types.Name
   ( isDataConNameSpace
@@ -244,16 +242,15 @@ import GHC.Types.Name
 import GHC.Types.Name.Occurrence (OccName)
 -- import Outputable (Outputable, ppr, showPpr, showSDoc)
 import GHC.Utils.Outputable (Outputable, ppr)
+import GHC.Utils.Misc (thenCmp)
 import GHC.Driver.Config (initParserOpts)
 import GHC.Driver.Ppr (showPpr, showSDoc)
 -- import PackageConfig (packageVersion)
 -- import Packages
-import Distribution.Package (packageVersion)
 import GHC.Unit.State
   ( LookupResult(..)
   , lookupModuleWithSuggestions
   , lookupUnit
-  , lookupUnitId
 --  , lookupPackage
 --  , packageNameString
   )
@@ -273,7 +270,12 @@ import GHC.Types.Name.Reader
 -- import RnEnv (dataTcOccs)
 import GHC.Rename.Env (dataTcOccs)
 -- import SrcLoc (GenLocated(..), mkRealSrcLoc, unLoc)
-import GHC.Types.SrcLoc (GenLocated(..), mkRealSrcLoc, unLoc)
+import GHC.Types.SrcLoc
+  ( GenLocated(..)
+  , mkRealSrcLoc
+  , unLoc
+  , UnhelpfulSpanReason(..)
+  )
 -- import StringBuffer (StringBuffer(..), stringToStringBuffer)
 import GHC.Data.StringBuffer (StringBuffer(..), stringToStringBuffer)
 import System.FilePath (normalise)
@@ -283,7 +285,6 @@ import GHC.Tc.Types.Evidence (HsWrapper(..), tcCoercionKind)
 import GHC.Tc.Utils.TcType (evVarPred)
 import GHC.Core.TyCo.Rep
   ( Type(..)
-  , ArgFlag(..)
   , mkVisFunTyMany
   , mkVisFunTys
   , mkVisFunTysMany
@@ -296,13 +297,12 @@ import GHC.Core.Type
   ( coreView
   , expandTypeSynonyms
   , mkForAllTy
-  , mkFunTy
   , mkTyCoInvForAllTys
 --  , mkFunTys
 --  , mkInvForAllTys
   , piResultTy
   , splitFunTy_maybe
-  , tidyOpenType, mkVisForAllTys
+  , tidyOpenType
   )
 import GHC.Core.TyCo.Ppr (pprSigmaType)
 #if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
@@ -524,34 +524,13 @@ hsGroupVals hsGroup =
 hsPatSynDetails :: HsPatSynDetails GhcRn -> [Name]
 hsPatSynDetails patDetails =
   case patDetails of
-    InfixCon name1 name2 -> [unXRec name1, unXRec name2]
-    PrefixCon _ fields -> unXRec <$> fields
+    InfixCon name1 name2 -> [unLoc name1, unLoc name2]
+    PrefixCon _ fields -> unLoc <$> fields
     RecCon fields -> concatMap
         (\field -> [extFieldOcc $ recordPatSynField field,
-                    unXRec $ recordPatSynPatVar field])
+                    unLoc $ recordPatSynPatVar field])
         fields
 
--- hsPatSynDetails :: HsPatSynDetails a -> [a]
--- hsPatSynDetails patDetails =
--- #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
---   case patDetails of
---     InfixCon name1 name2 -> [name1, name2]
---     PrefixCon _ fields -> fields
---     RecCon fields -> concatMap
---         (\field -> [-- recordPatSynSelectorId field,
---                     recordPatSynPatVar field])
---         fields
--- #else
---   case patDetails of
---     InfixPatSyn name1 name2 -> [name1, name2]
---     PrefixPatSyn name -> name
---     RecordPatSyn fields ->
---       concatMap
---         (\field -> [recordPatSynSelectorId field, recordPatSynPatVar field])
---         fields
--- #endif
-
-
 #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
 unwrapName :: LIEWrappedName a -> Located a
 unwrapName = reLocN . ieLWrappedName
@@ -1117,8 +1096,18 @@ tyVarsOfType = varSetElems . everything unionVarSet (emptyVarSet `mkQ` tyVar)
 -- mkDecls :: (a -> [Located b]) -> (b -> c) -> a -> [Located c]
 -- mkDecls field con struct = [L loc (con decl) | L loc decl <- field struct]
 
-sortByLoc :: [GenLocated l a] -> [GenLocated l a]
-sortByLoc = L.sortOn getLoc
+instance Ord FastString where
+  a `compare` b = unpackFS a `compare` unpackFS b
+
+deriving instance () => Ord SrcLoc
+
+instance Ord SrcSpan where
+  a `compare` b =
+     (srcSpanStart a `compare` srcSpanStart b) `thenCmp`
+     (srcSpanEnd   a `compare` srcSpanEnd   b)
+
+sortByLoc :: [GenLocated SrcSpanAnnA a] -> [GenLocated SrcSpanAnnA a]
+sortByLoc = L.sortOn getLocA
 
 #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
 classDeclDocs :: TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDocString])]
@@ -1241,7 +1230,7 @@ sigNameNoLoc _                         = []
 clsInstDeclSrcSpan :: ClsInstDecl (GhcPass p) -> SrcSpan
 clsInstDeclSrcSpan ClsInstDecl {cid_poly_ty = ty} = getLocA ty
 #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-clsInstDeclSrcSpan (XClsInstDecl _) = UnhelpfulSpan "XClsinstdecl"
+clsInstDeclSrcSpan (XClsInstDecl _) = UnhelpfulSpan (UnhelpfulOther "XClsinstdecl")
 #endif
 
 hsDocsToDocH :: DynFlags -> GlobalRdrEnv -> [HsDocString] -> Doc Name