buildwrapper 0.2.2 → 0.3.0
raw patch · 10 files changed
+289/−29 lines, 10 files
Files
- buildwrapper.cabal +1/−1
- src-exe/Language/Haskell/BuildWrapper/CMD.hs +4/−0
- src/Language/Haskell/BuildWrapper/API.hs +13/−6
- src/Language/Haskell/BuildWrapper/Base.hs +90/−0
- src/Language/Haskell/BuildWrapper/Cabal.hs +5/−3
- src/Language/Haskell/BuildWrapper/Find.hs +13/−1
- src/Language/Haskell/BuildWrapper/GHC.hs +1/−1
- src/Language/Haskell/BuildWrapper/Src.hs +44/−7
- test/Language/Haskell/BuildWrapper/GHCTests.hs +15/−2
- test/Language/Haskell/BuildWrapper/Tests.hs +103/−8
buildwrapper.cabal view
@@ -1,5 +1,5 @@ name: buildwrapper -version: 0.2.2 +version: 0.3.0 cabal-version: >= 1.8 build-type: Simple license: BSD3
src-exe/Language/Haskell/BuildWrapper/CMD.hs view
@@ -17,8 +17,11 @@ import Control.Monad.State import System.Console.CmdArgs hiding (Verbosity(..)) +import Paths_buildwrapper + import Data.Aeson import qualified Data.ByteString.Lazy as BS +import Data.Version (showVersion) type CabalFile = FilePath @@ -74,6 +77,7 @@ &= helpArg [explicit, name "help", name "h"] &= help "buildwrapper executable" &= program "buildwrapper" + &= summary ("buildwrapper executable, version " ++ (showVersion version)) ) >>= handle where
src/Language/Haskell/BuildWrapper/API.hs view
@@ -90,12 +90,17 @@ preproc cbi tgt= do inputOrig<-readFile tgt let cppo=fileCppOptions cbi ++ ["-D__GLASGOW_HASKELL__=" ++ show (__GLASGOW_HASKELL__::Int)] - --putStrLn $ "cppo=" ++ (show cppo) + --Prelude.putStrLn $ "cppo=" ++ (show cppo) if not $ null cppo then do let epo=parseOptions cppo case epo of - Right opts2->liftIO $ runCpphs opts2 tgt inputOrig + 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 Left _->return inputOrig else return inputOrig @@ -175,15 +180,17 @@ return (pr,bwns2) Nothing-> return (Nothing,bwns) -getOutline :: FilePath -> BuildWrapper (OpResult [OutlineDef]) +getOutline :: FilePath -> BuildWrapper (OpResult OutlineResult) getOutline fp=do (mast,bwns)<-getAST fp --liftIO $ putStrLn $ show mast case mast of Just (ParseOk ast)->do - return (getHSEOutline ast,bwns) - Just (ParseFailed loc err)->return ([],(BWNote BWError err (BWLocation fp (srcLine loc) (srcColumn loc))):bwns) - _ -> return ([],bwns) + let ods=getHSEOutline ast + let (es,is)=getHSEImportExport ast + return (OutlineResult ods es is,bwns) + Just (ParseFailed loc err)->return (OutlineResult [] [] [],(BWNote BWError err (BWLocation fp (srcLine loc) (srcColumn loc))):bwns) + _ -> return (OutlineResult [] [] [],bwns) getTokenTypes :: FilePath -> BuildWrapper (OpResult [TokenDef]) getTokenTypes fp=do
src/Language/Haskell/BuildWrapper/Base.hs view
@@ -171,7 +171,97 @@ parseJSON (Object o) | ((a,b):[])<-M.toList o, Success v0 <- fromJSON b=return $ TokenDef a v0 + parseJSON _= mzero + +data ImportExportType = IEVar + | IEAbs + | IEThingAll + | IEThingWith + | IEModule + deriving (Show,Read,Eq,Ord,Enum) + +instance ToJSON ImportExportType where + toJSON = toJSON . show + +instance FromJSON ImportExportType where + parseJSON (String s) =return $ read $ T.unpack s + parseJSON _= mzero + +data ExportDef = ExportDef { + e_name :: T.Text, + e_type :: ImportExportType, + e_loc :: InFileSpan, + e_children :: [T.Text] + } deriving (Show,Eq) + +instance ToJSON ExportDef where + toJSON (ExportDef n t l c)= object ["n" .= n , "t" .= t, "l" .= l, "c" .= map toJSON c] + +instance FromJSON ExportDef where + parseJSON (Object v) =ExportDef <$> + v .: "n" <*> + v .: "t" <*> + v .: "l" <*> + v .: "c" parseJSON _= mzero + +data ImportSpecDef = ImportSpecDef { + is_name :: T.Text, + is_type :: ImportExportType, + is_loc :: InFileSpan, + is_children :: [T.Text] + } deriving (Show,Eq) + +instance ToJSON ImportSpecDef where + toJSON (ImportSpecDef n t l c)= object ["n" .= n , "t" .= t, "l" .= l, "c" .= map toJSON c] + +instance FromJSON ImportSpecDef where + parseJSON (Object v) =ImportSpecDef <$> + v .: "n" <*> + v .: "t" <*> + v .: "l" <*> + v .: "c" + parseJSON _= mzero + +data ImportDef = ImportDef { + i_module :: T.Text, + i_loc :: InFileSpan, + i_qualified :: Bool, + i_hiding :: Bool, + i_alias :: T.Text, + i_children :: Maybe [ImportSpecDef] + } deriving (Show,Eq) + +instance ToJSON ImportDef where + toJSON (ImportDef m l q h a c)= object ["m" .= m , "l" .= l, "q" .= q, "h" .= h, "a" .= a, "c" .= c] + +instance FromJSON ImportDef where + parseJSON (Object v) =ImportDef <$> + v .: "m" <*> + v .: "l" <*> + v .: "q" <*> + v .: "h" <*> + v .: "a" <*> + v .: "c" + parseJSON _= mzero + +data OutlineResult = OutlineResult { + or_outline :: [OutlineDef], + or_exports :: [ExportDef], + or_imports :: [ImportDef] + } + deriving (Show,Eq) + +instance ToJSON OutlineResult where + toJSON (OutlineResult o e i)= object ["o" .= map toJSON o,"e" .= map toJSON e,"i" .= map toJSON i] + +instance FromJSON OutlineResult where + parseJSON (Object v) =OutlineResult <$> + v .: "o" <*> + v .: "e" <*> + v .: "i" + parseJSON _= mzero + --withCabal :: (GenericPackageDescription -> BuildWrapper a) -> BuildWrapper (Either BWNote a) --withCabal f =do -- cf<-gets cabalFile
src/Language/Haskell/BuildWrapper/Cabal.hs view
@@ -488,7 +488,7 @@ exeDir = targetDir </> (exeName' ++ "-tmp") modules= (otherModules ebi) hsd=getSourceDirs ebi - in (ebi,fromJustDebug "extractFromExeRef" $ lookup exeName' $ executableConfigs lbi,exeDir,False, copyFiles [modulePath e] hsd++ (copyModules modules hsd) ) + in (ebi,fromJustDebug "extractFromExeRef" $ lookup exeName' $ executableConfigs lbi,exeDir,False, copyMain (modulePath e) hsd++ (copyModules modules hsd) ) extractFromTest :: TestSuite -> CabalBuildInfo extractFromTest t@TestSuite {testName=testName'} =let tbi=testBuildInfo t @@ -497,14 +497,16 @@ modules= (otherModules tbi ) hsd=getSourceDirs tbi extras=case testInterface t of - (TestSuiteExeV10 _ mp)->(copyFiles [mp] hsd) + (TestSuiteExeV10 _ mp)->(copyMain mp hsd) (TestSuiteLibV09 _ mn)->copyModules [mn] hsd _->[] in (tbi,fromJustDebug ("extractFromTestRef:"++testName'++(show $ testSuiteConfigs lbi)) $ lookup testName' $ testSuiteConfigs lbi,testDir,False,extras++ (copyModules modules hsd) ) copyModules :: [ModuleName] -> [FilePath] -> [(ModuleName,FilePath)] copyModules mods=copyFiles (concatMap (\m->[(toFilePath m) <.> "hs",((toFilePath m) <.> "lhs")]) mods) copyFiles :: [FilePath] -> [FilePath] -> [(ModuleName,FilePath)] - copyFiles mods dirs=[(fromString $ fileToModule m,d </> m) | m<-mods, d<-dirs] + copyFiles mods dirs=[(fromString $ fileToModule m,d </> m) | m<-mods, d<-dirs] + copyMain :: FilePath ->[FilePath] -> [(ModuleName,FilePath)] + copyMain fs dirs=map (\d->(fromString "Main",d </> fs)) dirs moduleToString :: ModuleName -> String moduleToString = concat . intersperse ['.'] . components
src/Language/Haskell/BuildWrapper/Find.hs view
@@ -63,6 +63,7 @@ prettyResult (FoundId i) = ppr i prettyResult (FoundName n) = ppr n prettyResult (FoundCon _ c) = ppr c +prettyResult (FoundModule m) = ppr m prettyResult r = ppr r -- | Pretty-print a search result as qualified name @@ -70,6 +71,7 @@ qualifiedResult (FoundId i) = qualifiedName $ getName i qualifiedResult (FoundName n) = qualifiedName n qualifiedResult (FoundCon _ c) = qualifiedName $ getName c +qualifiedResult (FoundModule m) = ppr m qualifiedResult r = ppr r qualifiedName :: Name -> SDoc @@ -187,6 +189,7 @@ haddockType (FoundId i) | isValOcc (nameOccName (Var.varName i))="v" | otherwise= "t" +haddockType (FoundModule _)="m" haddockType _="t" data SearchResult id @@ -199,6 +202,7 @@ | FoundName Name | FoundCon SrcSpan DataCon | FoundLit SrcSpan HsLit + | FoundModule ModuleName resLoc :: SearchResult id -> SrcSpan resLoc (FoundId i) = nameSrcSpan (varName i) @@ -210,6 +214,7 @@ resLoc (FoundStmt s _) = s resLoc (FoundCon s _) = s resLoc (FoundLit s _) = s +resLoc (FoundModule _) = noSrcSpan instance Eq (SearchResult id) where a == b = resLoc a == resLoc b -- TODO: sufficient? @@ -286,6 +291,7 @@ ppr (FoundName n) = text "name:" <+> ppr n ppr (FoundCon s c) = text "con: " <+> ppr s $$ nest 4 (ppr c) ppr (FoundLit s l) = text "lit: " <+> ppr s $$ nest 4 (ppr l) + ppr (FoundModule m) = text "mod: " <+> ppr m instance Outputable a => Outputable (PosTree a) where ppr (Node v cs) = ppr v $$ nest 2 (vcat (map ppr (S.toList cs))) @@ -408,7 +414,13 @@ -- search p s m =search p s (hsmodDecls m) instance Search Name (RenamedSource) where - search p s (b,_,_,_) = search p s b + search p s (b,d,_,_) = search p s d `mappend` search p s b + +instance (Search id id) => Search id (ImportDecl id) where + search p s id=search p s (ideclName id) + +instance Search id ModuleName where + search _ _ mn = only (FoundModule mn) instance (Search id id) => Search id (HsType id) where search _ s t = only (FoundType s t)
src/Language/Haskell/BuildWrapper/GHC.hs view
@@ -544,7 +544,7 @@ ppSCpp (ts2,l2,f) (l,c) | (Continue _)<-f = addPPToken "PP" (l,c) (ts2,l2,lineBehavior l f) | ('#':_)<-l =addPPToken "PP" (l,c) (ts2,l2,lineBehavior l f) - | ("{-# " `List.isPrefixOf` l)=addPPToken "D" (l,c) (ts2,"":l2,Start) + | ("{-# " `List.isPrefixOf` l)=addPPToken "D" (l,c) (ts2,"":l2,f) | (Indent n)<-f=(ts2,l:((replicate n (takeWhile (==' ') l))++l2),Start) | otherwise =(ts2,l:l2,Start) ppSLit :: ([TokenDef],[String],PPBehavior) -> (String,Int) -> ([TokenDef],[String],PPBehavior)
src/Language/Haskell/BuildWrapper/Src.hs view
@@ -66,9 +66,6 @@ headDecl (DHead _ n _)=nameDecl n headDecl (DHInfix _ _ n _)=nameDecl n headDecl (DHParen _ h)=headDecl h - nameDecl :: Name a -> T.Text - nameDecl (Ident _ s)=T.pack s - nameDecl (Symbol _ s)=T.pack s typeDecl :: Type a -> T.Text typeDecl (TyForall _ _ _ t)=typeDecl t typeDecl (TyVar _ n )=nameDecl n @@ -77,10 +74,6 @@ typeDecl (TyParen _ t )=typeDecl t typeDecl (TyApp _ t1 t2)=T.concat [(typeDecl t1) , " ",(typeDecl t2)] typeDecl _ = "" - qnameDecl :: QName a -> T.Text - qnameDecl (Qual _ _ n)=nameDecl n - qnameDecl (UnQual _ n)=nameDecl n - qnameDecl _ ="" matchDecl :: Match a -> T.Text matchDecl (Match _ n _ _ _)=nameDecl n matchDecl (InfixMatch _ _ n _ _ _)=nameDecl n @@ -111,6 +104,50 @@ getHSEOutline _ = [] +getHSEImportExport :: (Module SrcSpanInfo, [Comment]) -> ([ExportDef],[ImportDef]) +getHSEImportExport (Module _ mhead _ imps _,_)=(headExp mhead,impDefs imps) + where + headExp :: Maybe (ModuleHead SrcSpanInfo) ->[ExportDef] + headExp (Just (ModuleHead _ _ _ (Just (ExportSpecList _ exps))))=map expExp exps + headExp _ = [] + expExp :: ExportSpec SrcSpanInfo -> ExportDef + expExp (EVar l qn) = ExportDef (qnameDecl qn) IEVar (makeSpan l) [] + expExp (EAbs l qn) = ExportDef (qnameDecl qn) IEAbs (makeSpan l) [] + expExp (EThingAll l qn) = ExportDef (qnameDecl qn) IEThingAll (makeSpan l) [] + expExp (EThingWith l qn cns) = ExportDef (qnameDecl qn) IEThingWith (makeSpan l) (map cnameDecl cns) + expExp (EModuleContents l mn) = ExportDef (mnnameDecl mn) IEModule (makeSpan l) [] + impDefs :: [ImportDecl SrcSpanInfo] -> [ImportDef] + impDefs=map impDef + impDef :: ImportDecl SrcSpanInfo -> ImportDef + impDef (ImportDecl l m qual _ _ al specs)=ImportDef (mnnameDecl m) (makeSpan l) qual (hide specs) (alias al) (children specs) + hide :: Maybe (ImportSpecList a)-> Bool + hide (Just (ImportSpecList _ b _))=b + hide _=False + alias :: Maybe (ModuleName a) -> T.Text + alias (Just mn)=mnnameDecl mn + alias Nothing ="" + children :: Maybe (ImportSpecList SrcSpanInfo) -> Maybe [ImportSpecDef] + children (Just (ImportSpecList _ _ ss))=Just $ map child ss + children Nothing = Nothing + child :: ImportSpec SrcSpanInfo -> ImportSpecDef + child (IVar l n)=ImportSpecDef (nameDecl n) IEVar (makeSpan l) [] + child (IAbs l n)=ImportSpecDef (nameDecl n) IEAbs (makeSpan l) [] + child (IThingAll l n) = ImportSpecDef (nameDecl n) IEThingAll (makeSpan l) [] + child (IThingWith l n cns) = ImportSpecDef (nameDecl n) IEThingWith (makeSpan l) (map cnameDecl cns) + + +nameDecl :: Name a -> T.Text +nameDecl (Ident _ s)=T.pack s +nameDecl (Symbol _ s)=T.pack s +cnameDecl :: CName a -> T.Text +cnameDecl (VarName _ s)=nameDecl s +cnameDecl (ConName _ s)=nameDecl s +qnameDecl :: QName a -> T.Text +qnameDecl (Qual _ _ n)=nameDecl n +qnameDecl (UnQual _ n)=nameDecl n +qnameDecl _ ="" +mnnameDecl :: ModuleName a -> T.Text +mnnameDecl (ModuleName _ s)=T.pack s makeSpan :: SrcSpanInfo -> InFileSpan makeSpan si=let
test/Language/Haskell/BuildWrapper/GHCTests.hs view
@@ -7,8 +7,8 @@ ghcTests :: [Test] -ghcTests=[testNoPreproc,testPreproc,testPreprocContiguous,testPreproc2Lines,testLiterate,testLiterateLatex - ,testKeepIndent] +ghcTests=[testNoPreproc,testPreproc,testPreprocContiguous,testPreproc2Lines,testLiterate,testLiterateLatex, + testPreprocPragma ,testKeepIndent] testNoPreproc:: Test testNoPreproc=TestLabel "testNoPreproc" (TestCase ( @@ -43,6 +43,19 @@ assertEqual "third tt is not correct" (TokenDef "PP" (mkLocation 7 1 7 20)) (t3) assertEqual "fourth tt is not correct" (TokenDef "PP" (mkLocation 9 1 9 7)) (t4) assertEqual ("content is not what expected: "++ s2) "\nmodule Main\nwhere\n\nimport Data.Map\n\n\nimport Data.Maybe\n\nmain=undefined\n" s2 + )) + +testPreprocPragma:: Test +testPreprocPragma=TestLabel "testPreprocPragma" (TestCase ( + do + let s="#if GHC_VERSION=612\n{-# LANGUAGE OverloadedStrings #-}\n#endif\nmodule Main\n" + let (tt,s2)=preprocessSource s False + assertEqual "tt is not 3" 3 (length tt) + let (t1:t2:t3:[])=tt + assertEqual "first tt is not correct" (TokenDef "PP" (mkLocation 1 1 1 20)) (t1) + assertEqual "second tt is not correct" (TokenDef "D" (mkLocation 2 1 2 35)) (t2) + assertEqual "third tt is not correct" (TokenDef "PP" (mkLocation 3 1 3 7)) (t3) + assertEqual ("content is not what expected: "++ s2) "\n\n\nmodule Main\n" s2 )) testPreproc2Lines:: Test
test/Language/Haskell/BuildWrapper/Tests.hs view
@@ -14,6 +14,9 @@ import Language.Haskell.BuildWrapper.Base +import Data.ByteString.Lazy () +import Data.ByteString.Lazy.Char8() + import Data.Maybe import Data.Aeson import Data.Char @@ -37,13 +40,17 @@ testModuleNotInCabal, testOutline, testOutlinePreproc, + testOutlineImportExport, + testOutlineLiterate, testPreviewTokenTypes, testThingAtPoint, testThingAtPointNotInCabal, + testThingAtPointMain, testNamesInScope, testInPlaceReference, testCabalComponents, testCabalDependencies + ] class APIFacade a where @@ -53,7 +60,7 @@ 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 [OutlineDef]) + 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)) @@ -183,7 +190,7 @@ synchronize api root False (bool1,ns1)<- configure api root Target assertBool ("returned false 1 "++ (show ns1)) bool1 - assertEqual ("didn't return 1 warning") 1 (length ns1) + assertEqual ("didn't return 1 warning: "++(show ns1)) 1 (length ns1) let (nsWarning1:[])=ns1 assertEqual "not proper warning 1" (BWNote BWWarning "Unknown fields: field1 (line 5)\nFields allowed in this section:\nname, version, cabal-version, build-type, license, license-file,\ncopyright, maintainer, build-depends, stability, homepage,\npackage-url, bug-reports, synopsis, description, category, author,\ntested-with, data-files, data-dir, extra-source-files,\nextra-tmp-files\n" (BWLocation cfn 5 1)) nsWarning1 writeFile cf $ unlines ["name: "++testProjectName, @@ -198,7 +205,7 @@ synchronize api root False (bool2,ns2)<- configure api root Target assertBool ("returned false 2 "++ (show ns2)) bool2 - assertEqual ("didn't return 1 warning") 1 (length ns2) + assertEqual ("didn't return 1 warning: "++(show ns1)) 1 (length ns2) let (nsWarning2:[])=ns2 assertEqual "not proper warning 2" (BWNote BWWarning "A package using section syntax must specify at least\n'cabal-version: >= 1.2'.\n" (BWLocation cfn 1 1)) nsWarning2 writeFile cf $ unlines ["name: "++testProjectName, @@ -215,7 +222,7 @@ synchronize api root False (bool3,ns3)<- configure api root Target assertBool ("returned false 3 "++ (show ns3)) bool3 - assertEqual ("didn't return 1 warning") 1 (length ns3) + assertEqual ("didn't return 1 warning: "++(show ns1)) 1 (length ns3) let (nsWarning3:[])=ns3 assertEqual "not proper warning 3" (BWNote BWWarning "No 'build-type' specified. If you do not need a custom Setup.hs or\n./configure script then use 'build-type: Simple'.\n" (BWLocation cfn 1 1)) nsWarning3 @@ -413,7 +420,7 @@ " mkt2_s :: String,", " mkt2_i :: Int", " }" ] - (defs,nsErrors1)<-getOutline api root rel + (OutlineResult defs es is,nsErrors1)<-getOutline api root rel assertBool ("errors or warnings on getOutline:"++show nsErrors1) (null nsErrors1) let expected=[ OutlineDef "XList" [Data,Family] (InFileSpan (InFileLoc 8 1)(InFileLoc 8 20)) [] @@ -445,6 +452,8 @@ ] assertEqual "length" (length expected) (length defs) mapM_ (\(e,c)->assertEqual "outline" e c) (zip expected defs) + assertEqual "exports" [] es + assertEqual "imports" [ImportDef "Data.Char" (InFileSpan (InFileLoc 5 1)(InFileLoc 5 17)) False False "" Nothing] is )) testOutlinePreproc :: (APIFacade a)=> a -> Test @@ -476,7 +485,7 @@ "#endif", "" ] - (defs1,nsErrors1)<-getOutline api root rel + (OutlineResult defs1 _ _,nsErrors1)<-getOutline api root rel assertBool ("errors or warnings on getOutlinePreproc 1:"++show nsErrors1) (null nsErrors1) let expected1=[ OutlineDef "testfunc1" [Function] (InFileSpan (InFileLoc 6 1)(InFileLoc 6 25)) [] @@ -498,7 +507,7 @@ "#endif", "" ] - (defs2,nsErrors2)<-getOutline api root rel + (OutlineResult defs2 _ _,nsErrors2)<-getOutline api root rel assertBool ("errors or warnings on getOutlinePreproc:"++show nsErrors2) (null nsErrors2) let expected2=[ OutlineDef "Name" [Data] (InFileSpan (InFileLoc 5 1)(InFileLoc 9 38)) [ @@ -520,7 +529,7 @@ "#endif", "" ] - (defs3,nsErrors3)<-getOutline api root rel + (OutlineResult defs3 _ _,nsErrors3)<-getOutline api root rel assertBool ("errors or warnings on getOutlinePreproc 3:"++show nsErrors3) (null nsErrors3) let expected3=[ OutlineDef "testfunc1" [Function] (InFileSpan (InFileLoc 6 1)(InFileLoc 6 25)) [] @@ -528,7 +537,65 @@ assertEqual "length of expected3" (length expected3) (length defs3) mapM_ (\(e,c)->assertEqual "outline" e c) (zip expected3 defs3) )) + + +testOutlineLiterate :: (APIFacade a)=> a -> Test +testOutlineLiterate api= TestLabel "testOutlineLiterate" (TestCase ( do + root<-createTestProject + synchronize api root False + let rel="src"</>"A.lhs" + -- use api to write temp file + write api root rel $ unlines [ + "comment 1", + "", + "> module Module1 where", + "", + "", + "> testfunc1=reverse \"test\"", + "", + "" + ] + (OutlineResult defs1 _ _,nsErrors1)<-getOutline api root rel + assertBool ("errors or warnings on testOutlineLiterate 1:"++show nsErrors1) (null nsErrors1) + let expected1=[ + OutlineDef "testfunc1" [Function] (InFileSpan (InFileLoc 6 3)(InFileLoc 6 27)) [] + ] + assertEqual "length of expected1" (length expected1) (length defs1) + mapM_ (\(e,c)->assertEqual "outline" e c) (zip expected1 defs1) + )) + +testOutlineImportExport :: (APIFacade a)=> a -> Test +testOutlineImportExport api= TestLabel "testOutlineImportExport" (TestCase ( do + root<-createTestProject + synchronize api root False + let rel="src"</>"A.hs" + -- use api to write temp file + write api root rel $ unlines [ + "module Module1 (dummy,module Data.Char,MkTest(..)) where", + "", + "import Data.Char", + "import Data.Map as DM (empty) ", + "import Data.List hiding (orderBy,groupBy)", + "import qualified Data.Maybe (Maybe(Just))" + ] + (OutlineResult _ es is,nsErrors1)<-getOutline api root rel + assertBool ("errors or warnings on getOutline:"++show nsErrors1) (null nsErrors1) + let exps=[ + ExportDef "dummy" IEVar (InFileSpan (InFileLoc 1 17)(InFileLoc 1 22)) [], + ExportDef "Data.Char" IEModule (InFileSpan (InFileLoc 1 23)(InFileLoc 1 39)) [], + ExportDef "MkTest" IEThingAll (InFileSpan (InFileLoc 1 40)(InFileLoc 1 50)) [] + ] + mapM_ (\(e,c)->assertEqual "exports" e c) (zip exps es) + let imps=[ + ImportDef "Data.Char" (InFileSpan (InFileLoc 3 1)(InFileLoc 3 17)) False False "" Nothing, + ImportDef "Data.Map" (InFileSpan (InFileLoc 4 1)(InFileLoc 4 30)) False False "DM" (Just [ImportSpecDef "empty" IEVar (InFileSpan (InFileLoc 4 24)(InFileLoc 4 29)) []]), + ImportDef "Data.List" (InFileSpan (InFileLoc 5 1)(InFileLoc 5 42)) False True "" (Just [ImportSpecDef "orderBy" IEVar (InFileSpan (InFileLoc 5 26)(InFileLoc 5 33)) [],ImportSpecDef "groupBy" IEVar (InFileSpan (InFileLoc 5 34)(InFileLoc 5 41)) []]), + ImportDef "Data.Maybe" (InFileSpan (InFileLoc 6 1)(InFileLoc 6 42)) True False "" (Just [ImportSpecDef "Maybe" IEThingWith (InFileSpan (InFileLoc 6 30)(InFileLoc 6 41)) ["Just"]]) + ] + mapM_ (\(e,c)->assertEqual "imports" e c) (zip imps is) + )) + testPreviewTokenTypes :: (APIFacade a)=> a -> Test testPreviewTokenTypes api= TestLabel "testPreviewTokenTypes" (TestCase ( do root<-createTestProject @@ -595,6 +662,34 @@ assertEqual "not just typed qualified" (Just "GHC.List.head :: [GHC.Integer.Type.Integer]\n -> GHC.Integer.Type.Integer") tap1 )) + +testThingAtPointMain :: (APIFacade a)=> a -> Test +testThingAtPointMain api= TestLabel "testThingAtPointMain" (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: A.hs", + " other-modules: B.D", + " build-depends: base"] + let rel="src"</>"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 + (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 + )) testNamesInScope :: (APIFacade a)=> a -> Test testNamesInScope api= TestLabel "testNamesInScope" (TestCase ( do