Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

returnAll parameter + catch source errors + getAll uses references too

  • Loading branch information...
commit 9092a99bebfca902be517546b82545d0439f5bb5 1 parent cf15f9e
@JPMoresmau authored
View
9 src-exe/Language/Haskell/BuildWrapper/CMD.hs
@@ -45,7 +45,7 @@ data BWCmd=Synchronize {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile:
| Dependencies {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String]}
| Components {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String]}
| GetBuildFlags {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath}
- | GenerateUsage {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], cabalComponent::String}
+ | GenerateUsage {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], returnAll:: Bool, cabalComponent::String}
deriving (Show,Read,Data,Typeable)
@@ -72,6 +72,9 @@ wc=Target &= help "which cabal file to use: original or temporary"
cc :: String
cc=def &= help "cabal component"
+ra :: Bool
+ra=def &= help "return all source paths"
+
msynchronize :: BWCmd
msynchronize = Synchronize tf cp cf uf co ff
msynchronize1 :: BWCmd
@@ -103,7 +106,7 @@ mdependencies=Dependencies tf cp cf uf co
mcomponents :: BWCmd
mcomponents=Components tf cp cf uf co
mgenerateUsage :: BWCmd
-mgenerateUsage=GenerateUsage tf cp cf uf co cc
+mgenerateUsage=GenerateUsage tf cp cf uf co ra cc
-- | main method for command handling
cmdMain :: IO ()
@@ -135,7 +138,7 @@ cmdMain = cmdArgs
handle c@NamesInScope{file=fi}=runCmd c (getNamesInScope fi)
handle c@Dependencies{}=runCmd c getCabalDependencies
handle c@Components{}=runCmd c getCabalComponents
- handle c@GenerateUsage{cabalComponent=comp}=runCmd c (generateUsage comp)
+ handle c@GenerateUsage{returnAll=reta,cabalComponent=comp}=runCmd c (generateUsage reta comp)
runCmd :: (ToJSON a) => BWCmd -> StateT BuildWrapperState IO a -> IO ()
runCmd=runCmdV Normal
runCmdV:: (ToJSON a) => Verbosity -> BWCmd -> StateT BuildWrapperState IO a -> IO ()
View
6 src/Language/Haskell/BuildWrapper/API.hs
@@ -90,8 +90,8 @@ build :: Bool -- ^ do we want output (True) or just compilation without linking?
-> BuildWrapper (OpResult BuildResult)
build = cabalBuild
-generateUsage :: String -> BuildWrapper(OpResult (Maybe [FilePath]))
-generateUsage ccn= do
+generateUsage :: Bool -> String -> BuildWrapper(OpResult (Maybe [FilePath]))
+generateUsage returnAll ccn= do
r<-withCabal Source (\lbi -> do
cbis<-getAllFiles lbi
cf<-gets cabalFile
@@ -116,7 +116,7 @@ generateUsage ccn= do
setCurrentDirectory cd
return mods
mapM_ (generate pkg) modules
- return mps
+ return $ if returnAll then mps1 else mps
) $ filter (\cbi->(cabalComponentName $ cbiComponent cbi)==ccn) cbis
return $ map fst $ concat allMps
)
View
2  src/Language/Haskell/BuildWrapper/Base.hs
@@ -28,6 +28,8 @@ import System.FilePath
import Data.List (isPrefixOf, isInfixOf)
import Data.Maybe (catMaybes)
+
+
-- | State type
type BuildWrapper=StateT BuildWrapperState IO
View
24 src/Language/Haskell/BuildWrapper/Cabal.hs
@@ -35,7 +35,7 @@ import qualified Distribution.PackageDescription as PD
import Distribution.Package
import Distribution.InstalledPackageInfo as IPI
import Distribution.Version
-import Distribution.Text (display)
+import Distribution.Text (display,simpleParse)
import qualified Distribution.Simple.Configure as DSC
@@ -446,9 +446,12 @@ getAllFiles lbi= do
let libs=maybe [] extractFromLib $ library pd
let exes=map extractFromExe $ executables pd
let tests=map extractFromTest $ testSuites pd
- mapM (\(a,b,c,isLib,d,cc)->do
+ cbis<-mapM (\(a,b,c,isLib,d,cc)->do
mf<-copyAll d
return (CabalBuildInfo a b c isLib mf cc)) (libs ++ exes ++ tests)
+ cbis2<-getReferencedFiles lbi
+ return $ zipWith (\c1@CabalBuildInfo{cbiModulePaths=cb1} CabalBuildInfo{cbiModulePaths=cb2}->c1{cbiModulePaths=nubOrd $ cb1++cb2}) cbis cbis2
+ -- return cbis
where
extractFromLib :: Library -> [(BuildInfo,ComponentLocalBuildInfo,FilePath,Bool,[FilePath],CabalComponent)]
extractFromLib l=let
@@ -482,7 +485,7 @@ getAllFiles lbi= do
-- exclude every file containing the temp folder name (".buildwrapper" by default)
-- which may happen if . is a source path
let notMyself=filter (not . isInfixOf tf) allF
- return $ map (\f->(fromString $ fileToModule $ makeRelative fullFP f,makeRelative dir f)) notMyself
+ return $ map (\(x,y)->(fromJust x,y)) $ filter (isJust . fst) $ map (\f->(simpleParse $ fileToModule $ makeRelative fullFP f,makeRelative dir f)) notMyself
-- | get all components, referencing only the files explicitely indicated in the cabal file
getReferencedFiles :: LocalBuildInfo -> BuildWrapper [CabalBuildInfo]
@@ -491,7 +494,12 @@ getReferencedFiles lbi= do
let libs=maybe [] extractFromLib $ library pd
let exes=map extractFromExe $ executables pd
let tests=map extractFromTest $ testSuites pd
- return (libs ++ exes ++ tests)
+ let cbis=(libs ++ exes ++ tests)
+ mapM (\c1@CabalBuildInfo{cbiModulePaths=cb1}->do
+ cb2<-filterM (\(_,f)->do
+ fs<-getFullSrc f
+ liftIO $ doesFileExist fs) cb1
+ return c1{cbiModulePaths=cb2}) cbis
where
extractFromLib :: Library -> [CabalBuildInfo]
extractFromLib l=let
@@ -522,9 +530,15 @@ getReferencedFiles lbi= do
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=let
+ rmods=filter (isJust . snd ) $ map (\x->(x,simpleParse $ fileToModule x)) mods
+ in [(modu,d </> m) | (m,Just modu)<-rmods, d<-dirs]
copyMain :: FilePath ->[FilePath] -> [(ModuleName,FilePath)]
copyMain fs = map (\ d -> (fromString "Main", d </> fs))
+
+
+stringToModuleName :: String -> Maybe ModuleName
+stringToModuleName=simpleParse
-- | convert a ModuleName to a String
moduleToString :: ModuleName -> String
View
10 src/Language/Haskell/BuildWrapper/GHC.hs
@@ -787,14 +787,15 @@ end (UnhelpfulSpan _)=error "UnhelpfulSpan in cmpOverlap start"
ghcImportToUsage :: T.Text -> LImportDecl Name -> Ghc [Usage]
-ghcImportToUsage myPkg (L _ imp)=do
+ghcImportToUsage myPkg (L _ imp)=(do
let L src modu=ideclName imp
pkg<-lookupModule modu (ideclPkgQual imp)
let tmod=T.pack $ showSDoc $ ppr modu
let tpkg=T.pack $ showSDoc $ ppr $ modulePackageId pkg
let nomain=if tpkg=="main" then myPkg else tpkg
let subs=concatMap (ghcLIEToUsage (Just nomain) tmod) $ maybe [] snd $ ideclHiding imp
- return $ (Usage (Just nomain) tmod "" False (toJSON $ ghcSpanToLocation src)):subs
+ return $ (Usage (Just nomain) tmod "" False (toJSON $ ghcSpanToLocation src)):subs)
+ `gcatch` (\(_ :: SourceError) -> return [])
ghcLIEToUsage :: Maybe T.Text -> T.Text -> LIE Name -> [Usage]
ghcLIEToUsage tpkg tmod (L src (IEVar nm))=[ghcNameToUsage tpkg tmod nm src False]
@@ -806,7 +807,7 @@ ghcLIEToUsage tpkg tmod (L src (IEModuleContents _))= [Usage tpkg tmod "" False
ghcLIEToUsage _ _ _=[]
ghcExportToUsage :: T.Text -> T.Text -> LIE Name -> Ghc [Usage]
-ghcExportToUsage myPkg myMod lie@(L _ name)=do
+ghcExportToUsage myPkg myMod lie@(L _ name)=(do
(tpkg,tmod)<-do
case name of
(IEModuleContents modu)-> do
@@ -815,7 +816,8 @@ ghcExportToUsage myPkg myMod lie@(L _ name)=do
let tmod=T.pack $ showSDoc $ ppr $ modu
return (tpkg,tmod)
_ -> return (myPkg,myMod)
- return $ ghcLIEToUsage (Just tpkg) tmod lie
+ return $ ghcLIEToUsage (Just tpkg) tmod lie)
+ `gcatch` (\(_ :: SourceError) -> return [])
ghcNameToUsage :: Maybe T.Text -> T.Text -> Name -> SrcSpan -> Bool -> Usage
ghcNameToUsage tpkg tmod nm src typ=Usage tpkg tmod (T.pack $ showSDocUnqual $ ppr nm) typ (toJSON $ ghcSpanToLocation src)
View
3  test/Language/Haskell/BuildWrapper/APITest.hs
@@ -38,9 +38,8 @@ instance APIFacade DirectAPI where
getNamesInScope _ r fp= runAPI r $ API.getNamesInScope fp
getCabalDependencies _ r= runAPI r API.getCabalDependencies
getCabalComponents _ r= runAPI r API.getCabalComponents
- generateUsage _ r cc=runAPI r $ API.generateUsage $ cabalComponentName cc
+ generateUsage _ r retAll cc=runAPI r $ API.generateUsage retAll $ cabalComponentName cc
-
runAPI:: FilePath -> StateT BuildWrapperState IO a -> IO a
runAPI root f =runAPIFlags root f ""
View
2  test/Language/Haskell/BuildWrapper/CMDTests.hs
@@ -51,7 +51,7 @@ instance APIFacade CMDAPI where
getNamesInScope _ r fp= runAPI r "namesinscope" ["--file="++fp]
getCabalDependencies _ r= runAPI r "dependencies" []
getCabalComponents _ r= runAPI r "components" []
- generateUsage _ r cc=runAPI r "generateusage" ["--cabalcomponent="++(cabalComponentName cc)]
+ generateUsage _ r retAll cc=runAPI r "generateusage" ["--returnall="++ show retAll,"--cabalcomponent="++(cabalComponentName cc)]
exeExtension :: String
#ifdef mingw32_HOST_OS
View
2  test/Language/Haskell/BuildWrapper/Tests.hs
@@ -77,7 +77,7 @@ class APIFacade a where
getNamesInScope :: a -> FilePath -> FilePath-> IO (OpResult (Maybe [String]))
getCabalDependencies :: a -> FilePath -> IO (OpResult [(FilePath,[CabalPackage])])
getCabalComponents :: a -> FilePath -> IO (OpResult [CabalComponent])
- generateUsage :: a -> FilePath -> CabalComponent -> IO (OpResult (Maybe [FilePath]))
+ generateUsage :: a -> FilePath -> Bool -> CabalComponent -> IO (OpResult (Maybe [FilePath]))
testSynchronizeAll :: (APIFacade a)=> a -> Test
testSynchronizeAll api= TestLabel "testSynchronizeAll" (TestCase ( do
View
56 test/Language/Haskell/BuildWrapper/UsagesTests.hs
@@ -30,7 +30,8 @@ utests :: (APIFacade a)=> [a -> Test]
utests= [ testGenerateBWUsage,
testGenerateReferencesSimple,
testGenerateReferencesImports,
- testGenerateReferencesExports
+ testGenerateReferencesExports,
+ testIncorrectModuleFileName
]
testGenerateBWUsage :: (APIFacade a)=> a -> Test
@@ -52,16 +53,19 @@ testGenerateBWUsage api= TestLabel "testGenerateBWUsage" (TestCase ( do
assertBool (bwI1 ++ " file exists after build") (not ef1)
(comps,_)<-getCabalComponents api root
c1<-getClockTime
- gar<-mapM (generateUsage api root) comps
+ gar<-mapM (generateUsage api root False) comps
let fs=concat $ mapMaybe fst gar
assertBool "fs doesn't contain rel" (rel `elem` fs)
c2<-getClockTime
putStrLn ("generateUsage: " ++ timeDiffToString (diffClockTimes c2 c1))
ef2<-doesFileExist bwI1
assertBool (bwI1 ++ " file doesn't exist after generateAST") ef2
- gar2<-mapM (generateUsage api root) comps
+ gar2<-mapM (generateUsage api root False) comps
let fs2=concat $ mapMaybe fst gar2
assertBool "fs2 contains rel" (not $ rel `elem` fs2)
+ gar3<-mapM (generateUsage api root True) comps
+ let fs3=concat $ mapMaybe fst gar3
+ assertBool "fs3 doesn't contain rel" (rel `elem` fs3)
))
testGenerateReferencesSimple :: (APIFacade a)=> a -> Test
@@ -98,7 +102,7 @@ testGenerateReferencesSimple api= TestLabel "testGenerateReferencesSimple" (Test
assertBool ("returned false on bool1:" ++ show nsErrors1) bool1
assertBool "no errors or warnings on nsErrors1" (null nsErrors1)
(comps,_)<-getCabalComponents api root
- mapM_ (generateUsage api root) comps
+ mapM_ (generateUsage api root False) comps
--sI<-fmap formatJSON (readFile $ getInfoFile(root </> ".dist-buildwrapper" </> rel))
--putStrLn sI
v<-readStoredUsage (root </> ".dist-buildwrapper" </> rel)
@@ -156,7 +160,7 @@ testGenerateReferencesImports api= TestLabel "testGenerateReferencesImports" (Te
assertBool ("returned false on bool1:" ++ show nsErrors1) bool1
assertBool "no errors or warnings on nsErrors1" (null nsErrors1)
(comps,_)<-getCabalComponents api root
- mapM_ (generateUsage api root) comps
+ mapM_ (generateUsage api root False) comps
vMain<-readStoredUsage (root </> ".dist-buildwrapper" </> relMain)
-- sUMain<-fmap formatJSON (readFile $ getUsageFile(root </> ".dist-buildwrapper" </> relMain))
-- putStrLn sUMain
@@ -206,7 +210,7 @@ testGenerateReferencesExports api= TestLabel "testGenerateReferencesExports" (Te
assertBool ("returned false on bool1:" ++ show nsErrors1) bool1
assertBool "no errors or warnings on nsErrors1" (null nsErrors1)
(comps,_)<-getCabalComponents api root
- mapM_ (generateUsage api root) comps
+ mapM_ (generateUsage api root False) comps
v<-readStoredUsage (root </> ".dist-buildwrapper" </> rel)
--sU<-fmap formatJSON (readFile $ getUsageFile(root </> ".dist-buildwrapper" </> rel))
--putStrLn sU
@@ -233,6 +237,46 @@ testGenerateReferencesExports api= TestLabel "testGenerateReferencesExports" (Te
assertTypeUsage "BWTest-0.1" "A" "MyData3" [[4,5,4,20],[24,6,24,13]] v
assertTypeUsage "ghc-prim" "GHC.Types" "Int" [[11,15,11,18],[22,16,22,19],[26,16,26,19]] v
))
+
+testIncorrectModuleFileName :: (APIFacade a)=> a -> Test
+testIncorrectModuleFileName api= TestLabel "testIncorrectModuleFileName" (TestCase ( do
+ root<-createTestProject
+ let relMain="src"</>"Main.hs"
+ let relMain2="src"</>"Main-exe.hs"
+ renameFile (root </> relMain) (root </> relMain2)
+ let cf=testCabalFile root
+ writeFile cf $ unlines ["name: "++testProjectName,
+ "version:0.1",
+ "cabal-version: >= 1.8",
+ "build-type: Simple",
+ "",
+ "library",
+ " hs-source-dirs: src",
+ " exposed-modules: A",
+ " other-modules: B.C",
+ " build-depends: base",
+ "",
+ "executable BWTest",
+ " hs-source-dirs: src",
+ " main-is: Main-exe.hs",
+ " other-modules: B.D",
+ " build-depends: base",
+ "",
+ "test-suite BWTest-test",
+ " type: exitcode-stdio-1.0",
+ " hs-source-dirs: test",
+ " main-is: Main.hs",
+ " other-modules: TestA",
+ " build-depends: base",
+ ""
+ ]
+ synchronize api root False
+ configure api root Target
+ (comps,_)<-getCabalComponents api root
+ gar<-mapM (generateUsage api root False) comps
+ let fs=concat $ mapMaybe fst gar
+ assertBool "fs doesn't contain relMain2" (relMain2 `elem` fs)
+ ))
getUsageFile :: FilePath -- ^ the source file
-> FilePath
Please sign in to comment.
Something went wrong with that request. Please try again.