moduleinfo done

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