content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE TupleSections #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE NamedFieldPuns #-}
  {-# LANGUAGE DuplicateRecordFields #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE StrictData #-}
  
  module HaskellCodeExplorer.ModuleInfo
    ( createModuleInfo
    , ModuleDependencies
    ) where
  
  import qualified Data.Generics.Uniplate.Data as U
  import Control.Monad.State.Strict (execState,evalState,get,put,State)
  import qualified Data.Aeson as Aeson
  import Data.Aeson.Text(encodeToLazyText)
  import qualified Data.Vector as V
  import qualified Data.HashMap.Strict as HM
  import qualified Data.Map.Strict as M
  import qualified Data.IntMap.Strict as IM
  import qualified Data.IntervalMap.Strict as IVM
  import qualified Data.List as L hiding (span)
  import Data.Maybe (fromMaybe, mapMaybe)
  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
  import HsExtension (GhcRn)
  #endif
  import qualified Data.Set as S
  import qualified Data.Text as T
  import qualified Data.Text.Encoding as TE
  import Data.Text.Lazy (toStrict)
  import Documentation.Haddock.Types (DocH)
  import DynFlags(DynFlags)
  import GHC
    ( GenLocated(..)
    , ModSummary
    , ModuleInfo
    , ModuleName
    , SrcSpan
    , TyThing(..)
    , Type
    , TypecheckedModule
    , getLoc
    , isGoodSrcSpan
    , modInfoExportsWithSelectors
    , modInfoInstances
    , moduleInfo
    , moduleNameString
    , ms_hspp_buf
    , ms_mod
    , renamedSource
    , tm_internals_
    , tm_typechecked_source
    , unLoc
    )
  import Type(expandTypeSynonyms)
  import TyCon (isFamInstTyCon,tyConName)
  import HaskellCodeExplorer.AST.RenamedSource
  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 HsBinds (HsBindLR)
  #endif
  import HsDecls
    ( ForeignDecl(..)
    , HsDecl(..)
    , HsGroup(..)
  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
    , InstDecl
    , TyClDecl
  #endif
    , InstDecl(..)
    , group_tyclds
    , tyClDeclLName
    , tcdName
  #if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
    , hsGroupInstDecls
  #endif
    )
  import HsDoc(HsDocString)
  import HsImpExp (IE(..), ImportDecl(..))
  import HsUtils(collectHsBindBinders)
  import HscTypes
    ( ExternalPackageState
    , HomePackageTable
    , TypeEnv
    , eps_PTE
    , eps_inst_env
    , hm_details
    , md_types
    , mkTypeEnv
    , typeEnvElts
    )
  import InstEnv (InstEnvs(..), is_dfun)
  import Module(Module(..))
  import Name (Name, OccName, getSrcSpan, nameOccName, nameSrcSpan, nameUnique)
  import Prelude hiding(id,span)
  import RdrName(GlobalRdrEnv)
  import SrcLoc (isOneLineSpan)
  import TcRnTypes (tcVisibleOrphanMods, tcg_inst_env, tcg_rdr_env, tcg_type_env)
  import qualified Text.Blaze.Html5 as H
  import qualified Text.Blaze.Html5.Attributes as A
  #if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
  import UniqDFM (eltsUDFM)
  #else
  import UniqFM (eltsUFM)
  #endif
  import Unique (getKey)
  import Var (varName, varType,Id)
  import VarEnv (emptyTidyEnv)
  
  type ModuleDependencies
     = ( HM.HashMap HCE.HaskellFilePath HCE.HaskellModulePath
       , HM.HashMap HCE.HaskellModulePath HCE.DefinitionSiteMap
       , HM.HashMap HCE.HaskellModuleName (HM.HashMap HCE.ComponentId HCE.HaskellModulePath))
  
  type ModuleGhcData
     = ( DynFlags
       , TypecheckedModule
       , HomePackageTable
       , ExternalPackageState
       , ModSummary)
  
  createModuleInfo ::
       ModuleDependencies -- ^ Modules that have already been indexed
    -> ModuleGhcData -- ^ Data types from GHC
    -> HCE.HaskellModulePath -- ^ Current module path
    -> HCE.PackageId -- ^ Current package id
    -> HCE.ComponentId -- ^ Current build component id
    -> (T.Text, HCE.SourceCodePreprocessing) -- ^ Source code
    -> (HCE.ModuleInfo, ModuleDependencies, [TypeError])
  createModuleInfo (fileMap, defSiteMap, moduleNameMap) (flags, typecheckedModule, homePackageTable, externalPackageState, modSum) modulePath currentPackageId compId (originalSourceCode, sourceCodePreprocessing) =
    let globalRdrEnv = tcg_rdr_env . fst . tm_internals_ $ typecheckedModule
        modInfo = moduleInfo typecheckedModule
        (Just (hsGroup, _, _, _)) = renamedSource typecheckedModule
        exportedNamesSet = S.fromList $ modInfoExportsWithSelectors modInfo
        --------------------------------------------------------------------------------
        -- Preprocessed source
        --------------------------------------------------------------------------------
        (transformation, sourceCode') =
          prepareSourceCode
            sourceCodePreprocessing
            originalSourceCode
            modSum
            modulePath
        includedFiles = HM.keys $ HCE.fileIndex transformation
        --------------------------------------------------------------------------------
        -- Type environment
        --------------------------------------------------------------------------------
        (tcGblEnv, _) = tm_internals_ typecheckedModule
        currentModuleTyThings = typeEnvElts $ tcg_type_env tcGblEnv
        homePackageTyThings =
          concatMap (typeEnvElts . md_types . hm_details) $
  #if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
          eltsUDFM homePackageTable
  #else
          eltsUFM homePackageTable
  #endif
        externalPackagesTyThings = typeEnvElts $ eps_PTE externalPackageState
        typeEnv =
          mkTypeEnv
            (currentModuleTyThings ++
             homePackageTyThings ++ externalPackagesTyThings)
        --------------------------------------------------------------------------------
        -- Exported entities
        --------------------------------------------------------------------------------
        dataFamTyCons =
          mapMaybe
            (\case
               ATyCon tc
                 | isFamInstTyCon tc -> Just $ tyConName tc
               _ -> Nothing)
            currentModuleTyThings
        (defSites, allNames) =
          createDefinitionSiteMap
            flags
            currentPackageId
            compId
            defSiteMap
            fileMap
            globalRdrEnv
            transformation
            modInfo
            dataFamTyCons
            hsGroup
        --------------------------------------------------------------------------------
        -- Instance environment
        --------------------------------------------------------------------------------
        homeInstEnv = tcg_inst_env tcGblEnv
        visOrphanModules = tcVisibleOrphanMods tcGblEnv
        packageInstEnv = eps_inst_env externalPackageState
        instEnv = InstEnvs packageInstEnv homeInstEnv visOrphanModules
        --------------------------------------------------------------------------------
        declarations =
          createDeclarations flags hsGroup typeEnv exportedNamesSet transformation
        environment =
          Environment
            { envDynFlags = flags
            , envInstEnv = instEnv
            , envTypeEnv = typeEnv
            , envTransformation = transformation
            , envCurrentModuleDefSites = defSites
            , envFileMap = fileMap
            , envDefSiteMap = defSiteMap
            , envModuleNameMap = moduleNameMap
            , envPackageId = currentPackageId
            , envComponentId = compId
            , envExportedNames = exportedNamesSet
            }
        externalIds =
          L.foldl'
            (\acc name ->
               maybe
                 acc
                 (\id -> (HCE.ExternalIdentifierInfo $ mkIdentifierInfo environment id (Just name)) : acc)
                 (lookupIdInTypeEnv typeEnv name))
            []
            allNames
        currentModuleName =
          (\(Module _ name) ->
             HCE.HaskellModuleName . T.pack . moduleNameString $ name) .
          ms_mod $
          modSum
        SourceInfo {..} = foldAST environment typecheckedModule
     in (tidyInternalIds HCE.ModuleInfo
            { id = modulePath
            , transformation = transformation
            , name = currentModuleName
            , declarations = declarations
            , exprInfoMap = sourceInfoExprMap
            , idInfoMap = sourceInfoIdMap
            , idOccMap = sourceInfoIdOccMap
            , definitionSiteMap = defSites
            , source = V.fromList . T.splitOn "\n" $ sourceCode'
            , externalIds = externalIds
            }
        , if not $ isHsBoot modulePath
            then  (HM.union
                     (HM.fromList .
                      (( HCE.HaskellFilePath $ HCE.getHaskellModulePath modulePath
                       , modulePath) :) .
                      map (, modulePath) $
                      includedFiles)
                     fileMap
                 , HM.union (HM.singleton modulePath defSites) defSiteMap
                 , HM.insertWith HM.union currentModuleName
                     (HM.singleton compId modulePath) moduleNameMap)
            else (fileMap, defSiteMap, moduleNameMap)
         , sourceInfoTypeErrors)
  
  data SourceInfo = SourceInfo
    { sourceInfoExprMap :: HCE.ExpressionInfoMap
    , sourceInfoIdMap :: HCE.IdentifierInfoMap
    , sourceInfoIdOccMap :: HCE.IdentifierOccurrenceMap
    , sourceInfoTypeErrors :: [TypeError]
    } deriving (Show, Eq)
  
  tidyInternalIds :: HCE.ModuleInfo -> HCE.ModuleInfo
  tidyInternalIds modInfo = evalState (U.transformBiM tidy modInfo) (HM.empty, 0)
    where
      tidy ::
           HCE.InternalId -> State (HM.HashMap T.Text T.Text, Int) HCE.InternalId
      tidy (HCE.InternalId text) = do
        (hmap, number) <- get
        case HM.lookup text hmap of
          Just val -> return $ HCE.InternalId val
          Nothing -> do
            let nextInternalId = T.pack . show $ number
            put (HM.insert text nextInternalId hmap, number + 1)
            return $ HCE.InternalId nextInternalId
  
  prepareSourceCode ::
       HCE.SourceCodePreprocessing
    -> T.Text
    -> ModSummary
    -> HCE.HaskellModulePath
    -> (HCE.SourceCodeTransformation, T.Text)
  prepareSourceCode sourceCodePreprocessing originalSourceCode modSum modulePath =
    let sourceCodeAfterPreprocessing =
          case TE.decodeUtf8' $
               maybe
                 (error "ms_hspp_buf is Nothing")
                 stringBufferToByteString
                 (ms_hspp_buf modSum) of
            Right text -> T.replace "\t" "        " text
            Left err ->
              error $
              "decodeUtf8' : " ++ show err ++ " , file : " ++ show modulePath
     in case sourceCodePreprocessing of
          HCE.BeforePreprocessing ->
            let sourceCodeLines = T.splitOn "\n" originalSourceCode
             in ( HCE.SourceCodeTransformation
                    (length sourceCodeLines)
                    modulePath
                    S.empty
                    HM.empty
                , originalSourceCode)
          HCE.AfterPreprocessing ->
            createSourceCodeTransformation
              modulePath
              originalSourceCode
              sourceCodeAfterPreprocessing
  
  createDefinitionSiteMap ::
       DynFlags
    -> HCE.PackageId
    -> HCE.ComponentId
    -> HM.HashMap HCE.HaskellModulePath HCE.DefinitionSiteMap
    -> HM.HashMap HCE.HaskellFilePath HCE.HaskellModulePath
    -> GlobalRdrEnv
    -> HCE.SourceCodeTransformation
    -> ModuleInfo
    -> [Name]
  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
    -> HsGroup GhcRn
  #else
    -> HsGroup Name
  #endif
    -> (HCE.DefinitionSiteMap, [Name])
  createDefinitionSiteMap flags currentPackageId compId defSiteMap fileMap globalRdrEnv transformation modInfo dataFamTyCons hsGroup =
    let
  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
        allDecls :: [GenLocated SrcSpan (HsDecl GhcRn)]
  #endif
        allDecls = L.sortOn getLoc . ungroup $ hsGroup
        (instanceDeclsWithDocs, valueAndTypeDeclsWithDocs) =
          L.partition
            (\(L _ decl, _) ->
               case decl of
                 InstD {} -> True
                 _ -> False) $
          collectDocs allDecls
        --------------------------------------------------------------------------------
        -- Instances
        --------------------------------------------------------------------------------
        -- No type instances or data instances here for now
        instanceDocMap :: M.Map SrcSpan [HsDocString]
        instanceDocMap =
          M.fromList .
          mapMaybe
            (\(L _n decl, docs) ->
               case decl of
  #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
                 InstD _ (ClsInstD _ inst) -> Just (clsInstDeclSrcSpan inst, docs)
  #else
                 InstD (ClsInstD inst) -> Just (clsInstDeclSrcSpan inst, docs)
  #endif
                 _ -> Nothing) $
          instanceDeclsWithDocs
        nameLocation :: Maybe SrcSpan -> Name -> HCE.LocationInfo
        nameLocation =
          nameLocationInfo
            flags
            currentPackageId
            compId
            transformation
            fileMap
            defSiteMap
            Nothing
        docHToHtml :: DocH (ModuleName, OccName) Name -> HCE.HTML
        docHToHtml =
          docWithNamesToHtml
            flags
            currentPackageId
            compId
            transformation
            fileMap
            defSiteMap
        instancesWithDocumentation =
          HM.fromList .
          map
            (\clsInst ->
               ( instanceToText flags clsInst
               , let location =
                       nameLocation Nothing (Var.varName . is_dfun $ clsInst)
                  in case M.lookup (getSrcSpan clsInst) instanceDocMap of
                       Just hsDocString ->
                         HCE.DefinitionSite
                           location
                           (Just . docHToHtml . hsDocsToDocH flags globalRdrEnv $
                            hsDocString)
                       Nothing -> HCE.DefinitionSite location Nothing)) $
          modInfoInstances modInfo -- all instances (including derived)
        --------------------------------------------------------------------------------
        -- Values and types
        --------------------------------------------------------------------------------
        mainDeclNamesWithDocumentation =
          concatMap
            (\(L span decl, docs) -> map (, docs, span) $ getMainDeclBinder decl)
            valueAndTypeDeclsWithDocs
        dataFamTyConsWithoutDocs =
          map (\name -> (name, [], nameSrcSpan name)) dataFamTyCons
        allNamesWithDocumentation =
          mainDeclNamesWithDocumentation ++
          subordinateNamesWithDocs allDecls ++ dataFamTyConsWithoutDocs
        (valuesWithDocumentation, typesWithDocumentation) =
          L.partition
            (\(name, _doc, _srcSpan) ->
               case occNameNameSpace . nameOccName $ name of
                 HCE.VarName -> True
                 HCE.DataName -> True
                 _ -> False)
            allNamesWithDocumentation
        toHashMap ::
             [(Name, [HsDocString], SrcSpan)]
          -> HM.HashMap HCE.OccName HCE.DefinitionSite
        toHashMap =
          HM.fromListWith
            (\(HCE.DefinitionSite loc newDoc) (HCE.DefinitionSite _ oldDoc) ->
               (HCE.DefinitionSite loc $ mappend newDoc oldDoc)) .
          map
            (\(name, docs, srcSpan) ->
               let location = nameLocation (Just srcSpan) name
                   htmlDoc =
                     if not . null $ docs
                       then Just . docHToHtml . hsDocsToDocH flags globalRdrEnv $
                            docs
                       else Nothing
                in (HCE.OccName $ toText flags name, HCE.DefinitionSite location htmlDoc))
        --------------------------------------------------------------------------------
     in ( HCE.DefinitionSiteMap
            { HCE.values = toHashMap valuesWithDocumentation
            , HCE.types =
                toHashMap $ typesWithDocumentation ++ dataFamTyConsWithoutDocs
            , HCE.instances = instancesWithDocumentation
            }
        , map (\(n, _, _) -> n) allNamesWithDocumentation)
  
  occNameToHtml ::
       DynFlags
    -> HCE.PackageId
    -> HCE.ComponentId
    -> (ModuleName, OccName)
    -> H.Html
  occNameToHtml flags packageId compId (modName, occName) =
    let location =
          H.textValue . toStrict . encodeToLazyText . Aeson.toJSON $
          occNameLocationInfo flags packageId compId (modName, occName)
     in (H.span H.! H.dataAttribute "location" location) H.! A.class_ "link" $
        H.toHtml (toText flags occName)
  
  nameToHtml ::
       DynFlags
    -> HCE.PackageId
    -> HCE.ComponentId
    -> HCE.SourceCodeTransformation
    -> HM.HashMap HCE.HaskellFilePath HCE.HaskellModulePath
    -> HM.HashMap HCE.HaskellModulePath HCE.DefinitionSiteMap
    -> Name
    -> H.Html
  nameToHtml flags packageId compId transformation files defSiteMap name =
    let location =
          H.textValue . toStrict . encodeToLazyText . Aeson.toJSON $
          nameLocationInfo
            flags
            packageId
            compId
            transformation
            files
            defSiteMap
            Nothing
            Nothing
            name
     in H.span H.! H.dataAttribute "location" location H.! A.class_ "link" $
        H.toHtml (nameToText name)
  
  docWithNamesToHtml ::
       DynFlags
    -> HCE.PackageId
    -> HCE.ComponentId
    -> HCE.SourceCodeTransformation
    -> HM.HashMap HCE.HaskellFilePath HCE.HaskellModulePath
    -> HM.HashMap HCE.HaskellModulePath HCE.DefinitionSiteMap
    -> DocH (ModuleName, OccName) Name
    -> HCE.HTML
  docWithNamesToHtml flags packageId compId transformation fileMap defSiteMap =
    HCE.docToHtml
      (occNameToHtml flags packageId compId)
      (nameToHtml flags packageId compId transformation fileMap defSiteMap)
  
  createDeclarations ::
       DynFlags
  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
    -> HsGroup GhcRn
  #else
    -> HsGroup Name
  #endif
    -> TypeEnv
    -> S.Set Name
    -> HCE.SourceCodeTransformation
    -> [HCE.Declaration]
  createDeclarations flags hsGroup typeEnv exportedSet transformation =
    let lineNumber :: SrcSpan -> Int
        lineNumber srcSpan =
          case srcSpanToLineAndColNumbers transformation srcSpan of
            Just (_file,(lineNum, _), (_, _)) -> lineNum
            Nothing -> 1
        nameType :: Name -> Maybe HCE.Type
        nameType n =
          case lookupIdInTypeEnv typeEnv n of
            Just i -> Just . mkType flags . varType $ i
            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) =
          map
            (\name ->
               HCE.Declaration
                 HCE.ValD
                 (toText flags name)
                 (nameType name)
                 (S.member name exportedSet)
                 (lineNumber loc)) $
          collectHsBindBinders 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) =
          HCE.Declaration
            HCE.TyClD
            (T.append (tyClDeclPrefix tyClDecl) (toText flags $ tcdName tyClDecl))
            (nameType $ tcdName tyClDecl)
            (S.member (unLoc $ tyClDeclLName tyClDecl) exportedSet)
            (lineNumber loc)
        tyclds =
          map tyClToDeclaration .
          filter (isGoodSrcSpan . getLoc) . concatMap group_tyclds . hs_tyclds $
          hsGroup
        -- | Instances
        --------------------------------------------------------------------------------
  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
        instToDeclaration :: GenLocated SrcSpan (InstDecl GhcRn) -> HCE.Declaration
  #endif
        instToDeclaration (L loc inst) =
          HCE.Declaration
            HCE.InstD
            (instanceDeclToText flags inst)
            Nothing
            True
            (lineNumber loc)
        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
          hsGroup
        -- | Foreign functions
        --------------------------------------------------------------------------------
  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
        foreignFunToDeclaration ::
             GenLocated SrcSpan (ForeignDecl GhcRn) -> HCE.Declaration
  #endif
        foreignFunToDeclaration (L loc fd) =
          let name = unLoc $ fd_name fd
           in HCE.Declaration
                HCE.ForD
                (toText flags name)
                (nameType name)
                True
                (lineNumber loc)
        fords = map foreignFunToDeclaration $ hs_fords hsGroup
        --------------------------------------------------------------------------------
     in L.sortOn HCE.lineNumber $ vals ++ tyclds ++ insts ++ fords
  
  foldAST :: Environment -> TypecheckedModule -> SourceInfo
  foldAST environment typecheckedModule =
    let (Just renamed@(_, importDecls, mbExported, _)) =
          renamedSource typecheckedModule
        emptyASTState =
          ASTState IVM.empty IM.empty M.empty emptyTidyEnv Nothing environment []
        ASTState {..} =
          execState
            (foldTypecheckedSource $ tm_typechecked_source typecheckedModule)
            emptyASTState
        -- A few things that are not in the output of the typechecker:
        --     - the export list
        --     - the imports
        --     - type signatures
        --     - type/data/newtype declarations
        --     - class declarations
  
        -- Both typechecked source and renamed source are used to populate
        -- 'IdentifierInfoMap' and 'IdentifierOccurrenceMap'
        (idInfoMap, idOccMap) =
          L.foldl'
            (addIdentifierToMaps environment astStateIdSrcSpanMap)
            (HM.empty, astStateIdOccMap)
            (namesFromRenamedSource renamed)
        flags = envDynFlags environment
        packageId = envPackageId environment
        compId = envComponentId environment
        importedModules =
          map
            ((\(L span modName) ->
                ( modName
                , span
                , moduleLocationInfo
                    flags
                    (envModuleNameMap environment)
                    packageId
                    compId
                    modName)) .
             ideclName . unLoc) .
          filter (not . ideclImplicit . unLoc) $
          importDecls
        exportedModules =
          case mbExported of
            Just lieNames ->
              mapMaybe
  #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
                (\(L span ie,_) ->
  #else
                (\(L span ie) ->
  #endif
                   case ie of
  #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
                     IEModuleContents _ (L _ modName) ->
  #else
                     IEModuleContents (L _ modName) ->
  #endif
                       Just
                         ( modName
                         , span
                         , moduleLocationInfo
                             flags
                             (envModuleNameMap environment)
                             packageId
                             compId
                             modName)
                     _ -> Nothing)
                lieNames
            Nothing -> []
        addImportedAndExportedModulesToIdOccMap ::
             HCE.IdentifierOccurrenceMap -> HCE.IdentifierOccurrenceMap
        addImportedAndExportedModulesToIdOccMap =
          IM.map (L.sortOn fst) .
          addModules
            (envTransformation environment)
            (importedModules ++ exportedModules)
     in SourceInfo
          { sourceInfoExprMap = astStateExprInfoMap
          , sourceInfoIdMap = idInfoMap
          , sourceInfoIdOccMap = addImportedAndExportedModulesToIdOccMap idOccMap
          , sourceInfoTypeErrors = astStateTypeErrors
          }
  
  -- | Updates 'IdentifierOccurrenceMap' and 'IdentifierInfoMap' using information
  -- from typechecked source and renamed source
  addIdentifierToMaps ::
       Environment
    -> M.Map SrcSpan (Id, Maybe (Type, [Type]))
    -> (HCE.IdentifierInfoMap, HCE.IdentifierOccurrenceMap)
    -> NameOccurrence
    -> (HCE.IdentifierInfoMap, HCE.IdentifierOccurrenceMap)
  addIdentifierToMaps environment idSrcSpanMap idMaps@(idInfoMap, idOccMap) nameOcc
    | isGoodSrcSpan (getLoc $ locatedName nameOcc) &&
        isOneLineSpan (getLoc $ locatedName nameOcc)
    , Just (_, (lineNumber, startCol), (_, endCol)) <-
       srcSpanToLineAndColNumbers (envTransformation environment) .
       getLoc . locatedName $
       nameOcc =
      case nameOcc of
        TyLitOccurrence {kind = kind} ->
          addNameToMaps
            environment
            idMaps
            (Just kind)
            Nothing
            (description nameOcc)
            lineNumber
            startCol
            endCol
        NameOccurrence {isBinder = isBinder} ->
          case lookupIdByNameOccurrence environment idSrcSpanMap nameOcc of
            Just (identifier, mbTypes) ->
              let name =
                    fromMaybe
                      (Var.varName identifier)
                      (unLoc $ locatedName nameOcc)
                  identifierType = varType identifier
                  identifierTypeExpanded = expandTypeSynonyms identifierType
                  tyConsAndTyVars =
                    map
                      (, Nothing)
                      (tyConsOfType identifierType ++
                       tyVarsOfType identifierType ++
                       tyConsOfType identifierTypeExpanded ++
                       tyVarsOfType identifierTypeExpanded ++
                       maybe [] (tyConsOfType . fst) mbTypes ++
                       maybe [] (tyVarsOfType . fst) mbTypes)
                  idInfoMap' =
                    updateIdMap
                      environment
                      ((identifier, unLoc $ locatedName nameOcc) : tyConsAndTyVars)
                      idInfoMap
                  idOcc =
                    mkIdentifierOccurrence
                      environment
                      identifier
                      name
                      mbTypes
                      isBinder
                      (description nameOcc)
                  idOccMap' =
                    IM.insertWith
                      removeOverlappingInterval
                      lineNumber
                      [((startCol, endCol), idOcc)]
                      idOccMap
               in (idInfoMap', idOccMap')
            Nothing -- type variable or an internal identifier in a pattern synonym
             ->
              case unLoc $ locatedName nameOcc of
                Just name ->
                  addNameToMaps
                    environment
                    idMaps
                    Nothing
                    (Just name)
                    (description nameOcc)
                    lineNumber
                    startCol
                    endCol
                Nothing -> idMaps
  addIdentifierToMaps _ _ idMaps _ = idMaps
  
  addNameToMaps ::
       Environment
    -> (HCE.IdentifierInfoMap, HCE.IdentifierOccurrenceMap)
    -> Maybe Type
    -> Maybe Name
    -> T.Text
    -> Int
    -> Int
    -> Int
    -> (HCE.IdentifierInfoMap, HCE.IdentifierOccurrenceMap)
  addNameToMaps environment (idInfoMap, idOccMap) mbKind mbName descr lineNumber colStart colEnd =
    let flags = envDynFlags environment
        idInfoMap' =
          maybe
            idInfoMap
            (\kind ->
               updateIdMap
                 environment
                 (map (, Nothing) $ tyConsOfType kind ++ tyVarsOfType kind)
                 idInfoMap)
            mbKind
        idOcc =
          HCE.IdentifierOccurrence
            { internalId = fmap (HCE.InternalId . nameKey) mbName
            , internalIdFromRenamedSource =
                HCE.InternalId . T.pack . show . getKey . nameUnique <$> mbName
            , isBinder = False
            , instanceResolution = Nothing
            , idOccType = mkType flags <$> mbKind
            , typeArguments = Nothing
            , description = descr
            , sort =
                maybe
                  HCE.TypeId
                  (\name ->
                     case occNameNameSpace . nameOccName $ name of
                       HCE.VarName -> HCE.ValueId
                       HCE.DataName -> HCE.ValueId
                       _ -> HCE.TypeId)
                  mbName
            }
        idOccMap' =
          IM.insertWith
            removeOverlappingInterval
            lineNumber
            [((colStart, colEnd), idOcc)]
            idOccMap
     in (idInfoMap', idOccMap')
  
  lookupIdByNameOccurrence ::
       Environment
    -> M.Map SrcSpan (Id, Maybe (Type, [Type]))
    -> NameOccurrence
    -> Maybe (Id, Maybe (Type, [Type]))
  lookupIdByNameOccurrence environment idSrcSpanMap (NameOccurrence (L span mbName) _ _) =
    case M.lookup span idSrcSpanMap of
      Just (identifier, mbTypes) -> Just (identifier, mbTypes)
      Nothing ->
        case mbName of
          Just name ->
            case M.lookup (nameSrcSpan name) idSrcSpanMap of
              -- LHS of a Match
              Just (identifier, mbTypes) -> Just (identifier, mbTypes)
              Nothing ->
                -- Things that are not in the typechecked source
                case lookupIdInTypeEnv (envTypeEnv environment) name of
                  Just t -> Just (t, Nothing)
                  Nothing -> Nothing
          Nothing -> Nothing
  lookupIdByNameOccurrence _ _ TyLitOccurrence {..} = Nothing
  
  updateIdMap ::
       Environment
    -> [(Id, Maybe Name)]
    -> HCE.IdentifierInfoMap
    -> HCE.IdentifierInfoMap
  updateIdMap environment ids identifiersMap =
    let flags = envDynFlags environment
        update ::
             HCE.IdentifierInfoMap -> (Id, Maybe Name) -> HCE.IdentifierInfoMap
        update idMap (identifier, mbName) =
          let info = mkIdentifierInfo environment identifier mbName
           in HM.insertWith
                (flip const)
                (HCE.InternalId $ identifierKey flags identifier)
                info
                idMap
     in L.foldl' update identifiersMap ids
  
  addModules ::
       HCE.SourceCodeTransformation
    -> [(ModuleName, SrcSpan, HCE.LocationInfo)]
    -> HCE.IdentifierOccurrenceMap
    -> HCE.IdentifierOccurrenceMap
  addModules transformation modules idMap =
    let update ::
             IM.IntMap [((Int, Int), HCE.IdentifierOccurrence)]
          -> (a, SrcSpan, HCE.LocationInfo)
          -> IM.IntMap [((Int, Int), HCE.IdentifierOccurrence)]
        update idOccMap (_modInfo, span, locInfo)
          | Just (_file,(lineNumber, colStart), (_, colEnd)) <-
             srcSpanToLineAndColNumbers transformation span =
            let idOcc =
                  HCE.IdentifierOccurrence
                    { internalId = Nothing
                    , internalIdFromRenamedSource = Nothing
                    , isBinder = False
                    , instanceResolution = Nothing
                    , idOccType = Nothing
                    , typeArguments = Nothing
                    , description = "ImportDecl"
                    , sort = HCE.ModuleId locInfo
                    }
             in IM.insertWith
                  removeOverlappingInterval
                  lineNumber
                  [((colStart, colEnd), idOcc)]
                  idOccMap
        update idOccMap _ = idOccMap
     in L.foldl' update idMap modules
  