aboutsummaryrefslogtreecommitdiff
path: root/src/HaskellCodeExplorer
diff options
context:
space:
mode:
authorYuchen Pei <hi@ypei.me>2022-06-06 11:38:52 +1000
committerYuchen Pei <hi@ypei.me>2022-06-06 11:38:52 +1000
commita26bf151b369fc1891678eedccca4cafdc84f4c4 (patch)
tree24b5de924871bf7da3884febb1884c0821193095 /src/HaskellCodeExplorer
parent08cd4c8be065ab1cf2dd672409035e47199bb2e6 (diff)
moduleinfo done
Diffstat (limited to 'src/HaskellCodeExplorer')
-rw-r--r--src/HaskellCodeExplorer/GhcUtils.hs4
-rw-r--r--src/HaskellCodeExplorer/ModuleInfo.hs100
2 files changed, 41 insertions, 63 deletions
diff --git a/src/HaskellCodeExplorer/GhcUtils.hs b/src/HaskellCodeExplorer/GhcUtils.hs
index 99cf7b4..a1b121c 100644
--- a/src/HaskellCodeExplorer/GhcUtils.hs
+++ b/src/HaskellCodeExplorer/GhcUtils.hs
@@ -100,6 +100,7 @@ import GHC.Data.FastString
import GHC
( DynFlags
, CollectFlag(..)
+ , LHsBindLR
, reLocN
, unXRec
, UnXRec
@@ -125,7 +126,6 @@ import GHC
, Id
, rdrNameFieldOcc
, HsGroup(..)
- , HsBindLR(..)
, HsValBindsLR(..)
#if MIN_VERSION_GLASGOW_HASKELL(8,4,1,0)
, HsPatSynDetails
@@ -474,7 +474,7 @@ mbIdDetails _ = Nothing
-- Syntax transformation
--------------------------------------------------------------------------------
-hsGroupVals :: HsGroup GhcRn -> [GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)]
+hsGroupVals :: HsGroup GhcRn -> [LHsBindLR GhcRn GhcRn]
hsGroupVals hsGroup =
filter (isGoodSrcSpan . getLocA) $
case hs_valds hsGroup of
diff --git a/src/HaskellCodeExplorer/ModuleInfo.hs b/src/HaskellCodeExplorer/ModuleInfo.hs
index 8942e6f..6f5c9b5 100644
--- a/src/HaskellCodeExplorer/ModuleInfo.hs
+++ b/src/HaskellCodeExplorer/ModuleInfo.hs
@@ -34,6 +34,7 @@ import Documentation.Haddock.Types (DocH)
import GHC
( GenLocated(..)
, DynFlags
+ , LHsBindLR
, ModSummary
, ModuleInfo
, ModuleName
@@ -63,28 +64,25 @@ import HaskellCodeExplorer.AST.TypecheckedSource
import HaskellCodeExplorer.GhcUtils
import HaskellCodeExplorer.Preprocessor (createSourceCodeTransformation)
import qualified HaskellCodeExplorer.Types as HCE
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
-import GHC.Hs.Binds (HsBindLR)
-#endif
import GHC.Hs.Decls
( ForeignDecl(..)
, HsDecl(..)
, HsGroup(..)
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
- , InstDecl
- , TyClDecl
-#endif
+ , LInstDecl
+ , LForeignDecl
+ , LTyClDecl
, InstDecl(..)
, group_tyclds
, tyClDeclLName
, tcdName
-#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
, hsGroupInstDecls
-#endif
)
import GHC.Hs.Doc(HsDocString)
import GHC.Hs.ImpExp (IE(..), ImportDecl(..))
-import GHC.Hs.Utils(collectHsBindBinders)
+import GHC.Hs.Utils
+ ( collectHsBindBinders
+ , CollectFlag(..)
+ )
import GHC.Unit.State (UnitState)
import GHC.Unit.Module.ModDetails
( md_types
@@ -99,9 +97,6 @@ import GHC.Unit.Home.ModInfo
, hm_details
)
import GHC.Core.InstEnv (InstEnvs(..), is_dfun)
-import GHC.Unit.Module
- ( Module(..)
- )
import GHC.Unit.Types
( GenModule(..)
)
@@ -376,6 +371,7 @@ createDefinitionSiteMap flags unitState currentPackageId compId defSiteMap fileM
docHToHtml =
docWithNamesToHtml
flags
+ unitState
currentPackageId
compId
transformation
@@ -401,7 +397,7 @@ createDefinitionSiteMap flags unitState currentPackageId compId defSiteMap fileM
--------------------------------------------------------------------------------
mainDeclNamesWithDocumentation =
concatMap
- (\dec@(L _ decl, docs) ->
+ (\(dec@(L _ decl), docs) ->
map (, docs, getLocA dec) $ getMainDeclBinder decl)
valueAndTypeDeclsWithDocs
dataFamTyConsWithoutDocs =
@@ -457,7 +453,7 @@ occNameToHtml flags packageId compId (modName, occName) =
H.toHtml (toText flags occName)
nameToHtml ::
- DynFlags
+ UnitState
-> HCE.PackageId
-> HCE.ComponentId
-> HCE.SourceCodeTransformation
@@ -465,11 +461,11 @@ nameToHtml ::
-> HM.HashMap HCE.HaskellModulePath HCE.DefinitionSiteMap
-> Name
-> H.Html
-nameToHtml flags packageId compId transformation files defSiteMap name =
+nameToHtml unitState packageId compId transformation files defSiteMap name =
let location =
H.textValue . toStrict . encodeToLazyText . Aeson.toJSON $
nameLocationInfo
- flags
+ unitState
packageId
compId
transformation
@@ -483,6 +479,7 @@ nameToHtml flags packageId compId transformation files defSiteMap name =
docWithNamesToHtml ::
DynFlags
+ -> UnitState
-> HCE.PackageId
-> HCE.ComponentId
-> HCE.SourceCodeTransformation
@@ -490,10 +487,10 @@ docWithNamesToHtml ::
-> HM.HashMap HCE.HaskellModulePath HCE.DefinitionSiteMap
-> DocH (ModuleName, OccName) Name
-> HCE.HTML
-docWithNamesToHtml flags packageId compId transformation fileMap defSiteMap =
+docWithNamesToHtml flags unitState packageId compId transformation fileMap defSiteMap =
HCE.docToHtml
(occNameToHtml flags packageId compId)
- (nameToHtml flags packageId compId transformation fileMap defSiteMap)
+ (nameToHtml unitState packageId compId transformation fileMap defSiteMap)
createDeclarations ::
DynFlags
@@ -519,10 +516,8 @@ createDeclarations flags hsGroup typeEnv exportedSet transformation =
Nothing -> Nothing
-- | Top-level functions
--------------------------------------------------------------------------------
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
- valToDeclarations :: GenLocated SrcSpan (HsBindLR GhcRn GhcRn) -> [HCE.Declaration]
-#endif
- valToDeclarations (L loc bind) =
+ valToDeclarations :: LHsBindLR GhcRn GhcRn -> [HCE.Declaration]
+ valToDeclarations lb@(L _ bind) =
map
(\name ->
HCE.Declaration
@@ -530,58 +525,49 @@ createDeclarations flags hsGroup typeEnv exportedSet transformation =
(toText flags name)
(nameType name)
(S.member name exportedSet)
- (lineNumber loc)) $
- collectHsBindBinders bind
+ (lineNumber (getLocA lb))) $
+ collectHsBindBinders CollNoDictBinders bind
vals = concatMap valToDeclarations $ hsGroupVals hsGroup
-- | Data, newtype, type, type family, data family or class declaration
--------------------------------------------------------------------------------
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
- tyClToDeclaration :: GenLocated SrcSpan (TyClDecl GhcRn) -> HCE.Declaration
-#endif
- tyClToDeclaration (L loc tyClDecl) =
+ tyClToDeclaration :: LTyClDecl GhcRn -> HCE.Declaration
+ tyClToDeclaration lt@(L _ tyClDecl) =
HCE.Declaration
HCE.TyClD
(T.append (tyClDeclPrefix tyClDecl) (toText flags $ tcdName tyClDecl))
(nameType $ tcdName tyClDecl)
(S.member (unLoc $ tyClDeclLName tyClDecl) exportedSet)
- (lineNumber loc)
+ (lineNumber (getLocA lt))
tyclds =
map tyClToDeclaration .
- filter (isGoodSrcSpan . getLoc) . concatMap group_tyclds . hs_tyclds $
+ filter (isGoodSrcSpan . getLocA) . concatMap group_tyclds . hs_tyclds $
hsGroup
-- | Instances
--------------------------------------------------------------------------------
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
- instToDeclaration :: GenLocated SrcSpan (InstDecl GhcRn) -> HCE.Declaration
+ instToDeclaration :: LInstDecl GhcRn -> HCE.Declaration
#endif
- instToDeclaration (L loc inst) =
+ instToDeclaration li@(L _ inst) =
HCE.Declaration
HCE.InstD
(instanceDeclToText flags inst)
Nothing
True
- (lineNumber loc)
+ (lineNumber (getLocA li))
insts =
-#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
- map instToDeclaration . filter (isGoodSrcSpan . getLoc) . hsGroupInstDecls $
-#else
- map instToDeclaration . filter (isGoodSrcSpan . getLoc) . hs_instds $
-#endif
+ map instToDeclaration . filter (isGoodSrcSpan . getLocA) . hsGroupInstDecls $
hsGroup
-- | Foreign functions
--------------------------------------------------------------------------------
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
- foreignFunToDeclaration ::
- GenLocated SrcSpan (ForeignDecl GhcRn) -> HCE.Declaration
-#endif
- foreignFunToDeclaration (L loc fd) =
+ foreignFunToDeclaration :: LForeignDecl GhcRn -> HCE.Declaration
+ foreignFunToDeclaration lf@(L _ fd) =
let name = unLoc $ fd_name fd
in HCE.Declaration
HCE.ForD
(toText flags name)
(nameType name)
True
- (lineNumber loc)
+ (lineNumber (getLocA lf))
fords = map foreignFunToDeclaration $ hs_fords hsGroup
--------------------------------------------------------------------------------
in L.sortOn HCE.lineNumber $ vals ++ tyclds ++ insts ++ fords
@@ -610,16 +596,16 @@ foldAST environment typecheckedModule =
(addIdentifierToMaps environment astStateIdSrcSpanMap)
(HM.empty, astStateIdOccMap)
(namesFromRenamedSource renamed)
- flags = envDynFlags environment
+ unitState = envUnitState environment
packageId = envPackageId environment
compId = envComponentId environment
importedModules =
map
- ((\(L span modName) ->
+ ((\lm@(L _ modName) ->
( modName
- , span
+ , getLocA lm
, moduleLocationInfo
- flags
+ unitState
(envModuleNameMap environment)
packageId
compId
@@ -631,22 +617,14 @@ foldAST environment typecheckedModule =
case mbExported of
Just lieNames ->
mapMaybe
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
- (\(L span ie,_) ->
-#else
- (\(L span ie) ->
-#endif
+ (\(li@(L _ ie),_) ->
case ie of
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
IEModuleContents _ (L _ modName) ->
-#else
- IEModuleContents (L _ modName) ->
-#endif
Just
( modName
- , span
+ , getLocA li
, moduleLocationInfo
- flags
+ unitState
(envModuleNameMap environment)
packageId
compId
@@ -817,7 +795,7 @@ lookupIdByNameOccurrence environment idSrcSpanMap (NameOccurrence (L span mbName
Just t -> Just (t, Nothing)
Nothing -> Nothing
Nothing -> Nothing
-lookupIdByNameOccurrence _ _ TyLitOccurrence {..} = Nothing
+lookupIdByNameOccurrence _ _ TyLitOccurrence {} = Nothing
updateIdMap ::
Environment