Initial commit

7 files changed, 5296 insertions, 0 deletions

diff --git a/src/HaskellCodeExplorer/AST/RenamedSource.hs b/src/HaskellCodeExplorer/AST/RenamedSource.hs
new file mode 100644
index 0000000..c1bf463
--- /dev/null
+++ b/src/HaskellCodeExplorer/AST/RenamedSource.hs
@@ -0,0 +1,498 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StrictData #-}
+
+module HaskellCodeExplorer.AST.RenamedSource
+  ( NameOccurrence(..)
+  , namesFromRenamedSource
+  ) where
+
+import BasicTypes (TupleSort(..))
+import BooleanFormula (BooleanFormula(..))
+import Data.Generics (Data, everything, extQ, mkQ)
+import Data.Maybe (Maybe(..), mapMaybe)
+import qualified Data.Text as T (Text)
+import GHC
+  ( AmbiguousFieldOcc(..)
+  , ConDecl(..)
+  , ConDeclField(..)
+  , DataFamInstDecl(..)
+  , FamilyDecl(..)
+  , FieldOcc(..)
+  , FixitySig(..)
+  , ForeignDecl(..)
+  , GenLocated(..)
+  , HsBindLR(..)
+  , HsExpr(..)
+  , HsPatSynDetails(..)
+  , HsRecField'(..)
+  , HsTupleSort(..)
+  , HsTyLit(..)
+  , HsTyPats
+  , HsTyVarBndr(..)
+  , HsType(..)
+  , IE(..)
+  , LHsBindLR
+  , LHsExpr
+  , LHsQTyVars(..)
+  , LHsType
+  , LPat
+  , LSig
+  , LTyClDecl
+  , Located
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+  , HsMatchContext(..)
+  , Match(..)
+#else
+  , m_fixity
+  , MatchFixity(..)
+#endif
+  , MatchGroup(..)
+  , Name
+  , Pat(..)
+  , PatSynBind(..)
+  , Sig(..)
+  , TyClDecl(..)
+  , TyFamEqn(..)
+  , Type
+  , unLoc
+  )
+import HaskellCodeExplorer.GhcUtils (hsPatSynDetails, ieLocNames)
+import Prelude hiding (span)
+import TysWiredIn
+  ( nilDataConName  
+  , tupleTyConName
+  , typeNatKind
+  , typeSymbolKind
+  )
+data NameOccurrence
+  = NameOccurrence { locatedName :: Located (Maybe Name)
+                   , description :: T.Text
+                   , isBinder :: Bool }
+  | TyLitOccurrence { locatedName :: Located (Maybe Name)
+                    , description :: T.Text
+                    , kind :: Type }
+
+-- | Here we are only interested in a small subset of all AST nodes, so it is
+-- convenient to use generic functions
+namesFromRenamedSource :: (Data a) => a -> [NameOccurrence]
+namesFromRenamedSource =
+  everything
+    (++)
+    ([] `mkQ` hsExprNames `extQ` matchGroupNames `extQ` bindNames `extQ`
+     patNames `extQ`
+     sigNames `extQ`
+     hsTypeNames `extQ`
+     tyClDeclNames `extQ`
+     familyDeclNames `extQ`
+     tyFamilyEqNames `extQ`
+     tyFamilyDefEqNames `extQ`
+     dataFamInstDeclNames `extQ`
+     conDeclNames `extQ`
+     importNames `extQ`
+     hsTyVarBndrNames `extQ`
+     hsPatSynDetailsNames `extQ`
+     conDeclFieldNames `extQ`
+     hsRecFieldExprNames `extQ`
+     hsRecAmbFieldExprNames `extQ`
+     hsRecFieldPatNames `extQ`
+     foreignDeclNames)
+
+fieldOccName :: Bool -> FieldOcc Name -> NameOccurrence
+fieldOccName isBinder (FieldOcc (L span _) name) =
+  NameOccurrence
+    { locatedName = L span (Just name)
+    , description = "FieldOcc"
+    , isBinder = isBinder
+    }
+
+conDeclFieldNames :: ConDeclField Name -> [NameOccurrence]
+conDeclFieldNames ConDeclField {..} =
+  map (fieldOccName True . unLoc) cd_fld_names
+
+hsRecFieldExprNames ::
+     HsRecField' (FieldOcc Name) (LHsExpr Name) -> [NameOccurrence]
+hsRecFieldExprNames HsRecField {..} = [fieldOccName False $ unLoc hsRecFieldLbl]
+
+hsRecAmbFieldExprNames ::
+     HsRecField' (AmbiguousFieldOcc Name) (LHsExpr Name) -> [NameOccurrence]
+hsRecAmbFieldExprNames HsRecField {..} =
+  let (L span recField) = hsRecFieldLbl
+      mbName =
+        case recField of
+          Ambiguous _ _ -> Nothing
+          Unambiguous _ name -> Just name
+   in [ NameOccurrence
+          { locatedName = L span mbName
+          , description = "AmbiguousFieldOcc"
+          , isBinder = False
+          }
+      ]
+
+hsRecFieldPatNames ::
+     HsRecField' (FieldOcc Name) (LPat Name) -> [NameOccurrence]
+hsRecFieldPatNames HsRecField {..} = [fieldOccName False $ unLoc hsRecFieldLbl]
+
+hsExprNames :: LHsExpr Name -> [NameOccurrence]
+hsExprNames (L _span (HsVar name)) =
+  [ NameOccurrence
+    { locatedName = Just <$> name
+    , description = "HsVar"
+    , isBinder = False
+    }
+  ]
+hsExprNames (L span (ExplicitList _ _ exprs))
+  | null exprs =
+    [ NameOccurrence
+      { locatedName = L span $ Just nilDataConName
+      , description = "ExplicitList"
+      , isBinder = False
+      }
+    ]
+  | otherwise = []
+hsExprNames (L _span (RecordCon name _conLike _instFun _binds)) =
+  [ NameOccurrence
+    { locatedName = Just <$> name
+    , description = "RecordCon"
+    , isBinder = False
+    }
+  ]
+hsExprNames (L _span (HsRecFld (Unambiguous (L span _) name))) =
+  [ NameOccurrence
+    { locatedName = L span (Just name)
+    , description = "HsRecFld"
+    , isBinder = False
+    }
+  ]
+hsExprNames (L _span (HsRecFld (Ambiguous (L span _) _name))) =
+  [ NameOccurrence
+    { locatedName = L span Nothing
+    , description = "HsRecFld"
+    , isBinder = False
+    }
+  ]
+hsExprNames _ = []
+
+matchGroupNames :: MatchGroup Name (LHsExpr Name) -> [NameOccurrence]
+matchGroupNames =
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)      
+  mapMaybe (fmap toNameOcc . matchContextName . m_ctxt . unLoc) .
+#else
+  mapMaybe (fmap toNameOcc . matchFixityName . m_fixity . unLoc) .
+#endif
+  unLoc . mg_alts
+  where
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)    
+    matchContextName :: HsMatchContext Name -> Maybe (Located Name)
+    matchContextName (FunRhs name _ _bool) = Just name
+    matchContextName _ = Nothing   
+#else
+    matchFixityName :: MatchFixity Name -> Maybe (Located Name)
+    matchFixityName NonFunBindMatch = Nothing
+    matchFixityName (FunBindMatch name _bool) = Just name
+#endif
+    toNameOcc :: Located Name -> NameOccurrence
+    toNameOcc n =
+      NameOccurrence
+        {locatedName = Just <$> n, description = "Match", isBinder = True}
+
+bindNames :: LHsBindLR Name Name -> [NameOccurrence]
+bindNames (L _span (PatSynBind PSB {..})) =
+  [ NameOccurrence
+      { locatedName = Just <$> psb_id
+      , description = "PatSynBind"
+      , isBinder = True
+      }
+  ]
+bindNames _ = []
+
+hsPatSynDetailsNames :: HsPatSynDetails (Located Name) -> [NameOccurrence]
+hsPatSynDetailsNames =
+  map
+    (\name ->
+       NameOccurrence
+         { locatedName = Just <$> name
+         , description = "HsPatSynDetails"
+         , isBinder = True
+         }) .
+  hsPatSynDetails
+
+importNames :: IE Name -> [NameOccurrence]
+importNames =
+  map
+    (\name ->
+        NameOccurrence
+        { locatedName = Just <$> name
+        , description = "IE"
+        , isBinder = False
+        }) .
+  ieLocNames
+
+patNames :: LPat Name -> [NameOccurrence]
+patNames (L _span (VarPat name)) =
+  [ NameOccurrence
+    { locatedName = Just <$> name
+    , description = "VarPat"
+    , isBinder = True
+    }
+  ]
+patNames (L _span (ConPatIn name _)) =
+  [ NameOccurrence
+    { locatedName = Just <$> name
+    , description = "ConPatIn"
+    , isBinder = False
+    }
+  ]
+patNames (L _span (AsPat name _)) =
+  [ NameOccurrence
+    { locatedName = Just <$> name
+    , description = "AsPat"
+    , isBinder = True
+    }
+  ]
+patNames (L _span (NPlusKPat name _ _ _ _ _)) =
+  [ NameOccurrence
+    { locatedName = Just <$> name
+    , description = "NPlusKPat"
+    , isBinder = True
+    }
+  ]
+patNames _ = []
+
+sigNames :: LSig Name -> [NameOccurrence]
+sigNames (L _span (TypeSig names _)) =
+  map
+    (\n ->
+        NameOccurrence
+        { locatedName = Just <$> n
+        , description = "TypeSig"
+        , isBinder = False
+        })
+    names
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)    
+sigNames (L _span (PatSynSig names _)) =
+  map (\name -> NameOccurrence (Just <$> name) "PatSynSig" False) names
+#else
+sigNames (L _span (PatSynSig name _)) =
+  [ NameOccurrence
+    { locatedName = Just <$> name
+    , description = "PatSynSig"
+    , isBinder = False
+    }
+  ]
+#endif
+sigNames (L _span (ClassOpSig _ names _)) =
+  map
+    (\n ->
+        NameOccurrence
+        { locatedName = Just <$> n
+        , description = "ClassOpSig"
+        , isBinder = True
+        })
+    names
+sigNames (L _span (FixSig (FixitySig names _))) =
+  map
+    (\n ->
+        NameOccurrence
+        { locatedName = Just <$> n
+        , description = "FixitySig"
+        , isBinder = False
+        })
+    names
+sigNames (L _span (InlineSig name _)) =
+  [ NameOccurrence
+    { locatedName = Just <$> name
+    , description = "InlineSig"
+    , isBinder = False
+    }
+  ]
+sigNames (L _span (SpecSig name _ _)) =
+  [ NameOccurrence
+    { locatedName = Just <$> name
+    , description = "SpecSig"
+    , isBinder = False
+    }
+  ]
+sigNames (L _span (MinimalSig _ (L _ boolFormula))) =
+  map
+    (\n ->
+        NameOccurrence
+        { locatedName = Just <$> n
+        , description = "MinimalSig"
+        , isBinder = False
+        }) .
+  boolFormulaNames $
+  boolFormula
+  where
+    boolFormulaNames :: BooleanFormula name -> [name]
+    boolFormulaNames (Var a) = [a]
+    boolFormulaNames (And fs) = concatMap (boolFormulaNames . unLoc) fs
+    boolFormulaNames (Or fs) = concatMap (boolFormulaNames . unLoc) fs
+    boolFormulaNames (Parens (L _ f)) = boolFormulaNames f
+sigNames (L _ _) = []
+
+hsTypeNames :: LHsType Name -> [NameOccurrence]
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+hsTypeNames (L _span (HsTyVar _promoted name)) =
+#else
+hsTypeNames (L _span (HsTyVar name)) =
+#endif
+  [ NameOccurrence
+    { locatedName = Just <$> name
+    , description = "HsTyVar"
+    , isBinder = False
+    }
+  ]
+hsTypeNames (L span (HsTyLit lit)) =
+  let kind =
+        case lit of
+          HsNumTy _ _ -> typeNatKind
+          HsStrTy _ _ -> typeSymbolKind
+  in [ TyLitOccurrence
+       { locatedName = L span Nothing
+       , description = "HsTyLit"
+       , kind = kind
+       }
+     ]
+hsTypeNames (L _span (HsOpTy _ name _)) =
+  [ NameOccurrence
+    { locatedName = Just <$> name
+    , description = "HsOpTy"
+    , isBinder = False
+    }
+  ]
+hsTypeNames (L span (HsTupleTy tupleSort types))
+  | null types =
+    let sort =
+          case tupleSort of
+            HsUnboxedTuple -> UnboxedTuple
+            HsBoxedTuple -> BoxedTuple
+            HsConstraintTuple -> ConstraintTuple
+            HsBoxedOrConstraintTuple -> BoxedTuple
+    in [ NameOccurrence
+         { locatedName = L span (Just $ tupleTyConName sort 0)
+         , description = "HsTupleTy"
+         , isBinder = False
+         }
+       ]
+  | otherwise = []
+--https://ghc.haskell.org/trac/ghc/ticket/13737    
+--hsTypeNames (L span (HsExplicitListTy _kind types)) = ...
+--hsTypeNames (L span (HsExplicitTupleTy _kind types)) = ...
+hsTypeNames _ = []
+
+hsTyVarBndrNames :: HsTyVarBndr Name -> [NameOccurrence]
+hsTyVarBndrNames (UserTyVar n) =
+  [ NameOccurrence
+    { locatedName = Just <$> n
+    , description = "UserTyVar"
+    , isBinder = True
+    }
+  ]
+hsTyVarBndrNames (KindedTyVar n _) =
+  [ NameOccurrence
+    { locatedName = Just <$> n
+    , description = "KindedTyVar"
+    , isBinder = True
+    }
+  ]
+
+tyClDeclNames :: LTyClDecl Name -> [NameOccurrence]
+tyClDeclNames (L _span DataDecl {..}) =
+  [ NameOccurrence
+    { locatedName = Just <$> tcdLName
+    , description = "DataDecl"
+    , isBinder = True
+    }
+  ]
+tyClDeclNames (L _span SynDecl {..}) =
+  [ NameOccurrence
+    { locatedName = Just <$> tcdLName
+    , description = "SynDecl"
+    , isBinder = True
+    }
+  ]
+tyClDeclNames (L _span ClassDecl {..}) =
+  NameOccurrence
+  { locatedName = Just <$> tcdLName
+  , description = "ClassDecl"
+  , isBinder = True
+  } :
+  concatMap
+    ((\(names1, names2) -> map toNameOcc names1 ++ map toNameOcc names2) . unLoc)
+    tcdFDs
+  where
+    toNameOcc :: Located Name -> NameOccurrence
+    toNameOcc n =
+      NameOccurrence
+      { locatedName = Just <$> n
+      , description = "FunDep"
+      , isBinder = False
+      }
+tyClDeclNames _ = []
+
+familyDeclNames :: FamilyDecl Name -> [NameOccurrence]
+familyDeclNames FamilyDecl {..} =
+  [ NameOccurrence
+    { locatedName = Just <$> fdLName
+    , description = "FamilyDecl"
+    , isBinder = True
+    }
+  ]
+
+tyFamilyEqNames :: TyFamEqn Name (HsTyPats Name) -> [NameOccurrence]
+tyFamilyEqNames TyFamEqn {tfe_tycon = tyCon} =
+  [ NameOccurrence
+    { locatedName = Just <$> tyCon
+    , description = "TyFamEqn"
+    , isBinder = False
+    }
+  ]
+
+tyFamilyDefEqNames :: TyFamEqn Name (LHsQTyVars Name) -> [NameOccurrence]
+tyFamilyDefEqNames TyFamEqn {tfe_tycon = tyCon} =
+  [ NameOccurrence
+    { locatedName = Just <$> tyCon
+    , description = "TyFamEqn"
+    , isBinder = False
+    }
+  ]
+
+dataFamInstDeclNames :: DataFamInstDecl Name -> [NameOccurrence]
+dataFamInstDeclNames DataFamInstDecl {dfid_tycon = tyCon} =
+  [ NameOccurrence
+    { locatedName = Just <$> tyCon
+    , description = "DataFamInstDecl"
+    , isBinder = False
+    }
+  ]
+
+conDeclNames :: ConDecl Name -> [NameOccurrence]
+conDeclNames con =
+  case con of
+    ConDeclGADT {con_names = names} ->
+      map
+        (\n ->
+            NameOccurrence
+            { locatedName = Just <$> n
+            , description = "ConDeclGADT"
+            , isBinder = True
+            })
+        names
+    ConDeclH98 {con_name = name} ->
+      [ NameOccurrence
+        { locatedName = Just <$> name
+        , description = "ConDeclH98"
+        , isBinder = True
+        }
+      ]
+
+foreignDeclNames :: ForeignDecl Name -> [NameOccurrence]
+foreignDeclNames decl =
+  [ NameOccurrence
+    { locatedName = Just <$> fd_name decl
+    , description = "ForeignDecl"
+    , isBinder = True
+    }
+  ]
diff --git a/src/HaskellCodeExplorer/AST/TypecheckedSource.hs b/src/HaskellCodeExplorer/AST/TypecheckedSource.hs
new file mode 100644
index 0000000..f97c33b
--- /dev/null
+++ b/src/HaskellCodeExplorer/AST/TypecheckedSource.hs
@@ -0,0 +1,1231 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StrictData #-}
+
+module HaskellCodeExplorer.AST.TypecheckedSource
+  ( ASTState(..)
+  , Environment(..)
+  , TypeError(..)
+  , foldTypecheckedSource
+  , mkIdentifierInfo
+  , mkIdentifierOccurrence
+  , mkType
+  , removeOverlappingInterval
+  ) where
+
+import Bag (bagToList)
+import BasicTypes (Origin(..))
+import Class (Class, classTyVars)
+import ConLike (ConLike(..),conLikeWrapId_maybe)
+import Control.Monad (return, unless, void)
+import Control.Monad.State.Strict (State, get, modify')
+import qualified Data.HashMap.Strict as HM
+import qualified Data.IntMap.Strict as IM
+import qualified Data.IntervalMap.Strict as IVM
+import qualified Data.Map.Strict as M
+import Data.Maybe (Maybe, fromMaybe, mapMaybe)
+import qualified Data.Set as S
+import qualified Data.Text as T
+import DataCon (dataConWorkId)
+import DynFlags (DynFlags)
+import FastString (mkFastString)
+import HaskellCodeExplorer.GhcUtils
+import qualified HaskellCodeExplorer.Types as HCE
+import HsBinds (HsPatSynDetails(..), RecordPatSynField(..))
+import HsSyn
+  ( ABExport(..)
+  , ApplicativeArg(..)
+  , ArithSeqInfo(..)
+  , FieldOcc(..)
+  , GRHS(..)
+  , GRHSs(..)
+  , HsBindLR(..)
+  , HsCmd(..)
+  , HsCmdTop(..)
+  , HsConDetails(..)
+  , HsConPatDetails
+  , HsExpr(..)
+  , HsLocalBindsLR(..)
+  , HsOverLit(..)
+  , HsRecField'(..)
+  , HsRecFields(..)
+  , HsTupArg(..)
+  , HsValBindsLR(..)
+  , HsValBindsLR(..)
+  , LGRHS
+  , LHsBindLR
+  , LHsBinds
+  , LHsCmd
+  , LHsCmd
+  , LHsCmdTop
+  , LHsExpr
+  , LHsRecField
+  , LHsRecUpdField
+  , LHsTupArg
+  , LMatch
+  , LPat
+  , LStmtLR
+  , Match(..)
+  , Match(..)
+  , MatchGroup(..)
+  , ParStmtBlock(..)
+  , Pat(..)
+  , PatSynBind(..)
+  , StmtLR(..)
+  , selectorAmbiguousFieldOcc
+  )
+import HscTypes (TypeEnv, lookupTypeEnv)
+import Id (idType)
+import IdInfo (IdDetails(..))
+import InstEnv
+  ( ClsInst(..)
+  , InstEnvs
+  , instanceSig
+  , is_dfun
+  , lookupUniqueInstEnv
+  )
+import Name (Name, nameOccName, nameUnique)
+import Prelude hiding (span)
+import SrcLoc (GenLocated(..), SrcSpan(..), isGoodSrcSpan, isOneLineSpan, unLoc)
+import TcEvidence (HsWrapper(..))
+import TcHsSyn (conLikeResTy, hsLitType)
+import Type
+  ( TyThing(..)
+  , Type
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+  , nonDetCmpTypes
+#else
+  , cmpTypes  
+#endif
+  , eqTypes
+  , eqType
+  , getClassPredTys_maybe
+  , mkFunTy
+  , mkFunTys
+  , splitForAllTys
+  , splitFunTy_maybe
+  , splitFunTys
+  , substTys
+  , tidyOpenType
+  , zipTvSubst
+  )
+import TysWiredIn (mkListTy, mkTupleTy)
+import Unique (getKey)
+import Var (Id, Var, idDetails, isId, setVarName, setVarType, varName, varType)
+import VarEnv (TidyEnv)
+
+data ASTState = ASTState
+  { astStateExprInfoMap :: !HCE.ExpressionInfoMap
+  -- ^ Type of each expression
+  , astStateIdOccMap :: !HCE.IdentifierOccurrenceMap
+  -- ^ Each occurrence of an identifier in a source code
+  , astStateIdSrcSpanMap :: !(M.Map SrcSpan (Var, Maybe (Type, [Type])))
+  -- ^ Intermediate data structure that is used to populate 'IdentifierOccurrenceMap'
+  -- and 'IdentifierInfoMap'.
+  -- 'SrcSpan' - location of an identifier in a source code
+  -- 'Type' - 'expected' type of an identifier
+  -- '[Type]' - types at which type variables are instantiated
+  , astStateTidyEnv :: !TidyEnv
+  -- ^ 'TidyEnv' is used to prevent name clashes of free type variables.
+  -- ('TidyEnv' contains all free type variables in scope)
+  , astStateHsWrapper :: !(Maybe HsWrapper)
+  -- ^ HsWrapper comes from 'HsWrap' constructor of 'HsExpr' datatype.
+  , astStateEnv :: !Environment
+  -- ^ 'Environment' doesn't change
+  , astStateTypeErrors :: [TypeError]
+  -- ^ Non-empty list of TypeError's indicates that most likely there is a bug in
+  -- a fold_something function in this module.
+  }
+
+-- | A 'TypeError' means that an assumption about a type of an AST node is incorrect.
+data TypeError = TypeError
+  { typeErrorSrcSpan :: SrcSpan
+  , typeErrorMessage :: T.Text
+  , typeErrorASTNodeName :: T.Text
+  } deriving (Show, Eq)
+
+data Environment = Environment
+  { envDynFlags :: DynFlags
+  , envTypeEnv :: TypeEnv
+  , envInstEnv :: InstEnvs
+  , envTransformation :: HCE.SourceCodeTransformation
+  , envPackageId :: HCE.PackageId
+  , envCurrentModuleDefSites :: HCE.DefinitionSiteMap
+  , envFileMap :: HM.HashMap HCE.HaskellFilePath HCE.HaskellModulePath
+  , envDefSiteMap :: HM.HashMap HCE.HaskellModulePath HCE.DefinitionSiteMap
+  , envModuleNameMap :: HM.HashMap HCE.HaskellModuleName (HM.HashMap HCE.ComponentId HCE.HaskellModulePath)
+  , envExportedNames :: S.Set Name
+  , envComponentId :: HCE.ComponentId
+  }
+
+-- | Indicates whether an expression consists of more than one token.
+-- Simple expression : wildcard, literal
+-- Composite expressin : applcation, lambda abstraction,...
+data ExprSort
+  = Simple
+  | Composite
+  deriving (Show, Eq)
+
+exprSort :: HsExpr a -> ExprSort
+exprSort (HsVar _) = Simple
+exprSort (HsIPVar _) = Simple
+exprSort (HsOverLit _) = Simple
+exprSort (HsLit _) = Simple
+exprSort (ExplicitTuple args _)
+  | null args = Simple
+  | otherwise = Composite   
+exprSort (ExplicitList _ _ args) 
+  | null args = Simple
+  | otherwise = Composite     
+exprSort _ = Composite
+
+patSort :: Pat a -> ExprSort
+patSort (WildPat _typ) = Simple
+patSort (LitPat _lit) = Simple
+patSort NPat {} = Simple
+patSort (ListPat pats _ _) 
+  | null pats = Simple
+  | otherwise = Composite       
+patSort (TuplePat pats _ _)
+  | null pats = Simple
+  | otherwise = Composite
+patSort _ = Composite
+
+-- | Splits a type of a function, adds 'TypeError' to 'ASTState'
+-- in case of failure.
+splitFunTySafe ::
+     SrcSpan -> T.Text -> Type -> State ASTState (Maybe (Type, Type))
+splitFunTySafe srcSpan astNode typ =
+  case splitFunTy_maybe typ of
+    Just (ty1, ty2) -> return $ Just (ty1, ty2)
+    Nothing -> do
+      flags <- envDynFlags . astStateEnv <$> get
+      let typeError =
+            TypeError
+              { typeErrorSrcSpan = srcSpan
+              , typeErrorMessage = T.append "splitFunTy : " $ toText flags typ
+              , typeErrorASTNodeName = astNode
+              }
+      modify'
+        (\st -> st {astStateTypeErrors = typeError : astStateTypeErrors st})
+      return Nothing
+      
+-- | Splits a type of a function of two arguments, adds
+-- 'TypeError' to 'ASTState' in case of a failure.
+splitFunTy2Safe ::
+     SrcSpan -> T.Text -> Type -> State ASTState (Maybe (Type, Type, Type))
+splitFunTy2Safe srcSpan astNode typ = do
+  tys <- splitFunTySafe srcSpan astNode typ
+  case tys of
+    Just (arg1, ty1) -> do
+      res <- splitFunTySafe srcSpan astNode ty1
+      case res of
+        Just (arg2, ty2) -> return $ Just (arg1, arg2, ty2)
+        Nothing -> return Nothing
+    Nothing -> return Nothing
+ 
+-- | Returns result type of a function, adds 'TypeError' to
+-- 'ASTState' in case of a failure.
+funResultTySafe :: SrcSpan -> T.Text -> Type -> State ASTState (Maybe Type)
+funResultTySafe srcSpan astNode typ =
+  fmap snd <$> splitFunTySafe srcSpan astNode typ
+
+-- | Returns result type of a function of two arguments,
+-- adds 'TypeError' to 'ASTState' in case of a failure.
+funResultTy2Safe :: SrcSpan -> T.Text -> Type -> State ASTState (Maybe Type)
+funResultTy2Safe srcSpan astNode typ = do
+  mbResTy1 <- funResultTySafe srcSpan astNode typ
+  case mbResTy1 of
+    Just resTy1 -> funResultTySafe srcSpan astNode resTy1
+    Nothing -> return Nothing
+
+addIdentifierToIdSrcSpanMap ::
+     SrcSpan -> Id -> Maybe (Type, [Type]) -> State ASTState ()
+addIdentifierToIdSrcSpanMap span identifier mbTypes
+  | isGoodSrcSpan span =
+    modify' $ \astState@ASTState {astStateIdSrcSpanMap = ids} ->
+      let ids' = M.insert span (identifier, mbTypes) ids
+       in astState {astStateIdSrcSpanMap = ids'}
+addIdentifierToIdSrcSpanMap _ _ _ = return ()
+
+-- | Updates 'ExpressionInfoMap' or 'IdentifierOccurrenceMap' depending
+-- on 'ExprSort'.
+addExprInfo :: SrcSpan -> Maybe Type -> T.Text -> ExprSort -> State ASTState ()
+addExprInfo span mbType descr sort = do
+  transformation <- envTransformation . astStateEnv <$> get
+  case srcSpanToLineAndColNumbers transformation span of
+    Just (_file,(startLine, startCol), (endLine, endCol)) -> do
+      flags <- envDynFlags . astStateEnv <$> get
+      mbHsWrapper <- astStateHsWrapper <$> get
+      modify' $ \astState@ASTState {astStateExprInfoMap = exprInfoMap} ->
+        case sort of
+          Composite ->
+            let exprInfo =
+                  HCE.ExpressionInfo
+                    {exprType = mkType flags <$> mbType, description = descr}
+                interval =
+                  IVM.OpenInterval (startLine, startCol) (endLine, endCol)
+                exprInfoMap' = IVM.insert interval exprInfo exprInfoMap
+             in astState {astStateExprInfoMap = exprInfoMap'}
+          Simple ->
+            let idOcc =
+                  HCE.IdentifierOccurrence
+                    { internalId = Nothing
+                    , internalIdFromRenamedSource = Nothing
+                    , isBinder = False
+                    , instanceResolution = Nothing
+                    , idOccType =
+                        case mbHsWrapper of                          
+                          Just w -> mkType flags <$> (applyWrapper w <$> mbType)
+                          Nothing -> mkType flags <$> mbType
+                    , typeArguments = Nothing
+                    , description = descr
+                    , sort = HCE.ValueId
+                    }
+                idOccMap =
+                  IM.insertWith
+                    removeOverlappingInterval
+                    startLine
+                    [((startCol, endCol), idOcc)]
+                    (astStateIdOccMap astState)
+             in astState {astStateIdOccMap = idOccMap}
+    Nothing -> return ()
+
+-- | Finds the first interval that overlaps with a new interval
+-- and adds the smaller one of the two to the list. If there are no overlapping
+-- intervals then this function adds a new interval to the list.
+removeOverlappingInterval ::
+     forall a. [((Int, Int), a)] -> [((Int, Int), a)] -> [((Int, Int), a)]
+removeOverlappingInterval [newInterval@((newStart, newEnd), _newVal)] intervals =
+  go intervals False
+  where
+    go ::
+         [((Int, Int), a)]
+      -> Bool -- If an overlapping interval is found
+      -> [((Int, Int), a)]
+    go (i:is) True = i : go is True
+    -- Current interval is inside new interval
+    go (interval@((s, e), _val):is) False
+      | newStart <= s && newEnd >= e = interval : go is True
+    -- New interval is inside current interval
+    go (((s, e), _val):is) False
+      | newStart >= s && newEnd <= e = newInterval : go is True
+    -- Intervals partially overlap
+    go (interval@((s, e), _val):is) False
+      | newStart >= s && newEnd >= e && newStart < e =
+        (if e - s >= newEnd - newStart
+           then newInterval
+           else interval) :
+        go is True
+    -- Intervals partially overlap
+    go (interval@((s, e), _val):is) False
+      | newStart <= s && newEnd <= e && newEnd > s =
+        (if e - s >= newEnd - newStart
+           then newInterval
+           else interval) :
+        go is True
+    -- Intervals don't overlap
+    go (interval:is) False = interval : go is False
+    go [] True = []
+    go [] False = [newInterval]
+removeOverlappingInterval _ intervals = intervals
+
+newtype InstTypes = InstTypes [Type]
+
+instance Eq InstTypes where
+  (==) (InstTypes ts1) (InstTypes ts2) = eqTypes ts1 ts2
+
+instance Ord InstTypes where
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+  compare (InstTypes ts1) (InstTypes ts2) = nonDetCmpTypes ts1 ts2
+#else
+  compare (InstTypes ts1) (InstTypes ts2) = cmpTypes ts1 ts2
+#endif
+
+-- | Creates an instance resolution tree 
+traceInstanceResolution ::
+     Environment
+  -> Class
+  -> [Type] -- ^ Types at which type variables of a class are instantated
+  -> HCE.InstanceResolution
+traceInstanceResolution environment c ts = go c ts S.empty
+  where
+    flags = envDynFlags environment
+    go :: Class -> [Type] -> S.Set (Name, InstTypes) -> HCE.InstanceResolution
+    go cls types seenInstances =
+      let clsTyVarCount = length $ classTyVars cls
+       in case lookupUniqueInstEnv
+                 (envInstEnv environment)
+                 cls
+                 (take clsTyVarCount types) of
+            Right (inst, instTypes) ->
+              -- A successful match is a ClsInst, together with the types at which
+              -- the dfun_id in the ClsInst should be instantiated              
+              let instWithTypes = (is_dfun_name inst, InstTypes instTypes)
+               in if not $ S.member instWithTypes seenInstances
+                    then let (typeVars, predTypes, _class, _types) =
+                               instanceSig inst
+                             subst = zipTvSubst typeVars instTypes
+                             constraints =
+                               mapMaybe getClassPredTys_maybe . substTys subst $
+                               predTypes
+                          in HCE.Instance
+                               (instanceToText flags inst)
+                               (mkType flags . idType $ is_dfun inst)
+                               (map (mkType flags) instTypes)
+                               (nameLocationInfo
+                                  flags
+                                  (envPackageId environment)
+                                  (envComponentId environment)
+                                  (envTransformation environment)
+                                  (envFileMap environment)
+                                  (envDefSiteMap environment)
+                                  (Just . instanceToText flags $ inst)
+                                  Nothing
+                                  (varName . is_dfun $ inst))
+                               (map
+                                  (\(cl, tys) ->
+                                     go
+                                       cl
+                                       tys
+                                       (S.insert instWithTypes seenInstances))
+                                  constraints)
+                    else HCE.Stop
+            Left _ -> HCE.Stop
+
+mkIdentifierInfo :: Environment -> Id -> Maybe Name -> HCE.IdentifierInfo
+mkIdentifierInfo environment identifier mbNameFromRenamedSource =
+  let name = fromMaybe (varName identifier) mbNameFromRenamedSource
+      sort = nameSort name
+      nameSpace = occNameNameSpace . nameOccName $ name
+      flags = envDynFlags environment
+      currentPackageId = envPackageId environment
+      compId = envComponentId environment
+      transformation = envTransformation environment
+      fileMap = envFileMap environment
+      defSiteMap = envDefSiteMap environment
+      locationInfo =
+        nameLocationInfo
+          flags
+          currentPackageId
+          compId
+          transformation
+          fileMap
+          defSiteMap
+          Nothing
+          Nothing
+          name
+   in HCE.IdentifierInfo
+        { sort = sort
+        , occName = HCE.OccName $ nameToText name
+        , demangledOccName = demangleOccName name
+        , nameSpace = nameSpace
+        , idType = mkType flags $ varType identifier
+        , locationInfo = locationInfo
+        , details = mbIdDetails identifier
+        , doc =
+            nameDocumentation
+              transformation
+              fileMap
+              defSiteMap
+              (envCurrentModuleDefSites environment)
+              name
+        , internalId = HCE.InternalId $ identifierKey flags identifier
+        , externalId =
+            case sort of
+              HCE.External ->
+                case locationInfo of
+                  HCE.ExactLocation {..} ->
+                    Just $
+                    HCE.ExternalId $
+                    T.intercalate
+                      "|"
+                      [ HCE.packageIdToText currentPackageId
+                      , HCE.getHaskellModuleName moduleName
+                      , case nameSpace of
+                          HCE.VarName -> T.pack $ show HCE.Val  
+                          HCE.DataName -> T.pack $ show HCE.Val  
+                          _ -> T.pack $ show HCE.Typ
+                      , nameToText name
+                      ]
+                  HCE.ApproximateLocation {name = n, ..} ->
+                    Just $
+                    HCE.ExternalId $
+                    T.intercalate
+                      "|"
+                      [ HCE.packageIdToText packageId
+                      , HCE.getHaskellModuleName moduleName
+                      , T.pack $ show entity  
+                      , n
+                      ]
+                  _ -> Nothing
+              _ -> Nothing
+        , isExported = S.member name $ envExportedNames environment
+        }
+
+mkIdentifierOccurrence ::
+     Environment
+  -> Id
+  -> Name
+  -> Maybe (Type, [Type])
+  -> Bool
+  -> T.Text
+  -> HCE.IdentifierOccurrence
+mkIdentifierOccurrence environment identifier nameFromRenamedSource mbInstTypes isBinder descr =
+  let flags = envDynFlags environment
+      mbClass
+        | isId identifier =
+          case idDetails identifier of
+            ClassOpId cls -> Just cls
+            _ -> Nothing
+        | otherwise = Nothing
+      mbInstanceResolution =
+        case (mbClass, mbInstTypes) of
+          (Just cls, Just (_, ts)) ->
+            Just $ traceInstanceResolution environment cls ts
+          _ -> Nothing
+   in HCE.IdentifierOccurrence
+        (Just . HCE.InternalId . identifierKey flags $ identifier)
+        (Just . HCE.InternalId . T.pack . show . getKey . nameUnique $ nameFromRenamedSource)
+        isBinder
+        mbInstanceResolution
+        (mkType flags . fst <$> mbInstTypes)
+        (map (mkType flags) . snd <$> mbInstTypes)
+        descr
+        (if isId identifier
+           then HCE.ValueId
+           else HCE.TypeId)
+
+restoreTidyEnv :: (State ASTState) a -> (State ASTState) a
+restoreTidyEnv action = do
+  tidyEnv <- astStateTidyEnv <$> get
+  res <- action
+  modify' $ \s -> s {astStateTidyEnv = tidyEnv}
+  return res
+
+restoreHsWrapper :: (State ASTState) a -> (State ASTState) a
+restoreHsWrapper action = do
+  wrapper <- astStateHsWrapper <$> get
+  res <- action
+  modify' $ \s -> s {astStateHsWrapper = wrapper}
+  return res  
+
+tidyIdentifier :: Id -> State ASTState (Id, Maybe (Type, [Type]))
+tidyIdentifier identifier = do
+  tidyEnv <- astStateTidyEnv <$> get
+  mbHsWrapper <- astStateHsWrapper <$> get
+  let (tidyEnv', identifier') = tidyIdentifierType tidyEnv identifier
+      identifierType = varType identifier'
+      (mbTypes, updatedEnv) =
+        case mbHsWrapper of
+          Just wrapper ->
+            let expectedType = applyWrapper wrapper identifierType
+                (tidyEnv'', expectedType') = tidyOpenType tidyEnv' expectedType
+                wrapperTys =
+                  map (snd . tidyOpenType tidyEnv'') (wrapperTypes wrapper)
+             in if not $ eqType expectedType identifierType
+                  then (Just (expectedType', wrapperTys), tidyEnv'')
+                  else (Nothing, tidyEnv')
+          Nothing -> (Nothing, tidyEnv')
+  modify' (\s -> s {astStateTidyEnv = updatedEnv})
+  return (identifier', mbTypes)
+
+tidyType :: Type -> State ASTState Type
+tidyType typ = do
+  tidyEnv <- astStateTidyEnv <$> get
+  let (tidyEnv', typ') = tidyOpenType tidyEnv typ
+  modify' (\s -> s {astStateTidyEnv = tidyEnv'})
+  return typ'
+  
+foldTypecheckedSource :: LHsBinds Id -> State ASTState ()
+foldTypecheckedSource = foldLHsBindsLR
+
+foldLHsExpr :: LHsExpr Var -> State ASTState (Maybe Type)
+foldLHsExpr (L span (HsVar (L _ identifier))) =
+  restoreTidyEnv $ do
+    (identifier', mbTypes) <- tidyIdentifier identifier
+    addIdentifierToIdSrcSpanMap span identifier' mbTypes
+    return . Just . varType $ identifier'
+foldLHsExpr (L _ (HsUnboundVar _)) = return Nothing
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+foldLHsExpr (L _ (HsConLikeOut conLike)) =
+  restoreTidyEnv $ do    
+    let mbType = varType <$> conLikeWrapId_maybe conLike    
+    mbType' <- maybe (return Nothing) (fmap Just . tidyType) mbType    
+    return mbType'
+#endif
+foldLHsExpr (L _ (HsRecFld _)) = return Nothing
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+foldLHsExpr (L _ (HsOverLabel _ _)) = return Nothing
+#else
+foldLHsExpr (L _ (HsOverLabel _)) = return Nothing
+#endif
+foldLHsExpr (L span expr@(HsIPVar _)) = do
+  addExprInfo span Nothing "HsIPVar" (exprSort expr)
+  return Nothing
+foldLHsExpr (L span (HsOverLit OverLit {ol_type})) =
+  restoreTidyEnv $ do
+    typ <- tidyType ol_type
+    addExprInfo
+      span
+      (Just typ)
+      "HsOverLit"
+      (if isOneLineSpan span
+         then Simple
+         else Composite)
+    return $ Just typ
+foldLHsExpr (L span (HsLit lit)) =
+  restoreTidyEnv $ do
+    typ <- tidyType $ hsLitType lit
+    addExprInfo
+      span
+      (Just typ)
+      "HsLit"
+      (if isOneLineSpan span
+         then Simple
+         else Composite)
+    return $ Just typ
+foldLHsExpr (L span expr@(HsLam MG {..})) =
+  restoreTidyEnv $ do
+    typ <- tidyType $ mkFunTys mg_arg_tys mg_res_ty
+    addExprInfo span (Just typ) "HsLam" (exprSort expr)
+    mapM_ foldLMatch $ unLoc mg_alts
+    return $ Just typ
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)    
+foldLHsExpr (L span expr@(HsLamCase MG {..})) =
+#else
+foldLHsExpr (L span expr@(HsLamCase _typ MG {..})) =
+#endif
+  restoreTidyEnv $ do
+    typ <- tidyType $ mkFunTys mg_arg_tys mg_res_ty
+    addExprInfo span (Just typ) "HsLamCase" (exprSort expr)
+    mapM_ foldLMatch $ unLoc mg_alts
+    return $ Just typ
+foldLHsExpr (L span expr@(HsApp fun arg)) = do
+  funTy <- foldLHsExpr fun
+  _argTy <- foldLHsExpr arg
+  typ <- fromMaybe (return Nothing) (funResultTySafe span "HsApp" <$> funTy)
+  addExprInfo span typ "HsApp" (exprSort expr)
+  return typ
+foldLHsExpr (L _ (HsAppType _ _)) = return Nothing
+foldLHsExpr (L span ex@(HsAppTypeOut expr _)) = do
+  typ <- foldLHsExpr expr
+  addExprInfo span typ "HsAppTypeOut" (exprSort ex)
+  return typ  
+foldLHsExpr (L span expr@(OpApp left op _fixity right)) = do
+  opTyp <- foldLHsExpr op
+  typ <- fromMaybe (return Nothing) (funResultTy2Safe span "HsApp" <$> opTyp)
+  _ <- foldLHsExpr left
+  _ <- foldLHsExpr right
+  addExprInfo span typ "OpApp" (exprSort expr)
+  return typ
+foldLHsExpr (L span e@(NegApp expr _syntaxExp)) = do
+  typ <- foldLHsExpr expr
+  addExprInfo span typ "NegApp" (exprSort e)
+  return typ
+foldLHsExpr (L _span (HsPar expr)) = foldLHsExpr expr
+foldLHsExpr (L span expr@(SectionL operand operator)) = do
+  opType <- foldLHsExpr operator
+  _ <- foldLHsExpr operand
+  mbTypes <-
+    fromMaybe (return Nothing) (splitFunTy2Safe span "SectionL" <$> opType)
+  let typ =
+        case mbTypes of
+          Just (_arg1, arg2, res) -> Just $ mkFunTy arg2 res
+          Nothing -> Nothing
+  addExprInfo span typ "SectionL" (exprSort expr)
+  return typ
+foldLHsExpr (L span e@(SectionR operator operand)) = do
+  opType <- foldLHsExpr operator
+  _ <- foldLHsExpr operand
+  mbTypes <-
+    fromMaybe (return Nothing) (splitFunTy2Safe span "SectionR" <$> opType)
+  let typ =
+        case mbTypes of
+          Just (arg1, _arg2, res) -> Just $ mkFunTy arg1 res
+          Nothing -> Nothing
+  addExprInfo span typ "SectionR" (exprSort e)
+  return typ
+foldLHsExpr (L span e@(ExplicitTuple tupArgs boxity)) = do
+  tupleArgs <- mapM foldLHsTupArg tupArgs
+  let tupleSectionArgTys =
+        mapM fst . filter ((== TupArgMissing) . snd) $ tupleArgs
+      tupleArgTys = mapM fst tupleArgs
+      resultType =
+        mkFunTys <$> tupleSectionArgTys <*> (mkTupleTy boxity <$> tupleArgTys)
+  tidyEnv <- astStateTidyEnv <$> get
+  addExprInfo
+    span
+    ((snd . tidyOpenType tidyEnv) <$> resultType)
+    "ExplicitTuple"
+    (exprSort e)
+  return resultType
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+foldLHsExpr (L _span (ExplicitSum _ _ expr _types)) = do
+  -- TODO
+  _ <- foldLHsExpr expr
+  return Nothing    
+#endif    
+foldLHsExpr (L span e@(HsCase expr MG {..})) =
+  restoreTidyEnv $ do
+    typ <- tidyType mg_res_ty
+    _ <- foldLHsExpr expr
+    mapM_ foldLMatch (unLoc mg_alts)
+    addExprInfo span (Just typ) "HsCase" (exprSort e)
+    return $ Just typ
+foldLHsExpr (L span e@(HsIf _mbSynExpr condExpr thenExpr elseExpr)) = do
+  _ <- foldLHsExpr condExpr
+  typ <- foldLHsExpr thenExpr
+  _ <- foldLHsExpr elseExpr
+  addExprInfo span typ "HsIf" (exprSort e)
+  return typ
+foldLHsExpr (L span e@(HsMultiIf typ grhss)) =
+  restoreTidyEnv $ do
+    typ' <- tidyType typ
+    addExprInfo span (Just typ') "HsMultiIf" (exprSort e)
+    mapM_ foldLGRHS grhss
+    return $ Just typ'
+foldLHsExpr (L span e@(HsLet (L _ binds) expr)) = do
+  _ <- foldHsLocalBindsLR binds
+  typ <- foldLHsExpr expr
+  addExprInfo span typ "HsLet" (exprSort e)
+  return typ
+foldLHsExpr (L span expr@(HsDo _context (L _ stmts) typ)) =
+  restoreTidyEnv $ do
+    typ' <- tidyType typ
+    addExprInfo span (Just typ') "HsDo" (exprSort expr)
+    mapM_ foldLStmtLR stmts
+    return $ Just typ'
+foldLHsExpr (L span (ExplicitList typ _syntaxExpr exprs)) =
+  restoreTidyEnv $ do
+    typ' <- mkListTy <$> tidyType typ
+    unless (null exprs) $ addExprInfo span (Just typ') "ExplicitList" Composite
+    mapM_ foldLHsExpr exprs
+    return $ Just typ'
+foldLHsExpr (L span e@(ExplicitPArr typ exprs)) =
+  restoreTidyEnv $ do
+    typ' <- tidyType typ
+    addExprInfo span (Just typ') "ExplicitPArr" (exprSort e)
+    mapM_ foldLHsExpr exprs
+    return $ Just typ'
+foldLHsExpr (L span e@(RecordCon (L _ _) _conLike conExpr binds)) = do
+    mbConType <-
+      fmap (snd . splitFunTys) <$>
+      foldLHsExpr (L (UnhelpfulSpan $ mkFastString "RecordCon") conExpr)
+    addExprInfo span mbConType "RecordCon" (exprSort e)
+    _ <- foldHsRecFields binds
+    return mbConType
+foldLHsExpr (L span e@(RecordUpd expr binds cons _inputTys outTys _wrapper)) =
+  restoreTidyEnv $ do   
+    -- cons is a non-empty list of DataCons that have  all the upd'd fields
+    let typ = conLikeResTy (head cons) outTys
+    typ' <- tidyType typ
+    addExprInfo span (Just typ') "RecordUpd" (exprSort e)
+    _ <- foldLHsExpr expr
+    mapM_ foldLHsRecUpdField binds
+    return $ Just typ'
+foldLHsExpr (L _span (ExprWithTySig _expr _type)) = return Nothing
+foldLHsExpr (L span e@(ExprWithTySigOut expr _type)) = do
+  typ <- foldLHsExpr expr
+  addExprInfo span typ "ExprWithTySigOut" (exprSort e)
+  return typ
+foldLHsExpr (L span e@(ArithSeq postTcExpr _mbSyntaxExpr seqInfo)) = do
+  typ <-
+    fmap (snd . splitFunTys . snd . splitForAllTys) <$>
+    foldLHsExpr (L (UnhelpfulSpan $ mkFastString "ArithSeq") postTcExpr)
+  _ <-
+    case seqInfo of
+      From expr -> foldLHsExpr expr
+      FromThen expr1 expr2 -> foldLHsExpr expr1 >> foldLHsExpr expr2
+      FromTo expr1 expr2 -> foldLHsExpr expr1 >> foldLHsExpr expr2
+      FromThenTo expr1 expr2 expr3 ->
+        foldLHsExpr expr1 >> foldLHsExpr expr2 >> foldLHsExpr expr3
+  addExprInfo span typ "ArithSeq" (exprSort e)
+  return typ
+foldLHsExpr (L span e@(PArrSeq postTcExpr _seqInfo)) = do
+  typ <- foldLHsExpr (L (UnhelpfulSpan $ mkFastString "PArrSeq") postTcExpr)
+  addExprInfo span typ "ArithSeq" (exprSort e)
+  return typ
+foldLHsExpr (L span e@(HsSCC _sourceText _fastString expr)) = do
+  typ <- foldLHsExpr expr
+  addExprInfo span typ "HsSCC" (exprSort e)
+  return typ
+foldLHsExpr (L span e@(HsCoreAnn _sourceText _fastString expr)) = do
+  typ <- foldLHsExpr expr
+  addExprInfo span typ "HsCoreAnn" (exprSort e)
+  return typ
+foldLHsExpr (L _span (HsBracket _bracket)) = return Nothing
+foldLHsExpr (L _span (HsRnBracketOut _ _)) = return Nothing
+foldLHsExpr (L _span (HsTcBracketOut _bracket _splice)) = return Nothing
+foldLHsExpr (L _span (HsSpliceE _)) = return Nothing
+foldLHsExpr (L span expr@(HsProc pat cmd)) = do
+  _ <- foldLPat pat
+  _ <- foldLHsCmdTop cmd
+  addExprInfo span Nothing "HsProc" (exprSort expr)
+  return Nothing
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)  
+foldLHsExpr (L span e@(HsStatic _ expr)) = do
+#else
+foldLHsExpr (L span e@(HsStatic expr)) = do
+#endif
+  typ <- foldLHsExpr expr
+  addExprInfo span typ "HsStatic" (exprSort e)
+  return typ
+foldLHsExpr (L _ HsArrForm {}) = return Nothing
+foldLHsExpr (L _ HsArrApp {}) = return Nothing
+foldLHsExpr (L span e@(HsTick _ expr)) = do
+  typ <- foldLHsExpr expr
+  addExprInfo span typ "HsTick" (exprSort e)
+  return typ
+foldLHsExpr (L span e@(HsBinTick _ _ expr)) = do
+  typ <- foldLHsExpr expr
+  addExprInfo span typ "HsBinTick" (exprSort e)
+  return typ
+foldLHsExpr (L span e@(HsTickPragma _ _ _ expr)) = do
+  typ <- foldLHsExpr expr
+  addExprInfo span typ "HsTickPragma" (exprSort e)
+  return typ
+foldLHsExpr (L _span EWildPat) = return Nothing
+foldLHsExpr (L _span (EAsPat _ _)) = return Nothing
+foldLHsExpr (L _span (EViewPat _ _)) = return Nothing
+foldLHsExpr (L _span (ELazyPat _)) = return Nothing
+foldLHsExpr (L span (HsWrap wrapper expr)) =
+  restoreHsWrapper $ do
+    case exprSort expr of
+      Simple -> modify' (\s -> s {astStateHsWrapper = Just wrapper})
+      Composite -> return () -- Not sure if it is possible
+    typ <- foldLHsExpr (L span expr)
+    return $ applyWrapper wrapper <$> typ
+  
+foldHsRecFields :: HsRecFields Id (LHsExpr Id) -> State ASTState (Maybe Type)
+foldHsRecFields HsRecFields {..} = do
+  let userWritten =
+        case rec_dotdot of
+          Just i -> take i
+          Nothing -> id
+  mapM_ foldLHsRecField $ userWritten rec_flds
+  return Nothing
+  
+foldLHsRecField :: LHsRecField Id (LHsExpr Id) -> State ASTState (Maybe Type)
+foldLHsRecField (L span (HsRecField (L idSpan (FieldOcc _ identifier)) arg pun)) =
+  restoreTidyEnv $ do
+    (identifier', mbTypes) <- tidyIdentifier identifier
+    addIdentifierToIdSrcSpanMap idSpan identifier' mbTypes
+    addExprInfo span (Just . varType $ identifier') "HsRecField" Composite
+    unless pun $ void (foldLHsExpr arg)
+    return . Just . varType $ identifier'
+
+foldLHsRecUpdField :: LHsRecUpdField Id -> State ASTState (Maybe Type)
+foldLHsRecUpdField (L span (HsRecField (L idSpan recField) arg pun)) =
+  restoreTidyEnv $ do
+    let selectorId = selectorAmbiguousFieldOcc recField
+    (identifier', mbTypes) <- tidyIdentifier selectorId
+     -- Name of the selectorId is not 'correct' (Internal instead of External) :
+     -- https://github.com/ghc/ghc/blob/321b420f4582d103ca7b304867b916a749712e9f/compiler/typecheck/TcExpr.hs#L2424
+    typeEnv <- envTypeEnv . astStateEnv <$> get
+    let selName = varName selectorId
+        originalName =
+          case lookupTypeEnv typeEnv selName of
+            Just (AnId originalSelId) -> varName originalSelId
+            _ -> selName
+    let identifier'' = setVarName identifier' originalName
+    addIdentifierToIdSrcSpanMap idSpan identifier'' mbTypes
+    addExprInfo span (Just . varType $ identifier'') "HsRecUpdField" Composite
+    unless pun $ void (foldLHsExpr arg)
+    return . Just . varType $ identifier'
+
+data TupArg
+  = TupArgPresent
+  | TupArgMissing
+  deriving (Show, Eq)
+
+foldLHsTupArg :: LHsTupArg Id -> State ASTState (Maybe Type, TupArg)
+foldLHsTupArg (L _span (Present expr)) =
+  restoreTidyEnv $ do
+    typ <- foldLHsExpr expr
+    typ' <-
+      case typ of
+        Just t -> Just <$> tidyType t
+        Nothing -> return Nothing
+    return (typ', TupArgPresent)
+foldLHsTupArg (L _ (Missing typ)) =
+  restoreTidyEnv $ do
+    typ' <- tidyType typ
+    return (Just typ', TupArgMissing)
+
+foldLMatch :: LMatch Id (LHsExpr Var) -> State ASTState (Maybe Type)
+foldLMatch (L _span Match {..}) = do
+  mapM_ foldLPat m_pats
+  _ <- foldGRHSs m_grhss
+  return Nothing    
+       
+foldLMatchCmd :: LMatch Id (LHsCmd Var) -> State ASTState (Maybe Type)
+foldLMatchCmd (L _span Match {..}) = do
+  mapM_ foldLPat m_pats
+  _ <- foldGRHSsCmd m_grhss
+  return Nothing
+
+foldGRHSsCmd :: GRHSs Id (LHsCmd Id) -> State ASTState (Maybe Type)
+foldGRHSsCmd GRHSs {..} = do
+  mapM_ foldLGRHSCmd grhssGRHSs
+  _ <- foldHsLocalBindsLR (unLoc grhssLocalBinds)
+  return Nothing
+
+foldGRHSs :: GRHSs Id (LHsExpr Var) -> State ASTState (Maybe Type)
+foldGRHSs GRHSs {..} = do
+  mapM_ foldLGRHS grhssGRHSs
+  _ <- foldHsLocalBindsLR (unLoc grhssLocalBinds)
+  return Nothing
+
+foldLStmtLR :: LStmtLR Id Id (LHsExpr Var) -> State ASTState (Maybe Type)
+foldLStmtLR (L span (LastStmt body _ _)) =  
+  do typ <- foldLHsExpr body
+     addExprInfo span typ "LastStmt" Composite
+     return typ
+foldLStmtLR (L _span (BindStmt pat body _ _ _)) = do
+  _ <- foldLPat pat
+  _ <- foldLHsExpr body
+  return Nothing
+foldLStmtLR (L span (BodyStmt body _ _ _)) = do
+  mbTyp <- foldLHsExpr body
+  addExprInfo span mbTyp "BodyStmt" Composite
+  return mbTyp
+foldLStmtLR (L _ (LetStmt (L _ binds))) = do
+  _ <- foldHsLocalBindsLR binds
+  return Nothing
+foldLStmtLR (L _ (ParStmt blocks _ _ _)) = do
+  mapM_ foldParStmtBlock blocks
+  return Nothing
+foldLStmtLR (L _ TransStmt {..}) = do
+  mapM_ foldLStmtLR trS_stmts  
+  _ <- maybe (return Nothing) foldLHsExpr trS_by
+  _ <- foldLHsExpr trS_using
+  return Nothing
+foldLStmtLR (L _span RecStmt {..}) = do
+  mapM_ foldLStmtLR recS_stmts
+  return Nothing
+foldLStmtLR (L span (ApplicativeStmt args _ typ)) =
+  restoreTidyEnv $ do
+    typ' <- tidyType typ
+    mapM_ (foldApplicativeArg . snd) args
+    addExprInfo span (Just typ') "ApplicativeStmt" Composite
+    return Nothing
+
+foldApplicativeArg :: ApplicativeArg Id Id -> State ASTState (Maybe Type)
+foldApplicativeArg appArg =
+  case appArg of
+    ApplicativeArgOne pat expr -> do
+      _ <- foldLPat pat
+      _ <- foldLHsExpr expr
+      return Nothing
+    ApplicativeArgMany exprStmts _ pat -> do
+      _ <- mapM_ foldLStmtLR exprStmts
+      _ <- foldLPat pat
+      return Nothing  
+
+foldLStmtLRCmd :: LStmtLR Id Id (LHsCmd Var) 
+               -> State ASTState (Maybe Type)
+foldLStmtLRCmd (L span (LastStmt body _syntaxExpr _)) = do
+  typ <- foldLHsCmd body
+  addExprInfo span typ "LastStmt Cmd" Composite
+  return typ
+foldLStmtLRCmd (L _ (BindStmt pat body _ _ _)) = do
+  _ <- foldLPat pat
+  _ <- foldLHsCmd body
+  return Nothing
+foldLStmtLRCmd (L span (BodyStmt body _ _ _)) = do
+  typ <- foldLHsCmd body
+  addExprInfo span typ "BodyStmt Cmd" Composite
+  return typ
+foldLStmtLRCmd (L _ (LetStmt (L _ binds))) = do
+  _ <- foldHsLocalBindsLR binds
+  return Nothing
+foldLStmtLRCmd (L _ (ParStmt blocks _ _ _)) = do
+  mapM_ foldParStmtBlock blocks
+  return Nothing
+foldLStmtLRCmd (L _ TransStmt {..}) = do
+  mapM_ foldLStmtLR trS_stmts
+  _ <- foldLHsExpr trS_using
+  _ <- maybe (return Nothing) foldLHsExpr trS_by
+  return Nothing
+foldLStmtLRCmd (L _ RecStmt {..}) = do
+  mapM_ foldLStmtLRCmd recS_stmts
+  return Nothing
+foldLStmtLRCmd (L span (ApplicativeStmt args _ typ)) =
+  restoreTidyEnv $ do
+    typ' <- tidyType typ
+    mapM_ (foldApplicativeArg . snd) args
+    addExprInfo span (Just typ') "ApplicativeStmt Cmd" Composite
+    return Nothing  
+  
+foldLGRHS :: LGRHS Id (LHsExpr Id) -> State ASTState (Maybe Type)
+foldLGRHS (L _span (GRHS guards body)) = do
+  typ <- foldLHsExpr body
+  mapM_ foldLStmtLR guards
+  return typ
+  
+foldLGRHSCmd :: LGRHS Id (LHsCmd Var) -> State ASTState (Maybe Type)
+foldLGRHSCmd (L _span (GRHS guards body)) = do
+  typ <- foldLHsCmd body
+  mapM_ foldLStmtLR guards
+  return typ   
+
+foldParStmtBlock :: ParStmtBlock Id Id -> State ASTState (Maybe Type)
+foldParStmtBlock (ParStmtBlock exprStmts _ids _syntaxExpr) = do
+  mapM_ foldLStmtLR exprStmts
+  return Nothing
+
+foldHsLocalBindsLR :: HsLocalBindsLR Id Id -> State ASTState (Maybe Type)
+foldHsLocalBindsLR (HsValBinds binds) = do
+  _ <- foldHsValBindsLR binds
+  return Nothing
+foldHsLocalBindsLR (HsIPBinds _binds) = return Nothing
+foldHsLocalBindsLR EmptyLocalBinds = return Nothing
+
+foldHsValBindsLR :: HsValBindsLR Id Var -> State ASTState (Maybe Type)
+foldHsValBindsLR (ValBindsIn _ _) = return Nothing
+foldHsValBindsLR (ValBindsOut binds _) = do
+  _ <- mapM_ (foldLHsBindsLR . snd) binds
+  return Nothing
+
+foldLHsBindsLR :: LHsBinds Id -> State ASTState ()
+foldLHsBindsLR = mapM_ (`foldLHsBindLR` Nothing) . bagToList
+
+foldLHsBindLR :: LHsBindLR Id Var
+              -> Maybe Id -- ^ Polymorphic id
+              -> State ASTState (Maybe Type)
+foldLHsBindLR (L _span FunBind {..}) mbPolyId
+  | mg_origin fun_matches == FromSource =
+    restoreTidyEnv $ do
+      let (L idSpan identifier) = fun_id -- monotype
+          typ =
+            case mbPolyId of
+              Just polyId -> varType polyId
+              Nothing -> varType identifier
+          name = maybe (varName identifier) varName mbPolyId
+          identifier' = setVarType (setVarName identifier name) typ
+      (identifier'', _) <- tidyIdentifier identifier'
+      addIdentifierToIdSrcSpanMap idSpan identifier'' Nothing
+      mapM_ foldLMatch (unLoc (mg_alts fun_matches))
+      return Nothing
+  | otherwise = return Nothing
+foldLHsBindLR (L _ PatBind {..}) _ = do
+  _ <- foldLPat pat_lhs
+  _ <- foldGRHSs pat_rhs
+  return Nothing
+foldLHsBindLR (L _ VarBind {..}) _ = return Nothing
+foldLHsBindLR (L _ AbsBinds {..}) _ = do
+  _ <-
+    mapM_ (\(bind, typ) -> foldLHsBindLR bind (Just typ)) $
+    zip (bagToList abs_binds) (map abe_poly abs_exports)
+  return Nothing
+foldLHsBindLR (L _ AbsBindsSig {..}) _ = do
+  _ <- foldLHsBindLR abs_sig_bind (Just abs_sig_export)
+  return Nothing
+foldLHsBindLR (L _ (PatSynBind PSB {..})) _ =
+  restoreTidyEnv $ do
+    _ <- foldLPat psb_def
+    _ <-
+      let addId :: GenLocated SrcSpan Id -> State ASTState ()
+          addId (L span i) = do
+            (i', _) <- tidyIdentifier i
+            addIdentifierToIdSrcSpanMap span i' Nothing
+       in case psb_args of
+            InfixPatSyn id1 id2 -> addId id1 >> addId id2
+            PrefixPatSyn ids -> mapM_ addId ids
+            RecordPatSyn recs ->
+              mapM_
+                (\(RecordPatSynField selId patVar) ->
+                   addId selId >> addId patVar)
+                recs
+    return Nothing
+
+foldLPat :: LPat Id -> State ASTState (Maybe Type)
+foldLPat (L span (VarPat (L _ identifier))) = do
+  (identifier', _) <- tidyIdentifier identifier
+  addIdentifierToIdSrcSpanMap span identifier' Nothing
+  return . Just . varType $ identifier'
+foldLPat (L span pat@(WildPat typ)) = do
+  typ' <- tidyType typ
+  addExprInfo span (Just typ') "WildPat" (patSort pat)
+  return $ Just typ'
+foldLPat (L span p@(LazyPat pat)) = do
+  mbType <- foldLPat pat
+  addExprInfo span mbType "LazyPat" (patSort p)
+  return mbType
+foldLPat (L span p@(AsPat (L idSpan identifier) pat)) = do
+  (identifier', _) <- tidyIdentifier identifier
+  addIdentifierToIdSrcSpanMap idSpan identifier' Nothing
+  addExprInfo span (Just . varType $ identifier') "AsPat" (patSort p)
+  _ <- foldLPat pat
+  return . Just . varType $ identifier'
+foldLPat (L _span (ParPat pat)) = foldLPat pat  
+foldLPat (L span p@(BangPat pat)) = do
+  typ <- foldLPat pat
+  addExprInfo span typ "BangPat" (patSort p)
+  return typ
+foldLPat (L span p@(ListPat pats typ _)) = do
+  typ' <- tidyType typ
+  let listType = mkListTy typ'
+  addExprInfo span (Just listType) "ListPat" (patSort p)
+  _ <- mapM_ foldLPat pats
+  return $ Just listType
+foldLPat (L span pat@(TuplePat pats boxity types)) = do
+  typ' <- tidyType $ mkTupleTy boxity types
+  addExprInfo span (Just typ') "TuplePat" (patSort pat)
+  _ <- mapM_ foldLPat pats
+  return $ Just typ'
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+foldLPat (L _span (SumPat pat _ _ _types)) = do
+  -- TODO
+  _ <- foldLPat pat
+  return Nothing  
+#endif
+foldLPat (L span pat@(PArrPat pats typ)) = do
+  typ' <- tidyType typ
+  addExprInfo span (Just typ') "PArrPat" (patSort pat)
+  _ <- mapM_ foldLPat pats
+  return $ Just typ'
+foldLPat (L _span (ConPatIn _ _)) = return Nothing
+foldLPat (L span pat@ConPatOut {..}) = do
+  let (L idSpan conLike) = pat_con 
+      conId =
+        case conLike of
+          RealDataCon dc -> dataConWorkId dc
+          PatSynCon ps -> patSynId ps
+      typ = conLikeResTy (unLoc pat_con) pat_arg_tys
+  (identifier', mbTypes) <- tidyIdentifier conId
+  addIdentifierToIdSrcSpanMap idSpan identifier' mbTypes
+  typ' <- tidyType typ
+  addExprInfo span (Just typ') "ConPatOut" (patSort pat)
+  _ <- foldHsConPatDetails pat_args
+  return . Just . varType $ identifier'
+foldLPat (L span p@(ViewPat expr pat typ)) = do
+  typ' <- tidyType typ
+  addExprInfo span (Just typ') "ViewPat" (patSort p)
+  _ <- foldLPat pat
+  _ <- foldLHsExpr expr
+  return $ Just typ'
+foldLPat (L _ (SplicePat _)) = return Nothing
+foldLPat (L span (LitPat hsLit)) = do
+  typ' <- tidyType $ hsLitType hsLit
+  addExprInfo
+    span
+    (Just typ')
+    "LitPat"
+    (if isOneLineSpan span
+       then Simple
+       else Composite)
+  return $ Just typ'
+foldLPat (L span pat@(NPat (L _spanLit OverLit {ol_type}) _ _ _)) = do
+  typ' <- tidyType ol_type
+  addExprInfo span (Just typ') "NPat" (patSort pat)
+  return $ Just ol_type
+foldLPat (L span pat@(NPlusKPat (L idSpan identifier) (L litSpan OverLit {ol_type}) _ _ _ typ)) = do
+  (identifier', _) <- tidyIdentifier identifier
+  addIdentifierToIdSrcSpanMap idSpan identifier' Nothing
+  typ' <- tidyType typ
+  addExprInfo span (Just typ') "NPlusKPat" (patSort pat)
+  olType' <- tidyType ol_type
+  addExprInfo
+    litSpan
+    (Just olType')
+    "NPlusKPat"
+    (if isOneLineSpan span
+       then Simple
+       else Composite)
+  return $ Just typ'
+foldLPat (L _span (SigPatIn _ _)) = return Nothing  
+foldLPat (L _span (SigPatOut pat typ)) = do
+  typ' <- tidyType typ
+  _ <- foldLPat pat
+  return $ Just typ'
+foldLPat (L span p@(CoPat _ pat typ)) = do
+  typ' <- tidyType typ
+  addExprInfo span (Just typ') "CoPat" (patSort p)
+  _ <- foldLPat (L span pat)
+  return Nothing 
+
+foldHsConPatDetails
+  :: HsConPatDetails Id
+  -> State ASTState (Maybe Type)
+foldHsConPatDetails (PrefixCon args) = do
+  _ <- mapM_ foldLPat args
+  return Nothing
+foldHsConPatDetails (RecCon rec) = do
+  _ <- foldHsRecFieldsPat rec
+  return Nothing
+foldHsConPatDetails (InfixCon arg1 arg2) = do
+  _ <- foldLPat arg1
+  _ <- foldLPat arg2
+  return Nothing
+
+foldHsRecFieldsPat :: HsRecFields Id (LPat Id) -> State ASTState (Maybe Type)
+foldHsRecFieldsPat HsRecFields {..} = do
+  let onlyUserWritten =
+        case rec_dotdot of
+          Just i -> take i
+          Nothing -> id
+  _ <- mapM_ foldLHsRecFieldPat $ onlyUserWritten rec_flds
+  return Nothing
+
+foldLHsRecFieldPat :: LHsRecField Id (LPat Id) -> State ASTState (Maybe Type)
+foldLHsRecFieldPat (L _ (HsRecField (L idSpan (FieldOcc _ identifier)) arg pun)) = do
+  (identifier', mbTypes) <- tidyIdentifier identifier
+  addIdentifierToIdSrcSpanMap idSpan identifier' mbTypes
+  unless pun $ void $ foldLPat arg
+  return . Just . varType $ identifier'
+
+foldLHsCmdTop :: LHsCmdTop Id -> State ASTState (Maybe Type)
+foldLHsCmdTop (L span (HsCmdTop cmd _ _ _)) = do
+  mbTyp <- foldLHsCmd cmd
+  addExprInfo span mbTyp "HsCmdTop" Composite
+  return mbTyp
+
+foldLHsCmd :: LHsCmd Id -> State ASTState (Maybe Type)
+foldLHsCmd (L _ (HsCmdArrApp expr1 expr2 _ _ _)) = do
+  _ <- foldLHsExpr expr1
+  _ <- foldLHsExpr expr2
+  return Nothing
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)  
+foldLHsCmd (L _ (HsCmdArrForm expr _  _ topCmds)) = do
+#else
+foldLHsCmd (L _ (HsCmdArrForm expr _ topCmds)) = do
+#endif
+  _ <- foldLHsExpr expr
+  _ <- mapM_ foldLHsCmdTop topCmds
+  return Nothing  
+foldLHsCmd (L _ (HsCmdApp cmd expr)) = do
+  _ <- foldLHsCmd cmd
+  _ <- foldLHsExpr expr
+  return Nothing
+foldLHsCmd (L _ (HsCmdLam MG {..})) = do
+  mapM_ foldLMatchCmd $ unLoc mg_alts
+  return Nothing
+foldLHsCmd (L _ (HsCmdCase expr MG {..})) = do
+  _ <- foldLHsExpr expr
+  mapM_ foldLMatchCmd $ unLoc mg_alts
+  return Nothing   
+foldLHsCmd (L _ (HsCmdPar cmd)) = do
+  _ <- foldLHsCmd cmd
+  return Nothing
+foldLHsCmd (L _ (HsCmdIf _ expr cmd1 cmd2)) = do
+  _ <- foldLHsCmd cmd1
+  _ <- foldLHsCmd cmd2
+  _ <- foldLHsExpr expr
+  return Nothing
+foldLHsCmd (L _ (HsCmdLet (L _ binds) cmd)) = do
+  _ <- foldLHsCmd cmd
+  _ <- foldHsLocalBindsLR binds
+  return Nothing
+foldLHsCmd (L _ (HsCmdDo stmts _)) = do
+  mapM_ foldLStmtLRCmd $ unLoc stmts
+  return Nothing
+foldLHsCmd (L span (HsCmdWrap _ cmd)) = do
+  _ <- foldLHsCmd (L span cmd)
+  return Nothing
diff --git a/src/HaskellCodeExplorer/GhcUtils.hs b/src/HaskellCodeExplorer/GhcUtils.hs
new file mode 100644
index 0000000..714e429
--- /dev/null
+++ b/src/HaskellCodeExplorer/GhcUtils.hs
@@ -0,0 +1,1122 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module HaskellCodeExplorer.GhcUtils
+  ( -- * Pretty-printing
+    toText
+  , instanceToText
+  , instanceDeclToText
+  , nameToText
+  , tyClDeclPrefix
+  , demangleOccName
+  , stringBufferToByteString
+  , nameSort
+  , occNameNameSpace
+  , identifierKey
+  , nameKey
+  , mbIdDetails  
+    -- * Syntax manipulation
+  , hsGroupVals
+  , hsPatSynDetails
+  , ieLocNames
+    -- * Lookups
+  , lookupIdInTypeEnv
+  , lookupNameModuleAndPackage
+    -- * Location info
+  , isHsBoot
+  , moduleLocationInfo
+  , nameLocationInfo
+  , occNameLocationInfo  
+  , nameDocumentation  
+  , srcSpanToLineAndColNumbers
+    -- * Type-related functions
+  , tyThingToId  
+  , tidyIdentifierType
+  , patSynId
+  , applyWrapper
+  , wrapperTypes  
+  , tyVarsOfType  
+  , tyConsOfType
+  , updateOccNames  
+  , mkType
+    -- * Documentation processing
+  , collectDocs
+  , ungroup
+  , mkDecls
+  , getMainDeclBinder
+  , classDeclDocs
+  , sigNameNoLoc
+  , clsInstDeclSrcSpan
+  , hsDocsToDocH
+  , subordinateNamesWithDocs
+  ) where
+import Bag (bagToList)
+import ConLike (ConLike(..))
+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()
+import qualified Data.HashMap.Strict as HM
+import qualified Data.List as L
+import Data.Maybe (fromMaybe, isJust, mapMaybe)
+import Data.Ord (comparing)
+import qualified Data.Text as T
+import DataCon (dataConWorkId, flSelector)
+import Documentation.Haddock.Parser (overIdentifier, parseParas)
+import Documentation.Haddock.Types (DocH(..), Header(..), _doc)
+import DynFlags ()
+import FastString (mkFastString, unpackFS)
+import GHC
+  ( DynFlags
+  , HsDocString(..)
+  , InstDecl(..)
+  , ModuleName
+  , Name
+  , SrcSpan(..)
+  , RealSrcSpan(..)
+  , ClsInstDecl(..)
+  , TyClDecl(..)  
+  , HsDataDefn(..)  
+  , NewOrData(..)
+  , Id
+  , HsGroup(..)  
+  , HsBindLR(..)  
+  , HsValBindsLR(..)
+  , HsPatSynDetails(..)
+  , Located
+  , IE(..)  
+  , TyThing(..)
+  , LHsDecl  
+  , HsDecl(..)  
+  , DocDecl(..)  
+  , ConDecl(..)
+  , PostRn  
+  , HsConDetails(..)  
+  , ConDeclField(..)  
+  , DataFamInstDecl(..)
+  , LSig  
+  , Sig(..)  
+  , ForeignDecl(..) 
+  , FixitySig(..)
+  , tcdName
+  , collectHsBindBinders
+  , getLoc
+  , hsSigType
+  , getConNames
+  , getConDetails
+  , selectorFieldOcc
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)    
+  , tyClGroupTyClDecls
+  , LIEWrappedName
+  , hsGroupInstDecls
+  , ieLWrappedName
+#else
+  , tyClGroupConcat
+#endif
+  , tyConKind
+  , nameSrcSpan
+  , srcSpanFile
+  , srcSpanStartLine
+  , srcSpanEndLine
+  , srcSpanStartCol
+  , srcSpanEndCol
+  , isExternalName
+  , moduleNameString
+  , recordPatSynSelectorId
+  , recordPatSynPatVar
+  , isGoodSrcSpan
+  , isLocalId
+  , isDataFamilyDecl
+  , tyFamInstDeclName 
+  , idType
+  , hsib_body
+  , tfe_pats
+  , tfid_eqn
+  )
+import qualified HaskellCodeExplorer.Types as HCE
+import HscTypes (TypeEnv, lookupTypeEnv)
+import IdInfo (IdDetails(..))
+import InstEnv (ClsInst(..))
+import Lexer (ParseResult(POk), mkPState, unP)
+import Module (Module(..))
+import Name
+  ( isDataConNameSpace
+  , isDerivedOccName
+  , isInternalName
+  , isSystemName
+  , isTvNameSpace
+  , isTyConName
+  , isVarNameSpace
+  , isWiredInName
+  , mkInternalName
+  , mkOccName
+  , nameModule_maybe
+  , nameOccName
+  , nameUnique
+  , occNameFS
+  , occNameSpace
+  , occNameString
+  , wiredInNameTyThing_maybe
+  )
+import OccName (OccName)
+import Outputable (Outputable, ppr, showPpr, showSDoc)
+import PackageConfig (packageVersion)
+import Packages
+  ( LookupResult(..)
+  , lookupModuleWithSuggestions
+  , lookupPackage
+  , packageNameString
+  )
+import Pair (pSnd)
+import Parser (parseIdentifier)
+import PatSyn (PatSyn, patSynMatcher, patSynSig)
+import Prelude hiding (id, span)
+import RdrName (GlobalRdrEnv, RdrName(..), gre_name, lookupGRE_RdrName)
+import RnEnv (dataTcOccs)
+import SrcLoc (GenLocated(..), mkRealSrcLoc, unLoc)
+import StringBuffer (StringBuffer(..), stringToStringBuffer)
+import System.FilePath (normalise)
+import TcEvidence (HsWrapper(..), tcCoercionKind)
+import TcType (evVarPred)
+import TyCoRep (Type(..),
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+  ArgFlag(..)
+#else
+  VisibilityFlag(..)
+#endif
+ )
+import TyCon (tyConName)
+import Type
+  ( coreView
+  , expandTypeSynonyms
+  , mkForAllTy
+  , mkFunTy
+  , mkFunTys
+  , mkInvForAllTys
+#if !MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+  , mkNamedBinder
+#endif  
+  , piResultTy  
+  , pprSigmaType
+  , splitFunTy_maybe
+  , tidyOpenType
+  )
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+import ToIface
+import IfaceType
+#endif
+import TysWiredIn (unitTy)
+import UniqSet (emptyUniqSet, unionUniqSets,
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+   nonDetEltsUniqSet
+#else
+   uniqSetToList
+#endif
+ )
+import Unique (getKey)
+import Var
+  ( idDetails
+  , isId
+  , mkTyVar
+  , setVarType
+  , varName
+  , varType
+  , varUnique
+  )
+import VarEnv (TidyEnv)
+import VarSet (VarSet, emptyVarSet, unionVarSet, unitVarSet
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+#else
+ ,varSetElems
+#endif
+ )
+
+--------------------------------------------------------------------------------
+-- Pretty-printing
+--------------------------------------------------------------------------------
+
+toText :: (Outputable a) => DynFlags -> a -> T.Text
+toText flags = T.pack . showSDoc flags . ppr
+
+instanceToText :: DynFlags -> ClsInst -> T.Text
+instanceToText flags ClsInst {..} =
+  T.append "instance " $ T.pack . showSDoc flags $ pprSigmaType (idType is_dfun)
+
+instanceDeclToText :: DynFlags -> InstDecl Name -> T.Text
+instanceDeclToText flags decl =
+  case decl of
+    ClsInstD ClsInstDecl {..} -> T.append "instance " (toText flags cid_poly_ty)
+    DataFamInstD di ->
+      let args =
+            T.intercalate " " . map (toText flags) . hsib_body $ dfid_pats di
+       in T.concat
+            ["data instance ", toText flags (unLoc $ dfid_tycon di), " ", args]
+    TyFamInstD ti ->
+      let args =
+            T.intercalate " " .
+            map (toText flags) . hsib_body . tfe_pats . unLoc . tfid_eqn $
+            ti
+       in T.concat
+            ["type instance ", toText flags $ tyFamInstDeclName ti, " ", args]
+
+nameToText :: Name -> T.Text
+nameToText = T.pack . unpackFS . occNameFS . nameOccName
+
+tyClDeclPrefix :: TyClDecl a -> T.Text
+tyClDeclPrefix tyClDecl =
+  let isNewTy :: TyClDecl a -> Bool
+      isNewTy DataDecl {tcdDataDefn = HsDataDefn {dd_ND = NewType}} = True
+      isNewTy _ = False
+   in case tyClDecl of
+        FamDecl _
+          | isDataFamilyDecl tyClDecl -> "data family "
+          | otherwise -> "type family "
+        SynDecl {} -> "type "
+        DataDecl {}
+          | isNewTy tyClDecl -> "newtype "
+          | otherwise -> "data "
+        ClassDecl {} -> "class "
+    
+demangleOccName :: Name -> T.Text
+demangleOccName name
+  | isDerivedOccName (nameOccName name) =
+    let removePrefix :: T.Text -> T.Text
+        removePrefix occName
+          | T.isPrefixOf "$sel:" occName =
+            fst $ T.breakOn ":" (T.drop 5 occName)
+          | T.isPrefixOf "$W" occName = T.drop 2 occName
+          | T.isPrefixOf "$w" occName = T.drop 2 occName
+          | T.isPrefixOf "$m" occName = T.drop 2 occName
+          | T.isPrefixOf "$b" occName = T.drop 2 occName
+          | T.isPrefixOf "$dm" occName = T.drop 3 occName
+          | T.isPrefixOf "$c" occName = T.drop 2 occName
+          | T.isPrefixOf "$d" occName = T.drop 2 occName
+          | T.isPrefixOf "$i" occName = T.drop 2 occName
+          | T.isPrefixOf "$s" occName = T.drop 2 occName
+          | T.isPrefixOf "$f" occName = T.drop 2 occName
+          | T.isPrefixOf "$r" occName = T.drop 2 occName
+          | T.isPrefixOf "C:" occName = T.drop 2 occName
+          | T.isPrefixOf "N:" occName = T.drop 2 occName
+          | T.isPrefixOf "D:" occName = T.drop 2 occName
+          | T.isPrefixOf "$co" occName = T.drop 3 occName
+          | otherwise = occName
+     in removePrefix $ nameToText name
+  | otherwise = nameToText name
+    
+stringBufferToByteString :: StringBuffer -> BS.ByteString
+stringBufferToByteString (StringBuffer buf len cur) =
+  BSI.fromForeignPtr buf cur len
+
+nameSort :: Name -> HCE.NameSort
+nameSort n =
+  if isExternalName n
+    then HCE.External
+    else HCE.Internal
+  
+occNameNameSpace :: OccName -> HCE.NameSpace
+occNameNameSpace n
+  | isVarNameSpace (occNameSpace n) = HCE.VarName
+  | isDataConNameSpace (occNameSpace n) = HCE.DataName
+  | isTvNameSpace (occNameSpace n) = HCE.TvName
+  | otherwise = HCE.TcClsName
+
+-- Two 'Id''s may have different types even though they have the same 'Unique'.
+identifierKey :: DynFlags -> Id -> T.Text
+identifierKey flags id
+  | isLocalId id =
+    T.concat
+      [ T.pack . show . getKey . varUnique $ id
+      , "_"
+      , T.pack . show . hash . showSDoc flags . ppr . varType $ id
+      ]
+identifierKey _ id = T.pack . show . getKey . varUnique $ id
+
+nameKey :: Name -> T.Text
+nameKey = T.pack . show . getKey . nameUnique
+
+mbIdDetails :: Id -> Maybe HCE.IdDetails
+mbIdDetails v
+  | isId v =
+    case idDetails v of
+      VanillaId -> Just HCE.VanillaId
+      RecSelId {sel_naughty = False} -> Just HCE.RecSelId
+      RecSelId {sel_naughty = True} -> Just HCE.RecSelIdNaughty
+      DataConWorkId _ -> Just HCE.DataConWorkId
+      DataConWrapId _ -> Just HCE.DataConWrapId
+      ClassOpId _ -> Just HCE.ClassOpId
+      PrimOpId _ -> Just HCE.PrimOpId
+      FCallId _ -> Just HCE.FCallId
+      TickBoxOpId _ -> Just HCE.TickBoxOpId
+      DFunId _ -> Just HCE.DFunId
+      CoVarId -> Just HCE.CoVarId
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+      JoinId _ -> Just HCE.JoinId
+#endif        
+mbIdDetails _ = Nothing
+
+--------------------------------------------------------------------------------
+--  Syntax transformation
+--------------------------------------------------------------------------------
+
+hsGroupVals :: HsGroup Name -> [GenLocated SrcSpan (HsBindLR Name Name)]
+hsGroupVals hsGroup =
+  filter (isGoodSrcSpan . getLoc) $
+  case hs_valds hsGroup of
+    ValBindsOut binds _ -> concatMap (bagToList . snd) binds
+    _ -> []
+
+hsPatSynDetails :: HsPatSynDetails a -> [a]
+hsPatSynDetails patDetails =
+  case patDetails of
+    InfixPatSyn name1 name2 -> [name1, name2]
+    PrefixPatSyn name -> name
+    RecordPatSyn fields ->
+      concatMap
+        (\field -> [recordPatSynSelectorId field, recordPatSynPatVar field])
+        fields
+
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+unwrapName :: LIEWrappedName Name -> Located Name
+unwrapName = ieLWrappedName
+#else
+unwrapName :: Located Name -> Located Name
+unwrapName n = n
+#endif
+
+ieLocNames :: IE Name -> [Located Name]
+ieLocNames (IEVar n) = [unwrapName n]
+ieLocNames (IEThingAbs n) = [unwrapName n]
+ieLocNames (IEThingAll n) = [unwrapName n]
+ieLocNames (IEThingWith n _ ns labels) =
+  unwrapName n : (map unwrapName ns ++ map (fmap flSelector) labels)
+ieLocNames (IEModuleContents (L _ _)) = []
+ieLocNames (IEGroup _ _) = []
+ieLocNames (IEDoc _) = []
+ieLocNames (IEDocNamed _) = []
+
+--------------------------------------------------------------------------------
+-- Lookups
+--------------------------------------------------------------------------------
+
+lookupIdInTypeEnv :: TypeEnv -> Name -> Maybe Id
+lookupIdInTypeEnv typeEnv name = do
+  let mbTyThing
+        | isInternalName name = Nothing
+        | isSystemName name = Nothing
+        | isWiredInName name = wiredInNameTyThing_maybe name
+        | isExternalName name = lookupTypeEnv typeEnv name
+        | otherwise = Nothing
+  case mbTyThing of
+    Just tyThing -> tyThingToId tyThing    
+    _ -> Nothing
+
+lookupNameModuleAndPackage ::
+     DynFlags
+  -> HCE.PackageId
+  -> Name
+  -> Either T.Text (HCE.HaskellModuleName, HCE.PackageId)
+lookupNameModuleAndPackage flags currentPackageId name =
+  case nameModule_maybe name of
+    Just Module {..} ->
+      case lookupPackage flags moduleUnitId of
+        Just packageConfig ->
+          let packageId =
+                if (T.pack . packageNameString $ packageConfig) ==
+                   HCE.name (currentPackageId :: HCE.PackageId)
+                  then currentPackageId
+                  else HCE.PackageId
+                         (T.pack $ packageNameString packageConfig)
+                         (PackageConfig.packageVersion packageConfig)
+           in Right
+                ( HCE.HaskellModuleName . T.pack . moduleNameString $ moduleName
+                , packageId)
+        Nothing ->
+          Right
+            ( HCE.HaskellModuleName . T.pack . moduleNameString $ moduleName
+            , currentPackageId)
+    Nothing ->
+      Left $ T.concat ["nameModule_maybe ", nameToText name, " is Nothing"]
+
+--------------------------------------------------------------------------------
+-- Location info
+--------------------------------------------------------------------------------
+
+isHsBoot :: HCE.HaskellModulePath -> Bool
+isHsBoot = T.isSuffixOf "-boot" . HCE.getHaskellModulePath 
+
+moduleLocationInfo ::
+     DynFlags
+  -> HM.HashMap HCE.HaskellModuleName (HM.HashMap HCE.ComponentId HCE.HaskellModulePath)
+  -> HCE.PackageId
+  -> HCE.ComponentId
+  -> ModuleName
+  -> HCE.LocationInfo
+moduleLocationInfo flags moduleNameMap currentPackageId compId moduleName =
+  let moduleNameText = T.pack . moduleNameString $ moduleName
+      currentPackageLocation =
+        HCE.ApproximateLocation
+          currentPackageId
+          (HCE.HaskellModuleName . T.pack . moduleNameString $ moduleName)
+          HCE.Mod
+          moduleNameText
+          Nothing
+          compId
+   in case HM.lookup (HCE.HaskellModuleName moduleNameText) moduleNameMap of
+        Just modulePathMap
+          | Just modulePath <- HM.lookup compId modulePathMap ->
+            HCE.ExactLocation
+              currentPackageId
+              modulePath
+              (HCE.HaskellModuleName moduleNameText)
+              1
+              1
+              1
+              1
+        _ ->
+          case lookupModuleWithSuggestions flags moduleName Nothing of
+            LookupFound Module {moduleUnitId = unitId} _ ->
+              case lookupPackage flags unitId of
+                Just packInfo ->
+                  let packageId =
+                        HCE.PackageId
+                          (T.pack $ packageNameString packInfo)
+                          (PackageConfig.packageVersion packInfo)
+                   in HCE.ApproximateLocation
+                        packageId
+                        (HCE.HaskellModuleName . T.pack . moduleNameString $
+                         moduleName)
+                        HCE.Mod
+                        moduleNameText
+                        Nothing
+                        (if packageId == currentPackageId
+                           then compId
+                           else HCE.ComponentId "lib")
+                Nothing -> currentPackageLocation
+            _ -> currentPackageLocation
+             
+isDefinedInCurrentModule ::
+     HCE.SourceCodeTransformation -> HCE.HaskellFilePath -> Bool
+isDefinedInCurrentModule transformation file =
+  let includedFiles = HM.keys $ HCE.fileIndex transformation
+      modPath =
+        HCE.getHaskellModulePath $
+        HCE.filePath (transformation :: HCE.SourceCodeTransformation)
+   in HCE.getHaskellFilePath file == modPath || (file `elem` includedFiles)
+      
+nameLocationInfo ::
+     DynFlags
+  -> HCE.PackageId
+  -> HCE.ComponentId
+  -> HCE.SourceCodeTransformation
+  -> HM.HashMap HCE.HaskellFilePath HCE.HaskellModulePath
+  -> HM.HashMap HCE.HaskellModulePath HCE.DefinitionSiteMap
+  -> Maybe T.Text -- ^ Instance head (when name is a dictionary function)
+  -> Maybe SrcSpan -- ^ Only for wired-in names
+  -> Name
+  -> HCE.LocationInfo
+nameLocationInfo flags currentPackageId compId transformation fileMap defSiteMap mbInstanceHead mbSrcSpan name
+  | Just srcSpan <- realSrcSpan name mbSrcSpan =
+    let filePath =
+          HCE.HaskellFilePath . T.pack . normalise . unpackFS . srcSpanFile $
+          srcSpan
+        approximateLocation =
+          mkApproximateLocation
+            flags
+            currentPackageId
+            compId
+            mbInstanceHead
+            name
+     in if isDefinedInCurrentModule transformation filePath
+          then let eitherStart =
+                     HCE.fromOriginalLineNumber
+                       transformation
+                       (filePath, srcSpanStartLine srcSpan)
+                   eitherEnd =
+                     HCE.fromOriginalLineNumber
+                       transformation
+                       (filePath, srcSpanEndLine srcSpan)                      
+                in case (,) eitherStart eitherEnd of
+                     (Right startLine,Right endLine) ->
+                         let  modulePath = HCE.filePath (transformation :: HCE.SourceCodeTransformation)
+                              moduleName =
+                                  either
+                                    (const $ HCE.HaskellModuleName "")
+                                    fst
+                                    (lookupNameModuleAndPackage flags currentPackageId name)
+                         in HCE.ExactLocation
+                              { packageId = currentPackageId
+                              , modulePath = modulePath
+                              , moduleName = moduleName
+                              , startLine = startLine
+                              , endLine = endLine
+                              , startColumn = srcSpanStartCol srcSpan
+                              , endColumn = srcSpanEndCol srcSpan
+                              }
+                     _ -> approximateLocation
+          else case HM.lookup filePath fileMap of
+                 Just haskellModulePath ->
+                   case HM.lookup haskellModulePath defSiteMap of
+                     Just defSites ->
+                       let key = fromMaybe (nameToText name) mbInstanceHead
+                        in lookupEntityLocation
+                             defSites
+                             (mkLocatableEntity name mbInstanceHead)
+                             key
+                     Nothing -> approximateLocation
+                 Nothing -> approximateLocation
+  where
+    realSrcSpan :: Name -> Maybe SrcSpan -> Maybe RealSrcSpan
+    realSrcSpan name mbSrcSpan =
+      case nameSrcSpan name of
+        RealSrcSpan span -> Just span
+        _
+          | isWiredInName name ->
+            case mbSrcSpan of
+              Just span ->
+                case span of
+                  RealSrcSpan s -> Just s
+                  _ -> Nothing
+              _ -> Nothing
+        _ -> Nothing
+nameLocationInfo flags currentPackageId compId _transformation _fileMap _defSiteMap mbInstanceHead _mbSrcSpan name =
+  mkApproximateLocation flags currentPackageId compId mbInstanceHead name
+
+mkApproximateLocation ::
+     DynFlags
+  -> HCE.PackageId
+  -> HCE.ComponentId
+  -> Maybe T.Text
+  -> Name
+  -> HCE.LocationInfo
+mkApproximateLocation flags currentPackageId compId mbInstanceHead name =
+  let haddockAnchor =
+        Just . T.pack . makeAnchorId . T.unpack . nameToText $ name
+   in case lookupNameModuleAndPackage flags currentPackageId name of
+        Right (moduleName, packageId) ->
+          HCE.ApproximateLocation
+            { moduleName = moduleName
+            , packageId = packageId
+            , componentId =
+                if packageId == currentPackageId
+                  then compId
+                  else HCE.ComponentId "lib"
+            , entity = mkLocatableEntity name mbInstanceHead
+            , haddockAnchorId = haddockAnchor
+            , name = fromMaybe (nameToText name) mbInstanceHead
+            }
+        Left errorMessage -> HCE.UnknownLocation errorMessage
+
+mkLocatableEntity :: Name -> Maybe a -> HCE.LocatableEntity
+mkLocatableEntity name mbInstanceHead
+  | isJust mbInstanceHead = HCE.Inst
+  | otherwise =
+    case occNameNameSpace . nameOccName $ name of
+      HCE.VarName -> HCE.Val
+      HCE.DataName -> HCE.Val
+      _ -> HCE.Typ        
+
+occNameLocationInfo ::
+     DynFlags
+  -> HCE.PackageId
+  -> HCE.ComponentId
+  -> (ModuleName, OccName)
+  -> HCE.LocationInfo
+occNameLocationInfo flags packageId componentId (modName, occName) =
+  HCE.ApproximateLocation
+    { packageId = packageId
+    , moduleName = HCE.HaskellModuleName $ toText flags modName
+    , entity =
+        case occNameNameSpace occName of
+          HCE.VarName -> HCE.Val
+          HCE.DataName -> HCE.Val
+          _ -> HCE.Typ
+    , name = toText flags occName
+    , haddockAnchorId =
+        Just . T.pack . makeAnchorId . T.unpack $ toText flags occName
+    , componentId = componentId
+    }
+
+lookupEntityLocation ::
+     HCE.DefinitionSiteMap -> HCE.LocatableEntity -> T.Text -> HCE.LocationInfo
+lookupEntityLocation defSiteMap locatableEntity text =
+  let errorMessage =
+        T.concat
+          [ "Cannot find location of "
+          , T.pack . show $ locatableEntity
+          , " "
+          , text
+          ]
+      defSiteLocation = HCE.location :: HCE.DefinitionSite -> HCE.LocationInfo
+      lookupLocation ::
+           (Eq a, Hashable a)
+        => (HCE.DefinitionSiteMap -> HM.HashMap a HCE.DefinitionSite)
+        -> (T.Text -> a)
+        -> HCE.LocationInfo
+      lookupLocation selector toKey =
+        maybe (HCE.UnknownLocation errorMessage) defSiteLocation $
+        HM.lookup (toKey text) (selector defSiteMap)
+   in case locatableEntity of
+        HCE.Val -> lookupLocation HCE.values HCE.OccName
+        HCE.Typ -> lookupLocation HCE.types HCE.OccName
+        HCE.Inst -> lookupLocation HCE.instances (\t -> t)
+        HCE.Mod -> HCE.UnknownLocation errorMessage
+
+nameDocumentation ::
+     HCE.SourceCodeTransformation
+  -> HM.HashMap HCE.HaskellFilePath HCE.HaskellModulePath
+  -> HM.HashMap HCE.HaskellModulePath HCE.DefinitionSiteMap
+  -> HCE.DefinitionSiteMap
+  -> Name
+  -> Maybe T.Text
+nameDocumentation transformation fileMap defSiteMap currentModuleDefSiteMap name
+  | isExternalName name || isWiredInName name
+  , Just file <- srcSpanToFilePath . nameSrcSpan $ name =
+    if isDefinedInCurrentModule transformation file
+      then lookupNameDocumentation name currentModuleDefSiteMap
+      else case HM.lookup file fileMap of
+             Just haskellModulePath ->
+               case HM.lookup haskellModulePath defSiteMap of
+                 Just defSites -> lookupNameDocumentation name defSites
+                 Nothing -> Nothing
+             Nothing -> Nothing
+nameDocumentation _ _ _ _ _ = Nothing
+
+lookupNameDocumentation :: Name -> HCE.DefinitionSiteMap -> Maybe T.Text
+lookupNameDocumentation name defSiteMap =
+  let key = HCE.OccName $ nameToText name
+      lookupDoc ::
+           (HCE.DefinitionSiteMap -> HM.HashMap HCE.OccName HCE.DefinitionSite)
+        -> Maybe T.Text
+      lookupDoc selector =
+        maybe Nothing HCE.documentation $
+        HM.lookup key (selector (defSiteMap :: HCE.DefinitionSiteMap))
+   in case occNameNameSpace . nameOccName $ name of
+        HCE.VarName -> lookupDoc HCE.values
+        HCE.DataName -> lookupDoc HCE.values
+        _ -> lookupDoc HCE.types
+
+srcSpanToFilePath :: SrcSpan -> Maybe HCE.HaskellFilePath
+srcSpanToFilePath (RealSrcSpan s) =
+  Just . HCE.HaskellFilePath . T.pack . normalise . unpackFS . srcSpanFile $ s   
+srcSpanToFilePath (UnhelpfulSpan _) = Nothing
+   
+srcSpanToLineAndColNumbers ::
+     HCE.SourceCodeTransformation
+  -> SrcSpan
+  -> Maybe (HCE.HaskellFilePath, (Int, Int), (Int, Int))
+srcSpanToLineAndColNumbers transformation (RealSrcSpan s) =
+  let filePath =
+        HCE.HaskellFilePath . T.pack . normalise . unpackFS . srcSpanFile $ s
+      eitherStart =
+        HCE.fromOriginalLineNumber transformation (filePath, srcSpanStartLine s)
+      eitherEnd =
+        HCE.fromOriginalLineNumber transformation (filePath, srcSpanEndLine s)
+   in case (,) eitherStart eitherEnd of
+        (Right startLine, Right endLine) ->
+          Just
+            ( filePath
+            , (startLine, srcSpanStartCol s)
+            , (endLine, srcSpanEndCol s))
+        _ -> Nothing
+srcSpanToLineAndColNumbers _ _ = Nothing
+
+--------------------------------------------------------------------------------
+-- Type-related functions
+--------------------------------------------------------------------------------
+
+tyThingToId :: TyThing -> Maybe Id
+tyThingToId tyThing =
+  case tyThing of
+    AnId id -> Just id
+    ATyCon tc -> Just $ mkTyVar (tyConName tc) (tyConKind tc)
+    AConLike con ->
+      case con of
+        RealDataCon dataCon -> Just $ dataConWorkId dataCon
+        PatSynCon ps -> Just $ patSynId ps
+    ACoAxiom _ -> Nothing
+
+tidyIdentifierType :: TidyEnv -> Id -> (TidyEnv, Id)
+tidyIdentifierType tidyEnv identifier =
+  let (tidyEnv', typ') = tidyOpenType tidyEnv (varType identifier)
+   in (tidyEnv', setVarType identifier typ')
+
+patSynId :: PatSyn -> Id
+patSynId patSyn =
+  let (univTvs, reqTheta, exTvs, provTheta, argTys, resTy) = patSynSig patSyn
+      reqTheta'
+        | null reqTheta && not (null provTheta && null exTvs) = [unitTy]
+        | otherwise = reqTheta
+      --  required => provided => arg_1 -> ... -> arg_n -> res
+      patSynTy =
+        mkInvForAllTys univTvs $
+        mkFunTys reqTheta' $
+        mkInvForAllTys exTvs $ mkFunTys provTheta $ mkFunTys argTys resTy
+   in flip setVarType patSynTy . fst . patSynMatcher $ patSyn
+
+applyWrapper :: HsWrapper -> Type -> Type
+applyWrapper wp ty
+  | Just ty' <- coreView ty = applyWrapper wp ty'
+applyWrapper WpHole t = t
+applyWrapper (WpCompose w1 w2) t = applyWrapper w1 . applyWrapper w2 $ t
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+applyWrapper (WpFun w1 w2 t1 _doc) t = mkFunTy t1 (applyWrapper w2 $ piResultTy t (applyWrapper w1 t1))
+#else
+applyWrapper (WpFun w1 w2 t1) t = mkFunTy t1 (applyWrapper w2 $ piResultTy t (applyWrapper w1 t1))
+#endif
+applyWrapper (WpCast coercion) _t = pSnd $ tcCoercionKind coercion
+applyWrapper (WpEvLam v) t = mkFunTy (evVarPred v) t
+applyWrapper (WpEvApp _ev) t = case splitFunTy_maybe t of
+  Just (_arg,res) -> res
+  Nothing -> t
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)  
+applyWrapper (WpTyLam v) t = mkForAllTy v Required t
+#else
+applyWrapper (WpTyLam v) t = mkForAllTy (mkNamedBinder Invisible v) t
+#endif
+applyWrapper (WpTyApp t') t = piResultTy t t'
+applyWrapper (WpLet _) t = t
+
+wrapperTypes :: HsWrapper -> [Type]
+wrapperTypes WpHole  = []
+wrapperTypes (WpCompose w1 w2) = wrapperTypes w2 ++ wrapperTypes w1
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+wrapperTypes (WpFun w1 w2 _ _) = wrapperTypes w2 ++ wrapperTypes w1
+#else
+wrapperTypes (WpFun w1 w2 _) = wrapperTypes w2 ++ wrapperTypes w1
+#endif
+wrapperTypes (WpCast _)  = []
+wrapperTypes (WpEvLam _) = []
+wrapperTypes (WpEvApp _) = []
+wrapperTypes (WpTyLam _) = []
+wrapperTypes (WpTyApp t) = [t]
+wrapperTypes (WpLet _) = []
+
+mkType :: DynFlags -> Type -> HCE.Type
+mkType flags typ =
+  let typeExpanded = expandTypeSynonyms typ
+      typeComponents = toTypeComponents flags typ
+      typeComponentsExpanded = toTypeComponents flags typeExpanded
+   in HCE.Type
+        typeComponents
+        (if typeComponents /= typeComponentsExpanded
+           then Just typeComponentsExpanded
+           else Nothing)
+
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+typeToText :: DynFlags -> Type -> T.Text    
+typeToText flags = T.pack . showSDoc flags . pprIfaceType . toIfaceType
+#else
+typeToText :: DynFlags -> Type -> T.Text    
+typeToText = toText
+#endif
+
+toTypeComponents :: DynFlags -> Type -> [HCE.TypeComponent]
+toTypeComponents flags typ =
+  let signature =
+        typeToText flags $
+        updateOccNames (\_unique occName -> ";" ++ drop 2 occName ++ ";") typ
+      -- Signature with OccNames and uniques
+      signatureWithUniques =
+        typeToText flags $
+        updateOccNames
+          (\unique occName -> ";," ++ occName ++ "," ++ unique ++ ";")
+          typ
+      -- Dirty but simple way to extract a list of TypeComponent from a type signature.      
+      -- Assumptions :
+      -- 1. Character ';' cannot appear anywhere in a type signature
+      -- 2. Character ',' cannot appear in an 'OccName'
+      -- 3. length (T.splitOn ";" signature) == length (T.splitOn ";" signatureWithUniques)
+      components =
+        L.zip (T.splitOn ";" signature) (T.splitOn ";" signatureWithUniques)
+   in mapMaybe
+        (\(text1, text2) ->
+           if T.isPrefixOf "," text2
+             then case T.splitOn "," text2 of
+                    ["", name, id] ->
+                      Just HCE.TyCon {name = name, internalId = HCE.InternalId id}
+                    _ -> Just $ HCE.Text text1
+             else if T.null text1
+                    then Nothing
+                    else Just $ HCE.Text text1)
+        components
+
+-- | Replaces 'OccName' of each type variable and type constructor in a type.
+updateOccNames :: (String -> String -> String) -> Type -> Type
+updateOccNames update = everywhere (mkT updateType)
+  where
+    updateType :: Type -> Type
+    updateType (TyVarTy var) = TyVarTy var {varName = updateName (varName var)}
+    updateType (TyConApp con args) =
+      TyConApp (con {tyConName = updateName (tyConName con)}) args
+    updateType other = other
+    updateName :: Name -> Name
+    updateName oldName =
+      let oldOccName = nameOccName oldName
+          unique = T.unpack $ nameKey oldName
+          newOccName =
+            mkOccName
+              (occNameSpace oldOccName)
+              (update unique (occNameString oldOccName))
+       in mkInternalName (nameUnique oldName) newOccName (nameSrcSpan oldName)
+          
+-- | This function doesn't look through type synonyms
+tyConsOfType :: Type -> [Id]
+tyConsOfType =
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)  
+  nonDetEltsUniqSet . everything unionUniqSets (emptyVarSet `mkQ` tyCon)
+#else
+  uniqSetToList . everything unionUniqSets (emptyVarSet `mkQ` tyCon)
+#endif
+  where
+    tyCon :: Type -> VarSet
+    tyCon (TyConApp tc _) = unitVarSet $ mkTyVar (tyConName tc) (tyConKind tc)
+    tyCon _ = emptyUniqSet
+
+tyVarsOfType :: (Data a) => a -> [Id]
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)  
+tyVarsOfType = nonDetEltsUniqSet . everything unionVarSet (emptyVarSet `mkQ` tyVar)
+#else
+tyVarsOfType = varSetElems . everything unionVarSet (emptyVarSet `mkQ` tyVar)
+#endif
+  where
+    tyVar :: Type -> VarSet
+    tyVar (TyVarTy ty) = unitVarSet ty
+    tyVar _ = emptyVarSet
+
+--------------------------------------------------------------------------------
+-- Documentation processing
+-- Some functions are copied from haddock-api package
+--------------------------------------------------------------------------------
+
+collectDocs :: [LHsDecl a] -> [(LHsDecl a, [HsDocString])]
+collectDocs = go Nothing []
+  where
+    go Nothing _ [] = []
+    go (Just prev) docs [] = finished prev docs []
+    go prev docs (L _ (DocD (DocCommentNext str)):ds)
+      | Nothing <- prev = go Nothing (str : docs) ds
+      | Just decl <- prev = finished decl docs (go Nothing [str] ds)
+    go prev docs (L _ (DocD (DocCommentPrev str)):ds) = go prev (str : docs) ds
+    go Nothing docs (d:ds) = go (Just d) docs ds
+    go (Just prev) docs (d:ds) = finished prev docs (go (Just d) [] ds)
+    finished decl docs rest = (decl, reverse docs) : rest
+
+ungroup :: HsGroup Name -> [LHsDecl Name]
+ungroup group_ =
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+  mkDecls (tyClGroupTyClDecls . hs_tyclds) TyClD group_ ++  
+#else
+  mkDecls (tyClGroupConcat . hs_tyclds) TyClD group_ ++
+#endif
+  mkDecls hs_derivds DerivD group_ ++
+  mkDecls hs_defds DefD group_ ++
+  mkDecls hs_fords ForD group_ ++
+  mkDecls hs_docs DocD group_ ++
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)  
+  mkDecls hsGroupInstDecls InstD group_ ++
+#else
+  mkDecls hs_instds InstD group_ ++
+#endif
+  mkDecls (typesigs . hs_valds) SigD group_ ++
+  mkDecls (valbinds . hs_valds) ValD group_
+  where
+    typesigs (ValBindsOut _ sigs) = filter isUserLSig sigs
+    typesigs _ = []
+    valbinds (ValBindsOut binds _) = concatMap bagToList . snd . unzip $ binds
+    valbinds _ = []
+
+mkDecls :: (a -> [Located b]) -> (b -> c) -> a -> [Located c]
+mkDecls field con struct = [L loc (con decl) | L loc decl <- field struct]
+
+sortByLoc :: [Located a] -> [Located a]
+sortByLoc = L.sortBy (comparing getLoc)
+
+classDeclDocs :: TyClDecl Name -> [(LHsDecl Name, [HsDocString])]
+classDeclDocs class_ = collectDocs . sortByLoc $ decls
+  where
+    decls = docs ++ defs ++ sigs ++ ats
+    docs = mkDecls tcdDocs DocD class_
+    defs = mkDecls (bagToList . tcdMeths) ValD class_
+    sigs = mkDecls tcdSigs SigD class_
+    ats = mkDecls tcdATs (TyClD . FamDecl) class_
+
+conDeclDocs :: ConDecl Name -> [(Name, [HsDocString], SrcSpan)]
+conDeclDocs conDecl =
+  map (\(L span n) -> (n, maybe [] ((: []) . unLoc) $ con_doc conDecl, span)) .
+  getConNames $
+  conDecl
+
+selectorDocs :: ConDecl name -> [(PostRn name name, [HsDocString], SrcSpan)]
+selectorDocs con =
+  case getConDetails con of
+    RecCon (L _ flds) ->
+      concatMap
+        (\(L _ (ConDeclField fieldOccs _ mbDoc)) ->
+           map
+             (\(L span f) ->
+                (selectorFieldOcc f, maybe [] ((: []) . unLoc) mbDoc, span))
+             fieldOccs)
+        flds
+    _ -> []
+
+subordinateNamesWithDocs ::
+     [GenLocated SrcSpan (HsDecl Name)] -> [(Name, [HsDocString], SrcSpan)]
+subordinateNamesWithDocs =
+  concatMap
+    (\(L span tyClDecl) ->
+       case tyClDecl of
+         TyClD classDecl@ClassDecl {..} ->
+           concatMap
+             (\(L _ decl, docs) -> map (, docs, span) $ getMainDeclBinder decl) $
+           classDeclDocs classDecl
+         TyClD DataDecl {..} ->
+           concatMap (\(L _ con) -> conDeclDocs con ++ selectorDocs con) $
+           dd_cons tcdDataDefn
+         InstD (DataFamInstD DataFamInstDecl {..}) ->
+           concatMap (conDeclDocs . unLoc) . dd_cons $ dfid_defn
+         _ -> [])
+    
+isUserLSig :: LSig name -> Bool
+isUserLSig (L _ TypeSig {})    = True
+isUserLSig (L _ ClassOpSig {}) = True
+isUserLSig _ = False
+
+getMainDeclBinder :: HsDecl name -> [name]
+getMainDeclBinder (TyClD d) = [tcdName d]
+getMainDeclBinder (ValD d) =
+  case collectHsBindBinders d of
+    [] -> []
+    (name:_) -> [name]
+getMainDeclBinder (SigD d) = sigNameNoLoc d
+getMainDeclBinder (ForD (ForeignImport name _ _ _)) = [unLoc name]
+getMainDeclBinder (ForD ForeignExport {}) = []
+getMainDeclBinder _ = []
+
+sigNameNoLoc :: Sig name -> [name]
+sigNameNoLoc (TypeSig      ns _)       = map unLoc ns
+sigNameNoLoc (ClassOpSig _ ns _)       = map unLoc ns
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
+sigNameNoLoc (PatSynSig    ns _)        = map unLoc ns
+#else
+sigNameNoLoc (PatSynSig    n _)        = [unLoc n]
+#endif
+sigNameNoLoc (SpecSig      n _ _)      = [unLoc n]
+sigNameNoLoc (InlineSig    n _)        = [unLoc n]
+sigNameNoLoc (FixSig (FixitySig ns _)) = map unLoc ns
+sigNameNoLoc _                         = []
+
+clsInstDeclSrcSpan :: ClsInstDecl name -> SrcSpan
+clsInstDeclSrcSpan ClsInstDecl {cid_poly_ty = ty} = getLoc (hsSigType ty)
+
+hsDocsToDocH :: DynFlags -> GlobalRdrEnv -> [HsDocString] -> Doc Name
+hsDocsToDocH flags rdrEnv =
+  rename flags rdrEnv .
+  overIdentifier (parseIdent flags) .
+  _doc . parseParas . concatMap (unpackFS . (\(HsDocString s) -> s))
+
+parseIdent :: DynFlags -> String -> Maybe RdrName
+parseIdent dflags str0 =
+  let buffer = stringToStringBuffer str0
+      realSrcLc = mkRealSrcLoc (mkFastString "<unknown file>") 0 0
+      pstate = mkPState dflags buffer realSrcLc
+  in case unP parseIdentifier pstate of
+    POk _ name -> Just (unLoc name)
+    _ -> Nothing
+
+type Doc id = DocH (ModuleName, OccName) id
+
+rename :: DynFlags -> GlobalRdrEnv -> Doc RdrName -> Doc Name
+rename dflags gre = rn
+  where
+    rn d = case d of
+      DocAppend a b -> DocAppend (rn a) (rn b)
+      DocParagraph doc -> DocParagraph (rn doc)
+      DocIdentifier x -> do
+        -- Generate the choices for the possible kind of thing this
+        -- is.
+        let choices = dataTcOccs x
+        -- Try to look up all the names in the GlobalRdrEnv that match
+        -- the names.
+        let names = concatMap (\c -> map gre_name (lookupGRE_RdrName c gre)) choices
+
+        case names of
+          -- We found no names in the env so we start guessing.
+          [] ->
+            case choices of
+              [] -> DocMonospaced (DocString (showPpr dflags x))
+              -- There was nothing in the environment so we need to
+              -- pick some default from what's available to us. We
+              -- diverge here from the old way where we would default
+              -- to type constructors as we're much more likely to
+              -- actually want anchors to regular definitions than
+              -- type constructor names (such as in #253). So now we
+              -- only get type constructor links if they are actually
+              -- in scope.
+              a:_ -> outOfScope dflags a
+
+          -- There is only one name in the environment that matches so
+          -- use it.
+          [a] -> DocIdentifier a
+          -- But when there are multiple names available, default to
+          -- type constructors: somewhat awfully GHC returns the
+          -- values in the list positionally.
+          a:b:_ | isTyConName a -> DocIdentifier a
+                | otherwise -> DocIdentifier b
+
+      DocWarning doc -> DocWarning (rn doc)
+      DocEmphasis doc -> DocEmphasis (rn doc)
+      DocBold doc -> DocBold (rn doc)
+      DocMonospaced doc -> DocMonospaced (rn doc)
+      DocUnorderedList docs -> DocUnorderedList (map rn docs)
+      DocOrderedList docs -> DocOrderedList (map rn docs)
+      DocDefList list -> DocDefList [ (rn a, rn b) | (a, b) <- list ]
+      DocCodeBlock doc -> DocCodeBlock (rn doc)
+      DocIdentifierUnchecked x -> DocIdentifierUnchecked x
+      DocModule str -> DocModule str
+      DocHyperlink l -> DocHyperlink l
+      DocPic str -> DocPic str
+      DocMathInline str -> DocMathInline str
+      DocMathDisplay str -> DocMathDisplay str
+      DocAName str -> DocAName str
+      DocProperty p -> DocProperty p
+      DocExamples e -> DocExamples e
+      DocEmpty -> DocEmpty
+      DocString str -> DocString str
+      DocHeader (Header l t) -> DocHeader $ Header l (rn t)
+
+-- | Wrap an identifier that's out of scope (i.e. wasn't found in
+-- 'GlobalReaderEnv' during 'rename') in an appropriate doc. Currently
+-- we simply monospace the identifier in most cases except when the
+-- identifier is qualified: if the identifier is qualified then we can
+-- still try to guess and generate anchors accross modules but the
+-- users shouldn't rely on this doing the right thing. See tickets
+-- #253 and #375 on the confusion this causes depending on which
+-- default we pick in 'rename'.
+outOfScope :: DynFlags -> RdrName -> Doc a
+outOfScope dflags x =
+  case x of
+    Unqual occ -> monospaced occ
+    Qual mdl occ -> DocIdentifierUnchecked (mdl, occ)
+    Orig _ occ -> monospaced occ
+    Exact name -> monospaced name -- Shouldn't happen since x is out of scope
+  where
+    monospaced a = DocMonospaced (DocString (showPpr dflags a))
+
+makeAnchorId :: String -> String
+makeAnchorId [] = []
+makeAnchorId (f:r) = escape isAlpha f ++ concatMap (escape isLegal) r
+  where
+    escape p c | p c = [c]
+               | otherwise = '-' : show (ord c) ++ "-"
+    isLegal ':' = True
+    isLegal '_' = True
+    isLegal '.' = True
+    isLegal c = isAscii c && isAlphaNum c    
diff --git a/src/HaskellCodeExplorer/ModuleInfo.hs b/src/HaskellCodeExplorer/ModuleInfo.hs
new file mode 100644
index 0000000..cc81a36
--- /dev/null
+++ b/src/HaskellCodeExplorer/ModuleInfo.hs
@@ -0,0 +1,811 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# 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)
+import Data.Ord(comparing)
+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
+import HsBinds(HsBindLR)
+import HsDecls
+  ( ForeignDecl(..)
+  , HsDecl(..)
+  , HsGroup(..)
+  , InstDecl
+  , InstDecl(..)
+  , TyClDecl
+  , 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 (\includedFile -> (includedFile, 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'
+               (fromMaybe (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]
+  -> HsGroup Name
+  -> (HCE.DefinitionSiteMap, [Name])
+createDefinitionSiteMap flags currentPackageId compId defSiteMap fileMap globalRdrEnv transformation modInfo dataFamTyCons hsGroup =
+  let allDecls :: [GenLocated SrcSpan (HsDecl Name)]
+      allDecls = L.sortBy (comparing 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
+               InstD (ClsInstD inst) -> Just (clsInstDeclSrcSpan inst, docs)
+               _ -> 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
+  -> HsGroup Name
+  -> 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
+      --------------------------------------------------------------------------------
+      valToDeclarations ::
+           GenLocated SrcSpan (HsBindLR Name Name) -> [HCE.Declaration]
+      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
+      --------------------------------------------------------------------------------
+      tyClToDeclaration :: GenLocated SrcSpan (TyClDecl Name) -> HCE.Declaration
+      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
+      --------------------------------------------------------------------------------
+      instToDeclaration :: GenLocated SrcSpan (InstDecl Name) -> HCE.Declaration
+      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
+      --------------------------------------------------------------------------------
+      foreignFunToDeclaration ::
+           GenLocated SrcSpan (ForeignDecl Name) -> HCE.Declaration
+      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.sortBy (comparing 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
+              (\(L span ie) ->
+                 case ie of
+                   IEModuleContents (L _ modName) ->
+                     Just
+                       ( modName
+                       , span
+                       , moduleLocationInfo
+                           flags
+                           (envModuleNameMap environment)
+                           packageId
+                           compId
+                           modName)
+                   _ -> Nothing)
+              lieNames
+          Nothing -> []
+      addImportedAndExportedModulesToIdOccMap ::
+           HCE.IdentifierOccurrenceMap -> HCE.IdentifierOccurrenceMap
+      addImportedAndExportedModulesToIdOccMap =
+        IM.map (L.sortBy $ comparing 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} ->
+        addTypeToMaps
+          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
+           ->
+            case unLoc $ locatedName nameOcc of
+              Just name ->
+                addTypeToMaps
+                  environment
+                  idMaps
+                  Nothing
+                  (Just name)
+                  (description nameOcc)
+                  lineNumber
+                  startCol
+                  endCol
+              Nothing -> idMaps             
+addIdentifierToMaps _ _ idMaps _ = idMaps
+
+addTypeToMaps ::
+     Environment
+  -> (HCE.IdentifierInfoMap, HCE.IdentifierOccurrenceMap)
+  -> Maybe Type
+  -> Maybe Name
+  -> T.Text
+  -> Int
+  -> Int
+  -> Int
+  -> (HCE.IdentifierInfoMap, HCE.IdentifierOccurrenceMap)
+addTypeToMaps 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 = HCE.TypeId
+          }
+      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
diff --git a/src/HaskellCodeExplorer/PackageInfo.hs b/src/HaskellCodeExplorer/PackageInfo.hs
new file mode 100644
index 0000000..f384a74
--- /dev/null
+++ b/src/HaskellCodeExplorer/PackageInfo.hs
@@ -0,0 +1,595 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module HaskellCodeExplorer.PackageInfo
+  ( createPackageInfo
+  ) where
+
+import Control.DeepSeq(deepseq)
+import Control.Exception
+  ( IOException
+  , SomeAsyncException
+  , SomeException
+  , fromException
+  , throw
+  , try
+  )
+import Control.Monad (foldM, join, unless)
+import Control.Monad.Extra (findM)
+import Control.Monad.Logger
+  ( LoggingT(..)
+  , MonadLogger(..)
+  , MonadLoggerIO(..)
+  , logDebugN
+  , logErrorN
+  , logInfoN
+  )
+import qualified Data.ByteString as BS
+import qualified Data.HashMap.Strict as HM
+import Data.IORef (readIORef)
+import qualified Data.IntMap.Strict as IM
+import qualified Data.List as L
+import Data.Maybe (fromMaybe, isJust, maybeToList)
+import qualified Data.Set as S
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import Digraph (flattenSCCs)
+import Distribution.Helper
+  ( ChComponentName(..)
+  , ChEntrypoint(..)
+  , ChModuleName(..)
+  , components
+  , entrypoints
+  , ghcOptions
+  , mkQueryEnv
+  , packageId
+  , runQuery
+  , sourceDirs
+  )
+import DynFlags
+  ( DynFlags(..)
+  , GeneralFlag(..)
+  , GhcMode(..)
+  , WarnReason(..)
+  , gopt_set
+  , parseDynamicFlagsCmdLine
+  )
+import Exception (ExceptionMonad(..), ghandle)
+import GHC
+  ( GhcLink(..)
+  , HscTarget(..)
+  , LoadHowMuch(..)
+  , ModLocation(..)
+  , ModSummary(..)
+  , Severity
+  , SrcSpan
+  , getModuleGraph
+  , getSession
+  , getSessionDynFlags
+  , guessTarget
+  , load
+  , noLoc
+  , parseModule
+  , runGhcT
+  , setSessionDynFlags
+  , setTargets
+  , topSortModuleGraph
+  , typecheckModule
+  , moduleNameString
+  , moduleName  
+  )
+import GHC.Paths (libdir)
+import GhcMonad (GhcT(..), liftIO)
+import HaskellCodeExplorer.GhcUtils (isHsBoot,toText)
+import HaskellCodeExplorer.ModuleInfo (ModuleDependencies, createModuleInfo)
+import qualified HaskellCodeExplorer.Types as HCE
+import HscTypes (hsc_EPS, hsc_HPT)
+import Outputable (PprStyle, SDoc, neverQualify, showSDocForUser)
+import Packages (initPackages)
+import Prelude hiding (id)
+import System.Directory
+  ( doesFileExist
+  , doesFileExist
+  , findExecutable
+  , setCurrentDirectory
+  , getCurrentDirectory
+  , makeAbsolute
+  )
+import qualified System.Directory.Tree as DT
+import System.FilePath
+  ( (</>)
+  , addTrailingPathSeparator
+  , joinPath
+  , normalise
+  , replaceExtension
+  , splitPath
+  , takeExtension
+  , takeBaseName
+  , splitDirectories
+  )
+import System.Process (readProcess)
+
+createPackageInfo ::
+     FilePath -- ^ Path to a Cabal package
+  -> Maybe FilePath -- ^ Relative path to a dist directory
+  -> HCE.SourceCodePreprocessing -- ^ Before or after preprocessor
+  -> [String] -- ^ Options for GHC
+  -> [String] -- ^ Directories to ignore
+  -> LoggingT IO (HCE.PackageInfo HCE.ModuleInfo)
+createPackageInfo packageDirectoryPath mbDistDirRelativePath sourceCodePreprocessing additionalGhcOptions ignoreDirectories = do
+  packageDirectoryAbsPath <- liftIO $ makeAbsolute packageDirectoryPath
+  currentDirectory <- liftIO getCurrentDirectory
+  liftIO $ setCurrentDirectory packageDirectoryAbsPath
+  distDir <-
+    case mbDistDirRelativePath of
+      Just path -> return $ packageDirectoryAbsPath </> path
+      Nothing -> findDistDirectory packageDirectoryAbsPath
+  let cabalHelperQueryEnv = mkQueryEnv packageDirectoryAbsPath distDir
+  ((packageName, packageVersion), compInfo) <-
+    liftIO $
+    runQuery
+      cabalHelperQueryEnv
+      ((,) <$> packageId <*>
+       (zip3 <$> components ((,) <$> ghcOptions) <*>
+        components ((,) <$> entrypoints) <*>
+        components ((,) <$> sourceDirs)))
+  let currentPackageId = HCE.PackageId (T.pack packageName) packageVersion
+  logInfoN $ T.append "Indexing " $ HCE.packageIdToText currentPackageId
+  let buildComponents =
+        L.map
+          (\((options, compName), (entrypoint, _), (srcDirs, _)) ->
+             ( chComponentNameToComponentId compName
+             , options
+             , chEntrypointsToModules entrypoint
+             , srcDirs
+             , chComponentNameToComponentType compName)) .
+        L.sortBy
+          (\((_, compName1), _, _) ((_, compName2), _, _) ->
+             compare compName1 compName2) $
+        compInfo
+      libSrcDirs =
+        concatMap (\(_, _, _, srcDirs, _) -> srcDirs) .
+        filter (\(_, _, _, _, compType) -> HCE.isLibrary compType) $
+        buildComponents
+  (indexedModules, (_fileMapResult, _defSiteMapResult, modNameMapResult)) <-
+    foldM
+      (\(modules, (fileMap, defSiteMap, modNameMap)) (compId, options, (mbMain, moduleNames), srcDirs, _) -> do
+         mbMainPath <-
+           case mbMain of
+             Just mainPath ->
+               liftIO $
+               findM doesFileExist $
+               mainPath :
+               map (\srcDir -> normalise $ srcDir </> mainPath) srcDirs
+             Nothing -> return Nothing
+         (modules', (fileMap', defSiteMap', modNameMap')) <-
+           indexBuildComponent
+             sourceCodePreprocessing
+             currentPackageId
+             compId
+             (fileMap, defSiteMap, modNameMap)
+             srcDirs
+             libSrcDirs
+             (options ++ additionalGhcOptions)
+             (maybe moduleNames (: moduleNames) mbMainPath)
+         return (modules ++ modules', (fileMap', defSiteMap', modNameMap')))
+      ([], (HM.empty, HM.empty, HM.empty))
+      buildComponents
+  let modId = HCE.id :: HCE.ModuleInfo -> HCE.HaskellModulePath
+      moduleMap =
+        HM.fromList . map (\modInfo -> (modId modInfo, modInfo)) $
+        indexedModules
+      references = L.foldl' addReferencesFromModule HM.empty indexedModules
+      moduleId = HCE.id :: HCE.ModuleInfo -> HCE.HaskellModulePath
+      topLevelIdentifiersTrie =
+        L.foldl' addTopLevelIdentifiersFromModule HCE.emptyTrie .
+        L.filter (not . isHsBoot . moduleId) $
+        indexedModules
+  directoryTree <-
+    liftIO $
+    buildDirectoryTree
+      packageDirectoryAbsPath
+      ignoreDirectories
+      (\path -> HM.member (HCE.HaskellModulePath . T.pack $ path) moduleMap)
+  liftIO $ setCurrentDirectory currentDirectory
+  return
+    HCE.PackageInfo
+      { id = currentPackageId
+      , moduleMap = moduleMap
+      , moduleNameMap = modNameMapResult
+      , directoryTree = directoryTree
+      , externalIdOccMap = references
+      , externalIdInfoMap = topLevelIdentifiersTrie
+      }
+  where
+    chEntrypointsToModules :: ChEntrypoint -> (Maybe String, [String])
+    chEntrypointsToModules (ChLibEntrypoint modules otherModules signatures) =
+      ( Nothing
+      , L.map chModuleToString modules ++
+        L.map chModuleToString otherModules ++ L.map chModuleToString signatures)
+    chEntrypointsToModules (ChExeEntrypoint mainModule _otherModules) =
+      (Just mainModule, [])
+    chEntrypointsToModules ChSetupEntrypoint = (Nothing, [])
+    chModuleToString :: ChModuleName -> String
+    chModuleToString (ChModuleName n) = n
+    chComponentNameToComponentType :: ChComponentName -> HCE.ComponentType
+    chComponentNameToComponentType ChSetupHsName = HCE.Setup
+    chComponentNameToComponentType ChLibName = HCE.Lib
+    chComponentNameToComponentType (ChSubLibName name) =
+      HCE.SubLib $ T.pack name
+    chComponentNameToComponentType (ChFLibName name) = HCE.FLib $ T.pack name
+    chComponentNameToComponentType (ChExeName name) = HCE.Exe $ T.pack name
+    chComponentNameToComponentType (ChTestName name) = HCE.Test $ T.pack name
+    chComponentNameToComponentType (ChBenchName name) = HCE.Bench $ T.pack name
+    chComponentNameToComponentId :: ChComponentName -> HCE.ComponentId
+    chComponentNameToComponentId ChLibName = HCE.ComponentId "lib"
+    chComponentNameToComponentId (ChSubLibName name) =
+      HCE.ComponentId . T.append "sublib-" . T.pack $ name
+    chComponentNameToComponentId (ChFLibName name) =
+      HCE.ComponentId . T.append "flib-" . T.pack $ name
+    chComponentNameToComponentId (ChExeName name) =
+      HCE.ComponentId . T.append "exe-" . T.pack $ name
+    chComponentNameToComponentId (ChTestName name) =
+      HCE.ComponentId . T.append "test-" . T.pack $ name
+    chComponentNameToComponentId (ChBenchName name) =
+      HCE.ComponentId . T.append "bench-" . T.pack $ name
+    chComponentNameToComponentId ChSetupHsName = HCE.ComponentId "setup"
+     
+buildDirectoryTree :: FilePath -> [FilePath] -> (FilePath -> Bool) -> IO HCE.DirTree
+buildDirectoryTree path ignoreDirectories isHaskellModule = do
+  (_dir DT.:/ tree) <- DT.readDirectoryWith (const . return $ ()) path
+  -- Tuple up the complete file path with the file contents, by building up the path,
+  -- trie-style, from the root. The filepath will be relative to "anchored" directory.
+  let treeWithPaths = DT.zipPaths ("" DT.:/ DT.filterDir (not . ignore) tree)
+  return $ toDirTree (removeTopDir . fst <$> treeWithPaths)
+  where
+    ignore :: DT.DirTree a -> Bool
+    ignore (DT.Dir dirName _)
+      | "." `L.isPrefixOf` dirName = True
+      | dirName == "dist" = True
+      | dirName == "dist-newstyle" = True
+      | dirName == "tmp" = True
+      | otherwise = dirName `elem` ignoreDirectories
+    ignore (DT.Failed _ _) = True
+    ignore _ = False
+    removeTopDir :: FilePath -> FilePath
+    removeTopDir p =
+      case splitPath p of
+        _x:xs -> joinPath xs
+        [] -> ""
+    toDirTree :: DT.DirTree FilePath -> HCE.DirTree
+    toDirTree (DT.Dir name contents) =
+      HCE.Dir name (map toDirTree . filter (not . DT.failed) $ contents)
+    toDirTree (DT.File name filePath) =
+      HCE.File name filePath (isHaskellModule filePath)
+    toDirTree (DT.Failed name err) =
+      HCE.File (name ++ " : " ++ show err) "" False
+        
+addTopLevelIdentifiersFromModule ::
+     HCE.Trie Char HCE.ExternalIdentifierInfo
+  -> HCE.ModuleInfo
+  -> HCE.Trie Char HCE.ExternalIdentifierInfo
+addTopLevelIdentifiersFromModule trieIdInfo HCE.ModuleInfo {..} =
+  L.foldl'
+    (\trie idInfo@(HCE.ExternalIdentifierInfo HCE.IdentifierInfo {..}) ->
+       HCE.insertToTrie S.insert (T.unpack demangledOccName) idInfo trie)
+    trieIdInfo
+    externalIds
+  
+addReferencesFromModule ::     
+     HM.HashMap HCE.ExternalId (S.Set HCE.IdentifierSrcSpan)
+  -> HCE.ModuleInfo
+  -> HM.HashMap HCE.ExternalId (S.Set HCE.IdentifierSrcSpan)
+addReferencesFromModule references modInfo@HCE.ModuleInfo {..} =
+  eachIdentifierOccurrence
+    references
+    modInfo
+    (\occMap lineNumber startCol endCol occ ->
+       let mbIdExternalId =
+             join $
+             HCE.externalId <$>
+             maybe
+               Nothing
+               (`HM.lookup` idInfoMap)
+               (HCE.internalId (occ :: HCE.IdentifierOccurrence))
+           idSrcSpan =
+             HCE.IdentifierSrcSpan
+               { modulePath = id
+               , line = lineNumber
+               , startColumn = startCol
+               , endColumn = endCol
+               }
+        in case mbIdExternalId of
+             Just externalId ->
+               HM.insertWith S.union externalId (S.singleton idSrcSpan) occMap
+             Nothing -> occMap)
+
+findDistDirectory :: FilePath -> LoggingT IO FilePath
+findDistDirectory packagePath = do
+  hasStackYaml <- liftIO $ doesFileExist (packagePath </> "stack.yaml")
+  mbStackExecutable <- liftIO $ findExecutable "stack"
+  let defaultDistDir = packagePath </> "dist"
+  case (hasStackYaml, mbStackExecutable) of
+    (True, Just stack) -> do
+      let removeEndOfLine str
+            | null str = str
+            | otherwise = init str
+      eitherDistDir :: (Either IOException String) <-
+        liftIO .
+        try . fmap removeEndOfLine . readProcess stack ["path", "--dist-dir"] $
+        ""
+      case eitherDistDir of
+        Right distDir -> do
+          logDebugN $ T.append "Stack dist directory : " $ T.pack distDir
+          return distDir
+        Left exception -> do
+          logDebugN $
+            T.append
+              "Error while executing \"stack path --dist-dir\" : "
+              (T.pack . show $ exception)
+          return defaultDistDir
+    (False, _) -> do
+      logDebugN
+        "stack.yaml is not found in the package directory. Using default dist directory."
+      return defaultDistDir
+    (_, Nothing) -> do
+      logDebugN "stack executable is not found. Using default dist directory."
+      return defaultDistDir
+      
+eachIdentifierOccurrence ::
+     forall a.
+     a
+  -> HCE.ModuleInfo
+  -> (a -> IM.Key -> Int -> Int -> HCE.IdentifierOccurrence -> a)
+  -> a
+eachIdentifierOccurrence accumulator HCE.ModuleInfo {..} f =
+  IM.foldlWithKey'
+    (\acc lineNumber occurences ->
+       L.foldl'
+         (\a ((startCol, endCol), occ) -> f a lineNumber startCol endCol occ)
+         acc
+         occurences)
+    accumulator
+    idOccMap
+
+instance ExceptionMonad (LoggingT IO) where
+  gcatch act h =
+    LoggingT $ \logFn ->
+      runLoggingT act logFn `gcatch` \e -> runLoggingT (h e) logFn
+  gmask f =
+    LoggingT $ \logFn ->
+      gmask $ \io_restore ->
+        let g_restore (LoggingT m) = LoggingT $ \lf -> io_restore (m lf)
+         in runLoggingT (f g_restore) logFn
+
+instance MonadLoggerIO (GhcT (LoggingT IO)) where
+  askLoggerIO = GhcT $ const askLoggerIO
+
+instance MonadLogger (GhcT (LoggingT IO)) where
+  monadLoggerLog loc source level =
+    GhcT . const . monadLoggerLog loc source level
+
+gtrySync :: (ExceptionMonad m) => m a -> m (Either SomeException a)
+gtrySync action = ghandleSync (return . Left) (fmap Right action)
+
+ghandleSync :: (ExceptionMonad m) => (SomeException -> m a) -> m a -> m a
+ghandleSync onError =
+  ghandle
+    (\ex ->
+       case fromException ex of
+         Just (asyncEx :: SomeAsyncException) -> throw asyncEx
+         _ -> onError ex)
+    
+indexBuildComponent ::
+     HCE.SourceCodePreprocessing -- ^ Before or after preprocessor
+  -> HCE.PackageId -- ^ Current package id
+  -> HCE.ComponentId -- ^ Current component id
+  -> ModuleDependencies -- ^ Already indexed modules
+  -> [FilePath] -- ^ Src dirs
+  -> [FilePath] -- ^ Src dirs of libraries
+  -> [String] -- ^ Command-line options for GHC
+  -> [String] -- ^ Modules to compile
+  -> LoggingT IO ([HCE.ModuleInfo],ModuleDependencies)
+indexBuildComponent sourceCodePreprocessing currentPackageId componentId deps@(fileMap, defSiteMap, modNameMap) srcDirs libSrcDirs options modules = do
+  let onError ex = do
+        logErrorN $
+          T.concat
+            [ "Error while indexing component "
+            , HCE.getComponentId componentId
+            , " : "
+            , T.pack . show $ ex
+            ]
+        return ([], deps)
+  ghandleSync onError $
+    runGhcT (Just libdir) $ do
+      logDebugN (T.append "Component id : " $ HCE.getComponentId componentId)
+      logDebugN (T.append "Modules : " $ T.pack $ show modules)
+      logDebugN (T.append "GHC options : " $ T.pack $ show options)
+      flags <- getSessionDynFlags
+      (flags', _, _) <- parseDynamicFlagsCmdLine flags (L.map noLoc options)
+      (flags'', _) <- liftIO $ initPackages flags'
+      logFn <- askLoggerIO
+      let logAction ::
+               DynFlags
+            -> WarnReason
+            -> Severity
+            -> SrcSpan
+            -> Outputable.PprStyle
+            -> SDoc
+            -> IO ()
+          logAction fs _reason _severity srcSpan _stype msg =
+            runLoggingT
+              (logDebugN
+                 (T.append "GHC message : " $
+                  T.pack $
+                  showSDocForUser fs neverQualify msg ++
+                  " , SrcSpan : " ++ show srcSpan))
+              logFn
+          mbTmpDir =
+            case hiDir flags'' of
+              Just buildDir ->
+                Just $ buildDir </> (takeBaseName buildDir ++ "-tmp")
+              Nothing -> Nothing
+      _ <-
+        setSessionDynFlags $
+        L.foldl'
+          gopt_set
+          (flags''
+             { hscTarget = HscAsm
+             , ghcLink = LinkInMemory
+             , ghcMode = CompManager
+             , log_action = logAction
+             , importPaths = importPaths flags'' ++ maybeToList mbTmpDir
+             })
+          [Opt_Haddock]
+      targets <- mapM (`guessTarget` Nothing) modules
+      setTargets targets
+      _ <- load LoadAllTargets
+      modGraph <- getModuleGraph
+      let topSortMods = flattenSCCs (topSortModuleGraph False modGraph Nothing)
+          buildDir =
+            addTrailingPathSeparator . normalise . fromMaybe "" . hiDir $
+            flags''
+          pathsModuleName =
+            "Paths_" ++
+            map
+              (\c ->
+                 if c == '-'
+                   then '_'
+                   else c)
+              (T.unpack (HCE.name (currentPackageId :: HCE.PackageId)))      
+      (modSumWithPath, modulesNotFound) <-
+        (\(mods, notFound) ->
+           ( L.reverse .
+             L.foldl'
+               (\acc (mbPath, modSum) ->
+                  case mbPath of
+                    Just path
+                      | not $ HM.member path defSiteMap -> (path, modSum) : acc
+                    _ -> acc)
+               [] $
+             mods
+           , map snd notFound)) .
+        L.partition (\(mbPath, _) -> isJust mbPath) <$>
+        mapM
+          (\modSum ->
+             liftIO $
+             (, modSum) <$>
+             findHaskellModulePath buildDir (srcDirs ++ libSrcDirs) modSum)
+          (filter
+             (\modSum ->
+                pathsModuleName /=
+                (moduleNameString . moduleName $ ms_mod modSum))
+             topSortMods)      
+      unless (null modulesNotFound) $
+        logErrorN $
+        T.append
+          "Cannot find module path : "
+          (toText flags'' $ map ms_mod modulesNotFound)
+      foldM
+        (\(indexedModules, (fileMap', defSiteMap', modNameMap')) (modulePath, modSum) -> do
+           result <-
+             indexModule
+               sourceCodePreprocessing
+               componentId
+               currentPackageId
+               flags''
+               (fileMap', defSiteMap', modNameMap')
+               (modulePath, modSum)
+           case result of
+             Right (modInfo, (fileMap'', defSiteMap'', modNameMap'')) ->
+               return
+                 ( modInfo : indexedModules
+                 , (fileMap'', defSiteMap'', modNameMap''))
+             Left exception -> do
+               logErrorN $
+                 T.concat
+                   [ "Error while indexing "
+                   , T.pack . show $ modulePath
+                   , " : "
+                   , T.pack . show $ exception
+                   ]
+               return (indexedModules, (fileMap', defSiteMap', modNameMap')))
+        ([], (fileMap, defSiteMap, modNameMap))
+        modSumWithPath
+          
+findHaskellModulePath ::
+     FilePath -> [FilePath] -> ModSummary -> IO (Maybe HCE.HaskellModulePath)
+findHaskellModulePath buildDir srcDirs modSum =
+  case normalise <$> (ml_hs_file . ms_location $ modSum) of
+    Just modulePath ->
+      let toHaskellModulePath = return . Just . HCE.HaskellModulePath . T.pack
+          removeTmpDir path =
+            case splitDirectories path of
+              parent:rest ->
+                if "-tmp" `L.isSuffixOf` parent
+                  then joinPath rest
+                  else path
+              _ -> path
+       in case removeTmpDir <$> L.stripPrefix buildDir modulePath of
+            -- File is in the build directory        
+            Just path
+              | takeExtension path == ".hs-boot" -> do
+                let possiblePaths = path : map (</> path) srcDirs
+                mbFoundPath <- findM doesFileExist possiblePaths
+                case mbFoundPath of
+                  Just p -> toHaskellModulePath p
+                  _ -> return Nothing
+              | takeExtension path == ".hs" -> do
+                let paths =
+                      map
+                        (replaceExtension path)
+                        HCE.haskellPreprocessorExtensions
+                    possiblePaths =
+                      paths ++
+                      concatMap (\srcDir -> map (srcDir </>) paths) srcDirs
+                mbFoundPath <- findM doesFileExist possiblePaths
+                case mbFoundPath of
+                  Just p -> toHaskellModulePath p
+                  _ -> return Nothing
+              | otherwise -> return Nothing
+            Nothing -> toHaskellModulePath modulePath
+    Nothing -> return Nothing
+
+indexModule ::
+     HCE.SourceCodePreprocessing
+  -> HCE.ComponentId
+  -> HCE.PackageId
+  -> DynFlags
+  -> ModuleDependencies
+  -> (HCE.HaskellModulePath, ModSummary)
+  -> GhcT (LoggingT IO) (Either SomeException ( HCE.ModuleInfo
+                                              , ModuleDependencies))
+indexModule sourceCodePreprocessing componentId currentPackageId flags deps (modulePath, modSum) =
+  gtrySync $ do
+    logDebugN (T.append "Indexing " $ HCE.getHaskellModulePath modulePath)
+    parsedModule <- parseModule modSum
+    typecheckedModule <- typecheckModule parsedModule
+    hscEnv <- getSession
+    externalPackageState <- liftIO . readIORef . hsc_EPS $ hscEnv
+    originalSourceCode <-
+      liftIO $
+      T.replace "\t" "        " . TE.decodeUtf8 <$>
+      BS.readFile (T.unpack . HCE.getHaskellModulePath $ modulePath)
+    let (modInfo, (fileMap', exportMap', moduleNameMap'), typeErrors) =
+          createModuleInfo
+            deps
+            ( flags
+            , typecheckedModule
+            , hsc_HPT hscEnv
+            , externalPackageState
+            , modSum)
+            modulePath
+            currentPackageId
+            componentId
+            (originalSourceCode, sourceCodePreprocessing)
+    unless (null typeErrors) $
+      logInfoN $ T.append "Type errors : " $ T.pack $ show typeErrors
+    deepseq modInfo $ return (modInfo, (fileMap', exportMap', moduleNameMap'))
diff --git a/src/HaskellCodeExplorer/Preprocessor.hs b/src/HaskellCodeExplorer/Preprocessor.hs
new file mode 100644
index 0000000..6a90ff9
--- /dev/null
+++ b/src/HaskellCodeExplorer/Preprocessor.hs
@@ -0,0 +1,159 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module HaskellCodeExplorer.Preprocessor
+  ( createSourceCodeTransformation
+  ) where
+
+import Control.Applicative ((<|>))
+import qualified Data.Attoparsec.Text as AT
+import Data.Foldable (foldl')
+import qualified Data.HashMap.Strict as HM
+import qualified Data.List as L
+import qualified Data.Set as S
+import qualified Data.Text as T
+import HaskellCodeExplorer.Types
+  ( FileLocation(..)
+  , HaskellFilePath(..)
+  , HaskellModulePath(..)
+  , LinePragma(..)
+  , SourceCodeTransformation(..)
+  , haskellPreprocessorExtensions  
+  )
+import System.FilePath (normalise,takeExtension,takeFileName)
+
+
+-- | Finds locations of line pragmas and creates an index
+createSourceCodeTransformation ::
+     HaskellModulePath -> T.Text -> T.Text -> (SourceCodeTransformation, T.Text)
+createSourceCodeTransformation currentModulePath originalSourceCode sourceCodeAfterPreprocessing =
+  let sourceCodeLines = T.splitOn "\n" sourceCodeAfterPreprocessing
+      numberedLines = zip [1 :: Int ..] sourceCodeLines
+      currentFilePath =
+        HaskellFilePath . getHaskellModulePath $ currentModulePath
+      addPragma :: [LinePragma] -> (Int, T.Text) -> [LinePragma]
+      addPragma acc (lineNumber, line) =
+        case AT.parseOnly linePragmaParser line of
+          Right (originalLineNumber, mbFileName) ->
+            LinePragma
+              (maybe
+                 currentFilePath
+                 (HaskellFilePath . T.pack . normalise . T.unpack)
+                 mbFileName)
+              lineNumber
+              originalLineNumber :
+            acc
+          Left _ -> acc
+      totalLines = length numberedLines
+      pragmas = L.reverse . L.foldl' addPragma [] $ numberedLines
+      pragmaPath = filePath :: LinePragma -> HaskellFilePath
+      currentFileExtension =
+        takeExtension . T.unpack . getHaskellFilePath $ currentFilePath
+      standardHeaderFiles = ["stdc-predef.h", "cabal_macros.h", "ghcversion.h"]      
+      hasIncludedFiles =
+        L.any
+          ((\path ->
+              let fileName = takeFileName . T.unpack . getHaskellFilePath $ path
+               in (path /= currentFilePath) &&
+                  (path /= HaskellFilePath "<built-in>") &&
+                  (path /= HaskellFilePath "<command-line>") &&
+                  not ("ghc_" `L.isPrefixOf` fileName) &&
+                  (fileName `notElem` standardHeaderFiles)) .
+           pragmaPath)
+          pragmas
+   in if hasIncludedFiles ||
+         currentFileExtension `elem` haskellPreprocessorExtensions
+        then ( SourceCodeTransformation
+                 totalLines
+                 currentModulePath
+                 (S.fromList pragmas)
+                 (indexLocations totalLines currentFilePath pragmas)
+             , sourceCodeAfterPreprocessing)
+        else ( SourceCodeTransformation
+                 (length $ T.splitOn "\n" originalSourceCode)
+                 currentModulePath
+                 S.empty
+                 HM.empty
+             , originalSourceCode)
+
+-- | Parses line pragma
+linePragmaParser :: AT.Parser (Int, Maybe T.Text)
+linePragmaParser = pragma1 <|> pragma2
+  where   
+    pragma1 :: AT.Parser (Int, Maybe T.Text)
+    pragma1 = parser "#" "line"
+    
+    pragma2 :: AT.Parser (Int, Maybe T.Text)
+    pragma2 = parser "{-#" "LINE"
+    
+    parser :: T.Text -> T.Text -> AT.Parser (Int, Maybe T.Text)
+    parser start line = do
+      _ <- AT.string start
+      _ <- AT.takeWhile (== ' ')
+      _ <- AT.string line <|> return ""
+      _ <- AT.takeWhile (== ' ')
+      num <- AT.decimal
+      _ <- AT.takeWhile (== ' ')
+      mbName <- (Just <$> fileName) <|> return Nothing
+      return (num, mbName)
+      
+    fileName :: AT.Parser T.Text
+    fileName = AT.string "\"" *> AT.takeTill (== '\"') <* AT.string "\""    
+
+data Line = FirstLine | LastLine Int | Pragma LinePragma deriving (Show,Eq)
+
+-- | Creates a HashMap whose keys are filenames and values are locations in a
+-- preprocessed source code
+indexLocations ::
+     Int
+  -> HaskellFilePath
+  -> [LinePragma]
+  -> HM.HashMap HaskellFilePath (S.Set FileLocation)
+indexLocations totalLines preprocessedFilePath pragmas =
+  foldl' add HM.empty . (zip <*> tail) $
+  (FirstLine : map Pragma pragmas) ++ [LastLine totalLines]
+  where
+    add ::
+         HM.HashMap HaskellFilePath (S.Set FileLocation)
+      -> (Line, Line)
+      -> HM.HashMap HaskellFilePath (S.Set FileLocation)
+    -- Interval between the first line and the first pragma
+    add hMap (FirstLine, Pragma LinePragma {..})
+      | lineNumberPreprocessed > 1 =
+        HM.insertWith
+          S.union
+          preprocessedFilePath
+          (S.singleton (FileLocation 1 lineNumberPreprocessed 0))
+          hMap
+      | otherwise = hMap
+    -- Interval between two pragmas
+    add hMap (Pragma (LinePragma fileName lineNumberPreprocessed1 lineNumberOriginal1),
+              Pragma (LinePragma _ lineNumberPreprocessed2 _))
+      | lineNumberPreprocessed2 - lineNumberPreprocessed1 > 1 =
+        HM.insertWith
+          S.union
+          fileName
+          (S.singleton
+             (FileLocation
+                lineNumberOriginal1
+                (lineNumberOriginal1 +
+                 (lineNumberPreprocessed2 - lineNumberPreprocessed1 - 2))
+                (lineNumberPreprocessed1 - lineNumberOriginal1 + 1)))
+          hMap
+      | otherwise = hMap
+    -- Interval between the last pragma and the last line
+    add hMap (Pragma (LinePragma fileName lineNumberPreprocessed lineNumberOriginal),
+              LastLine lastLineNumberPreprocessed)
+      | lastLineNumberPreprocessed - lineNumberPreprocessed > 1 =
+        HM.insertWith
+          S.union
+          fileName
+          (S.singleton
+             (FileLocation
+                lineNumberOriginal
+                (lineNumberOriginal + (lastLineNumberPreprocessed - lineNumberPreprocessed - 2))
+                (lineNumberPreprocessed - lineNumberOriginal + 1)))
+          hMap
+      | otherwise = hMap
+    add hMap _ = hMap
diff --git a/src/HaskellCodeExplorer/Types.hs b/src/HaskellCodeExplorer/Types.hs
new file mode 100644
index 0000000..9e3667d
--- /dev/null
+++ b/src/HaskellCodeExplorer/Types.hs
@@ -0,0 +1,880 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module HaskellCodeExplorer.Types where
+
+import Control.DeepSeq (NFData)
+import qualified Data.Aeson as A
+import Data.Aeson.Types (Options, defaultOptions, omitNothingFields)
+import Data.Generics
+  ( Constr
+  , Data(..)
+  , DataType
+  , Fixity(..)
+  , constrIndex
+  , gcast2
+  , mkConstr
+  , mkDataType
+  )
+import qualified Data.HashMap.Strict as HM
+import Data.Hashable (Hashable)
+import qualified Data.IntMap.Strict as IM
+import qualified Data.IntervalMap.Strict as IVM
+import qualified Data.List as L
+import Data.Maybe (fromMaybe, isJust)
+import Data.Serialize (Get, Serialize(..))
+import qualified Data.Set as S      
+import qualified Data.Text as T
+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import Data.Text.Lazy (toStrict)
+import qualified Data.Vector as V
+import Data.Version (Version(..),showVersion)
+import Documentation.Haddock.Types
+  ( DocH(..)
+  , Example(..)
+  , Header(..)
+  , Hyperlink(..)
+  , Picture(..)
+  )
+import GHC.Generics (Generic)
+import Prelude hiding (id)
+import Text.Blaze.Html.Renderer.Text (renderHtml)
+import qualified Text.Blaze.Html5 as Html
+import qualified Text.Blaze.Html5.Attributes as Attr
+
+--------------------------------------------------------------------------------
+-- Package info
+--------------------------------------------------------------------------------
+
+data PackageInfo modInfo = PackageInfo
+  { id :: PackageId
+  , moduleMap :: HM.HashMap HaskellModulePath modInfo
+  , moduleNameMap :: HM.HashMap HaskellModuleName (HM.HashMap ComponentId HaskellModulePath)
+  , directoryTree :: DirTree
+  , externalIdInfoMap :: Trie Char ExternalIdentifierInfo
+  -- ^ All external identifiers defined in the package
+  , externalIdOccMap :: HM.HashMap ExternalId (S.Set IdentifierSrcSpan)
+  -- ^ All occurrences of each external identifier in the package
+  } deriving (Show, Eq, Generic, Data)
+
+data PackageId = PackageId
+  { name :: T.Text
+  , version :: Data.Version.Version
+  } deriving (Show, Eq, Ord, Generic, Data)
+
+packageIdToText :: PackageId -> T.Text
+packageIdToText (PackageId name version) =
+  T.concat [name, "-", T.pack $ showVersion version]
+
+packageName :: PackageInfo a -> T.Text
+packageName =
+  (name :: (PackageId -> T.Text)) . (id :: PackageInfo a -> PackageId)
+
+data IdentifierSrcSpan = IdentifierSrcSpan
+  { modulePath :: HaskellModulePath
+  , line :: Int
+  , startColumn :: Int
+  , endColumn :: Int
+  } deriving (Show, Eq, Ord, Generic, Data)
+
+data DirTree
+  = Dir { name :: FilePath
+        , contents :: [DirTree] }
+  | File { name :: FilePath
+         , path :: FilePath
+         , isHaskellModule :: Bool }
+  deriving (Show, Eq, Generic, Data)
+
+newtype ComponentId = ComponentId
+  { getComponentId :: T.Text
+  } deriving (Show, Eq, Ord, Generic, A.ToJSONKey, Data, Hashable)
+
+data ComponentType
+  = Setup
+  | Lib
+  | SubLib T.Text
+  | FLib T.Text
+  | Exe T.Text
+  | Test T.Text
+  | Bench T.Text
+  deriving (Show, Eq, Generic, Data)
+
+isLibrary :: ComponentType -> Bool
+isLibrary Lib = True
+isLibrary (SubLib _) = True
+isLibrary (FLib _) = True
+isLibrary _ = False
+
+packageInfoBinaryFileName :: FilePath
+packageInfoBinaryFileName = "packageInfo"
+
+packageInfoJsonFileName :: FilePath
+packageInfoJsonFileName = "packageInfo.json"
+
+defaultOutputDirectoryName :: FilePath
+defaultOutputDirectoryName = ".haskell-code-explorer"
+
+--------------------------------------------------------------------------------
+-- A simple Trie implementation
+--------------------------------------------------------------------------------
+
+data Trie k v = Trie
+  { values :: S.Set v
+  , children :: HM.HashMap k (Trie k v)
+  } deriving (Show, Eq, Generic, Data)
+
+emptyTrie :: Trie k v
+emptyTrie = Trie S.empty HM.empty
+
+insertToTrie ::
+     (Hashable k, Eq k, Ord v)
+  => (v -> S.Set v -> S.Set v)
+  -> [k]
+  -> v
+  -> Trie k v
+  -> Trie k v
+insertToTrie f [] v (Trie vals children) = Trie (f v vals) children
+insertToTrie f word@(first:rest) val (Trie vals children) =
+  case HM.lookup first children of
+    Just trie ->
+      Trie vals (HM.insert first (insertToTrie f rest val trie) children)
+    Nothing ->
+      insertToTrie f word val (Trie vals (HM.insert first emptyTrie children))
+
+match :: (Hashable k, Eq k, Ord v) => [k] -> Trie k v -> S.Set v
+match (first:rest) (Trie _ children) =
+  maybe S.empty (match rest) (HM.lookup first children)
+match [] (Trie val children) =
+  S.union val $
+  S.unions
+    [S.union v $ match [] trie | (_, trie@(Trie v _)) <- HM.toList children]
+
+--------------------------------------------------------------------------------
+-- Module info
+--------------------------------------------------------------------------------
+
+data ModuleInfo = ModuleInfo
+  { id :: HaskellModulePath
+  , name :: HaskellModuleName
+  , source :: V.Vector T.Text
+    -- ^ Source code of the module
+  , transformation :: SourceCodeTransformation
+  , exprInfoMap :: ExpressionInfoMap
+    -- ^ Type of each expression in the module
+  , idOccMap :: IdentifierOccurrenceMap
+    -- ^ All occurrences of each identifier in the module
+  , idInfoMap :: IdentifierInfoMap
+    -- ^ Information about each identifier in the module
+  , declarations :: [Declaration]
+  , definitionSiteMap :: DefinitionSiteMap
+    -- ^ Definition site of each top-level value, type, and type class instance    
+  , externalIds :: [ExternalIdentifierInfo]
+  } deriving (Show, Eq, Generic, Data)
+
+type ExpressionInfoMap = IVM.IntervalMap (Int, Int) ExpressionInfo
+type IdentifierOccurrenceMap = IM.IntMap [((Int, Int), IdentifierOccurrence)]
+type IdentifierInfoMap = HM.HashMap InternalId IdentifierInfo
+
+data DefinitionSiteMap = DefinitionSiteMap
+  { values :: HM.HashMap OccName DefinitionSite
+  , types :: HM.HashMap OccName DefinitionSite
+  , instances :: HM.HashMap T.Text DefinitionSite
+  } deriving (Show, Eq, Generic, Data)
+
+data DefinitionSite = DefinitionSite
+  { location :: LocationInfo
+  , documentation :: Maybe HTML
+  } deriving (Show, Eq, Generic, Data)
+
+type HTML = T.Text
+
+newtype OccName = OccName
+  { getOccName :: T.Text
+  } deriving (Show, Eq, Ord, Generic, A.ToJSONKey, Data, Hashable)
+
+-- | 'CompactModuleInfo' contains a subset of fields of 'ModuleInfo'.
+data CompactModuleInfo = CompactModuleInfo
+  { id :: HaskellModulePath
+  , name :: HaskellModuleName
+  , exprInfoMap :: ExpressionInfoMap
+  , definitionSiteMap :: DefinitionSiteMap
+  , source :: V.Vector T.Text
+  } deriving (Show, Eq, Generic, Data)
+
+haskellPreprocessorExtensions :: [FilePath]
+haskellPreprocessorExtensions =
+  [".hsc", ".chs", ".cpphs", ".gc", ".x", ".y", ".ly"]
+
+toCompactPackageInfo :: PackageInfo ModuleInfo -> PackageInfo CompactModuleInfo
+toCompactPackageInfo PackageInfo {..} =
+  PackageInfo
+    { id = id    
+    , moduleMap = HM.map toCompactModuleInfo moduleMap
+    , moduleNameMap = moduleNameMap
+    , directoryTree = directoryTree
+    , externalIdOccMap = externalIdOccMap
+    , externalIdInfoMap = externalIdInfoMap
+    }
+
+toCompactModuleInfo :: ModuleInfo -> CompactModuleInfo
+toCompactModuleInfo ModuleInfo {..} =
+  CompactModuleInfo
+    { id = id
+    , name = name
+    , exprInfoMap = exprInfoMap
+    , definitionSiteMap = definitionSiteMap
+    , source = source
+    }
+
+newtype HaskellModuleName = HaskellModuleName
+  { getHaskellModuleName :: T.Text
+  } deriving (Show, Eq, Ord, Generic, A.ToJSONKey, Data)
+
+newtype HaskellModulePath = HaskellModulePath
+  { getHaskellModulePath :: T.Text
+  } deriving (Show, Eq, Ord, Generic, A.ToJSONKey, Data)
+
+newtype HaskellFilePath = HaskellFilePath
+  { getHaskellFilePath :: T.Text
+  } deriving (Show, Eq, Ord, Generic, A.ToJSONKey, Data)
+
+-- | Haskell identifier (value or type)
+data IdentifierInfo = IdentifierInfo
+  { sort :: NameSort
+  , occName :: OccName
+  , demangledOccName :: T.Text
+  , nameSpace :: NameSpace
+  , locationInfo :: LocationInfo
+  , idType :: Type
+  , details :: Maybe IdDetails
+  , doc :: Maybe HTML
+  , internalId :: InternalId
+  , externalId :: Maybe ExternalId
+  , isExported :: Bool
+  } deriving (Show, Eq, Ord, Generic, Data)
+
+data NameSort
+  = External
+  | Internal
+  deriving (Show, Eq, Ord, Generic, Data)
+
+data NameSpace
+  = VarName
+  | DataName
+  | TvName
+  | TcClsName
+  deriving (Show, Eq, Ord, Generic, Data)
+
+data IdDetails
+  = VanillaId
+  | RecSelId
+  | RecSelIdNaughty
+  | DataConWorkId
+  | DataConWrapId
+  | ClassOpId
+  | PrimOpId
+  | FCallId
+  | TickBoxOpId
+  | DFunId
+  | CoVarId
+  | JoinId
+  deriving (Show, Eq, Ord, Generic, Data)
+
+-- | Each Haskell identifier has an 'InternalId' that is unique within a single module
+newtype InternalId = InternalId
+  { getInternalId :: T.Text
+  } deriving (Show, Eq, Ord, Generic, Data, Hashable, A.ToJSONKey)
+
+newtype ExternalId = ExternalId
+  { getExternalId :: T.Text
+  } deriving (Show, Eq, Ord, Generic, Data, Hashable, A.ToJSONKey)
+
+newtype ExternalIdentifierInfo = ExternalIdentifierInfo
+  { getIdentifierInfo :: IdentifierInfo
+  } deriving (Eq, Show, Generic, Data)
+
+instance Ord ExternalIdentifierInfo where
+  compare (ExternalIdentifierInfo i1) (ExternalIdentifierInfo i2) =
+    case compare
+           (T.length . demangledOccName $ i1)
+           (T.length . demangledOccName $ i2) of
+      GT -> GT
+      LT -> LT
+      EQ ->
+        case compare (demangledOccName i1) (demangledOccName i2) of
+          GT -> GT
+          LT -> LT
+          EQ ->            
+            compare
+              (internalId (i1 :: IdentifierInfo))
+              (internalId (i2 :: IdentifierInfo))
+        
+data ExpressionInfo = ExpressionInfo
+  { description :: T.Text
+  , exprType :: Maybe Type
+  } deriving (Show, Eq, Generic, Data)
+
+-- | Occurrence of an identifier in a source code
+data IdentifierOccurrence = IdentifierOccurrence
+  { internalId :: Maybe InternalId
+  , internalIdFromRenamedSource :: Maybe InternalId
+  , isBinder :: Bool
+  , instanceResolution :: Maybe InstanceResolution
+  , idOccType :: Maybe Type
+  -- ^ Instantiated type of an identifier
+  , typeArguments :: Maybe [Type]
+  , description :: T.Text
+  , sort :: IdentifierOccurrenceSort
+  } deriving (Show, Eq, Ord, Generic, Data)
+
+data IdentifierOccurrenceSort
+  = ValueId
+  | TypeId
+  | ModuleId LocationInfo
+  deriving (Show, Eq, Ord, Generic, Data)
+
+data Type = Type
+  { components :: [TypeComponent]
+  , componentsExpanded :: Maybe [TypeComponent]
+  -- ^ Components of a type with all type synonyms expanded
+  } deriving (Show, Eq, Ord, Generic, Data)
+
+data TypeComponent
+  = Text T.Text
+  | TyCon { internalId :: InternalId
+          , name :: T.Text }
+  deriving (Show, Eq, Ord, Generic, Data)
+
+-- | Tree of instances
+data InstanceResolution =
+  Instance
+  { name :: T.Text
+  -- ^ Type of an instance, e.g., "instance Show a => ClassName a"
+  , instanceType :: Type
+  , types :: [Type]
+  -- ^ Types at which type variables of a class are instantiated
+  , location :: LocationInfo
+  , instances :: [InstanceResolution]  
+  }
+  | Stop
+  deriving (Show,Eq,Ord,Generic,Data)
+
+data SourceCodeTransformation = SourceCodeTransformation
+  { totalLines :: Int
+  , filePath :: HaskellModulePath
+  , linePragmas :: S.Set LinePragma
+  , fileIndex :: HM.HashMap HaskellFilePath (S.Set FileLocation)
+  -- ^ Map from an original filename to its locations in a preprocessed source code
+  } deriving (Show, Eq, Generic, Data)
+
+-- | Location of a file included by a preprocessor
+data FileLocation = FileLocation
+  { lineStart :: Int
+  , lineEnd :: Int
+  , offset :: Int
+  -- ^ (line number in a preprocessed file) - (line number in an original file) + 1
+  } deriving (Show, Eq, Generic, Data)
+
+-- | Line pragma inserted by a preprocessor
+data LinePragma = LinePragma
+  { filePath :: HaskellFilePath
+  , lineNumberPreprocessed :: Int
+  , lineNumberOriginal :: Int
+  } deriving (Show, Eq, Generic, Data)
+
+fromOriginalLineNumber ::
+     SourceCodeTransformation -> (HaskellFilePath, Int) -> Either T.Text Int
+fromOriginalLineNumber SourceCodeTransformation {linePragmas = pragmas} (_originalFileName, originalLineNumber)
+  | S.null pragmas = Right originalLineNumber
+fromOriginalLineNumber SourceCodeTransformation {fileIndex = index} (originalFileName, originalLineNumber) =
+  case HM.lookup originalFileName index of
+    Just set ->
+      -- lookupGE finds smallest element greater or equal to the given one
+      case S.lookupGE (FileLocation 1 originalLineNumber 1) set of
+        Just FileLocation {..} -> Right $ originalLineNumber + offset
+        Nothing ->
+          Left $
+          T.concat
+            [ "Cannot find "
+            , T.pack . show $ (originalFileName, originalLineNumber)
+            , " in "
+            , T.pack $ show index
+            ]
+    Nothing ->
+      Left $
+      T.concat
+        [ "Cannot find file "
+        , T.pack . show $ originalFileName
+        , " in "
+        , T.pack $ show index
+        ]
+        
+data Declaration = Declaration
+  { sort :: DeclarationSort
+  , name :: T.Text
+  , declType :: Maybe Type
+  , isExported :: Bool
+  , lineNumber :: Int
+  } deriving (Show, Eq, Ord, Generic, Data)
+
+data DeclarationSort
+  = TyClD
+  | InstD
+  | ValD
+  | ForD
+  deriving (Show, Eq, Ord, Generic, Data)
+
+data LocationInfo
+  = ExactLocation { packageId :: PackageId
+                  , modulePath :: HaskellModulePath
+                  , moduleName :: HaskellModuleName
+                  , startLine :: Int
+                  , endLine :: Int
+                  , startColumn :: Int
+                  , endColumn :: Int }
+  | ApproximateLocation { packageId :: PackageId
+                        , moduleName :: HaskellModuleName
+                        , entity :: LocatableEntity
+                        , name :: T.Text
+                        , haddockAnchorId :: Maybe T.Text
+                        , componentId :: ComponentId }
+  | UnknownLocation T.Text
+  deriving (Show, Eq, Ord, Generic, Data)
+
+data LocatableEntity
+  = Typ
+  | Val
+  | Inst
+  | Mod
+  deriving (Show, Eq, Ord, Generic, Data)
+
+--------------------------------------------------------------------------------
+-- Instances
+--------------------------------------------------------------------------------
+
+deriving instance (Data k) => Data (IVM.Interval k)
+
+instance (Data k, Data v, Eq k, Ord k, Data (IVM.Interval k)) =>
+         Data (IVM.IntervalMap k v) where
+  gfoldl f z m = z IVM.fromList `f` IVM.toList m
+  toConstr _ = fromListConstr
+  gunfold k z c =
+    case constrIndex c of
+      1 -> k (z IVM.fromList)
+      _ -> error "gunfold"
+  dataTypeOf _ = intervalMapDataType
+  dataCast2 = gcast2
+
+fromListConstr :: Constr
+fromListConstr = mkConstr intervalMapDataType "fromList" [] Prefix
+
+intervalMapDataType :: DataType
+intervalMapDataType = mkDataType "Data.IntervalMap" [fromListConstr]
+
+deriving instance Generic (IVM.Interval k)
+
+instance Hashable HaskellModuleName
+instance Serialize HaskellModuleName
+instance Hashable HaskellModulePath
+instance Serialize HaskellModulePath
+instance Hashable HaskellFilePath
+instance Serialize HaskellFilePath
+instance (Serialize k, Serialize v, Ord k) =>
+         Serialize (IVM.IntervalMap k v) where
+  put = put . IVM.toAscList
+  get = IVM.fromAscList <$> Data.Serialize.get
+instance Ord LinePragma where
+  compare p1 p2 =
+    compare
+      (lineNumberPreprocessed (p1 :: LinePragma))
+      (lineNumberPreprocessed (p2 :: LinePragma))
+instance Ord FileLocation where
+  compare l1 l2 = compare (lineEnd l1) (lineEnd l2)
+instance Serialize LinePragma
+instance Serialize FileLocation
+instance Serialize SourceCodeTransformation
+instance Serialize IdentifierInfo
+instance Serialize InternalId
+instance Serialize ExternalId
+instance Serialize ExternalIdentifierInfo where
+  put (ExternalIdentifierInfo info) = put info
+  get = ExternalIdentifierInfo <$>(get :: Get IdentifierInfo)
+instance Serialize InstanceResolution
+instance Serialize OccName
+instance Serialize IdDetails
+instance Serialize NameSpace
+instance Serialize DefinitionSiteMap
+instance Serialize DefinitionSite
+instance Serialize Declaration
+instance Serialize NameSort
+instance Serialize DeclarationSort
+instance Serialize PackageId
+instance Serialize Data.Version.Version
+instance Serialize (PackageInfo ModuleInfo)
+instance Serialize (PackageInfo CompactModuleInfo)
+instance Serialize IdentifierSrcSpan
+instance Serialize DirTree
+instance Serialize ComponentId
+instance Serialize ComponentType
+instance Serialize T.Text where
+  put = put . encodeUtf8
+  get = decodeUtf8 <$> Data.Serialize.get
+instance (Serialize k, Serialize v, Eq k,Hashable k) => Serialize (HM.HashMap k v) where
+  put = put . HM.toList
+  get = HM.fromList <$> get
+instance Serialize ModuleInfo
+instance Serialize CompactModuleInfo
+instance (Serialize k) => Serialize (IVM.Interval k)
+instance Serialize LocationInfo
+instance Serialize IdentifierOccurrence
+instance Serialize IdentifierOccurrenceSort
+instance Serialize TypeComponent
+instance (Serialize a) => Serialize (V.Vector a) where
+  put = put . V.toList
+  get = V.fromList <$> get
+instance Serialize Type
+instance Serialize ExpressionInfo
+instance Serialize LocatableEntity
+instance (Serialize k,Ord k,Serialize v,Ord v,Hashable k) => Serialize (Trie k v)
+instance NFData HaskellModuleName
+instance NFData HaskellModulePath
+instance NFData HaskellFilePath
+instance NFData LinePragma
+instance NFData FileLocation
+instance NFData SourceCodeTransformation
+instance NFData IdentifierInfo
+instance NFData InternalId
+instance NFData ExternalId
+instance NFData ExternalIdentifierInfo 
+instance NFData InstanceResolution
+instance NFData IdDetails
+instance NFData NameSpace
+instance NFData OccName
+instance NFData DefinitionSiteMap
+instance NFData DefinitionSite
+instance NFData Declaration
+instance NFData NameSort
+instance NFData DeclarationSort
+instance NFData PackageId
+instance NFData (PackageInfo ModuleInfo)
+instance NFData (PackageInfo CompactModuleInfo)
+instance NFData IdentifierSrcSpan
+instance NFData DirTree
+instance NFData ComponentId
+instance NFData ComponentType
+instance NFData ModuleInfo
+instance NFData CompactModuleInfo
+instance NFData LocationInfo
+instance NFData IdentifierOccurrence
+instance NFData IdentifierOccurrenceSort
+instance NFData TypeComponent
+instance NFData Type
+instance NFData ExpressionInfo
+instance NFData LocatableEntity
+instance (NFData k, Ord k, NFData v, Ord v, Hashable k) =>
+         NFData (Trie k v)
+
+omitNothingOptions :: Options
+omitNothingOptions = defaultOptions {omitNothingFields = True}
+
+instance A.ToJSON (PackageInfo a) where
+  toJSON PackageInfo {..} =
+    A.object
+      [ ("id", A.toJSON $ packageIdToText id)
+      , ("directoryTree", A.toJSON directoryTree)
+      , ("modules", A.toJSON . HM.map (const ()) $ moduleMap)
+      ]
+
+instance A.ToJSON ModuleInfo where
+  toJSON ModuleInfo {..} =
+    let sourceCodeLines = zip [1 ..] $ V.toList source
+        tokenizedLines =
+          L.map
+            (\(lineNumber, lineText) ->
+               case IM.lookup lineNumber idOccMap of
+                 Just identifiers -> (lineNumber, tokenize lineText identifiers)
+                 Nothing ->
+                   ( lineNumber
+                   , [(lineText, (1, T.length lineText + 1), Nothing)]))
+            sourceCodeLines
+        html =
+          Html.table Html.! Attr.class_ "source-code" $
+          Html.tbody $ mapM_ (uncurry lineToHtml) tokenizedLines
+     in A.object
+          [ ("id", A.toJSON id)
+          , ("name", A.toJSON name)
+          , ("sourceCodeHtml", A.toJSON . renderHtml $ html)
+          , ("identifiers", A.toJSON idInfoMap)
+          , ("occurrences", A.toJSON $ idOccurrencesHashMap idOccMap)
+          , ("declarations", A.toJSON declarations)
+          ]
+          
+idOccurrencesHashMap ::
+     IM.IntMap [((Int, Int), IdentifierOccurrence)]
+  -> HM.HashMap T.Text IdentifierOccurrence
+idOccurrencesHashMap =
+  HM.fromList .
+  concatMap
+    (\(lineNum, occs) ->
+       L.map
+         (\((startCol, endCol), occ) ->
+            (occurrenceLocationToText lineNum startCol endCol, occ))
+         occs) .
+  IM.toList 
+
+idOccurrenceList ::
+     IM.IntMap [((Int, Int), IdentifierOccurrence)]
+  -> HM.HashMap T.Text IdentifierOccurrence
+idOccurrenceList =
+  HM.fromList .
+  concatMap
+    (\(lineNum, occs) ->
+       L.map
+         (\((startCol, endCol), occ) ->
+            (occurrenceLocationToText lineNum startCol endCol, occ))
+         occs) .
+  IM.toList 
+
+occurrenceLocationToText :: Int -> Int -> Int -> T.Text
+occurrenceLocationToText lineNum startCol endCol =
+  T.concat
+    [ T.pack . show $ lineNum
+    , "-"
+    , T.pack . show $ startCol
+    , "-"
+    , T.pack . show $ endCol
+    ]
+
+lineToHtml :: Int
+           -> [(T.Text, (Int, Int), Maybe IdentifierOccurrence)]
+           -> Html.Html
+lineToHtml lineNumber tokens =
+  Html.tr $ do
+    Html.td Html.! Attr.class_ "line-number" Html.!
+      Attr.id (Html.textValue . T.append "LN" . T.pack $ show lineNumber) $
+      Html.toHtml (T.pack $ show lineNumber)
+    Html.td Html.! Attr.class_ "line-content" Html.!
+      Html.dataAttribute "line" (Html.textValue $ T.pack . show $ lineNumber) Html.!
+      Attr.id (Html.textValue . T.append "LC" . T.pack $ show lineNumber) $
+      mapM_
+        (\(content, (start, end), mbIdOcc) ->
+           let addPositionAttrs :: Html.Html -> Html.Html
+               addPositionAttrs htmlElement =
+                 htmlElement Html.!
+                 Html.dataAttribute
+                   "start"
+                   (Html.textValue $ T.pack . show $ start) Html.!
+                 Html.dataAttribute "end" (Html.textValue $ T.pack . show $ end)
+            in case mbIdOcc of
+                 Just idOcc ->
+                   addPositionAttrs $
+                   Html.span Html.! Attr.class_ "identifier" Html.!
+                   Attr.id
+                     (Html.textValue .
+                      maybe "" getInternalId . internalIdFromRenamedSource $
+                      idOcc) Html.!
+                   Html.dataAttribute
+                     "occurrence"
+                     (Html.textValue $
+                      occurrenceLocationToText lineNumber start end) Html.!
+                   Html.dataAttribute
+                     "identifier"
+                     (Html.textValue $
+                      maybe "" getInternalId $
+                      internalId (idOcc :: IdentifierOccurrence)) $
+                   Html.toHtml content
+                 Nothing -> addPositionAttrs . Html.span . Html.toHtml $ content)
+        tokens
+
+tokenize
+  :: forall a.
+     T.Text -- ^ Source code
+  -> [((Int, Int), a)] -- ^ Identifier locations
+                       -- The end position is defined to be the column /after/ the end of the
+                       -- span. That is, a span of (1,1)-(1,2) is one character long, and a
+                       -- span of (1,1)-(1,1) is zero characters long.                       
+  -> [(T.Text, (Int, Int), Maybe a)]
+tokenize line =
+  L.reverse .
+  (\(remainingLine, currentIndex, c) ->
+     if T.null remainingLine
+       then c
+       else (remainingLine, (currentIndex, T.length line + 1), Nothing) : c) .
+  L.foldl' split (line, 1, [])
+  where
+    split ::
+         (T.Text, Int, [(T.Text, (Int, Int), Maybe a)])
+      -> ((Int, Int), a)
+      -> (T.Text, Int, [(T.Text, (Int, Int), Maybe a)])
+    split (remainingLine, currentIndex, chunks) ((start, end), a)
+      | start == currentIndex =
+        let (chunk, remainingLine') = T.splitAt (end - start) remainingLine
+            chunks' = (chunk, (start, end), Just a) : chunks
+         in (remainingLine', end, chunks')
+      | otherwise =
+        let (chunkNoId, remainingLine') =
+              T.splitAt (start - currentIndex) remainingLine
+            (chunk, remainingLine'') = T.splitAt (end - start) remainingLine'
+         in ( remainingLine''
+            , end
+            , (chunk, (start, end), Just a) :
+              (chunkNoId, (currentIndex, start), Nothing) : chunks)
+
+docToHtml ::
+     forall mod id.
+     (mod -> Html.Html)
+  -> (id -> Html.Html)
+  -> DocH mod id
+  -> HTML
+docToHtml modToHtml idToHtml = toStrict . renderHtml . toH
+  where
+    toH :: DocH mod id -> Html.Html
+    toH (DocAppend doc1 doc2) = toH doc1 >> toH doc2
+    toH (DocParagraph doc) = Html.p $ toH doc
+    toH (DocIdentifier identifier) = Html.span $ idToHtml identifier
+    toH (DocWarning doc) = Html.div Html.! Attr.class_ "warning" $ toH doc
+    toH (DocEmphasis doc) = Html.em $ toH doc
+    toH DocEmpty = mempty
+    toH (DocBold doc) = Html.b $ toH doc
+    toH (DocMonospaced doc) =
+      Html.span Html.! Attr.class_ "source-code-font" $ toH doc
+    toH (DocUnorderedList docs) = Html.ul $ mapM_ (Html.li . toH) docs
+    toH (DocOrderedList docs) = Html.ol $ mapM_ (Html.li . toH) docs
+    toH (DocDefList docs) =
+      Html.dl $
+      mapM_ (\(doc1, doc2) -> Html.dt (toH doc1) >> Html.dd (toH doc2)) docs
+    toH (DocCodeBlock doc) = Html.div Html.! Attr.class_ "source-code" $ toH doc
+    toH (DocIdentifierUnchecked modName) = modToHtml modName
+    toH (DocModule str) = Html.span . Html.toHtml . T.pack $ str
+    toH (DocHyperlink (Hyperlink url mbTitle)) =
+      Html.a Html.! (Attr.href . Html.textValue . T.pack $ url) $
+      Html.toHtml $ fromMaybe url mbTitle
+    toH (DocPic (Picture uri mbTitle)) =
+      Html.img Html.! (Attr.src . Html.textValue . T.pack $ uri) Html.!
+      (Attr.title . Html.textValue . T.pack $ fromMaybe "" mbTitle)
+    toH (DocMathInline str) =
+      Html.span . Html.toHtml $ T.pack ("\\(" ++ str ++ "\\)")
+    toH (DocMathDisplay str) =
+      Html.div . Html.toHtml $ T.pack ("\\[" ++ str ++ "\\]")
+    toH (DocAName str) =
+      Html.a Html.! (Attr.id . Html.textValue . T.pack $ str) $ mempty
+    toH (DocProperty str) =
+      Html.div Html.! Attr.class_ "source-code" $ Html.toHtml $ T.pack str
+    toH (DocExamples examples) =
+      Html.div Html.! Attr.class_ "source-code" $
+      mapM_
+        (\(Example expr results) ->
+           let htmlPrompt = Html.span $ Html.toHtml (">>> " :: String)
+               htmlExpression = Html.span $ Html.toHtml (expr ++ "\n")
+            in htmlPrompt >> htmlExpression >>
+               mapM_ (Html.span . Html.toHtml) (unlines results))
+        examples
+    toH (DocString str) = Html.span . Html.toHtml $ T.pack str    
+    toH (DocHeader (Header level doc)) = toHeader level $ toH doc
+      where
+        toHeader 1 = Html.h1
+        toHeader 2 = Html.h2
+        toHeader 3 = Html.h3
+        toHeader 4 = Html.h4
+        toHeader 5 = Html.h5
+        toHeader _ = Html.h6
+        
+instance A.ToJSON HaskellModuleName where
+  toJSON (HaskellModuleName name) = A.String name
+instance A.ToJSON HaskellModulePath where
+  toJSON (HaskellModulePath path) = A.String path
+instance A.ToJSON HaskellFilePath where
+  toJSON (HaskellFilePath path) = A.String path  
+instance A.ToJSON LinePragma where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON FileLocation where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON IdentifierInfo where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON InternalId where
+  toJSON (InternalId text) = A.toJSON text
+instance A.ToJSON ExternalId where
+  toJSON (ExternalId text) = A.toJSON text    
+instance A.ToJSON ExternalIdentifierInfo where
+  toJSON (ExternalIdentifierInfo info) = A.toJSON info
+instance A.ToJSON InstanceResolution where
+  toJSON (Instance name typ types location instances) =
+    A.object
+      [ "name" A..= A.toJSON name
+      , "types" A..= A.toJSON types
+      , "location" A..= A.toJSON location
+      , "instanceType" A..= A.toJSON typ
+      , "instances" A..=
+        (A.Array . V.fromList . Prelude.map A.toJSON $ instances)
+      ]
+  toJSON Stop = A.Null
+instance A.ToJSON IdDetails where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON NameSpace where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON Declaration  
+instance A.ToJSON NameSort
+instance A.ToJSON OccName where
+  toJSON (OccName name) = A.String name
+instance A.ToJSON DeclarationSort
+instance A.ToJSON PackageId
+instance A.ToJSON ComponentId where
+  toJSON (ComponentId id) = A.toJSON id
+instance A.ToJSON ComponentType
+instance A.ToJSON LocationInfo where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON LocatableEntity
+instance A.ToJSON IdentifierOccurrence where
+  toJSON IdentifierOccurrence {..} =
+    A.object $
+    [("sort", A.toJSON sort)] ++
+    [("description", A.toJSON description)] ++
+    [("internalId", A.toJSON internalId) | isJust internalId] ++
+    [("isBinder", A.toJSON isBinder) | isBinder] ++
+    [("instanceResolution", A.toJSON instanceResolution) | isJust instanceResolution] ++
+    [("idOccType", A.toJSON idOccType) | isJust idOccType]
+instance A.ToJSON IdentifierOccurrenceSort
+instance A.ToJSON TypeComponent where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON Type where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON ExpressionInfo where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON DirTree    
+instance A.ToJSON DefinitionSite where
+  toJSON = A.genericToJSON omitNothingOptions
+instance A.ToJSON IdentifierSrcSpan
+instance A.ToJSON (IVM.Interval (Int, Int)) where
+  toJSON (IVM.IntervalCO a b) = intervalToValue a b
+  toJSON (IVM.ClosedInterval a b) = intervalToValue a b
+  toJSON (IVM.OpenInterval a b) = intervalToValue a b
+  toJSON (IVM.IntervalOC a b) = intervalToValue a b
+
+intervalToValue :: (Int, Int) -> (Int, Int) -> A.Value
+intervalToValue (l1, c1) (l2, c2) =
+  A.object
+    [ ("start", A.object [("line", A.toJSON l1), ("column", A.toJSON c1)])
+    , ("end", A.object [("line", A.toJSON l2), ("column", A.toJSON c2)])
+    ]
+
+data SourceCodePreprocessing
+  = AfterPreprocessing
+  | BeforePreprocessing
+  deriving (Show, Eq)
+
+data Log
+  = StdOut
+  | ToFile FilePath
+  deriving (Show, Eq)