fixing typecheckedSource

1 files changed, 104 insertions, 93 deletions

diff --git a/src/HaskellCodeExplorer/AST/TypecheckedSource.hs b/src/HaskellCodeExplorer/AST/TypecheckedSource.hs
index 41a202e..7cf5157 100644
--- a/src/HaskellCodeExplorer/AST/TypecheckedSource.hs
+++ b/src/HaskellCodeExplorer/AST/TypecheckedSource.hs
@@ -18,13 +18,11 @@ module HaskellCodeExplorer.AST.TypecheckedSource
   , removeOverlappingInterval
   ) where
 
-import Bag (bagToList)
-import BasicTypes (Origin(..))
-import Class (Class, classTyVars)
-import ConLike (ConLike(..)
-#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
-  , conLikeWrapId_maybe
-#endif
+import GHC.Data.Bag (bagToList)
+import GHC.Types.Basic (Origin(..))
+import GHC.Core.Class (Class, classTyVars)
+import GHC.Core.ConLike (ConLike(..)
+--  , conLikeWrapId_maybe
   )
 import Control.Monad (return, unless, void)
 import Control.Monad.State.Strict (State, get, modify')
@@ -35,18 +33,23 @@ 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 GHC.Core.DataCon (dataConWorkId)
+import GHC
+  ( DynFlags
+  , TyThing(..)
+  , CoPat(..)
+  )
+import GHC.Data.FastString (mkFastString)
+import GHC.Unit.State (UnitState)
 import HaskellCodeExplorer.GhcUtils
 import qualified HaskellCodeExplorer.Types as HCE
-import HsBinds (RecordPatSynField(..)
+import GHC.Hs.Binds (RecordPatSynField(..)
 #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
 #else
   , HsPatSynDetails (..)
 #endif
   )
-import HsSyn
+import GHC.Hs
   ( ABExport(..)
   , ApplicativeArg(..)
   , ArithSeqInfo(..)
@@ -88,7 +91,7 @@ import HsSyn
   , StmtLR(..)
   , selectorAmbiguousFieldOcc
 #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-  , RecordConTc (..)
+--  , RecordConTc (..)
   , RecordUpdTc (..)
   , ListPatTc (..)
   , OverLitTc (..)
@@ -96,36 +99,36 @@ import HsSyn
   , NHsValBindsLR (..)
 #endif
   )
-import HscTypes (TypeEnv, lookupTypeEnv)
+import GHC.Types.TypeEnv (TypeEnv, lookupTypeEnv)
 #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
-import HsExtension (GhcTc)
+import GHC.Hs.Extension (GhcTc)
 #endif
-import Id (idType)
-import IdInfo (IdDetails(..))
-import InstEnv
+import GHC.Types.Id (idType)
+import GHC.Types.Id.Info (IdDetails(..))
+import GHC.Core.InstEnv
   ( ClsInst(..)
   , InstEnvs
   , instanceSig
   , is_dfun
   , lookupUniqueInstEnv
   )
-import Name (Name, nameOccName, nameUnique)
+import GHC.Types.Name (Name, nameOccName, nameUnique)
 import Prelude hiding (span)
-import SrcLoc
+import GHC.Types.SrcLoc
    ( GenLocated(..)
    , SrcSpan(..)
    , isGoodSrcSpan
    , isOneLineSpan
    , unLoc
-#if MIN_VERSION_GLASGOW_HASKELL(8,8,1,0)
-   , cL 
-#endif    
+-- #if MIN_VERSION_GLASGOW_HASKELL(8,8,1,0)
+--    , cL 
+-- #endif    
    )
-import TcEvidence (HsWrapper(..))
-import TcHsSyn (conLikeResTy, hsLitType)
-import Type
-  ( TyThing(..)
-  , Type
+import GHC.Tc.Types.Evidence (HsWrapper(..))
+import GHC.Tc.Utils.Zonk (conLikeResTy, hsLitType)
+import GHC.Core.Predicate (getClassPredTys_maybe)
+import GHC.Core.Type
+  ( Type
 #if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
   , nonDetCmpTypes
 #else
@@ -133,20 +136,19 @@ import Type
 #endif
   , eqTypes
   , eqType
-  , getClassPredTys_maybe
   , mkFunTy
-  , mkFunTys
-  , splitForAllTys
+--  , 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)
+import GHC.Builtin.Types (mkListTy, mkTupleTy)
+import GHC.Types.Unique (getKey)
+import GHC.Types.Var (Id, Var, idDetails, isId, setVarName, setVarType, varName, varType)
+import GHC.Types.Var.Env (TidyEnv)
 
 data ASTState = ASTState
   { astStateExprInfoMap :: !HCE.ExpressionInfoMap
@@ -180,6 +182,7 @@ data TypeError = TypeError
 
 data Environment = Environment
   { envDynFlags :: DynFlags
+  , envUnitState :: UnitState
   , envTypeEnv :: TypeEnv
   , envInstEnv :: InstEnvs
   , envTransformation :: HCE.SourceCodeTransformation
@@ -213,7 +216,7 @@ exprSort (ExplicitTuple args _)
 #endif
   | null args = Simple
   | otherwise = Composite
-exprSort (ExplicitList _ _ args)
+exprSort (ExplicitList _ args)
   | null args = Simple
   | otherwise = Composite
 exprSort _ = Composite
@@ -447,6 +450,7 @@ mkIdentifierInfo environment identifier mbNameFromRenamedSource =
       sort = nameSort name
       nameSpace = occNameNameSpace . nameOccName $ name
       flags = envDynFlags environment
+      unitState = envUnitState environment
       currentPackageId = envPackageId environment
       compId = envComponentId environment
       transformation = envTransformation environment
@@ -454,7 +458,7 @@ mkIdentifierInfo environment identifier mbNameFromRenamedSource =
       defSiteMap = envDefSiteMap environment
       locationInfo =
         nameLocationInfo
-          flags
+          unitState
           currentPackageId
           compId
           transformation
@@ -618,10 +622,11 @@ foldLHsExpr (L _ (HsConLikeOut _ conLike)) =
 #else
 foldLHsExpr (L _ (HsConLikeOut conLike)) =
 #endif
-  restoreTidyEnv $ do
-    let mbType = varType <$> conLikeWrapId_maybe conLike
-    mbType' <- maybe (return Nothing) (fmap Just . tidyType) mbType
-    return mbType'
+  -- restoreTidyEnv $ do
+  --   let mbType = varType <$> conLikeWrapId_maybe conLike
+  --   mbType' <- maybe (return Nothing) (fmap Just . tidyType) mbType
+  --   return mbType'
+  restoreTidyEnv $ return Nothing
 #endif
 foldLHsExpr (L _ HsRecFld {}) = return Nothing
 foldLHsExpr (L _ HsOverLabel {}) = return Nothing
@@ -846,7 +851,7 @@ foldLHsExpr (L span e@(ExplicitPArr typ exprs)) =
     return $ Just typ'
 #endif
 #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span e@(RecordCon (RecordConTc _ conExpr) _ binds)) = do
+foldLHsExpr (L span e@(RecordCon conExpr _ binds)) = do
 #else
 foldLHsExpr (L span e@(RecordCon (L _ _) _conLike conExpr binds)) = do
 #endif
@@ -900,22 +905,22 @@ foldLHsExpr (L span e@(PArrSeq postTcExpr _seqInfo)) = do
   addExprInfo span typ "ArithSeq" (exprSort e)
   return typ
 #endif
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span e@(HsSCC _ _sourceText _fastString expr)) = do
-#else
-foldLHsExpr (L span e@(HsSCC _sourceText _fastString expr)) = do
-#endif
-  typ <- foldLHsExpr expr
-  addExprInfo span typ "HsSCC" (exprSort e)
-  return typ
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span e@(HsCoreAnn _ _sourceText _fastString expr)) = do
-#else
-foldLHsExpr (L span e@(HsCoreAnn _sourceText _fastString expr)) = do
-#endif
-  typ <- foldLHsExpr expr
-  addExprInfo span typ "HsCoreAnn" (exprSort e)
-  return typ
+-- #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
+-- foldLHsExpr (L span e@(HsSCC _ _sourceText _fastString expr)) = do
+-- #else
+-- foldLHsExpr (L span e@(HsSCC _sourceText _fastString expr)) = do
+-- #endif
+--   typ <- foldLHsExpr expr
+--   addExprInfo span typ "HsSCC" (exprSort e)
+--   return typ
+-- #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
+-- foldLHsExpr (L span e@(HsCoreAnn _ _sourceText _fastString expr)) = do
+-- #else
+-- foldLHsExpr (L span e@(HsCoreAnn _sourceText _fastString expr)) = do
+-- #endif
+--   typ <- foldLHsExpr expr
+--   addExprInfo span typ "HsCoreAnn" (exprSort e)
+--   return typ
 foldLHsExpr (L _span HsBracket {}) = return Nothing
 foldLHsExpr (L _span HsRnBracketOut {}) = return Nothing
 foldLHsExpr (L _span HsTcBracketOut {}) = return Nothing
@@ -937,8 +942,8 @@ foldLHsExpr (L span e@(HsStatic expr)) = do
   typ <- foldLHsExpr expr
   addExprInfo span typ "HsStatic" (exprSort e)
   return typ
-foldLHsExpr (L _ HsArrForm {}) = return Nothing
-foldLHsExpr (L _ HsArrApp {}) = return Nothing
+-- foldLHsExpr (L _ HsArrForm {}) = return Nothing
+-- foldLHsExpr (L _ HsArrApp {}) = return Nothing
 #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
 foldLHsExpr (L span e@(HsTick _ _ expr)) = do
 #else
@@ -955,29 +960,33 @@ foldLHsExpr (L span e@(HsBinTick _ _ expr)) = do
   typ <- foldLHsExpr expr
   addExprInfo span typ "HsBinTick" (exprSort e)
   return typ
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span e@(HsTickPragma _ _ _ _ expr)) = do
-#else
-foldLHsExpr (L span e@(HsTickPragma _ _ _ expr)) = do
-#endif
-  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
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsExpr (L span (HsWrap _ wrapper expr)) =
-#else
-foldLHsExpr (L span (HsWrap wrapper expr)) =
-#endif
-  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
+-- #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
+-- foldLHsExpr (L span e@(HsTickPragma _ _ _ _ expr)) = do
+-- #else
+-- foldLHsExpr (L span e@(HsTickPragma _ _ _ expr)) = do
+-- #endif
+--   typ <- foldLHsExpr expr
+--   addExprInfo span typ "HsTickPragma" (exprSort e)
+--   return typ
+
+-- A few similarly named symbols are in GHC.Hs.Pat
+-- foldLHsExpr (L _span EWildPat {}) = return Nothing
+-- foldLHsExpr (L _span EAsPat {}) = return Nothing
+-- foldLHsExpr (L _span EViewPat {}) = return Nothing
+-- foldLHsExpr (L _span ELazyPat {}) = return Nothing
+
+-- there's an hswrap but it is not in hsexpr
+-- #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
+-- foldLHsExpr (L span (HsWrap _ wrapper expr)) =
+-- #else
+-- foldLHsExpr (L span (HsWrap wrapper expr)) =
+-- #endif
+--   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
 
 #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
 foldHsRecFields :: HsRecFields GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type)
@@ -1519,8 +1528,9 @@ foldLPat (L span pat@(PArrPat pats typ)) = do
   mapM_ foldLPat pats
   return $ Just typ'
 #endif
-foldLPat (ghcDL -> L _span (ConPatIn _ _)) = return Nothing
-foldLPat (ghcDL -> L span pat@ConPatOut {..}) = do
+-- no more conpatin / conpatout, just conpat
+-- foldLPat (ghcDL -> L _span (ConPatIn _ _)) = return Nothing
+foldLPat (ghcDL -> L span pat@ConPat {..}) = do
   let (L idSpan conLike) = pat_con
       conId =
         case conLike of
@@ -1530,7 +1540,7 @@ foldLPat (ghcDL -> L span pat@ConPatOut {..}) = do
   (identifier', mbTypes) <- tidyIdentifier conId
   addIdentifierToIdSrcSpanMap idSpan identifier' mbTypes
   typ' <- tidyType typ
-  addExprInfo span (Just typ') "ConPatOut" (patSort pat)
+  addExprInfo span (Just typ') "ConPat" (patSort pat)
   _ <- foldHsConPatDetails pat_args
   return . Just . varType $ identifier'
 #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
@@ -1766,10 +1776,11 @@ foldLHsCmd (L _ (HsCmdDo stmts _)) = do
 #endif
   mapM_ foldLStmtLRCmd $ unLoc stmts
   return Nothing
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-foldLHsCmd (L span (HsCmdWrap _ _ cmd)) = do
-#else
-foldLHsCmd (L span (HsCmdWrap _ cmd)) = do
-#endif
-  _ <- foldLHsCmd (L span cmd)
-  return Nothing
+-- no more hscmdwrap
+-- #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
+-- foldLHsCmd (L span (HsCmdWrap _ _ cmd)) = do
+-- #else
+-- foldLHsCmd (L span (HsCmdWrap _ cmd)) = do
+-- #endif
+--   _ <- foldLHsCmd (L span cmd)
+--   return Nothing