aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/HaskellCodeExplorer/GhcUtils.hs79
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-27 06:16:53 +0000