mirror of
https://github.com/alexwl/haskell-code-explorer.git
synced 2024-09-11 11:05:53 +03:00
WIP. It compiles with ghc-8.4.3, but not all features of the indexer are supported yet.
This commit is contained in:
alexwl
parent
f38daf6773
commit
166265e93d
@ -73,7 +73,10 @@ data Compression
|
||||
| NoCompression
|
||||
deriving (Show, Eq)
|
||||
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
ghcVersion :: Version
|
||||
ghcVersion = Version {versionBranch = [8, 4, 3, 0], versionTags = []}
|
||||
#elif MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
|
||||
ghcVersion :: Version
|
||||
ghcVersion = Version {versionBranch = [8, 2, 2, 0], versionTags = []}
|
||||
#else
|
||||
|
||||
@ -343,9 +343,11 @@ loadPackageInfo config path =
|
||||
HCE.source :: HCE.CompactModuleInfo -> V.Vector T.Text
|
||||
in if not enableExpressionInfo
|
||||
then modInfo
|
||||
{ HCE.exprInfoMap = IVM.empty
|
||||
{ HCE.exprInfoMap = IVM.empty
|
||||
, HCE.source = V.force $ source modInfo
|
||||
-- 'force' fixes this error: Data.Vector.Mutable: uninitialised element CallStack (from HasCallStack): error, called at ./Data/Vector/Mutable.hs:188:17 in vector-0.12.0.1-GGZqQZyzchy8YFPCF67wxL:Data.Vector.Mutable
|
||||
}
|
||||
else modInfo)
|
||||
else modInfo {HCE.source = V.force $ source modInfo})
|
||||
, path)
|
||||
Left e -> return . Left $ (e, path)
|
||||
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE StrictData #-}
|
||||
@ -54,10 +55,16 @@ import GHC
|
||||
, PatSynBind(..)
|
||||
, Sig(..)
|
||||
, TyClDecl(..)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
#else
|
||||
, TyFamEqn(..)
|
||||
#endif
|
||||
, Type
|
||||
, unLoc
|
||||
)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
import HsExtension (GhcRn)
|
||||
#endif
|
||||
import HaskellCodeExplorer.GhcUtils (hsPatSynDetails, ieLocNames)
|
||||
import Prelude hiding (span)
|
||||
import TysWiredIn
|
||||
@ -86,9 +93,12 @@ namesFromRenamedSource =
|
||||
hsTypeNames `extQ`
|
||||
tyClDeclNames `extQ`
|
||||
familyDeclNames `extQ`
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
#else
|
||||
tyFamilyEqNames `extQ`
|
||||
tyFamilyDefEqNames `extQ`
|
||||
dataFamInstDeclNames `extQ`
|
||||
#endif
|
||||
conDeclNames `extQ`
|
||||
importNames `extQ`
|
||||
hsTyVarBndrNames `extQ`
|
||||
@ -99,7 +109,9 @@ namesFromRenamedSource =
|
||||
hsRecFieldPatNames `extQ`
|
||||
foreignDeclNames)
|
||||
|
||||
fieldOccName :: Bool -> FieldOcc Name -> NameOccurrence
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
fieldOccName :: Bool -> FieldOcc GhcRn -> NameOccurrence
|
||||
#endif
|
||||
fieldOccName isBinder (FieldOcc (L span _) name) =
|
||||
NameOccurrence
|
||||
{ locatedName = L span (Just name)
|
||||
@ -107,16 +119,20 @@ fieldOccName isBinder (FieldOcc (L span _) name) =
|
||||
, isBinder = isBinder
|
||||
}
|
||||
|
||||
conDeclFieldNames :: ConDeclField Name -> [NameOccurrence]
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
conDeclFieldNames :: ConDeclField GhcRn -> [NameOccurrence]
|
||||
#endif
|
||||
conDeclFieldNames ConDeclField {..} =
|
||||
map (fieldOccName True . unLoc) cd_fld_names
|
||||
|
||||
hsRecFieldExprNames ::
|
||||
HsRecField' (FieldOcc Name) (LHsExpr Name) -> [NameOccurrence]
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
hsRecFieldExprNames :: HsRecField' (FieldOcc GhcRn) (LHsExpr GhcRn) -> [NameOccurrence]
|
||||
#endif
|
||||
hsRecFieldExprNames HsRecField {..} = [fieldOccName False $ unLoc hsRecFieldLbl]
|
||||
|
||||
hsRecAmbFieldExprNames ::
|
||||
HsRecField' (AmbiguousFieldOcc Name) (LHsExpr Name) -> [NameOccurrence]
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
hsRecAmbFieldExprNames :: HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn) -> [NameOccurrence]
|
||||
#endif
|
||||
hsRecAmbFieldExprNames HsRecField {..} =
|
||||
let (L span recField) = hsRecFieldLbl
|
||||
mbName =
|
||||
@ -130,11 +146,14 @@ hsRecAmbFieldExprNames HsRecField {..} =
|
||||
}
|
||||
]
|
||||
|
||||
hsRecFieldPatNames ::
|
||||
HsRecField' (FieldOcc Name) (LPat Name) -> [NameOccurrence]
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
hsRecFieldPatNames :: HsRecField' (FieldOcc GhcRn) (LPat GhcRn) -> [NameOccurrence]
|
||||
#endif
|
||||
hsRecFieldPatNames HsRecField {..} = [fieldOccName False $ unLoc hsRecFieldLbl]
|
||||
|
||||
hsExprNames :: LHsExpr Name -> [NameOccurrence]
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
hsExprNames :: LHsExpr GhcRn -> [NameOccurrence]
|
||||
#endif
|
||||
hsExprNames (L _span (HsVar name)) =
|
||||
[ NameOccurrence
|
||||
{ locatedName = Just <$> name
|
||||
@ -174,7 +193,9 @@ hsExprNames (L _span (HsRecFld (Ambiguous (L span _) _name))) =
|
||||
]
|
||||
hsExprNames _ = []
|
||||
|
||||
matchGroupNames :: MatchGroup Name (LHsExpr Name) -> [NameOccurrence]
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
matchGroupNames :: MatchGroup GhcRn (LHsExpr GhcRn) -> [NameOccurrence]
|
||||
#endif
|
||||
matchGroupNames =
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
|
||||
mapMaybe (fmap toNameOcc . matchContextName . m_ctxt . unLoc) .
|
||||
@ -184,20 +205,22 @@ matchGroupNames =
|
||||
unLoc . mg_alts
|
||||
where
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
|
||||
matchContextName :: HsMatchContext Name -> Maybe (Located Name)
|
||||
--matchContextName :: HsMatchContext Name -> Maybe (Located Name)
|
||||
matchContextName (FunRhs name _ _bool) = Just name
|
||||
matchContextName _ = Nothing
|
||||
#else
|
||||
matchFixityName :: MatchFixity Name -> Maybe (Located Name)
|
||||
--matchFixityName :: MatchFixity Name -> Maybe (Located Name)
|
||||
matchFixityName NonFunBindMatch = Nothing
|
||||
matchFixityName (FunBindMatch name _bool) = Just name
|
||||
#endif
|
||||
toNameOcc :: Located Name -> NameOccurrence
|
||||
--toNameOcc :: Located Name -> NameOccurrence
|
||||
toNameOcc n =
|
||||
NameOccurrence
|
||||
{locatedName = Just <$> n, description = "Match", isBinder = True}
|
||||
|
||||
bindNames :: LHsBindLR Name Name -> [NameOccurrence]
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
bindNames :: LHsBindLR GhcRn GhcRn -> [NameOccurrence]
|
||||
#endif
|
||||
bindNames (L _span (PatSynBind PSB {..})) =
|
||||
[ NameOccurrence
|
||||
{ locatedName = Just <$> psb_id
|
||||
@ -207,7 +230,6 @@ bindNames (L _span (PatSynBind PSB {..})) =
|
||||
]
|
||||
bindNames _ = []
|
||||
|
||||
hsPatSynDetailsNames :: HsPatSynDetails (Located Name) -> [NameOccurrence]
|
||||
hsPatSynDetailsNames =
|
||||
map
|
||||
(\name ->
|
||||
@ -218,7 +240,10 @@ hsPatSynDetailsNames =
|
||||
}) .
|
||||
hsPatSynDetails
|
||||
|
||||
importNames :: IE Name -> [NameOccurrence]
|
||||
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
importNames :: IE GhcRn -> [NameOccurrence]
|
||||
#endif
|
||||
importNames =
|
||||
map
|
||||
(\name ->
|
||||
@ -229,7 +254,10 @@ importNames =
|
||||
}) .
|
||||
ieLocNames
|
||||
|
||||
patNames :: LPat Name -> [NameOccurrence]
|
||||
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
patNames :: LPat GhcRn -> [NameOccurrence]
|
||||
#endif
|
||||
patNames (L _span (VarPat name)) =
|
||||
[ NameOccurrence
|
||||
{ locatedName = Just <$> name
|
||||
@ -260,7 +288,10 @@ patNames (L _span (NPlusKPat name _ _ _ _ _)) =
|
||||
]
|
||||
patNames _ = []
|
||||
|
||||
sigNames :: LSig Name -> [NameOccurrence]
|
||||
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
sigNames :: LSig GhcRn -> [NameOccurrence]
|
||||
#endif
|
||||
sigNames (L _span (TypeSig names _)) =
|
||||
map
|
||||
(\n ->
|
||||
@ -332,7 +363,10 @@ sigNames (L _span (MinimalSig _ (L _ boolFormula))) =
|
||||
boolFormulaNames (Parens (L _ f)) = boolFormulaNames f
|
||||
sigNames (L _ _) = []
|
||||
|
||||
hsTypeNames :: LHsType Name -> [NameOccurrence]
|
||||
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
hsTypeNames :: LHsType GhcRn -> [NameOccurrence]
|
||||
#endif
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
|
||||
hsTypeNames (L _span (HsTyVar _promoted name)) =
|
||||
#else
|
||||
@ -382,7 +416,10 @@ hsTypeNames (L span (HsTupleTy tupleSort types))
|
||||
--hsTypeNames (L span (HsExplicitTupleTy _kind types)) = ...
|
||||
hsTypeNames _ = []
|
||||
|
||||
hsTyVarBndrNames :: HsTyVarBndr Name -> [NameOccurrence]
|
||||
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
hsTyVarBndrNames :: HsTyVarBndr GhcRn -> [NameOccurrence]
|
||||
#endif
|
||||
hsTyVarBndrNames (UserTyVar n) =
|
||||
[ NameOccurrence
|
||||
{ locatedName = Just <$> n
|
||||
@ -398,7 +435,9 @@ hsTyVarBndrNames (KindedTyVar n _) =
|
||||
}
|
||||
]
|
||||
|
||||
tyClDeclNames :: LTyClDecl Name -> [NameOccurrence]
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
tyClDeclNames :: LTyClDecl GhcRn -> [NameOccurrence]
|
||||
#endif
|
||||
tyClDeclNames (L _span DataDecl {..}) =
|
||||
[ NameOccurrence
|
||||
{ locatedName = Just <$> tcdLName
|
||||
@ -432,7 +471,9 @@ tyClDeclNames (L _span ClassDecl {..}) =
|
||||
}
|
||||
tyClDeclNames _ = []
|
||||
|
||||
familyDeclNames :: FamilyDecl Name -> [NameOccurrence]
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
familyDeclNames :: FamilyDecl GhcRn -> [NameOccurrence]
|
||||
#endif
|
||||
familyDeclNames FamilyDecl {..} =
|
||||
[ NameOccurrence
|
||||
{ locatedName = Just <$> fdLName
|
||||
@ -441,7 +482,11 @@ familyDeclNames FamilyDecl {..} =
|
||||
}
|
||||
]
|
||||
|
||||
tyFamilyEqNames :: TyFamEqn Name (HsTyPats Name) -> [NameOccurrence]
|
||||
|
||||
--TODO
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
#else
|
||||
--tyFamilyEqNames :: TyFamEqn Name (HsTyPats Name) -> [NameOccurrence]
|
||||
tyFamilyEqNames TyFamEqn {tfe_tycon = tyCon} =
|
||||
[ NameOccurrence
|
||||
{ locatedName = Just <$> tyCon
|
||||
@ -450,7 +495,7 @@ tyFamilyEqNames TyFamEqn {tfe_tycon = tyCon} =
|
||||
}
|
||||
]
|
||||
|
||||
tyFamilyDefEqNames :: TyFamEqn Name (LHsQTyVars Name) -> [NameOccurrence]
|
||||
--tyFamilyDefEqNames :: TyFamEqn Name (LHsQTyVars Name) -> [NameOccurrence]
|
||||
tyFamilyDefEqNames TyFamEqn {tfe_tycon = tyCon} =
|
||||
[ NameOccurrence
|
||||
{ locatedName = Just <$> tyCon
|
||||
@ -459,7 +504,8 @@ tyFamilyDefEqNames TyFamEqn {tfe_tycon = tyCon} =
|
||||
}
|
||||
]
|
||||
|
||||
dataFamInstDeclNames :: DataFamInstDecl Name -> [NameOccurrence]
|
||||
|
||||
--dataFamInstDeclNames :: DataFamInstDecl Name -> [NameOccurrence]
|
||||
dataFamInstDeclNames DataFamInstDecl {dfid_tycon = tyCon} =
|
||||
[ NameOccurrence
|
||||
{ locatedName = Just <$> tyCon
|
||||
@ -467,8 +513,11 @@ dataFamInstDeclNames DataFamInstDecl {dfid_tycon = tyCon} =
|
||||
, isBinder = False
|
||||
}
|
||||
]
|
||||
#endif
|
||||
|
||||
conDeclNames :: ConDecl Name -> [NameOccurrence]
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
conDeclNames :: ConDecl GhcRn -> [NameOccurrence]
|
||||
#endif
|
||||
conDeclNames con =
|
||||
case con of
|
||||
ConDeclGADT {con_names = names} ->
|
||||
@ -488,7 +537,9 @@ conDeclNames con =
|
||||
}
|
||||
]
|
||||
|
||||
foreignDeclNames :: ForeignDecl Name -> [NameOccurrence]
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foreignDeclNames :: ForeignDecl GhcRn -> [NameOccurrence]
|
||||
#endif
|
||||
foreignDeclNames decl =
|
||||
[ NameOccurrence
|
||||
{ locatedName = Just <$> fd_name decl
|
||||
|
||||
@ -80,6 +80,7 @@ import HsSyn
|
||||
, selectorAmbiguousFieldOcc
|
||||
)
|
||||
import HscTypes (TypeEnv, lookupTypeEnv)
|
||||
import HsExtension (GhcTc)
|
||||
import Id (idType)
|
||||
import IdInfo (IdDetails(..))
|
||||
import InstEnv
|
||||
@ -541,11 +542,15 @@ tidyType typ = do
|
||||
let (tidyEnv', typ') = tidyOpenType tidyEnv typ
|
||||
modify' (\s -> s {astStateTidyEnv = tidyEnv'})
|
||||
return typ'
|
||||
|
||||
foldTypecheckedSource :: LHsBinds Id -> State ASTState ()
|
||||
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldTypecheckedSource :: LHsBinds GhcTc -> State ASTState ()
|
||||
#endif
|
||||
foldTypecheckedSource = foldLHsBindsLR
|
||||
|
||||
foldLHsExpr :: LHsExpr Var -> State ASTState (Maybe Type)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldLHsExpr :: LHsExpr GhcTc -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldLHsExpr (L span (HsVar (L _ identifier))) =
|
||||
restoreTidyEnv $ do
|
||||
(identifier', mbTypes) <- tidyIdentifier identifier
|
||||
@ -801,8 +806,10 @@ foldLHsExpr (L span (HsWrap wrapper expr)) =
|
||||
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)
|
||||
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldHsRecFields :: HsRecFields GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldHsRecFields HsRecFields {..} = do
|
||||
let userWritten =
|
||||
case rec_dotdot of
|
||||
@ -810,8 +817,10 @@ foldHsRecFields HsRecFields {..} = do
|
||||
Nothing -> id
|
||||
mapM_ foldLHsRecField $ userWritten rec_flds
|
||||
return Nothing
|
||||
|
||||
foldLHsRecField :: LHsRecField Id (LHsExpr Id) -> State ASTState (Maybe Type)
|
||||
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldLHsRecField :: LHsRecField GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldLHsRecField (L span (HsRecField (L idSpan (FieldOcc _ identifier)) arg pun)) =
|
||||
restoreTidyEnv $ do
|
||||
(identifier', mbTypes) <- tidyIdentifier identifier
|
||||
@ -820,7 +829,9 @@ foldLHsRecField (L span (HsRecField (L idSpan (FieldOcc _ identifier)) arg pun))
|
||||
unless pun $ void (foldLHsExpr arg)
|
||||
return . Just . varType $ identifier'
|
||||
|
||||
foldLHsRecUpdField :: LHsRecUpdField Id -> State ASTState (Maybe Type)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldLHsRecUpdField :: LHsRecUpdField GhcTc -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldLHsRecUpdField (L span (HsRecField (L idSpan recField) arg pun)) =
|
||||
restoreTidyEnv $ do
|
||||
let selectorId = selectorAmbiguousFieldOcc recField
|
||||
@ -844,7 +855,9 @@ data TupArg
|
||||
| TupArgMissing
|
||||
deriving (Show, Eq)
|
||||
|
||||
foldLHsTupArg :: LHsTupArg Id -> State ASTState (Maybe Type, TupArg)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldLHsTupArg :: LHsTupArg GhcTc -> State ASTState (Maybe Type, TupArg)
|
||||
#endif
|
||||
foldLHsTupArg (L _span (Present expr)) =
|
||||
restoreTidyEnv $ do
|
||||
typ <- foldLHsExpr expr
|
||||
@ -858,31 +871,41 @@ foldLHsTupArg (L _ (Missing typ)) =
|
||||
typ' <- tidyType typ
|
||||
return (Just typ', TupArgMissing)
|
||||
|
||||
foldLMatch :: LMatch Id (LHsExpr Var) -> State ASTState (Maybe Type)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldLMatch :: LMatch GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldLMatch (L _span Match {..}) = do
|
||||
mapM_ foldLPat m_pats
|
||||
_ <- foldGRHSs m_grhss
|
||||
return Nothing
|
||||
|
||||
foldLMatchCmd :: LMatch Id (LHsCmd Var) -> State ASTState (Maybe Type)
|
||||
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldLMatchCmd :: LMatch GhcTc (LHsCmd GhcTc) -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldLMatchCmd (L _span Match {..}) = do
|
||||
mapM_ foldLPat m_pats
|
||||
_ <- foldGRHSsCmd m_grhss
|
||||
return Nothing
|
||||
|
||||
foldGRHSsCmd :: GRHSs Id (LHsCmd Id) -> State ASTState (Maybe Type)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldGRHSsCmd :: GRHSs GhcTc (LHsCmd GhcTc) -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldGRHSsCmd GRHSs {..} = do
|
||||
mapM_ foldLGRHSCmd grhssGRHSs
|
||||
_ <- foldHsLocalBindsLR (unLoc grhssLocalBinds)
|
||||
return Nothing
|
||||
|
||||
foldGRHSs :: GRHSs Id (LHsExpr Var) -> State ASTState (Maybe Type)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldGRHSs :: GRHSs GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldGRHSs GRHSs {..} = do
|
||||
mapM_ foldLGRHS grhssGRHSs
|
||||
_ <- foldHsLocalBindsLR (unLoc grhssLocalBinds)
|
||||
return Nothing
|
||||
|
||||
foldLStmtLR :: LStmtLR Id Id (LHsExpr Var) -> State ASTState (Maybe Type)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldLStmtLR :: LStmtLR GhcTc GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldLStmtLR (L span (LastStmt body _ _)) =
|
||||
do typ <- foldLHsExpr body
|
||||
addExprInfo span typ "LastStmt" Composite
|
||||
@ -916,10 +939,16 @@ foldLStmtLR (L span (ApplicativeStmt args _ typ)) =
|
||||
addExprInfo span (Just typ') "ApplicativeStmt" Composite
|
||||
return Nothing
|
||||
|
||||
foldApplicativeArg :: ApplicativeArg Id Id -> State ASTState (Maybe Type)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldApplicativeArg :: ApplicativeArg GhcTc GhcTc -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldApplicativeArg appArg =
|
||||
case appArg of
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
ApplicativeArgOne pat expr _bool -> do
|
||||
#else
|
||||
ApplicativeArgOne pat expr -> do
|
||||
#endif
|
||||
_ <- foldLPat pat
|
||||
_ <- foldLHsExpr expr
|
||||
return Nothing
|
||||
@ -927,9 +956,10 @@ foldApplicativeArg appArg =
|
||||
_ <- mapM_ foldLStmtLR exprStmts
|
||||
_ <- foldLPat pat
|
||||
return Nothing
|
||||
|
||||
foldLStmtLRCmd :: LStmtLR Id Id (LHsCmd Var)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldLStmtLRCmd :: LStmtLR GhcTc GhcTc (LHsCmd GhcTc)
|
||||
-> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldLStmtLRCmd (L span (LastStmt body _syntaxExpr _)) = do
|
||||
typ <- foldLHsCmd body
|
||||
addExprInfo span typ "LastStmt Cmd" Composite
|
||||
@ -962,43 +992,57 @@ foldLStmtLRCmd (L span (ApplicativeStmt args _ typ)) =
|
||||
mapM_ (foldApplicativeArg . snd) args
|
||||
addExprInfo span (Just typ') "ApplicativeStmt Cmd" Composite
|
||||
return Nothing
|
||||
|
||||
foldLGRHS :: LGRHS Id (LHsExpr Id) -> State ASTState (Maybe Type)
|
||||
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldLGRHS :: LGRHS GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldLGRHS (L _span (GRHS guards body)) = do
|
||||
typ <- foldLHsExpr body
|
||||
mapM_ foldLStmtLR guards
|
||||
return typ
|
||||
|
||||
foldLGRHSCmd :: LGRHS Id (LHsCmd Var) -> State ASTState (Maybe Type)
|
||||
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldLGRHSCmd :: LGRHS GhcTc (LHsCmd GhcTc) -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldLGRHSCmd (L _span (GRHS guards body)) = do
|
||||
typ <- foldLHsCmd body
|
||||
mapM_ foldLStmtLR guards
|
||||
return typ
|
||||
|
||||
foldParStmtBlock :: ParStmtBlock Id Id -> State ASTState (Maybe Type)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldParStmtBlock :: ParStmtBlock GhcTc GhcTc -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldParStmtBlock (ParStmtBlock exprStmts _ids _syntaxExpr) = do
|
||||
mapM_ foldLStmtLR exprStmts
|
||||
return Nothing
|
||||
|
||||
foldHsLocalBindsLR :: HsLocalBindsLR Id Id -> State ASTState (Maybe Type)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldHsLocalBindsLR :: HsLocalBindsLR GhcTc GhcTc -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
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)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldHsValBindsLR :: HsValBindsLR GhcTc GhcTc -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldHsValBindsLR (ValBindsIn _ _) = return Nothing
|
||||
foldHsValBindsLR (ValBindsOut binds _) = do
|
||||
_ <- mapM_ (foldLHsBindsLR . snd) binds
|
||||
return Nothing
|
||||
|
||||
foldLHsBindsLR :: LHsBinds Id -> State ASTState ()
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldLHsBindsLR :: LHsBinds GhcTc -> State ASTState ()
|
||||
#endif
|
||||
foldLHsBindsLR = mapM_ (`foldLHsBindLR` Nothing) . bagToList
|
||||
|
||||
foldLHsBindLR :: LHsBindLR Id Var
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldLHsBindLR :: LHsBindLR GhcTc GhcTc
|
||||
-> Maybe Id -- ^ Polymorphic id
|
||||
-> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldLHsBindLR (L _span FunBind {..}) mbPolyId
|
||||
| mg_origin fun_matches == FromSource =
|
||||
restoreTidyEnv $ do
|
||||
@ -1024,12 +1068,17 @@ foldLHsBindLR (L _ AbsBinds {..}) _ = do
|
||||
mapM_ (\(bind, typ) -> foldLHsBindLR bind (Just typ)) $
|
||||
zip (bagToList abs_binds) (map abe_poly abs_exports)
|
||||
return Nothing
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
#else
|
||||
foldLHsBindLR (L _ AbsBindsSig {..}) _ = do
|
||||
_ <- foldLHsBindLR abs_sig_bind (Just abs_sig_export)
|
||||
return Nothing
|
||||
#endif
|
||||
foldLHsBindLR (L _ (PatSynBind PSB {..})) _ =
|
||||
restoreTidyEnv $ do
|
||||
_ <- foldLPat psb_def
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
#else
|
||||
_ <-
|
||||
let addId :: GenLocated SrcSpan Id -> State ASTState ()
|
||||
addId (L span i) = do
|
||||
@ -1043,9 +1092,12 @@ foldLHsBindLR (L _ (PatSynBind PSB {..})) _ =
|
||||
(\(RecordPatSynField selId patVar) ->
|
||||
addId selId >> addId patVar)
|
||||
recs
|
||||
#endif
|
||||
return Nothing
|
||||
|
||||
foldLPat :: LPat Id -> State ASTState (Maybe Type)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldLPat :: LPat GhcTc -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldLPat (L span (VarPat (L _ identifier))) = do
|
||||
(identifier', _) <- tidyIdentifier identifier
|
||||
addIdentifierToIdSrcSpanMap span identifier' Nothing
|
||||
@ -1151,9 +1203,11 @@ foldLPat (L span p@(CoPat _ pat typ)) = do
|
||||
_ <- foldLPat (L span pat)
|
||||
return Nothing
|
||||
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldHsConPatDetails
|
||||
:: HsConPatDetails Id
|
||||
:: HsConPatDetails GhcTc
|
||||
-> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldHsConPatDetails (PrefixCon args) = do
|
||||
_ <- mapM_ foldLPat args
|
||||
return Nothing
|
||||
@ -1165,7 +1219,9 @@ foldHsConPatDetails (InfixCon arg1 arg2) = do
|
||||
_ <- foldLPat arg2
|
||||
return Nothing
|
||||
|
||||
foldHsRecFieldsPat :: HsRecFields Id (LPat Id) -> State ASTState (Maybe Type)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldHsRecFieldsPat :: HsRecFields GhcTc (LPat GhcTc) -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldHsRecFieldsPat HsRecFields {..} = do
|
||||
let onlyUserWritten =
|
||||
case rec_dotdot of
|
||||
@ -1174,20 +1230,26 @@ foldHsRecFieldsPat HsRecFields {..} = do
|
||||
_ <- mapM_ foldLHsRecFieldPat $ onlyUserWritten rec_flds
|
||||
return Nothing
|
||||
|
||||
foldLHsRecFieldPat :: LHsRecField Id (LPat Id) -> State ASTState (Maybe Type)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldLHsRecFieldPat :: LHsRecField GhcTc (LPat GhcTc) -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
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)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldLHsCmdTop :: LHsCmdTop GhcTc -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldLHsCmdTop (L span (HsCmdTop cmd _ _ _)) = do
|
||||
mbTyp <- foldLHsCmd cmd
|
||||
addExprInfo span mbTyp "HsCmdTop" Composite
|
||||
return mbTyp
|
||||
|
||||
foldLHsCmd :: LHsCmd Id -> State ASTState (Maybe Type)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foldLHsCmd :: LHsCmd GhcTc -> State ASTState (Maybe Type)
|
||||
#endif
|
||||
foldLHsCmd (L _ (HsCmdArrApp expr1 expr2 _ _ _)) = do
|
||||
_ <- foldLHsExpr expr1
|
||||
_ <- foldLHsExpr expr2
|
||||
|
||||
@ -3,6 +3,8 @@
|
||||
{-# LANGUAGE Rank2Types #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module HaskellCodeExplorer.GhcUtils
|
||||
@ -138,11 +140,18 @@ import GHC
|
||||
, tyFamInstDeclName
|
||||
, idType
|
||||
, hsib_body
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
#else
|
||||
, tfe_pats
|
||||
#endif
|
||||
, tfid_eqn
|
||||
)
|
||||
|
||||
import qualified HaskellCodeExplorer.Types as HCE
|
||||
import HscTypes (TypeEnv, lookupTypeEnv)
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
import HsExtension (GhcPs, GhcRn, GhcTc, IdP(..), Pass(..))
|
||||
#endif
|
||||
import IdInfo (IdDetails(..))
|
||||
import InstEnv (ClsInst(..))
|
||||
import Lexer (ParseResult(POk), mkPState, unP)
|
||||
@ -250,9 +259,12 @@ 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 :: DynFlags -> InstDecl Name -> T.Text
|
||||
instanceDeclToText flags decl =
|
||||
case decl of
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
_ -> ""
|
||||
#else
|
||||
ClsInstD ClsInstDecl {..} -> T.append "instance " (toText flags cid_poly_ty)
|
||||
DataFamInstD di ->
|
||||
let args =
|
||||
@ -266,6 +278,7 @@ instanceDeclToText flags decl =
|
||||
ti
|
||||
in T.concat
|
||||
["type instance ", toText flags $ tyFamInstDeclName ti, " ", args]
|
||||
#endif
|
||||
|
||||
nameToText :: Name -> T.Text
|
||||
nameToText = T.pack . unpackFS . occNameFS . nameOccName
|
||||
@ -366,7 +379,9 @@ mbIdDetails _ = Nothing
|
||||
-- Syntax transformation
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
hsGroupVals :: HsGroup Name -> [GenLocated SrcSpan (HsBindLR Name Name)]
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
hsGroupVals :: HsGroup GhcRn -> [GenLocated SrcSpan (HsBindLR GhcRn GhcRn)]
|
||||
#endif
|
||||
hsGroupVals hsGroup =
|
||||
filter (isGoodSrcSpan . getLoc) $
|
||||
case hs_valds hsGroup of
|
||||
@ -375,6 +390,9 @@ hsGroupVals hsGroup =
|
||||
|
||||
hsPatSynDetails :: HsPatSynDetails a -> [a]
|
||||
hsPatSynDetails patDetails =
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
[]
|
||||
#else
|
||||
case patDetails of
|
||||
InfixPatSyn name1 name2 -> [name1, name2]
|
||||
PrefixPatSyn name -> name
|
||||
@ -382,8 +400,13 @@ hsPatSynDetails patDetails =
|
||||
concatMap
|
||||
(\field -> [recordPatSynSelectorId field, recordPatSynPatVar field])
|
||||
fields
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
|
||||
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
--unwrapName :: LIEWrappedName n -> Located n
|
||||
unwrapName = ieLWrappedName
|
||||
#elif MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
|
||||
unwrapName :: LIEWrappedName Name -> Located Name
|
||||
unwrapName = ieLWrappedName
|
||||
#else
|
||||
@ -391,7 +414,7 @@ unwrapName :: Located Name -> Located Name
|
||||
unwrapName n = n
|
||||
#endif
|
||||
|
||||
ieLocNames :: IE Name -> [Located Name]
|
||||
--ieLocNames :: IE (IdP GhcTc) -> [Located Name]
|
||||
ieLocNames (IEVar n) = [unwrapName n]
|
||||
ieLocNames (IEThingAbs n) = [unwrapName n]
|
||||
ieLocNames (IEThingAll n) = [unwrapName n]
|
||||
@ -909,7 +932,7 @@ collectDocs = go Nothing []
|
||||
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 :: HsGroup Name -> [LHsDecl Name]
|
||||
ungroup group_ =
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
|
||||
mkDecls (tyClGroupTyClDecls . hs_tyclds) TyClD group_ ++
|
||||
@ -939,7 +962,7 @@ 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 :: TyClDecl Name -> [(LHsDecl Name, [HsDocString])]
|
||||
classDeclDocs class_ = collectDocs . sortByLoc $ decls
|
||||
where
|
||||
decls = docs ++ defs ++ sigs ++ ats
|
||||
@ -948,13 +971,13 @@ classDeclDocs class_ = collectDocs . sortByLoc $ decls
|
||||
sigs = mkDecls tcdSigs SigD class_
|
||||
ats = mkDecls tcdATs (TyClD . FamDecl) class_
|
||||
|
||||
conDeclDocs :: ConDecl Name -> [(Name, [HsDocString], SrcSpan)]
|
||||
--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 :: ConDecl name -> [(PostRn name name, [HsDocString], SrcSpan)]
|
||||
selectorDocs con =
|
||||
case getConDetails con of
|
||||
RecCon (L _ flds) ->
|
||||
@ -967,9 +990,14 @@ selectorDocs con =
|
||||
flds
|
||||
_ -> []
|
||||
|
||||
subordinateNamesWithDocs ::
|
||||
[GenLocated SrcSpan (HsDecl Name)] -> [(Name, [HsDocString], SrcSpan)]
|
||||
subordinateNamesWithDocs =
|
||||
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
subordinateNamesWithDocs :: [GenLocated SrcSpan (HsDecl GhcRn)] -> [(Name, [HsDocString], SrcSpan)]
|
||||
#endif
|
||||
subordinateNamesWithDocs _ =
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
[]
|
||||
#else
|
||||
concatMap
|
||||
(\(L span tyClDecl) ->
|
||||
case tyClDecl of
|
||||
@ -983,13 +1011,14 @@ subordinateNamesWithDocs =
|
||||
InstD (DataFamInstD DataFamInstDecl {..}) ->
|
||||
concatMap (conDeclDocs . unLoc) . dd_cons $ dfid_defn
|
||||
_ -> [])
|
||||
#endif
|
||||
|
||||
isUserLSig :: LSig name -> Bool
|
||||
isUserLSig (L _ TypeSig {}) = True
|
||||
isUserLSig (L _ ClassOpSig {}) = True
|
||||
isUserLSig _ = False
|
||||
|
||||
getMainDeclBinder :: HsDecl name -> [name]
|
||||
--getMainDeclBinder :: HsDecl name -> [name]
|
||||
getMainDeclBinder (TyClD d) = [tcdName d]
|
||||
getMainDeclBinder (ValD d) =
|
||||
case collectHsBindBinders d of
|
||||
@ -1000,7 +1029,7 @@ getMainDeclBinder (ForD (ForeignImport name _ _ _)) = [unLoc name]
|
||||
getMainDeclBinder (ForD ForeignExport {}) = []
|
||||
getMainDeclBinder _ = []
|
||||
|
||||
sigNameNoLoc :: Sig name -> [name]
|
||||
--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)
|
||||
@ -1108,6 +1137,7 @@ outOfScope dflags x =
|
||||
Orig _ occ -> monospaced occ
|
||||
Exact name -> monospaced name -- Shouldn't happen since x is out of scope
|
||||
where
|
||||
monospaced :: (Outputable a) => a -> Doc b
|
||||
monospaced a = DocMonospaced (DocString (showPpr dflags a))
|
||||
|
||||
makeAnchorId :: String -> String
|
||||
|
||||
@ -23,8 +23,9 @@ 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 Data.Maybe (fromMaybe, mapMaybe)
|
||||
import Data.Ord (comparing)
|
||||
import HsExtension (GhcRn)
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as TE
|
||||
@ -307,10 +308,17 @@ createDefinitionSiteMap ::
|
||||
-> HCE.SourceCodeTransformation
|
||||
-> ModuleInfo
|
||||
-> [Name]
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
-> HsGroup GhcRn
|
||||
#else
|
||||
-> HsGroup Name
|
||||
#endif
|
||||
-> (HCE.DefinitionSiteMap, [Name])
|
||||
createDefinitionSiteMap flags currentPackageId compId defSiteMap fileMap globalRdrEnv transformation modInfo dataFamTyCons hsGroup =
|
||||
let allDecls :: [GenLocated SrcSpan (HsDecl Name)]
|
||||
let
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
allDecls :: [GenLocated SrcSpan (HsDecl GhcRn)]
|
||||
#endif
|
||||
allDecls = L.sortBy (comparing getLoc) . ungroup $ hsGroup
|
||||
(instanceDeclsWithDocs, valueAndTypeDeclsWithDocs) =
|
||||
L.partition
|
||||
@ -465,7 +473,9 @@ docWithNamesToHtml flags packageId compId transformation fileMap defSiteMap =
|
||||
|
||||
createDeclarations ::
|
||||
DynFlags
|
||||
-> HsGroup Name
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
-> HsGroup GhcRn
|
||||
#endif
|
||||
-> TypeEnv
|
||||
-> S.Set Name
|
||||
-> HCE.SourceCodeTransformation
|
||||
@ -483,8 +493,9 @@ createDeclarations flags hsGroup typeEnv exportedSet transformation =
|
||||
Nothing -> Nothing
|
||||
-- | Top-level functions
|
||||
--------------------------------------------------------------------------------
|
||||
valToDeclarations ::
|
||||
GenLocated SrcSpan (HsBindLR Name Name) -> [HCE.Declaration]
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
valToDeclarations :: GenLocated SrcSpan (HsBindLR GhcRn GhcRn) -> [HCE.Declaration]
|
||||
#endif
|
||||
valToDeclarations (L loc bind) =
|
||||
map
|
||||
(\name ->
|
||||
@ -498,7 +509,9 @@ createDeclarations flags hsGroup typeEnv exportedSet transformation =
|
||||
vals = concatMap valToDeclarations $ hsGroupVals hsGroup
|
||||
-- | Data, newtype, type, type family, data family or class declaration
|
||||
--------------------------------------------------------------------------------
|
||||
tyClToDeclaration :: GenLocated SrcSpan (TyClDecl Name) -> HCE.Declaration
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
tyClToDeclaration :: GenLocated SrcSpan (TyClDecl GhcRn) -> HCE.Declaration
|
||||
#endif
|
||||
tyClToDeclaration (L loc tyClDecl) =
|
||||
HCE.Declaration
|
||||
HCE.TyClD
|
||||
@ -512,7 +525,9 @@ createDeclarations flags hsGroup typeEnv exportedSet transformation =
|
||||
hsGroup
|
||||
-- | Instances
|
||||
--------------------------------------------------------------------------------
|
||||
instToDeclaration :: GenLocated SrcSpan (InstDecl Name) -> HCE.Declaration
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
instToDeclaration :: GenLocated SrcSpan (InstDecl GhcRn) -> HCE.Declaration
|
||||
#endif
|
||||
instToDeclaration (L loc inst) =
|
||||
HCE.Declaration
|
||||
HCE.InstD
|
||||
@ -529,8 +544,10 @@ createDeclarations flags hsGroup typeEnv exportedSet transformation =
|
||||
hsGroup
|
||||
-- | Foreign functions
|
||||
--------------------------------------------------------------------------------
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
foreignFunToDeclaration ::
|
||||
GenLocated SrcSpan (ForeignDecl Name) -> HCE.Declaration
|
||||
GenLocated SrcSpan (ForeignDecl GhcRn) -> HCE.Declaration
|
||||
#endif
|
||||
foreignFunToDeclaration (L loc fd) =
|
||||
let name = unLoc $ fd_name fd
|
||||
in HCE.Declaration
|
||||
@ -588,7 +605,11 @@ foldAST environment typecheckedModule =
|
||||
case mbExported of
|
||||
Just lieNames ->
|
||||
mapMaybe
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
|
||||
(\(L span ie,_) ->
|
||||
#else
|
||||
(\(L span ie) ->
|
||||
#endif
|
||||
case ie of
|
||||
IEModuleContents (L _ modName) ->
|
||||
Just
|
||||
|
||||
10
stack-8.2.2.yaml
Normal file
10
stack-8.2.2.yaml
Normal file
@ -0,0 +1,10 @@
|
||||
resolver: lts-11.3
|
||||
packages:
|
||||
- '.'
|
||||
packages:
|
||||
- .
|
||||
- location: vendor/cabal-helper-0.8.1.2
|
||||
extra-dep: true
|
||||
extra-deps:
|
||||
- cabal-plan-0.4.0.0
|
||||
- pretty-show-1.8.2
|
||||
@ -1,9 +0,0 @@
|
||||
# stack build haskell-code-explorer:haskell-code-server --stack-yaml=stack-8.4.3.yaml
|
||||
resolver: lts-12.4
|
||||
packages:
|
||||
- '.'
|
||||
allow-newer: true
|
||||
extra-deps:
|
||||
- cabal-helper-0.8.1.0
|
||||
- cabal-plan-0.3.0.0
|
||||
|
||||
12
stack.yaml
12
stack.yaml
@ -1,10 +1,8 @@
|
||||
resolver: lts-11.3
|
||||
resolver: lts-12.4
|
||||
packages:
|
||||
- '.'
|
||||
packages:
|
||||
- .
|
||||
- location: vendor/cabal-helper-0.8.1.2
|
||||
extra-dep: true
|
||||
- location: vendor/cabal-helper-0.8.1.2
|
||||
extra-dep: true
|
||||
allow-newer: true
|
||||
extra-deps:
|
||||
- cabal-plan-0.4.0.0
|
||||
- pretty-show-1.8.2
|
||||
- cabal-plan-0.4.0.0
|
||||
|
||||
Loading…
Reference in New Issue
Block a user