Merge branch 'release-5.6.0.0' into ghc-8
This commit is contained in:
commit
66c6379945
@ -7,12 +7,13 @@ import Language.Haskell.GhcMod.Flag
|
||||
import Language.Haskell.GhcMod.Lang
|
||||
import Language.Haskell.GhcMod.Monad
|
||||
import Language.Haskell.GhcMod.Modules
|
||||
import Language.Haskell.GhcMod.Types (defaultBrowseOpts)
|
||||
|
||||
-- | Printing necessary information for front-end booting.
|
||||
boot :: IOish m => GhcModT m String
|
||||
boot = concat <$> sequence ms
|
||||
where
|
||||
ms = [modules False, languages, flags, concat <$> mapM (browse (BrowseOpts False False False)) preBrowsedModules]
|
||||
ms = [modules False, languages, flags, concat <$> mapM (browse defaultBrowseOpts) preBrowsedModules]
|
||||
|
||||
preBrowsedModules :: [String]
|
||||
preBrowsedModules = [
|
||||
|
@ -11,6 +11,7 @@ import Data.List
|
||||
import Data.Maybe
|
||||
import FastString
|
||||
import GHC
|
||||
import HscTypes
|
||||
import qualified GHC as G
|
||||
import Language.Haskell.GhcMod.Convert
|
||||
import Language.Haskell.GhcMod.Doc (showPage, styleUnqualified)
|
||||
@ -96,14 +97,20 @@ showExport opt minfo e = do
|
||||
mqualified = (G.moduleNameString (G.moduleName $ G.nameModule e) ++ ".") `justIf` optBrowseQualified opt
|
||||
mtype :: m (Maybe String)
|
||||
mtype
|
||||
| optBrowseDetailed opt = do
|
||||
| optBrowseDetailed opt || optBrowseParents opt = do
|
||||
tyInfo <- G.modInfoLookupName minfo e
|
||||
-- If nothing found, load dependent module and lookup global
|
||||
tyResult <- maybe (inOtherModule e) (return . Just) tyInfo
|
||||
dflag <- G.getSessionDynFlags
|
||||
return $ do
|
||||
typeName <- tyResult >>= showThing dflag
|
||||
(" :: " ++ typeName) `justIf` optBrowseDetailed opt
|
||||
let sig = do
|
||||
typeName <- tyResult >>= showThing dflag
|
||||
(" :: " ++ typeName) `justIf` optBrowseDetailed opt
|
||||
let parent = do
|
||||
thing <- fmap getOccString $ tyResult >>= tyThingParent_maybe
|
||||
(" -- from:" ++ thing) `justIf` optBrowseParents opt
|
||||
return $ case concat $ catMaybes [sig, parent] of
|
||||
[] -> Nothing
|
||||
x -> Just x
|
||||
| otherwise = return Nothing
|
||||
formatOp nm
|
||||
| null nm = error "formatOp"
|
||||
|
@ -29,6 +29,7 @@ import Language.Haskell.GhcMod.Logging
|
||||
import Language.Haskell.GhcMod.Types
|
||||
import Language.Haskell.GhcMod.Utils (withMappedFile)
|
||||
import Language.Haskell.GhcMod.FileMapping (fileModSummaryWithMapping)
|
||||
import Control.DeepSeq
|
||||
|
||||
----------------------------------------------------------------
|
||||
-- CASE SPLITTING
|
||||
@ -55,19 +56,17 @@ splits file lineNo colNo =
|
||||
style <- getStyle
|
||||
dflag <- G.getSessionDynFlags
|
||||
modSum <- fileModSummaryWithMapping (cradleCurrentDir crdl </> file)
|
||||
whenFound' oopts (getSrcSpanTypeForSplit modSum lineNo colNo) $ \x -> case x of
|
||||
(SplitInfo varName bndLoc (varLoc,varT) _matches) -> do
|
||||
let varName' = showName dflag style varName -- Convert name to string
|
||||
whenFound' oopts (getSrcSpanTypeForSplit modSum lineNo colNo) $ \x -> do
|
||||
let (varName, bndLoc, (varLoc,varT))
|
||||
| (SplitInfo vn bl vlvt _matches) <- x
|
||||
= (vn, bl, vlvt)
|
||||
| (TySplitInfo vn bl vlvt) <- x
|
||||
= (vn, bl, vlvt)
|
||||
varName' = showName dflag style varName -- Convert name to string
|
||||
t <- withMappedFile file $ \file' ->
|
||||
genCaseSplitTextFile file' (SplitToTextInfo varName' bndLoc varLoc $
|
||||
getTyCons dflag style varName varT)
|
||||
return (fourInts bndLoc, t)
|
||||
(TySplitInfo varName bndLoc (varLoc,varT)) -> do
|
||||
let varName' = showName dflag style varName -- Convert name to string
|
||||
t <- withMappedFile file $ \file' ->
|
||||
genCaseSplitTextFile file' (SplitToTextInfo varName' bndLoc varLoc $
|
||||
getTyCons dflag style varName varT)
|
||||
return (fourInts bndLoc, t)
|
||||
return $!! (fourInts bndLoc, t)
|
||||
where
|
||||
handler (SomeException ex) = do
|
||||
gmLog GmException "splits" $
|
||||
@ -215,8 +214,8 @@ genCaseSplitTextFile file info = liftIO $ do
|
||||
return $ getCaseSplitText (T.lines t) info
|
||||
|
||||
getCaseSplitText :: [T.Text] -> SplitToTextInfo -> String
|
||||
getCaseSplitText t (SplitToTextInfo { sVarName = sVN, sBindingSpan = sBS
|
||||
, sVarSpan = sVS, sTycons = sT }) =
|
||||
getCaseSplitText t SplitToTextInfo{ sVarName = sVN, sBindingSpan = sBS
|
||||
, sVarSpan = sVS, sTycons = sT } =
|
||||
let bindingText = getBindingText t sBS
|
||||
difference = srcSpanDifference sBS sVS
|
||||
replaced = map (replaceVarWithTyCon bindingText difference sVN) sT
|
||||
|
@ -44,6 +44,7 @@ module Language.Haskell.GhcMod.Gap (
|
||||
, Language.Haskell.GhcMod.Gap.isSynTyCon
|
||||
, parseModuleHeader
|
||||
, mkErrStyle'
|
||||
, everythingStagedWithContext
|
||||
) where
|
||||
|
||||
import Control.Applicative hiding (empty)
|
||||
@ -115,6 +116,8 @@ import Lexer as L
|
||||
import Parser
|
||||
import SrcLoc
|
||||
import Packages
|
||||
import Data.Generics (GenericQ, extQ, gmapQ)
|
||||
import GHC.SYB.Utils (Stage(..))
|
||||
|
||||
import Language.Haskell.GhcMod.Types (Expression(..))
|
||||
import Prelude
|
||||
@ -607,3 +610,20 @@ instance NFData ByteString where
|
||||
rnf Empty = ()
|
||||
rnf (Chunk _ b) = rnf b
|
||||
#endif
|
||||
|
||||
-- | Like 'everything', but avoid known potholes, based on the 'Stage' that
|
||||
-- generated the Ast.
|
||||
everythingStagedWithContext :: Stage -> s -> (r -> r -> r) -> r -> GenericQ (s -> (r, s)) -> GenericQ r
|
||||
everythingStagedWithContext stage s0 f z q x
|
||||
| (const False
|
||||
#if __GLASGOW_HASKELL__ <= 708
|
||||
`extQ` postTcType
|
||||
#endif
|
||||
`extQ` fixity `extQ` nameSet) x = z
|
||||
| otherwise = foldl f r (gmapQ (everythingStagedWithContext stage s' f z q) x)
|
||||
where nameSet = const (stage `elem` [Parser,TypeChecker]) :: NameSet -> Bool
|
||||
#if __GLASGOW_HASKELL__ <= 708
|
||||
postTcType = const (stage<TypeChecker) :: PostTcType -> Bool
|
||||
#endif
|
||||
fixity = const (stage<Renamer) :: GHC.Fixity -> Bool
|
||||
(r, s') = q x s0
|
||||
|
@ -5,10 +5,9 @@ module Language.Haskell.GhcMod.Info (
|
||||
|
||||
import Data.Function (on)
|
||||
import Data.List (sortBy)
|
||||
import Data.Maybe (catMaybes)
|
||||
import System.FilePath
|
||||
import Exception (ghandle, SomeException(..))
|
||||
import GHC (GhcMonad, LHsBind, LHsExpr, LPat, Id, TypecheckedModule(..), SrcSpan, Type)
|
||||
import GHC (GhcMonad, SrcSpan)
|
||||
import Prelude
|
||||
import qualified GHC as G
|
||||
import qualified Language.Haskell.GhcMod.Gap as Gap
|
||||
@ -53,17 +52,18 @@ info file expr =
|
||||
|
||||
-- | Obtaining type of a target expression. (GHCi's type:)
|
||||
types :: IOish m
|
||||
=> FilePath -- ^ A target file.
|
||||
=> Bool -- ^ Include constraints into type signature
|
||||
-> FilePath -- ^ A target file.
|
||||
-> Int -- ^ Line number.
|
||||
-> Int -- ^ Column number.
|
||||
-> GhcModT m String
|
||||
types file lineNo colNo =
|
||||
types withConstraints file lineNo colNo =
|
||||
ghandle handler $
|
||||
runGmlT' [Left file] deferErrors $
|
||||
withInteractiveContext $ do
|
||||
crdl <- cradle
|
||||
modSum <- fileModSummaryWithMapping (cradleCurrentDir crdl </> file)
|
||||
srcSpanTypes <- getSrcSpanType modSum lineNo colNo
|
||||
srcSpanTypes <- getSrcSpanType withConstraints modSum lineNo colNo
|
||||
dflag <- G.getSessionDynFlags
|
||||
st <- getStyle
|
||||
convert' $ map (toTup dflag st) $ sortBy (cmp `on` fst) srcSpanTypes
|
||||
@ -72,14 +72,8 @@ types file lineNo colNo =
|
||||
gmLog GmException "types" $ showDoc ex
|
||||
return []
|
||||
|
||||
getSrcSpanType :: GhcMonad m => G.ModSummary -> Int -> Int -> m [(SrcSpan, Type)]
|
||||
getSrcSpanType modSum lineNo colNo = do
|
||||
p <- G.parseModule modSum
|
||||
tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p
|
||||
let bs = listifySpans tcs (lineNo, colNo) :: [LHsBind Id]
|
||||
es = listifySpans tcs (lineNo, colNo) :: [LHsExpr Id]
|
||||
ps = listifySpans tcs (lineNo, colNo) :: [LPat Id]
|
||||
bts <- mapM (getType tcm) bs
|
||||
ets <- mapM (getType tcm) es
|
||||
pts <- mapM (getType tcm) ps
|
||||
return $ catMaybes $ concat [ets, bts, pts]
|
||||
getSrcSpanType :: (GhcMonad m) => Bool -> G.ModSummary -> Int -> Int -> m [(SrcSpan, G.Type)]
|
||||
getSrcSpanType withConstraints modSum lineNo colNo =
|
||||
G.parseModule modSum
|
||||
>>= G.typecheckModule
|
||||
>>= flip (collectSpansTypes withConstraints) (lineNo, colNo)
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE TupleSections, FlexibleInstances, Rank2Types #-}
|
||||
{-# LANGUAGE TupleSections, FlexibleInstances, Rank2Types, ImpredicativeTypes #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module Language.Haskell.GhcMod.SrcUtils where
|
||||
@ -6,11 +6,14 @@ module Language.Haskell.GhcMod.SrcUtils where
|
||||
import Control.Applicative
|
||||
import CoreUtils (exprType)
|
||||
import Data.Generics
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Maybe
|
||||
import Data.Ord as O
|
||||
import GHC (LHsExpr, LPat, Id, DynFlags, SrcSpan, Type, Located, ParsedSource, RenamedSource, TypecheckedSource, GenLocated(L))
|
||||
import Var (Var)
|
||||
import qualified GHC as G
|
||||
import GHC.SYB.Utils (Stage(..), everythingStaged)
|
||||
import qualified Var as G
|
||||
import qualified Type as G
|
||||
import GHC.SYB.Utils
|
||||
import GhcMonad
|
||||
import qualified Language.Haskell.Exts.Annotated as HE
|
||||
import Language.Haskell.GhcMod.Doc
|
||||
@ -20,6 +23,10 @@ import OccName (OccName)
|
||||
import Outputable (PprStyle)
|
||||
import TcHsSyn (hsPatType)
|
||||
import Prelude
|
||||
import Control.Monad
|
||||
import Data.List (nub)
|
||||
import Control.Arrow
|
||||
import qualified Data.Map as M
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
@ -34,6 +41,82 @@ instance HasType (LPat Id) where
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- | Stores mapping from monomorphic to polymorphic types
|
||||
type CstGenQS = M.Map Var Type
|
||||
-- | Generic type to simplify SYB definition
|
||||
type CstGenQT a = forall m. GhcMonad m => a Id -> CstGenQS -> (m [(SrcSpan, Type)], CstGenQS)
|
||||
|
||||
collectSpansTypes :: (GhcMonad m) => Bool -> G.TypecheckedModule -> (Int, Int) -> m [(SrcSpan, Type)]
|
||||
collectSpansTypes withConstraints tcs lc =
|
||||
-- This walks AST top-down, left-to-right, while carrying CstGenQS down the tree
|
||||
-- (but not left-to-right)
|
||||
everythingStagedWithContext TypeChecker M.empty (liftM2 (++))
|
||||
(return [])
|
||||
((return [],)
|
||||
`mkQ` (hsBind :: CstGenQT G.LHsBind) -- matches on binds
|
||||
`extQ` (genericCT :: CstGenQT G.LHsExpr) -- matches on expressions
|
||||
`extQ` (genericCT :: CstGenQT G.LPat) -- matches on patterns
|
||||
)
|
||||
(G.tm_typechecked_source tcs)
|
||||
where
|
||||
-- Helper function to insert mapping into CstGenQS
|
||||
insExp x = M.insert (G.abe_mono x) (G.varType $ G.abe_poly x)
|
||||
-- If there is AbsBinds here, insert mapping into CstGenQS if needed
|
||||
hsBind (L _ G.AbsBinds{abs_exports = es'}) s
|
||||
| withConstraints = (return [], foldr insExp s es')
|
||||
| otherwise = (return [], s)
|
||||
-- Otherwise, it's the same as other cases
|
||||
hsBind x s = genericCT x s
|
||||
-- Generic SYB function to get type
|
||||
genericCT x s
|
||||
| withConstraints
|
||||
= (maybe [] (uncurry $ constrainedType (collectBinders x) s) <$> getType' x, s)
|
||||
| otherwise = (maybeToList <$> getType' x, s)
|
||||
-- Collects everything with Id from LHsBind, LHsExpr, or LPat
|
||||
collectBinders :: Data a => a -> [Id]
|
||||
collectBinders = listifyStaged TypeChecker (const True)
|
||||
-- Gets monomorphic type with location
|
||||
getType' x@(L spn _)
|
||||
| G.isGoodSrcSpan spn && spn `G.spans` lc
|
||||
= getType tcs x
|
||||
| otherwise = return Nothing
|
||||
-- Gets constrained type
|
||||
constrainedType :: [Var] -- ^ Binders in expression, i.e. anything with Id
|
||||
-> CstGenQS -- ^ Map from Id to polymorphic type
|
||||
-> SrcSpan -- ^ extent of expression, copied to result
|
||||
-> Type -- ^ monomorphic type
|
||||
-> [(SrcSpan, Type)] -- ^ result
|
||||
constrainedType pids s spn genTyp =
|
||||
let
|
||||
-- runs build on every binder.
|
||||
ctys = mapMaybe build (nub pids)
|
||||
-- Computes constrained type for x. Returns (constraints, substitutions)
|
||||
-- Substitutions are needed because type variables don't match
|
||||
-- between polymorphic and monomorphic types.
|
||||
-- E.g. poly type might be `Monad m => m ()`, while monomorphic might be `f ()`
|
||||
build x | Just cti <- x `M.lookup` s
|
||||
= let
|
||||
(preds', ctt) = getPreds cti
|
||||
-- list of type variables in monomorphic type
|
||||
vts = listifyStaged TypeChecker G.isTyVar $ G.varType x
|
||||
-- list of type variables in polymorphic type
|
||||
tvm = listifyStaged TypeChecker G.isTyVarTy ctt
|
||||
in Just (preds', zip vts tvm)
|
||||
| otherwise = Nothing
|
||||
-- list of constraints
|
||||
preds = concatMap fst ctys
|
||||
-- Type variable substitutions
|
||||
subs = G.mkTopTvSubst $ concatMap snd ctys
|
||||
-- Constrained type
|
||||
ty = G.substTy subs $ G.mkFunTys preds genTyp
|
||||
in [(spn, ty)]
|
||||
-- Splits a given type into list of constraints and simple type. Drops foralls.
|
||||
getPreds :: Type -> ([Type], Type)
|
||||
getPreds x | G.isForAllTy x = getPreds $ G.dropForAlls x
|
||||
| Just (c, t) <- G.splitFunTy_maybe x
|
||||
, G.isPredTy c = first (c:) $ getPreds t
|
||||
| otherwise = ([], x)
|
||||
|
||||
listifySpans :: Typeable a => TypecheckedSource -> (Int, Int) -> [Located a]
|
||||
listifySpans tcs lc = listifyStaged TypeChecker p tcs
|
||||
where
|
||||
|
@ -71,7 +71,7 @@ data OutputStyle = LispStyle -- ^ S expression style.
|
||||
newtype LineSeparator = LineSeparator String deriving (Show)
|
||||
|
||||
data FileMapping = FileMapping {fmPath :: FilePath, fmTemp :: Bool}
|
||||
deriving Show
|
||||
deriving (Eq, Show)
|
||||
|
||||
type FileMappingMap = Map FilePath FileMapping
|
||||
|
||||
@ -388,13 +388,15 @@ data BrowseOpts = BrowseOpts {
|
||||
-- ^ If 'True', "browseWith" also returns operators.
|
||||
, optBrowseDetailed :: Bool
|
||||
-- ^ If 'True', "browseWith" also returns types.
|
||||
, optBrowseParents :: Bool
|
||||
-- ^ If 'True', "browseWith" also returns parents.
|
||||
, optBrowseQualified :: Bool
|
||||
-- ^ If 'True', "browseWith" will return fully qualified name
|
||||
} deriving (Show)
|
||||
|
||||
-- | Default "BrowseOpts" instance
|
||||
defaultBrowseOpts :: BrowseOpts
|
||||
defaultBrowseOpts = BrowseOpts False False False
|
||||
defaultBrowseOpts = BrowseOpts False False False False
|
||||
|
||||
mkLabel ''GhcModCaches
|
||||
mkLabel ''GhcModState
|
||||
|
@ -19,6 +19,7 @@ data World = World {
|
||||
, worldCabalFile :: Maybe TimedFile
|
||||
, worldCabalConfig :: Maybe TimedFile
|
||||
, worldCabalSandboxConfig :: Maybe TimedFile
|
||||
, worldMappedFiles :: FileMappingMap
|
||||
} deriving (Eq)
|
||||
|
||||
timedPackageCaches :: IOish m => GhcModT m [TimedFile]
|
||||
@ -34,12 +35,14 @@ getCurrentWorld = do
|
||||
mCabalFile <- liftIO $ timeFile `traverse` cradleCabalFile crdl
|
||||
mCabalConfig <- liftIO $ timeMaybe (setupConfigFile crdl)
|
||||
mCabalSandboxConfig <- liftIO $ timeMaybe (sandboxConfigFile crdl)
|
||||
mFileMap <- getMMappedFiles
|
||||
|
||||
return World {
|
||||
worldPackageCaches = pkgCaches
|
||||
, worldCabalFile = mCabalFile
|
||||
, worldCabalConfig = mCabalConfig
|
||||
, worldCabalSandboxConfig = mCabalSandboxConfig
|
||||
, worldMappedFiles = mFileMap
|
||||
}
|
||||
|
||||
didWorldChange :: IOish m => World -> GhcModT m Bool
|
||||
|
@ -165,7 +165,7 @@ Library
|
||||
, bytestring < 0.11
|
||||
, binary < 0.9 && >= 0.5.1.0
|
||||
, containers < 0.6
|
||||
, cabal-helper < 0.8 && >= 0.7.0.1
|
||||
, cabal-helper < 0.8 && >= 0.7.1.0
|
||||
, deepseq < 1.5
|
||||
, directory < 1.3
|
||||
, filepath < 1.5
|
||||
|
@ -151,7 +151,7 @@ ghcCommands (CmdBrowse opts ms) = concat <$> browse opts `mapM` ms
|
||||
ghcCommands (CmdCheck files) = checkSyntax files
|
||||
ghcCommands (CmdExpand files) = expandTemplate files
|
||||
ghcCommands (CmdInfo file symb) = info file $ Expression symb
|
||||
ghcCommands (CmdType file (line, col)) = types file line col
|
||||
ghcCommands (CmdType wCon file (line, col)) = types wCon file line col
|
||||
ghcCommands (CmdSplit file (line, col)) = splits file line col
|
||||
ghcCommands (CmdSig file (line, col)) = sig file line col
|
||||
ghcCommands (CmdAuto file (line, col)) = auto file line col
|
||||
|
@ -51,7 +51,7 @@ data GhcModCommands =
|
||||
| CmdCheck [FilePath]
|
||||
| CmdExpand [FilePath]
|
||||
| CmdInfo FilePath Symbol
|
||||
| CmdType FilePath Point
|
||||
| CmdType Bool FilePath Point
|
||||
| CmdSplit FilePath Point
|
||||
| CmdSig FilePath Point
|
||||
| CmdAuto FilePath Point
|
||||
@ -215,12 +215,12 @@ interactiveCommandsSpec =
|
||||
strArg :: String -> Parser String
|
||||
strArg = argument str . metavar
|
||||
|
||||
filesArgsSpec :: ([String] -> b) -> Parser b
|
||||
filesArgsSpec x = x <$> some (strArg "FILES..")
|
||||
filesArgsSpec :: Parser ([String] -> b) -> Parser b
|
||||
filesArgsSpec x = x <*> some (strArg "FILES..")
|
||||
|
||||
locArgSpec :: (String -> (Int, Int) -> b) -> Parser b
|
||||
locArgSpec :: Parser (String -> (Int, Int) -> b) -> Parser b
|
||||
locArgSpec x = x
|
||||
<$> strArg "FILE"
|
||||
<*> strArg "FILE"
|
||||
<*> ( (,)
|
||||
<$> argument int (metavar "LINE")
|
||||
<*> argument int (metavar "COL")
|
||||
@ -255,23 +255,31 @@ browseArgSpec = CmdBrowse
|
||||
$$ long "detailed"
|
||||
<=> short 'd'
|
||||
<=> help "Print symbols with accompanying signature"
|
||||
<*> switch
|
||||
$$ long "parents"
|
||||
<=> short 'p'
|
||||
<=> help "Print symbols parents"
|
||||
<*> switch
|
||||
$$ long "qualified"
|
||||
<=> short 'q'
|
||||
<=> help "Qualify symbols"
|
||||
)
|
||||
<*> some (strArg "MODULE")
|
||||
debugComponentArgSpec = filesArgsSpec CmdDebugComponent
|
||||
checkArgSpec = filesArgsSpec CmdCheck
|
||||
expandArgSpec = filesArgsSpec CmdExpand
|
||||
debugComponentArgSpec = filesArgsSpec (pure CmdDebugComponent)
|
||||
checkArgSpec = filesArgsSpec (pure CmdCheck)
|
||||
expandArgSpec = filesArgsSpec (pure CmdExpand)
|
||||
infoArgSpec = CmdInfo
|
||||
<$> strArg "FILE"
|
||||
<*> strArg "SYMBOL"
|
||||
typeArgSpec = locArgSpec CmdType
|
||||
autoArgSpec = locArgSpec CmdAuto
|
||||
splitArgSpec = locArgSpec CmdSplit
|
||||
sigArgSpec = locArgSpec CmdSig
|
||||
refineArgSpec = locArgSpec CmdRefine <*> strArg "SYMBOL"
|
||||
typeArgSpec = locArgSpec $ CmdType <$>
|
||||
switch
|
||||
$$ long "constraints"
|
||||
<=> short 'c'
|
||||
<=> help "Include constraints into type signature"
|
||||
autoArgSpec = locArgSpec (pure CmdAuto)
|
||||
splitArgSpec = locArgSpec (pure CmdSplit)
|
||||
sigArgSpec = locArgSpec (pure CmdSig)
|
||||
refineArgSpec = locArgSpec (pure CmdRefine) <*> strArg "SYMBOL"
|
||||
mapArgSpec = CmdMapFile <$> strArg "FILE"
|
||||
unmapArgSpec = CmdUnmapFile <$> strArg "FILE"
|
||||
legacyInteractiveArgSpec = const CmdLegacyInteractive <$>
|
||||
|
@ -39,3 +39,8 @@ spec = do
|
||||
res `shouldBe` "38 21 38 59"++
|
||||
" \"mlReverse' Nil accum = _mlReverse_body\NUL"++
|
||||
" mlReverse' (Cons xs'1 xs'2) accum = _mlReverse_body\"\n"
|
||||
|
||||
it "doesn't crash when source doesn't make sense" $
|
||||
withDirectory_ "test/data/case-split" $ do
|
||||
res <- runD $ splits "Crash.hs" 4 6
|
||||
res `shouldBe` []
|
||||
|
@ -134,13 +134,19 @@ spec = do
|
||||
let tdir = "test/data/file-mapping"
|
||||
res <- runD' tdir $ do
|
||||
loadMappedFile "File.hs" "File_Redir_Lint.hs"
|
||||
types "File.hs" 4 12
|
||||
types False "File.hs" 4 12
|
||||
res `shouldBe` "4 12 4 15 \"a -> a -> a\"\n4 12 4 17 \"a -> a\"\n4 12 4 19 \"a\"\n4 1 4 19 \"a -> a -> a\"\n"
|
||||
it "shows types of the expression with constraints for redirected files" $ do
|
||||
let tdir = "test/data/file-mapping"
|
||||
res <- runD' tdir $ do
|
||||
loadMappedFile "File.hs" "File_Redir_Lint.hs"
|
||||
types True "File.hs" 4 12
|
||||
res `shouldBe` "4 12 4 15 \"a -> a -> a\"\n4 12 4 17 \"a -> a\"\n4 12 4 19 \"a\"\n4 1 4 19 \"Num a => a -> a -> a\"\n"
|
||||
it "shows types of the expression for in-memory files" $ do
|
||||
let tdir = "test/data/file-mapping"
|
||||
res <- runD' tdir $ do
|
||||
loadMappedFileSource "File.hs" "main = putStrLn \"Hello!\""
|
||||
types "File.hs" 1 14
|
||||
types False "File.hs" 1 14
|
||||
res `shouldBe` "1 8 1 16 \"String -> IO ()\"\n1 8 1 25 \"IO ()\"\n1 1 1 25 \"IO ()\"\n"
|
||||
it "shows info for the expression for redirected files" $ do
|
||||
let tdir = "test/data/file-mapping"
|
||||
@ -234,7 +240,7 @@ spec = do
|
||||
,("Bar.hs", tmpdir </> "Bar_Redir.hs")]
|
||||
res <- run defaultOptions $ do
|
||||
mapM_ (uncurry loadMappedFile) fm
|
||||
types "Bar.hs" 5 1
|
||||
types False "Bar.hs" 5 1
|
||||
res `shouldBe` unlines ["5 1 5 20 \"[Char]\""]
|
||||
it "works with a memory module using TemplateHaskell" $ do
|
||||
srcFoo <- readFile "test/data/template-haskell/Foo.hs"
|
||||
@ -244,5 +250,5 @@ spec = do
|
||||
,("Bar.hs", srcBar)]
|
||||
res <- run defaultOptions $ do
|
||||
mapM_ (uncurry loadMappedFileSource) fm
|
||||
types "Bar.hs" 5 1
|
||||
types False "Bar.hs" 5 1
|
||||
res `shouldBe` unlines ["5 1 5 20 \"[Char]\""]
|
||||
|
@ -19,17 +19,22 @@ spec = do
|
||||
describe "types" $ do
|
||||
it "shows types of the expression and its outers" $ do
|
||||
let tdir = "test/data/ghc-mod-check"
|
||||
res <- runD' tdir $ types "lib/Data/Foo.hs" 9 5
|
||||
res <- runD' tdir $ types False "lib/Data/Foo.hs" 9 5
|
||||
res `shouldBe` "9 5 11 40 \"Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n"
|
||||
|
||||
it "shows types of the expression with constraints and its outers" $ do
|
||||
let tdir = "test/data/ghc-mod-check"
|
||||
res <- runD' tdir $ types True "lib/Data/Foo.hs" 9 5
|
||||
res `shouldBe` "9 5 11 40 \"Num a => Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n"
|
||||
|
||||
it "works with a module using TemplateHaskell" $ do
|
||||
let tdir = "test/data/template-haskell"
|
||||
res <- runD' tdir $ types "Bar.hs" 5 1
|
||||
res <- runD' tdir $ types False "Bar.hs" 5 1
|
||||
res `shouldBe` unlines ["5 1 5 20 \"[Char]\""]
|
||||
|
||||
it "works with a module that imports another module using TemplateHaskell" $ do
|
||||
let tdir = "test/data/template-haskell"
|
||||
res <- runD' tdir $ types "ImportsTH.hs" 3 8
|
||||
res <- runD' tdir $ types False "ImportsTH.hs" 3 8
|
||||
res `shouldBe` unlines ["3 8 3 16 \"String -> IO ()\"", "3 8 3 20 \"IO ()\"", "3 1 3 20 \"IO ()\""]
|
||||
|
||||
describe "info" $ do
|
||||
|
4
test/data/case-split/Crash.hs
Normal file
4
test/data/case-split/Crash.hs
Normal file
@ -0,0 +1,4 @@
|
||||
module Crash where
|
||||
|
||||
test :: Maybe a
|
||||
test x = undefined
|
Loading…
Reference in New Issue
Block a user