buildwrapper 0.3.0 → 0.4.0
raw patch · 9 files changed
+569/−132 lines, 9 files
Files
- buildwrapper.cabal +6/−3
- src-exe/Language/Haskell/BuildWrapper/CMD.hs +4/−1
- src/Language/Haskell/BuildWrapper/API.hs +62/−79
- src/Language/Haskell/BuildWrapper/Base.hs +23/−1
- src/Language/Haskell/BuildWrapper/Cabal.hs +15/−4
- src/Language/Haskell/BuildWrapper/GHC.hs +72/−35
- src/Language/Haskell/BuildWrapper/GHCStorage.hs +315/−0
- test/Language/Haskell/BuildWrapper/CMDTests.hs +1/−0
- test/Language/Haskell/BuildWrapper/Tests.hs +71/−9
buildwrapper.cabal view
@@ -1,5 +1,5 @@ name: buildwrapper -version: 0.3.0 +version: 0.4.0 cabal-version: >= 1.8 build-type: Simple license: BSD3 @@ -37,7 +37,9 @@ old-time, aeson >=0.4, unordered-containers, - utf8-string + utf8-string, + bytestring, + attoparsec ghc-options: -Wall -fno-warn-unused-do-bind exposed-modules: Language.Haskell.BuildWrapper.API, @@ -48,7 +50,8 @@ other-modules: Language.Haskell.BuildWrapper.Find, Language.Haskell.BuildWrapper.Packages, - Language.Haskell.BuildWrapper.Src + Language.Haskell.BuildWrapper.Src, + Language.Haskell.BuildWrapper.GHCStorage executable buildwrapper hs-source-dirs: src-exe
src-exe/Language/Haskell/BuildWrapper/CMD.hs view
@@ -41,6 +41,7 @@ | NamesInScope {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, file:: FilePath} | Dependencies {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String} | Components {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String} + | GetBuildFlags {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, file:: FilePath} deriving (Show,Read,Data,Typeable) @@ -60,6 +61,7 @@ mwrite= Write tf cp cf uf fp (def &= help "file contents") mbuild = Build tf cp cf uf v (def &= help "output compilation and linking result") wc mbuild1 = Build1 tf cp cf uf fp +mgetbf = GetBuildFlags tf cp cf uf fp moutline = Outline tf cp cf uf fp mtokenTypes= TokenTypes tf cp cf uf fp moccurrences=Occurrences tf cp cf uf fp (def &= help "text to search occurrences of" &= name "token") @@ -73,7 +75,7 @@ mcomponents=Components tf cp cf uf cmdMain = (cmdArgs $ - modes [msynchronize, msynchronize1, mconfigure,mwrite,mbuild,mbuild1, moutline, mtokenTypes,moccurrences,mthingAtPoint,mnamesInScope,mdependencies,mcomponents] + modes [msynchronize, msynchronize1, mconfigure,mwrite,mbuild,mbuild1,mgetbf, moutline, mtokenTypes,moccurrences,mthingAtPoint,mnamesInScope,mdependencies,mcomponents] &= helpArg [explicit, name "help", name "h"] &= help "buildwrapper executable" &= program "buildwrapper" @@ -88,6 +90,7 @@ handle (Configure tf cp cf uf v wc)=runV v tf cp cf uf (configure wc) handle (Build tf cp cf uf v output wc)=runV v tf cp cf uf (build output wc) handle (Build1 tf cp cf uf fp)=runV v tf cp cf uf (build1 fp) + handle (GetBuildFlags tf cp cf uf fp)=runV v tf cp cf uf (getBuildFlags fp) handle (Outline tf cp cf uf fp)=run tf cp cf uf (getOutline fp) handle (TokenTypes tf cp cf uf fp)=run tf cp cf uf (getTokenTypes fp) handle (Occurrences tf cp cf uf fp token)=run tf cp cf uf (getOccurrences fp token)
src/Language/Haskell/BuildWrapper/API.hs view
@@ -15,6 +15,7 @@ import Language.Haskell.BuildWrapper.Base import Language.Haskell.BuildWrapper.Cabal import qualified Language.Haskell.BuildWrapper.GHC as BwGHC +import Language.Haskell.BuildWrapper.GHCStorage import Language.Haskell.BuildWrapper.Src import qualified Data.Text as T @@ -45,7 +46,7 @@ "Setup.hs": "Setup.lhs": fileList) - return $ (catMaybes (m:m1),ns) + return (catMaybes (m : m1), ns) synchronize1 :: Bool -> FilePath -> BuildWrapper(Maybe FilePath) @@ -89,97 +90,80 @@ preproc :: CabalBuildInfo -> FilePath -> IO String preproc cbi tgt= do inputOrig<-readFile tgt - let cppo=fileCppOptions cbi ++ ["-D__GLASGOW_HASKELL__=" ++ show (__GLASGOW_HASKELL__::Int)] + let lit=".lhs" == takeExtension tgt + let cppo=fileCppOptions cbi ++ ["-D__GLASGOW_HASKELL__=" ++ show (__GLASGOW_HASKELL__::Int)] ++ (if lit then ["--unlit"] else []) --Prelude.putStrLn $ "cppo=" ++ (show cppo) if not $ null cppo then do let epo=parseOptions cppo case epo of - Right opts2->do - let bo=boolopts opts2 - let opts3=if (".lhs" == takeExtension tgt) - then opts2 {boolopts=bo{literate=True}} - else opts2 - runCpphs opts3 tgt inputOrig + Right opts2->runCpphs opts2 tgt inputOrig Left _->return inputOrig else return inputOrig +preprocF :: BuildFlags -> FilePath -> IO String +preprocF bf tgt= do + inputOrig<-readFile tgt + let epo=parseOptions $ bf_preproc bf + case epo of + Right opts2->runCpphs opts2 tgt inputOrig + Left _->return inputOrig +getBuildFlags :: FilePath -> BuildWrapper (OpResult BuildFlags) +getBuildFlags fp=do + tgt<-getTargetPath fp + src<-getCabalFile Source + modSrc<-liftIO $ getModificationTime src + mbf<-liftIO $ readBuildFlagsInfo tgt modSrc + case mbf of + Just bf-> return bf + Nothing -> do + (mcbi,bwns)<-getBuildInfo fp + ret<-case mcbi of + Just cbi->do + let (modName,opts)=cabalExtensions $ snd cbi + (_,opts2)<-fileGhcOptions cbi + let lit=".lhs" == takeExtension fp + let cppo=(fileCppOptions $ snd cbi) ++ ["-D__GLASGOW_HASKELL__=" ++ show (__GLASGOW_HASKELL__::Int)] ++ (if lit then ["--unlit"] else []) + let modS=moduleToString modName + return (BuildFlags (opts ++ opts2) cppo (Just modS),bwns) + Nothing -> return (BuildFlags knownExtensionNames [] Nothing,[]) + liftIO $ storeBuildFlagsInfo tgt ret + return ret + getAST :: FilePath -> BuildWrapper (OpResult (Maybe (ParseResult (Module SrcSpanInfo, [Comment])))) -getAST fp = do - (mcbi,bwns)<-getBuildInfo fp - case mcbi of - Just(cbi)->do - let (_,opts)=cabalExtensions $ snd cbi - (_,opts2)<-fileGhcOptions cbi - tgt<-getTargetPath fp - --let modS=moduleToString modName - input<-liftIO $ preproc (snd cbi) tgt - pr<- liftIO $ getHSEAST input (opts++opts2) - --let json=makeObj [("parse" , (showJSON $ pr))] - return (Just pr,bwns) - Nothing-> do - -- cf<-gets cabalFile - tgt<-getTargetPath fp - -- let dir=(takeDirectory cf) - --liftIO $ putStrLn "not in cabal" - input<-liftIO $ readFile tgt -- (dir </> fp) - pr<- liftIO $ getHSEAST input knownExtensionNames - --let json=makeObj [("parse" , (showJSON $ pr))] - return (Just pr,[]) +getAST fp=do + (bf,ns)<-getBuildFlags fp + tgt<-getTargetPath fp + input<-liftIO $ preprocF bf tgt + pr<- liftIO $ getHSEAST input (bf_ast bf) + return (Just pr,ns) + getGHCAST :: FilePath -> BuildWrapper (OpResult (Maybe TypecheckedSource)) getGHCAST fp = withGHCAST' fp (\_->BwGHC.getAST) ---do --- (mcbi,bwns)<-getBuildInfo fp --- case mcbi of --- Just(cbi)->do --- let (modName,opts)=cabalExtensions $ snd cbi --- (_,opts2)<-fileGhcOptions cbi --- tgt<-getTargetPath fp --- temp<-getFullTempDir --- let modS=moduleToString modName --- (pr,bwns2)<- liftIO $ BwGHC.getAST tgt temp modS (opts++opts2) --- return (pr,bwns2) --- Nothing-> return (Nothing,bwns) - -withGHCAST :: FilePath -> (FilePath -> FilePath -> String -> [String] -> IO a) -> BuildWrapper (OpResult (Maybe a)) +withGHCAST :: FilePath -> (FilePath -> FilePath -> String -> [String] -> IO a) -> BuildWrapper (OpResult (Maybe a)) withGHCAST fp f=withGHCAST' fp (\n a b c d->do r<- f a b c d return $ ((Just r),n)) ---do --- (mcbi,bwns)<-getBuildInfo fp --- case mcbi of --- Just(cbi)->do --- let (modName,opts)=cabalExtensions $ snd cbi --- (_,opts2)<-fileGhcOptions cbi --- tgt<-getTargetPath fp --- temp<-getFullTempDir --- let modS=moduleToString modName --- pr<- liftIO $ f tgt temp modS (opts++opts2) --- return (Just pr,bwns) --- Nothing-> return (Nothing,bwns) - -withGHCAST' :: FilePath -> ([BWNote] -> FilePath -> FilePath -> String -> [String] -> IO (OpResult (Maybe a))) -> BuildWrapper (OpResult (Maybe a)) -withGHCAST' fp f= do - (mcbi,bwns)<-getBuildInfo fp - case mcbi of - Just(cbi)->do - let (modName,opts)=cabalExtensions $ snd cbi - (_,opts2)<-fileGhcOptions cbi +withGHCAST' :: FilePath -> ([BWNote] -> FilePath -> FilePath -> String -> [String] -> IO (OpResult (Maybe a))) -> BuildWrapper (OpResult (Maybe a)) +withGHCAST' fp f= do + (bf,ns)<-getBuildFlags fp + case bf of + (BuildFlags opts _ (Just modS))-> do tgt<-getTargetPath fp temp<-getFullTempDir liftIO $ do cd<-getCurrentDirectory setCurrentDirectory temp - let modS=moduleToString modName - (pr,bwns2)<- f bwns tgt temp modS (opts++opts2) + (pr,bwns2)<- f [] tgt temp modS opts setCurrentDirectory cd - return (pr,bwns2) - Nothing-> return (Nothing,bwns) + return (pr,ns ++ bwns2) + _ -> return (Nothing,ns) + getOutline :: FilePath -> BuildWrapper (OpResult OutlineResult) getOutline fp=do (mast,bwns)<-getAST fp @@ -228,22 +212,21 @@ Left bw -> return ([],bw:[]) -- bwns + getOccurrences :: FilePath -> String -> BuildWrapper (OpResult [TokenDef]) getOccurrences fp query=do - (mcbi,bwns)<-getBuildInfo fp - case mcbi of - Just(cbi)->do - let (_,opts)=cabalExtensions $ snd cbi - tgt<-getTargetPath fp - input<-liftIO $ readFile tgt - ett<-liftIO $ BwGHC.occurrences tgt input (T.pack query) (".lhs" == (takeExtension fp)) opts - case ett of - Right tt->return (tt,bwns) - Left bw -> return ([],bw:bwns) - Nothing-> return ([],bwns) + ((BuildFlags opts _ _),_)<-getBuildFlags fp + tgt<-getTargetPath fp + input<-liftIO $ readFile tgt + ett<-liftIO $ BwGHC.occurrences tgt input (T.pack query) (".lhs" == (takeExtension fp)) opts + case ett of + Right tt->return (tt,[]) + Left bw -> return ([],[bw]) + + getThingAtPoint :: FilePath -> Int -> Int -> Bool -> Bool -> BuildWrapper (OpResult (Maybe String)) -getThingAtPoint fp line col qual typed=withGHCAST fp $ BwGHC.getThingAtPoint line col qual typed +getThingAtPoint fp line col qual typed=withGHCAST fp $ BwGHC.getThingAtPointJSON line col qual typed getNamesInScope :: FilePath-> BuildWrapper (OpResult (Maybe [String])) getNamesInScope fp=withGHCAST fp BwGHC.getGhcNamesInScope
src/Language/Haskell/BuildWrapper/Base.hs view
@@ -68,7 +68,9 @@ bwn_location :: BWLocation } deriving (Show,Read,Eq) + + instance ToJSON BWNote where toJSON (BWNote s t l)= object ["s" .= s, "t" .= t, "l" .= l] @@ -261,7 +263,27 @@ v .: "e" <*> v .: "i" parseJSON _= mzero - + + +data BuildFlags = BuildFlags { + bf_ast :: [String], + bf_preproc :: [String], + bf_modName :: Maybe String + } + deriving (Show,Read,Eq,Data,Typeable) + +instance ToJSON BuildFlags where + toJSON (BuildFlags ast preproc modName)= object ["a" .= map toJSON ast, "p" .= map toJSON preproc, "m" .= toJSON modName] + +instance FromJSON BuildFlags where + parseJSON (Object v)=BuildFlags <$> + v .: "a" <*> + v .: "p" <*> + v .: "m" + parseJSON _= mzero + + + --withCabal :: (GenericPackageDescription -> BuildWrapper a) -> BuildWrapper (Either BWNote a) --withCabal f =do -- cf<-gets cabalFile
src/Language/Haskell/BuildWrapper/Cabal.hs view
@@ -357,6 +357,13 @@ _ -> Nothing type CabalBuildInfo=(BuildInfo,ComponentLocalBuildInfo,FilePath,Bool,[(ModuleName,FilePath)]) + +canonicalizeBuildInfo :: CabalBuildInfo -> IO CabalBuildInfo +canonicalizeBuildInfo (n1,n2,n3,n4,ls)=do + lsC<-mapM (\(m,path)->do + pathC<-canonicalizePath path + return (m,pathC)) ls + return (n1,n2,n3,n4,lsC) getBuildInfo :: FilePath -> BuildWrapper (OpResult (Maybe (LocalBuildInfo,CabalBuildInfo))) getBuildInfo fp=do @@ -368,13 +375,17 @@ return $ case mmr2 of Just (Just a)-> (Just a,bwns2) _-> (Nothing,bwns) - where go f=withCabal Source (\lbi->do + where + go f=withCabal Source (\lbi->do fps<-f lbi + fpC<-liftIO $ canonicalizePath fp + fpsC<-liftIO $ mapM canonicalizeBuildInfo fps --liftIO $ putStrLn $ (show $ length fps) - -- liftIO $ mapM_ (\(_,_,_,_,ls)->mapM_ (putStrLn . snd) ls) fps + --liftIO $ mapM_ (\(_,_,_,_,ls)->mapM_ (putStrLn . snd) ls) fps let ok=filter (\(_,_,_,_,ls)->not $ null ls ) $ - map (\(n1,n2,n3,n4,ls)->(n1,n2,n3,n4,filter (\(_,b)->b==fp || b==("." </> fp)) ls) ) - fps + --b==fpC || b==("." </> fpC) + map (\(n1,n2,n3,n4,ls)->(n1,n2,n3,n4,filter (\(_,b)->equalFilePath fpC b) ls) ) + fpsC --liftIO $ putStrLn $ (show $ length ok) --liftIO $ mapM_ (\(_,_,_,_,ls)->mapM_ (putStrLn . snd) ls) ok return $ if null ok
src/Language/Haskell/BuildWrapper/GHC.hs view
@@ -14,7 +14,7 @@ module Language.Haskell.BuildWrapper.GHC where import Language.Haskell.BuildWrapper.Base hiding (Target) import Language.Haskell.BuildWrapper.Find - +import Language.Haskell.BuildWrapper.GHCStorage -- import Text.JSON -- import Data.DeriveTH @@ -23,6 +23,7 @@ import Data.Generics hiding (Fixity, typeOf) import Data.Maybe import Data.Monoid +import Data.Aeson import Data.IORef import qualified Data.List as List @@ -34,7 +35,7 @@ import GHC import SrcLoc import GHC.Paths ( libdir ) -import HscTypes ( srcErrorMessages, SourceError) +import HscTypes ( srcErrorMessages, SourceError, liftIO) import Outputable import FastString (FastString,unpackFS,concatFS,fsLit,mkFastString) import Lexer @@ -50,6 +51,9 @@ import qualified MonadUtils as GMU + +import qualified Data.ByteString.Lazy as BS + getAST :: FilePath -> FilePath -> String -> [String] -> IO (OpResult (Maybe TypecheckedSource)) getAST =withASTNotes (\t -> do return $ tm_typechecked_source t @@ -60,49 +64,66 @@ (a,_)<-withASTNotes f fp base_dir mod options return a +withJSONAST :: (Value -> IO a) -> FilePath -> FilePath -> String -> [String] -> IO (Maybe a) +withJSONAST f fp base_dir mod options=do + mv<-readGHCInfo fp + case mv of + Just v-> f v >>= return . Just + Nothing->do + (mTc,ns)<-getAST fp base_dir mod options + case mTc of + Just tc->f (dataToJSON tc) >>= return . Just + Nothing -> return Nothing withASTNotes :: (TypecheckedModule -> Ghc a) -> FilePath -> FilePath -> String -> [String] -> IO (OpResult (Maybe a)) withASTNotes f fp base_dir mod options=do let lflags=map noLoc options - --putStrLn $ show options + -- putStrLn $ show options (_leftovers, _) <- parseStaticFlags lflags runGhc (Just libdir) $ do flg <- getSessionDynFlags (flg', _, _) <- parseDynamicFlags flg _leftovers - ref <- GMU.liftIO $ newIORef [] - setSessionDynFlags flg' { hscTarget = HscNothing, ghcLink = NoLink , ghcMode = CompManager, log_action = logAction ref } - -- $ dopt_set (flg' { ghcLink = NoLink , ghcMode = CompManager }) Opt_ForceRecomp - addTarget Target { targetId = TargetFile fp Nothing, targetAllowObjCode = True, targetContents = Nothing } - --c1<-GMU.liftIO getClockTime - let modName=mkModuleName mod - -- loadWithLogger (logWarnErr ref) - res<- load (LoadUpTo modName) -- LoadAllTargets - `gcatch` (\(e :: SourceError) -> handle_error ref e) - --(warns, errs) <- GMU.liftIO $ readIORef ref - --let notes = ghcMessagesToNotes base_dir (warns, errs) - notes <- GMU.liftIO $ readIORef ref - --c2<-GMU.liftIO getClockTime - --GMU.liftIO $ putStrLn ("load all targets: " ++ (timeDiffToString $ diffClockTimes c2 c1)) - case res of - Succeeded -> do - modSum <- getModSummary $ modName - p <- parseModule modSum - --return $ showSDocDump $ ppr $ pm_mod_summary p - t <- typecheckModule p - d <- desugarModule t -- to get warnings - l <- loadModule d - --c3<-GMU.liftIO getClockTime - setContext [ms_mod modSum] [] - --GMU.liftIO $ putStrLn ("parse, typecheck load: " ++ (timeDiffToString $ diffClockTimes c3 c2)) - a<-f (dm_typechecked_module l) + GHC.defaultCleanupHandler flg' $ do + ref <- GMU.liftIO $ newIORef [] + -- our options here + -- if we use OneShot, we need the other modules to be built + -- so we can't use hscTarget = HscNothing + -- and it takes a while to actually generate the o and hi files for big modules + -- if we use CompManager, it's slower for modules with lots of dependencies but we can keep hscTarget= HscNothing which makes it better for bigger modules + setSessionDynFlags flg' {hscTarget = HscNothing, ghcLink = NoLink , ghcMode = CompManager, log_action = logAction ref } + -- $ dopt_set (flg' { ghcLink = NoLink , ghcMode = CompManager }) Opt_ForceRecomp + addTarget Target { targetId = TargetFile fp Nothing, targetAllowObjCode = True, targetContents = Nothing } + --c1<-GMU.liftIO getClockTime + let modName=mkModuleName mod + -- loadWithLogger (logWarnErr ref) + res<- load (LoadUpTo modName) -- LoadAllTargets + `gcatch` (\(e :: SourceError) -> handle_error ref e) + --(warns, errs) <- GMU.liftIO $ readIORef ref + --let notes = ghcMessagesToNotes base_dir (warns, errs) + notes <- GMU.liftIO $ readIORef ref + --c2<-GMU.liftIO getClockTime + --GMU.liftIO $ putStrLn ("load all targets: " ++ (timeDiffToString $ diffClockTimes c2 c1)) + case res of + Succeeded -> do + modSum <- getModSummary $ modName + p <- parseModule modSum + --return $ showSDocDump $ ppr $ pm_mod_summary p + t <- typecheckModule p + d <- desugarModule t -- to get warnings + l <- loadModule d + --c3<-GMU.liftIO getClockTime + setContext [ms_mod modSum] [] + GMU.liftIO $ storeGHCInfo fp (typecheckedSource $ dm_typechecked_module l) + --GMU.liftIO $ putStrLn ("parse, typecheck load: " ++ (timeDiffToString $ diffClockTimes c3 c2)) + a<-f (dm_typechecked_module l) #if __GLASGOW_HASKELL__ < 702 - warns <- getWarnings - return $ (Just a,List.nub $ notes++ (reverse $ ghcMessagesToNotes base_dir (warns, emptyBag))) + warns <- getWarnings + return $ (Just a,List.nub $ notes++ (reverse $ ghcMessagesToNotes base_dir (warns, emptyBag))) #else - notes2 <- GMU.liftIO $ readIORef ref - return $ (Just a,notes2) + notes2 <- GMU.liftIO $ readIORef ref + return $ (Just a,notes2) #endif - Failed -> return $ (Nothing,notes) + Failed -> return $ (Nothing,notes) where -- logWarnErr :: GhcMonad m => IORef [BWNote] -> Maybe SourceError -> m () -- logWarnErr ref err = do @@ -172,12 +193,17 @@ --GMU.liftIO $ putStrLn ("getNamesInScope: " ++ (timeDiffToString $ diffClockTimes c2 c1)) return $ map (showSDocDump . ppr ) names) f base_dir mod options return $ fromMaybe[] names + + + getThingAtPoint :: Int -> Int -> Bool -> Bool -> FilePath -> FilePath -> String -> [String] -> IO String getThingAtPoint line col qual typed fp base_dir mod options= do t<-withAST (\tcm->do let loc = srcLocSpan $ mkSrcLoc (fsLit fp) line (scionColToGhcCol col) uq<-unqualifiedForModule tcm + --liftIO $ debugToJSON (typecheckedSource tcm) + --liftIO $ debugFindInJSON line col (typecheckedSource tcm) let f=(if typed then (doThingAtPointTyped $ typecheckedSource tcm) else (doThingAtPointUntyped $ renamedSource tcm)) --tap<- doThingAtPoint loc qual typed tcm (if typed then (typecheckedSource tcm) else (renamedSource tcm)) let tap=f loc qual tcm uq @@ -217,6 +243,17 @@ then showSDocForUser unqual ((qualifiedResult x) <+> (text $ haddockType x)) else showSDocForUser unqual ((prettyResult x) <+> (text $ haddockType x)) +getThingAtPointJSON :: Int -> Int -> Bool -> Bool -> FilePath -> FilePath -> String -> [String] -> IO String +getThingAtPointJSON line col qual typed fp base_dir mod options= do + mr<-withJSONAST (\v->do + let f=overlap line (scionColToGhcCol col) + let mf=findInJSON f v + BS.putStrLn $ encode (fromJust mf) + return $ findInJSONFormatted qual typed mf + ) fp base_dir mod options + return $ fromMaybe "no info" mr + + unqualifiedForModule :: TypecheckedMod m => m -> Ghc PrintUnqualified unqualifiedForModule tcm =fromMaybe alwaysQualify `fmap` mkPrintUnqualifiedForModule (moduleInfo tcm) @@ -240,7 +277,7 @@ -- p t@(TestLoc a b)= if a==line || b==col -- then [show t] -- else [] --- +-- --getThingAtPoint :: TypecheckedSource -> Int -> Int -> [String] --getThingAtPoint ts line col= maybeToList $ something (mkQ Nothing toS) test1
+ src/Language/Haskell/BuildWrapper/GHCStorage.hs view
@@ -0,0 +1,315 @@+{-# LANGUAGE CPP,OverloadedStrings,PatternGuards #-} +module Language.Haskell.BuildWrapper.GHCStorage where + +import Language.Haskell.BuildWrapper.Base + +import Data.Generics +import System.Directory +import System.FilePath + +-- import qualified GHC.Paths +import PprTyThing +import GHC +import Outputable +import qualified OccName(occNameString) +import Bag(Bag,bagToList) +import Var(Var,varType,varName) +import FastString(FastString) +import NameSet(NameSet) +import Name hiding (varName) +import DataCon (dataConName) +#if __GLASGOW_HASKELL__ < 700 +import GHC.SYB.Instances +#endif + +#if __GLASGOW_HASKELL__ < 702 +import TypeRep ( Type(..), PredType(..) ) +#else +import TypeRep ( Type(..), Pred(..) ) +#endif + + +import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString as BSS +import Data.Aeson +import Data.Maybe +import qualified Data.Text as T +import qualified Data.HashMap.Lazy as HM +import qualified Data.Vector as V +import Data.Attoparsec.Number (Number(I)) +import System.Time (ClockTime) + + +getInfoFile :: FilePath -> FilePath +getInfoFile fp= let + (dir,file)=splitFileName fp + in combine dir ("." ++ (addExtension file ".bwinfo")) + +clearInfo :: FilePath -> IO() +clearInfo fp =do + let ghcInfoFile=getInfoFile fp + removeFile ghcInfoFile + +storeBuildFlagsInfo :: FilePath -> (BuildFlags,[BWNote]) -> IO() +storeBuildFlagsInfo fp bf=setStoredInfo fp "BuildFlags" (toJSON bf) + +storeGHCInfo :: FilePath -> TypecheckedSource -> IO() +storeGHCInfo fp tcs=setStoredInfo fp "AST" (dataToJSON tcs) + +readGHCInfo :: FilePath -> IO(Maybe Value) +readGHCInfo fp=do + (Object hm)<-readStoredInfo fp + return $ HM.lookup "AST" hm + +readBuildFlagsInfo :: FilePath -> ClockTime -> IO (Maybe (BuildFlags,[BWNote])) +readBuildFlagsInfo fp ct=do + let ghcInfoFile=getInfoFile fp + ex<-doesFileExist ghcInfoFile + if ex then do + ctF<-getModificationTime ghcInfoFile + if ctF>ct + then do + (Object hm)<-readStoredInfo fp + return $ maybe Nothing (\x-> case fromJSON x of + Success a->Just a + Error _->Nothing) $ HM.lookup "BuildFlags" hm + else return Nothing + else return Nothing + +setStoredInfo :: FilePath -> T.Text -> Value -> IO() +setStoredInfo fp k v=do + let ghcInfoFile=getInfoFile fp + (Object hm)<-readStoredInfo fp + let hm2=HM.insert k v hm + BSS.writeFile ghcInfoFile $ BSS.concat $ BS.toChunks $ encode $ Object hm2 + +readStoredInfo :: FilePath -> IO Value +readStoredInfo fp=do + let ghcInfoFile=getInfoFile fp + ex<-doesFileExist ghcInfoFile + mv<-if ex + then do + bs<-BSS.readFile ghcInfoFile + return $ decode' $ BS.fromChunks [bs] + else return Nothing + return $ fromMaybe (object []) mv + +dataToJSON :: Data a =>a -> Value +dataToJSON = + generic `ext1Q` list `extQ` string `extQ` fastString `extQ` srcSpan + `extQ` name `extQ` occName `extQ` modName `extQ` var `extQ` exprVar `extQ` dataCon + `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet + `extQ` postTcType `extQ` fixity + where generic :: Data a => a -> Value + generic t =arr $ gmapQ dataToJSON t + -- object [(T.pack $ showConstr (toConstr t)) .= sub ] + string = Data.Aeson.String . T.pack :: String -> Value + fastString:: FastString -> Value + fastString fs= object ["FastString" .= (T.pack $ show fs)] + list l = arr $ map dataToJSON l + arr a = let + sub=filter (/= Null) $ a + in case sub of + [] -> Null + [x] -> x + _ -> toJSON sub + name :: Name -> Value + name n = object ((nameAndModule n) ++["GType" .= (string $ "Name"),"HType".= (string $ (if isValOcc (nameOccName n) then "v" else "t"))]) + occName :: OccName -> Value + occName o = object ["OccName" .= (string $ OccName.occNameString o),"HType".= (string $ (if isValOcc o then "v" else "t"))] + modName :: ModuleName -> Value + modName m= object [ "Name" .= (string $ showSDoc $ ppr m),"GType" .= (string "ModuleName"),"HType".= (string $ "m")] + srcSpan :: SrcSpan -> Value + srcSpan src + | isGoodSrcSpan src = object[ "SrcSpan" .= toJSON [srcLoc $ srcSpanStart src, srcLoc $ srcSpanEnd src]] + | otherwise = Null + srcLoc :: SrcLoc -> Value + srcLoc sl + | isGoodSrcLoc sl=object ["line" .= toJSON (srcLocLine sl),"column" .= toJSON (srcLocCol sl)] + | otherwise = Null + var :: Var -> Value + var v = typedVar v (varType v) + dataCon :: DataCon -> Value + dataCon d = object ((nameAndModule $ dataConName d) ++["GType" .= (string $ "DataCon")]) +-- simple:: T.Text -> String -> Value +-- simple nm v=object [nm .= T.pack v] + simpleV:: T.Text -> Value -> Value + simpleV nm v=object [nm .= v] + bagRdrName:: Bag (Located (HsBind RdrName)) -> Value + bagRdrName = simpleV "Bag(Located (HsBind RdrName))" . list . bagToList + bagName :: Bag (Located (HsBind Name)) -> Value + bagName = simpleV "Bag(Located (HsBind Name))" . list . bagToList + bagVar :: Bag (Located (HsBind Var)) -> Value + bagVar = simpleV "Bag(Located (HsBind Var))". list . bagToList + exprVar :: HsExpr Var -> Value + exprVar ev = let + mt=typeOfExpr ev + in case mt of + Just (t,v)-> typedVar v t + Nothing->generic ev + typedVar :: Var -> Type -> Value + typedVar v t=object ((nameAndModule $ varName v)++ [ + "GType" .= (string "Var") + ,"Type" .= (string $ showSDocUnqual $ pprTypeForUser True $ t) + ,"QType" .= (string $ showSDoc $ pprTypeForUser True $ t) + ,"HType".= (string $ (if isValOcc (nameOccName (Var.varName v)) then "v" else "t"))]) + + nameSet = const $ Data.Aeson.String "{!NameSet placeholder here!}" :: NameSet -> Value + + postTcType = const Null :: Type -> Value -- string . showSDoc . ppr + + fixity = const Null :: GHC.Fixity -> Value --simple "Fixity" . showSDoc . ppr + + -- nameAndModule :: Name -> [Pair] + nameAndModule n=let + mn=maybe "" (showSDoc . ppr . moduleName) $ nameModule_maybe n + na=showSDocUnqual $ ppr n + in ["Module" .= (string mn), "Name" .= (string na)] + +debugToJSON :: Data a =>a -> IO() +debugToJSON = BS.putStrLn . encode . dataToJSON + +debugFindInJSON :: Data a => Int -> Int -> a -> IO() +debugFindInJSON l c a= do + let v=dataToJSON a + let mv=findInJSON (overlap l c) v + case mv of + Just rv->do + putStrLn "something found!" + BS.putStrLn $ encode rv + Nothing->putStrLn "nothing found!" + +type FindFunc=(Value -> Bool) + + +findInJSONFormatted :: Bool -> Bool -> Maybe Value -> String +findInJSONFormatted qual typed (Just (Object m)) | Just (String name)<-HM.lookup "Name" m=let + tn=T.unpack name + qn=if qual + then + let mo=maybe "" (\(String s)->(T.unpack s)++".") $ HM.lookup "Module" m + in mo ++ tn + else tn + in if typed then + let mt=HM.lookup (if qual then "QType" else "Type") m + in case mt of + Just (String t)->qn ++ " :: " ++ (T.unpack t) + _ -> tn + else + let mt=HM.lookup "HType" m + in case mt of + Just (String t)->qn ++ " " ++ (T.unpack t) + _ -> tn +findInJSONFormatted _ _ _="no info" + +findInJSON :: FindFunc -> Value -> Maybe Value +findInJSON f (Array arr) | not $ V.null arr=let + v1=arr V.! 0 + in if f v1 && V.length arr==2 + then + let + mv=findInJSON f $ arr V.! 1 + in case mv of + Just rv-> Just rv + Nothing -> Just $ arr V.! 1 + else + let rvs=catMaybes $ V.toList $ fmap (findInJSON f) arr + in case rvs of + (x:_)->Just x + []->Nothing +findInJSON f (Object obj)=let rvs=mapMaybe (findInJSON f) $ HM.elems obj + in case rvs of + (x:_)->Just x + []->Nothing +findInJSON _ _= Nothing + +overlap :: Int -> Int -> Value -> Bool +overlap l c (Object m) | + Just pos<-HM.lookup "SrcSpan" m, + Just (l1,c1,l2,c2)<-extractSourceSpan pos=l1<=l && c1<=c && l2>=l && c2>=c +overlap _ _ _=False + +extractSourceSpan :: Value -> Maybe (Int,Int,Int,Int) +extractSourceSpan (Array arr) | V.length arr==2 = do + let v1=arr V.! 0 + let v2=arr V.! 1 + (l1,c1)<-extractSourceLoc v1 + (l2,c2)<-extractSourceLoc v2 + return (l1,c1,l2,c2) +extractSourceSpan _ =Nothing + +extractSourceLoc :: Value -> Maybe (Int,Int) +extractSourceLoc (Object m) | + Just (Number(I l))<-HM.lookup "line" m, + Just (Number(I c))<-HM.lookup "column" m=Just (fromIntegral l,fromIntegral c) +extractSourceLoc _ = Nothing + + +typeOfExpr :: HsExpr Var -> Maybe (Type,Var) +typeOfExpr (HsWrap wr (HsVar ident)) = + let -- Unwrap a HsWrapper and its associated type + unwrap WpHole t = t + unwrap (WpCompose w1 w2) t = unwrap w1 (unwrap w2 t) + unwrap (WpCast _) t = t -- XXX: really? + unwrap (WpTyApp t') t = AppTy t t' + unwrap (WpTyLam tv) t = ForAllTy tv t + -- do something else with coercion/dict vars? +#if __GLASGOW_HASKELL__ < 700 + unwrap (WpApp v) t = AppTy t (TyVarTy v) + unwrap (WpLam v) t = ForAllTy v t +#else + -- unwrap (WpEvApp v) t = AppTy t (TyVarTy v) + unwrap (WpEvLam v) t = ForAllTy v t + unwrap (WpEvApp _) t = t +#endif + unwrap (WpLet _) t = t +#ifdef WPINLINE + unwrap WpInline t = t +#endif + in Just $ (reduce_type $ unwrap wr (varType ident),ident) +-- All other search results produce no type information +typeOfExpr _ = Nothing + +-- | Reduce a top-level type application if possible. That is, we perform the +-- following simplification step: +-- @ +-- (forall v . t) t' ==> t [t'/v] +-- @ +-- where @[t'/v]@ is the substitution of @t'@ for @v@. +-- +reduce_type :: Type -> Type +reduce_type (AppTy (ForAllTy tv b) t) = + reduce_type (subst_type tv t b) +reduce_type t = t + +subst_type :: TyVar -> Type -> Type -> Type +subst_type v t' t0 = go t0 + where + go t = case t of + TyVarTy tv + | tv == v -> t' + | otherwise -> t + AppTy t1 t2 -> AppTy (go t1) (go t2) + TyConApp c ts -> TyConApp c (map go ts) + FunTy t1 t2 -> FunTy (go t1) (go t2) + ForAllTy v' bt + | v == v' -> t + | otherwise -> ForAllTy v' (go bt) + PredTy pt -> PredTy (go_pt pt) + + -- XXX: this is probably not right + go_pt (ClassP c ts) = ClassP c (map go ts) + go_pt (IParam i t) = IParam i (go t) + go_pt (EqPred t1 t2) = EqPred (go t1) (go t2) + + +--haddockType :: SearchResult a -> String +--haddockType (FoundName n) +-- | isValOcc (nameOccName n)="v" +-- | otherwise= "t" +--haddockType (FoundId i) +-- | isValOcc (nameOccName (Var.varName i))="v" +-- | otherwise= "t" +--haddockType (FoundModule _)="m" +--haddockType _="t" +
test/Language/Haskell/BuildWrapper/CMDTests.hs view
@@ -39,6 +39,7 @@ configure _ r t= runAPI r "configure" ["--cabaltarget="++(show t)] build _ r b wc= runAPI r "build" ["--output="++(show b),"--cabaltarget="++(show wc)] build1 _ r fp= runAPI r "build1" ["--file="++fp] + getBuildFlags _ r fp= runAPI r "getbuildflags" ["--file="++fp] getOutline _ r fp= runAPI r "outline" ["--file="++fp] getTokenTypes _ r fp= runAPI r "tokentypes" ["--file="++fp] getOccurrences _ r fp s= runAPI r "occurrences" ["--file="++fp,"--token="++s]
test/Language/Haskell/BuildWrapper/Tests.hs view
@@ -34,8 +34,8 @@ tests= [ testSynchronizeAll, testConfigureWarnings , testConfigureErrors , - testBuildErrors , - testBuildWarnings , + testBuildErrors, + testBuildWarnings, testBuildOutput, testModuleNotInCabal, testOutline, @@ -43,9 +43,10 @@ testOutlineImportExport, testOutlineLiterate, testPreviewTokenTypes, - testThingAtPoint, + testThingAtPoint , testThingAtPointNotInCabal, testThingAtPointMain, + testThingAtPointMainSubFolder , testNamesInScope, testInPlaceReference, testCabalComponents, @@ -60,7 +61,8 @@ configure :: a -> FilePath -> WhichCabal -> IO (OpResult Bool) build :: a -> FilePath -> Bool -> WhichCabal -> IO (OpResult BuildResult) build1 :: a -> FilePath -> FilePath -> IO (OpResult Bool) - getOutline :: a -> FilePath -> FilePath -> IO (OpResult OutlineResult) + getBuildFlags :: a -> FilePath -> FilePath -> IO (OpResult BuildFlags) + getOutline :: a -> FilePath -> FilePath -> IO (OpResult OutlineResult) getTokenTypes :: a -> FilePath -> FilePath -> IO (OpResult [TokenDef]) getOccurrences :: a -> FilePath -> FilePath -> String -> IO (OpResult [TokenDef]) getThingAtPoint :: a -> FilePath -> FilePath -> Int -> Int -> Bool -> Bool -> IO (OpResult (Maybe String)) @@ -260,6 +262,8 @@ -- assertBool ("no rel in fps2: "++(show fps2)) (elem rel fps1) let (nsError2:[])=nsErrors2 assertEqualNotesWithoutSpaces "not proper error 2" (BWNote BWError "Could not find module `Toto':\n Use -v to see a list of the files searched for.\n" (BWLocation rel 2 8)) nsError2 + (bf3,nsErrors3f)<- getBuildFlags api root ("src"</>"A.hs") + assertBool ("errors or warnings on nsErrors3f:"++ (show nsErrors3f)) (null nsErrors3f) (bool3,nsErrors3)<-build1 api root ("src"</>"A.hs") assertBool ("returned true on bool3") (not bool3) assertBool ("no errors or warnings on nsErrors3") (not $ null nsErrors3) @@ -299,6 +303,8 @@ let (nsError1:nsError2:[])=nsErrors1 assertEqualNotesWithoutSpaces "not proper error 1" (BWNote BWWarning "The import of `Data.List' is redundant\n except perhaps to import instances from `Data.List'\n To import instances alone, use: import Data.List()\n" (BWLocation rel 2 1)) nsError1 assertEqualNotesWithoutSpaces "not proper error 2" (BWNote BWWarning "Top-level binding with no type signature:\n fA :: forall a. a\n" (BWLocation rel 3 1)) nsError2 + (bf3,nsErrors3f)<-getBuildFlags api root rel + assertBool ("errors or warnings on nsErrors3f") (null nsErrors3f) (bool3,nsErrors3)<-build1 api root rel assertBool ("returned false on bool3") bool3 assertBool ("no errors or warnings on nsErrors3") (not $ null nsErrors3) @@ -346,6 +352,8 @@ (BuildResult bool1 _,nsErrors1)<-build api root True Source assertBool ("returned false on bool1") bool1 assertBool ("errors or warnings on nsErrors1") (null nsErrors1) + (bf2,nsErrors2f)<-getBuildFlags api root rel + assertBool ("no errors or warnings on nsErrors2f") (null nsErrors2f) (bool2, nsErrors2)<-build1 api root rel assertBool ("returned false on bool2: "++(show nsErrors2)) bool2 assertBool ("errors or warnings on nsErrors2: "++(show nsErrors2)) (null nsErrors2) @@ -420,6 +428,8 @@ " mkt2_s :: String,", " mkt2_i :: Int", " }" ] + (bf3,nsErrors3f)<-getBuildFlags api root rel + assertBool ("errors or warnings on nsErrors3f") (null nsErrors3f) (OutlineResult defs es is,nsErrors1)<-getOutline api root rel assertBool ("errors or warnings on getOutline:"++show nsErrors1) (null nsErrors1) let expected=[ @@ -485,6 +495,8 @@ "#endif", "" ] + (bf3,nsErrors3f)<-getBuildFlags api root rel + assertBool ("errors or warnings on nsErrors3f") (null nsErrors3f) (OutlineResult defs1 _ _,nsErrors1)<-getOutline api root rel assertBool ("errors or warnings on getOutlinePreproc 1:"++show nsErrors1) (null nsErrors1) let expected1=[ @@ -555,6 +567,8 @@ "", "" ] + (bf3,nsErrors3f)<-getBuildFlags api root rel + assertBool ("errors or warnings on nsErrors3f") (null nsErrors3f) (OutlineResult defs1 _ _,nsErrors1)<-getOutline api root rel assertBool ("errors or warnings on testOutlineLiterate 1:"++show nsErrors1) (null nsErrors1) let expected1=[ @@ -578,6 +592,8 @@ "import Data.List hiding (orderBy,groupBy)", "import qualified Data.Maybe (Maybe(Just))" ] + (bf3,nsErrors3f)<-getBuildFlags api root rel + assertBool ("errors or warnings on nsErrors3f") (null nsErrors3f) (OutlineResult _ es is,nsErrors1)<-getOutline api root rel assertBool ("errors or warnings on getOutline:"++show nsErrors1) (null nsErrors1) let exps=[ @@ -633,9 +649,11 @@ "module Main where", "main=return $ map id \"toto\"" ] + (bf3,nsErrors3f)<-getBuildFlags api root rel + assertBool ("errors or warnings on nsErrors3f") (null nsErrors3f) (tap1,nsErrors1)<-getThingAtPoint api root rel 2 16 True True assertBool ("errors or warnings on getThingAtPoint1:"++show nsErrors1) (null nsErrors1) - assertEqual "not just typed qualified" (Just "GHC.Base.map :: forall a b.\n (a -> b) -> [a] -> [b] GHC.Types.Char GHC.Types.Char") tap1 + assertEqual "not just typed qualified" (Just "GHC.Base.map :: forall a b. (a -> b) -> [a] -> [b] GHC.Types.Char GHC.Types.Char") tap1 (tap2,nsErrors2)<-getThingAtPoint api root rel 2 16 False True assertBool ("errors or warnings on getThingAtPoint2:"++show nsErrors2) (null nsErrors2) assertEqual "not just typed unqualified" (Just "map :: forall a b. (a -> b) -> [a] -> [b] Char Char") tap2 @@ -647,6 +665,10 @@ assertBool ("errors or warnings on getThingAtPoint4:"++show nsErrors4) (null nsErrors4) assertEqual "not just untyped unqualified" (Just "map v") tap4 + (tap5,nsErrors5)<-getThingAtPoint api root rel 2 20 True True + assertBool ("errors or warnings on getThingAtPoint1:"++show nsErrors5) (null nsErrors5) + assertEqual "not just typed qualified" (Just "GHC.Base.id :: GHC.Types.Char -> GHC.Types.Char") tap5 + )) testThingAtPointNotInCabal :: (APIFacade a)=> a -> Test @@ -657,9 +679,11 @@ let rel2="src"</>"Auto.hs" writeFile (root </> rel2) $ unlines ["module Auto where","fAuto=head [2,3,4]"] (fps,ns)<-synchronize api root False + (bf3,nsErrors3f)<-getBuildFlags api root rel2 + assertBool ("errors or warnings on nsErrors3f") (null nsErrors3f) (tap1,nsErrors1)<-getThingAtPoint api root rel2 2 8 True True assertBool ("errors or warnings on getThingAtPoint1:"++show nsErrors1) (null nsErrors1) - assertEqual "not just typed qualified" (Just "GHC.List.head :: [GHC.Integer.Type.Integer]\n -> GHC.Integer.Type.Integer") tap1 + assertEqual "not just typed qualified" (Just "GHC.List.head :: [GHC.Integer.Type.Integer] -> GHC.Integer.Type.Integer") tap1 )) @@ -686,10 +710,46 @@ ] synchronize api root False configure api root Target + (bf3,nsErrors3f)<-getBuildFlags api root rel + assertBool ("errors or warnings on nsErrors3f") (null nsErrors3f) + assertEqual ("not main module") (Just "Main") (bf_modName bf3) (tap1,nsErrors1)<-getThingAtPoint api root rel 3 16 True True assertBool ("errors or warnings on getThingAtPoint1:"++show nsErrors1) (null nsErrors1) - assertEqual "not just typed qualified" (Just "GHC.List.head :: [GHC.Integer.Type.Integer]\n -> GHC.Integer.Type.Integer") tap1 - )) + assertEqual "not just typed qualified" (Just "GHC.List.head :: [GHC.Integer.Type.Integer] -> GHC.Integer.Type.Integer") tap1 + )) + +testThingAtPointMainSubFolder :: (APIFacade a)=> a -> Test +testThingAtPointMainSubFolder api= TestLabel "testThingAtPointMainSubFolder" (TestCase ( do + root<-createTestProject + let cf=testCabalFile root + let cfn=takeFileName cf + writeFile cf $ unlines ["name: "++testProjectName, + "version:0.1", + "cabal-version: >= 1.8", + "build-type: Simple", + "", + "executable BWTest", + " hs-source-dirs: src", + " main-is: src2/A.hs", + " other-modules: B.D", + " build-depends: base"] + let sf=root </> "src" </> "src2" + createDirectory sf + let rel="src" </> "src2" </> "A.hs" + writeFile (root </> rel) $ unlines [ + "module Main where", + "import B.D", + "main=return $ head [2,3,4]" + ] + synchronize api root False + configure api root Target + (bf3,nsErrors3f)<-getBuildFlags api root rel + assertBool ("errors or warnings on nsErrors3f") (null nsErrors3f) + assertEqual ("not main module") (Just "Main") (bf_modName bf3) + (tap1,nsErrors1)<-getThingAtPoint api root rel 3 16 True True + assertBool ("errors or warnings on getThingAtPoint1:"++show nsErrors1) (null nsErrors1) + assertEqual "not just typed qualified" (Just "GHC.List.head :: [GHC.Integer.Type.Integer] -> GHC.Integer.Type.Integer") tap1 + )) testNamesInScope :: (APIFacade a)=> a -> Test testNamesInScope api= TestLabel "testNamesInScope" (TestCase ( do @@ -767,9 +827,11 @@ let tts=fromJust mtts assertBool "getNamesInScope in place 1 does not contain Main.main" (elem "Main.main" tts) assertBool "getNamesInScope in place 1 does not contain B.C.fC" (elem "B.C.fC" tts) + (bf3,nsErrors3f)<-getBuildFlags api root rel + assertBool ("errors or warnings on nsErrors3f") (null nsErrors3f) (tap1,nsErrorsTap1)<-getThingAtPoint api root rel 3 16 True True assertBool ("errors or warnings on getThingAtPoint1 in place:"++show nsErrorsTap1) (null nsErrorsTap1) - assertEqual "not just typed qualified" (Just "GHC.Base.map :: forall a b.\n (a -> b) -> [a] -> [b] GHC.Types.Char GHC.Types.Char") tap1 + assertEqual "not just typed qualified" (Just "GHC.Base.map :: forall a b. (a -> b) -> [a] -> [b] GHC.Types.Char GHC.Types.Char") tap1 (mtts2,nsErrors2)<-getNamesInScope api root rel2 assertBool ("errors or warnings on getNamesInScope in place 2:"++show nsErrors2) (null nsErrors2) assertBool "getNamesInScope in place 2 not just" (isJust mtts2)