buildwrapper 0.5.0 → 0.5.1
raw patch · 13 files changed
+409/−146 lines, 13 filessetup-changed
Files
- README.md +101/−0
- Setup.hs +3/−3
- buildwrapper.cabal +38/−4
- src-exe/Language/Haskell/BuildWrapper/CMD.hs +44/−42
- src/Language/Haskell/BuildWrapper/API.hs +11/−11
- src/Language/Haskell/BuildWrapper/Base.hs +38/−14
- src/Language/Haskell/BuildWrapper/Cabal.hs +83/−42
- src/Language/Haskell/BuildWrapper/GHC.hs +12/−13
- src/Language/Haskell/BuildWrapper/GHCStorage.hs +4/−4
- src/Language/Haskell/BuildWrapper/Packages.hs +8/−8
- test/Language/Haskell/BuildWrapper/APITest.hs +20/−2
- test/Language/Haskell/BuildWrapper/CMDTests.hs +1/−0
- test/Language/Haskell/BuildWrapper/Tests.hs +46/−3
+ README.md view
@@ -0,0 +1,101 @@+# BuildWrapper + +BuildWrapper is a program designed to help an IDE deal with a Haskell project. It combines several tools under a simple API: + +- Cabal to configure and build the project. BuildWrapper works best on project that provide a cabal file. +- GHC to load a particular file or buffer and generate a typechecked AST +- Haskell-src-exts to parse a particular file and generate an outline + +BuildWrapper provides a library and an executable. Intended usage is mostly through the executable. This is how it's used by EclipseFP, the set of Haskell development plugins for the Eclipse IDE. +This executable is *short-lived*, it is not a running server as scion (the project BuildWrapper is an evolution of) or scion-browser. You launch it with parameters, it perform some work, and returns a JSON result. +BuildWrapper uses a temporary work folder inside the project to store both a copy of the source files and the result of its operations. In an IDE setting, the content of the temporary folder may contain files representing unsaved data, which allow BuildWrapper to use Cabal and file based operations regardless. + + +You can run `buildwrapper --help` to get a feel for the different options you can call buildwrapper with. You can also run EclipseFP with the debug mode preference on to see the BuildWrapper interaction in an Eclipse console view. + +## Generic options +These options apply to all commands + +- tempFolder: the name of the temporary folder, relative to the location of the project cabal file. Usually .dist-buildwrapper +- cabalpath: the location of the cabal executable +- cabalfile: the location of the project cabal file +- cabalFlags: the flags to pass to cabal when configuring + +## synchronize +Synchronize ensures that all the files in the temporary work folder represent the up to date version of the source files. It returns the list of files actually copied from the main folder to the work folder. + +- force: true/false: copies files even if destination (in temporary folder) is newer + +## synchronize1 +Synchronizes only one file. + +- file: the relative path of the file to synchronize (relative to the project root) +- force: true/false: copies files even if destination (in temporary folder) is newer + +## write +Updates the content of the file in the work folder. Note that an external tool could also write directly in the work folder. + +- file: the relative path of the file to update (relative to the project root) +- contents: the contents to write + +## configure +Runs cabal configure on the project. This command usually is not needed, as the build command will trigger a configure if needed. +Returns the errors encountered, if any. + +- verbosity: the verbosity of Cabal output +- whichcabal: Source|Target: use the original cabal file or the one in the work folder + +## build +Runs cabal build on the project. +Returns the errors encountered, if any, and the files processed during that build. + +- verbosity: the verbosity of Cabal output +- whichcabal: Source/Target: use the original cabal file or the one in the work folder +- output: true/false: should we actually run the linker and generates output + +## build1 +Build one file using the GHC API. BuildWrapper takes care of calling the API with the proper flags from the cabal file. +Returns the errors encountered during the build, if any. +The AST and the build flags used are stored in a hidden file alongside the source file in the work folder. This file, with the .bwinfo extension, is plain JSON and can be parsed by an external tool if need be. + +- file: the relative path of the file to update (relative to the project root) + +## getbuildflags +Returns the build flags use to build a particular file + +- file: the relative path of the file to update (relative to the project root) + +## outline +Returns an outline of the file: the top level declarations, the import and export statements. This is generated using haskell-src-exts so the file does not need to be correct in respect to the typechecker, but needs to be valid Haskell syntax. If need be, the file is pre-processed by cpp2hs. + +- file: the relative path of the file to update (relative to the project root) + +## tokentypes +Returns a collection of lexer tokens for a particular file. The tokens have a type assigned to them (documentation, symbols, etc). This is used to provide syntax coloring in an IDE. If need be, the file is pre-processed and the preprocessor tokens are returned in the collection too. + +- file: the relative path of the file to update (relative to the project root) + +## occurrences +Find all occurrences of the given text in lexer tokens. Only fully matching tokens are retrieved. + +- file: the relative path of the file to update (relative to the project root) +- token: the token text to search for + +## thingatpoint +Returns the object found at a particular point in a source. Information can include a name, a module, a type, a haddock type code. +This uses the generated .bwinfo file to perform the search so does not invoke the GHC API unless necessary (.bwinfo file missing or older than source) + +- file: the relative path of the file to update (relative to the project root) +- line: the line to look at +- column: the column to look at + +## namesinscope +Returns the list of names in scope (GHC API call) + +- file: the relative path of the file to update (relative to the project root) + +## dependencies +Returns the list of all package dependencies for all cabal components in the cabal file, with the package database they are registered in + +## components +Returns the list of all components of the cabal file (executables, library, test suites)
Setup.hs view
@@ -1,4 +1,4 @@-#!/usr/bin/env runhaskell -import Distribution.Simple -main :: IO () +#!/usr/bin/env runhaskell+import Distribution.Simple+main :: IO () main = defaultMain
buildwrapper.cabal view
@@ -1,5 +1,5 @@ name: buildwrapper -version: 0.5.0 +version: 0.5.1 cabal-version: >= 1.8 build-type: Simple license: BSD3 @@ -14,6 +14,7 @@ maintainer: JP Moresmau <jpmoresmau@gmail.com> author: JP Moresmau <jpmoresmau@gmail.com>, based on the work of Thomas Schilling and others homepage: https://github.com/JPMoresmau/BuildWrapper +extra-source-files: README.md library hs-source-dirs: src @@ -57,8 +58,27 @@ hs-source-dirs: src-exe main-is: Main.hs build-depends: - base < 5, buildwrapper, cmdargs, filepath, Cabal, directory, mtl, ghc, cpphs,haskell-src-exts, old-time, ghc-syb-utils, ghc-paths - ,vector >= 0.8, containers, syb, process, regex-tdfa, text, aeson >=0.4, bytestring, + base < 5, + buildwrapper, + cmdargs, + filepath, + Cabal, + directory, + mtl, + ghc, + cpphs, + haskell-src-exts, + old-time, + ghc-syb-utils, + ghc-paths, + vector >= 0.8, + containers, + syb, + process, + regex-tdfa, + text, + aeson >=0.4, + bytestring, transformers ghc-options: -Wall -fno-warn-unused-do-bind other-modules: Language.Haskell.BuildWrapper.CMD @@ -67,7 +87,21 @@ type: exitcode-stdio-1.0 hs-source-dirs: test build-depends: - base < 5, buildwrapper, HUnit, mtl, filepath, directory, Cabal, old-time, aeson >=0.4, text, process, bytestring, attoparsec, test-framework, test-framework-hunit, + base < 5, + buildwrapper, + HUnit, + mtl, + filepath, + directory, + Cabal, + old-time, + aeson >=0.4, + text, + process, + bytestring, + attoparsec, + test-framework, + test-framework-hunit, transformers main-is: Main.hs ghc-options: -Wall -fno-warn-unused-do-bind
src-exe/Language/Haskell/BuildWrapper/CMD.hs view
@@ -22,7 +22,7 @@ import Data.Aeson import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy.Char8 as BSC -import Data.Version (showVersion) +import Data.Version (showVersion) type CabalFile = FilePath @@ -30,20 +30,20 @@ type TempFolder = FilePath -- | all the different actions and their parameters -data BWCmd=Synchronize {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, force::Bool} - | Synchronize1 {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, force::Bool, file:: FilePath} - | Write {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, file:: FilePath, contents::String} - | Configure {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, verbosity::Verbosity,cabalTarget::WhichCabal} - | Build {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, verbosity::Verbosity,output::Bool,cabalTarget::WhichCabal} - | Build1 {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, file:: FilePath} - | Outline {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, file:: FilePath} - | TokenTypes {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, file:: FilePath} - | Occurrences {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, file:: FilePath,token::String} - | ThingAtPointCmd {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, file:: FilePath, line::Int, column::Int} - | 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} +data BWCmd=Synchronize {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], force::Bool} + | Synchronize1 {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], force::Bool, file:: FilePath} + | Write {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath, contents::String} + | Configure {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], verbosity::Verbosity,cabalTarget::WhichCabal} + | Build {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], verbosity::Verbosity,output::Bool,cabalTarget::WhichCabal} + | Build1 {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath} + | Outline {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath} + | TokenTypes {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath} + | Occurrences {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath,token::String} + | ThingAtPointCmd {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath, line::Int, column::Int} + | NamesInScope {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath} + | 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} deriving (Show,Read,Data,Typeable) @@ -59,6 +59,8 @@ ff=def &= help "overwrite newer file" uf :: String uf=def &= help "user cabal flags" +co :: [String] +co=def &= help "cabal extra parameters" v :: Verbosity v=Normal &= help "verbosity" @@ -66,49 +68,49 @@ wc=Target &= help "which cabal file to use: original or temporary" msynchronize :: BWCmd -msynchronize = Synchronize tf cp cf uf ff +msynchronize = Synchronize tf cp cf uf co ff msynchronize1 :: BWCmd -msynchronize1 = Synchronize1 tf cp cf uf ff fp +msynchronize1 = Synchronize1 tf cp cf uf co ff fp mconfigure :: BWCmd -mconfigure = Configure tf cp cf uf v wc +mconfigure = Configure tf cp cf uf co v wc mwrite :: BWCmd -mwrite= Write tf cp cf uf fp (def &= help "file contents") +mwrite= Write tf cp cf uf co fp (def &= help "file contents") mbuild :: BWCmd -mbuild = Build tf cp cf uf v (def &= help "output compilation and linking result") wc +mbuild = Build tf cp cf uf co v (def &= help "output compilation and linking result") wc mbuild1 :: BWCmd -mbuild1 = Build1 tf cp cf uf fp +mbuild1 = Build1 tf cp cf uf co fp mgetbf :: BWCmd -mgetbf = GetBuildFlags tf cp cf uf fp +mgetbf = GetBuildFlags tf cp cf uf co fp moutline :: BWCmd -moutline = Outline tf cp cf uf fp +moutline = Outline tf cp cf uf co fp mtokenTypes :: BWCmd -mtokenTypes= TokenTypes tf cp cf uf fp +mtokenTypes= TokenTypes tf cp cf uf co fp moccurrences :: BWCmd -moccurrences=Occurrences tf cp cf uf fp (def &= help "text to search occurrences of" &= name "token") +moccurrences=Occurrences tf cp cf uf co fp (def &= help "text to search occurrences of" &= name "token") mthingAtPoint :: BWCmd -mthingAtPoint=ThingAtPointCmd tf cp cf uf fp +mthingAtPoint=ThingAtPointCmd tf cp cf uf co fp (def &= help "line" &= name "line") (def &= help "column" &= name "column") mnamesInScope :: BWCmd -mnamesInScope=NamesInScope tf cp cf uf fp +mnamesInScope=NamesInScope tf cp cf uf co fp mdependencies :: BWCmd -mdependencies=Dependencies tf cp cf uf +mdependencies=Dependencies tf cp cf uf co mcomponents :: BWCmd -mcomponents=Components tf cp cf uf +mcomponents=Components tf cp cf uf co -- | main method for command handling cmdMain :: IO () -cmdMain = cmdArgs - (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" - &= - summary - ("buildwrapper executable, version " ++ showVersion version)) +cmdMain = cmdArgs+ (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"+ &=+ summary+ ("buildwrapper executable, version " ++ showVersion version)) >>= handle where handle ::BWCmd -> IO () @@ -122,13 +124,13 @@ handle c@Outline{file=fi}=runCmd c (getOutline fi) handle c@TokenTypes{file=fi}=runCmd c (getTokenTypes fi) handle c@Occurrences{file=fi,token=t}=runCmd c (getOccurrences fi t) - handle c@ThingAtPointCmd{file=fi,line=l,column=co}=runCmd c (getThingAtPoint fi l co) + handle c@ThingAtPointCmd{file=fi,line=l,column=col}=runCmd c (getThingAtPoint fi l col) handle c@NamesInScope{file=fi}=runCmd c (getNamesInScope fi) handle c@Dependencies{}=runCmd c getCabalDependencies handle c@Components{}=runCmd c getCabalComponents runCmd :: (ToJSON a) => BWCmd -> StateT BuildWrapperState IO a -> IO () runCmd=runCmdV Normal runCmdV:: (ToJSON a) => Verbosity -> BWCmd -> StateT BuildWrapperState IO a -> IO () - runCmdV vb cmd f=evalStateT f (BuildWrapperState (tempFolder cmd) (cabalPath cmd) (cabalFile cmd) vb (cabalFlags cmd)) + runCmdV vb cmd f=evalStateT f (BuildWrapperState (tempFolder cmd) (cabalPath cmd) (cabalFile cmd) vb (cabalFlags cmd) (cabalOption cmd)) >>= BSC.putStrLn . BS.append "build-wrapper-json:" . encode
src/Language/Haskell/BuildWrapper/API.hs view
@@ -135,22 +135,22 @@ -- | perform an action on the GHC AST withGHCAST :: FilePath -- ^ the source file - -> (FilePath -- ^ the source file - -> FilePath -- ^ the base directory - -> String -- ^ the module name - -> [String] -- ^ the GHC options - -> IO a) + -> (FilePath -- ^ the source file + -> FilePath -- ^ the base directory + -> String -- ^ the module name + -> [String] -- ^ the GHC options + -> 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)) withGHCAST' :: FilePath -- ^ the source file - -> ([BWNote] -- ^ the notes from getting the flags - -> FilePath -- ^ the source file - -> FilePath -- ^ the base directory - -> String -- ^ the module name - -> [String] -- ^ the GHC options + -> ([BWNote] -- ^ the notes from getting the flags + -> FilePath -- ^ the source file + -> FilePath -- ^ the base directory + -> String -- ^ the module name + -> [String] -- ^ the GHC options -> IO (OpResult (Maybe a))) -> BuildWrapper (OpResult (Maybe a)) withGHCAST' fp f= do (bf,ns)<-getBuildFlags fp @@ -173,7 +173,7 @@ (mast,bwns)<-getAST fp case mast of Just (ParseOk ast)->do - liftIO $ Prelude.print ast + --liftIO $ Prelude.print ast let ods=getHSEOutline ast let (es,is)=getHSEImportExport ast return (OutlineResult ods es is,bwns)
src/Language/Haskell/BuildWrapper/Base.hs view
@@ -36,6 +36,7 @@ ,cabalFile::FilePath -- ^ path of the project cabal file ,verbosity::Verbosity -- ^ verbosity of logging ,cabalFlags::String -- ^ flags to pass cabal + ,cabalOpts::[String] -- ^ extra arguments to cabal configure } -- | status of notes: error or warning @@ -75,7 +76,8 @@ } deriving (Show,Read,Eq) - +isBWNoteError :: BWNote -> Bool +isBWNoteError bw=(bwn_status bw) == BWError instance ToJSON BWNote where toJSON (BWNote s t l)= object ["s" .= s, "t" .= t, "l" .= l] @@ -144,14 +146,36 @@ deriving (Show,Read,Eq,Ord) instance ToJSON InFileSpan where - toJSON (InFileSpan (InFileLoc sr sc) (InFileLoc er ec))=toJSON $ map toJSON [sr,sc,er,ec] + toJSON (InFileSpan (InFileLoc sr sc) (InFileLoc er ec)) + | sr==er = if ec==sc+1 + then toJSON $ map toJSON [sr,sc] + else toJSON $ map toJSON [sr,sc,ec] + | otherwise = toJSON $ map toJSON [sr,sc,er,ec] instance FromJSON InFileSpan where - parseJSON (Array v) | - Success v0 <- fromJSON (v V.! 0), - Success v1 <- fromJSON (v V.! 1), - Success v2 <- fromJSON (v V.! 2), - Success v3 <- fromJSON (v V.! 3)=return $ InFileSpan (InFileLoc v0 v1) (InFileLoc v2 v3) + parseJSON (Array v) =do + let + l=V.length v + case l of + 2->do + let + Success v0 = fromJSON (v V.! 0) + Success v1 = fromJSON (v V.! 1) + return $ InFileSpan (InFileLoc v0 v1) (InFileLoc v0 (v1+1)) + 3->do + let + Success v0 = fromJSON (v V.! 0) + Success v1 = fromJSON (v V.! 1) + Success v2 = fromJSON (v V.! 2) + return $ InFileSpan (InFileLoc v0 v1) (InFileLoc v0 v2) + 4->do + let + Success v0 = fromJSON (v V.! 0) + Success v1 = fromJSON (v V.! 1) + Success v2 = fromJSON (v V.! 2) + Success v3 = fromJSON (v V.! 3) + return $ InFileSpan (InFileLoc v0 v1) (InFileLoc v2 v3) + _ -> mzero parseJSON _= mzero -- | construct a file span @@ -431,17 +455,17 @@ -- | component in cabal file data CabalComponent - = CCLibrary -- ^ library + = CCLibrary { cc_buildable :: Bool -- ^ is the library buildable - } - | CCExecutable -- executable + } -- ^ library + | CCExecutable { cc_exe_name :: String -- ^ executable name , cc_buildable :: Bool -- ^ is the executable buildable - } - | CCTestSuite -- est suite + } -- ^ executable + | CCTestSuite { cc_test_name :: String -- ^ test suite name , cc_buildable :: Bool -- ^ is the test suite buildable - } + } -- ^ test suite deriving (Eq, Show) instance ToJSON CabalComponent where @@ -463,7 +487,7 @@ ,cp_version::String -- ^ version ,cp_exposed::Bool -- ^ is the package exposed or hidden ,cp_dependent::[CabalComponent] -- ^ components in the cabal file that use this package - ,cp_exposedModules::[String] -- ^ exposed modules + ,cp_modules::[String] -- ^ all modules. We keep all modules so that we can try to open non exposed but imported modules directly } deriving (Eq, Show)
src/Language/Haskell/BuildWrapper/Cabal.hs view
@@ -104,8 +104,8 @@ return Nothing else do - let fps=(mapMaybe getBuiltPath (lines out)) - let ret=parseBuildMessages err + let fps=mapMaybe getBuiltPath (lines out) + let ret=parseBuildMessages (takeFileName cf) (takeFileName cp) dist_dir err setCurrentDirectory cd return $ Just (ex==ExitSuccess,ret,fps) ) @@ -132,14 +132,16 @@ v<-cabalV dist_dir<-getDistDir uf<-gets cabalFlags + copts<-gets cabalOpts let args=[ "configure", "--verbose=" ++ show (fromEnum v), "--user", "--enable-tests", - "--builddir="++dist_dir, - "--flags="++uf - ] + "--builddir="++dist_dir + ] + ++ (if null uf then [] else ["--flags="++uf]) + ++ copts liftIO $ do cd<-getCurrentDirectory setCurrentDirectory (takeDirectory cf) @@ -147,9 +149,11 @@ putStrLn err let msgs=(parseCabalMessages (takeFileName cf) (takeFileName cp) err) -- ++ (parseCabalMessages (takeFileName cf) out) ret<-case ex of - ExitSuccess -> do - lbi<-DSC.getPersistBuildConfig dist_dir - return (Just lbi,msgs) + ExitSuccess -> if any isBWNoteError msgs + then return (Nothing,msgs) + else do + lbi<-DSC.getPersistBuildConfig dist_dir + return (Just lbi,msgs) ExitFailure ec -> if null msgs then return (Nothing,[BWNote BWError ("Cabal configure returned error code " ++ show ec) (BWLocation cf 0 1)]) else return (Nothing, msgs) @@ -217,13 +221,6 @@ Nothing -> ls Just (bwn,msgs)->ls++[makeNote bwn msgs] where - setupExe :: String - setupExe=addExtension "setup" $ takeExtension cabalExe - dropPrefixes :: [String] -> String -> Maybe String - dropPrefixes prfxs s2=foldr (stripPrefixIfNeeded s2) Nothing prfxs - stripPrefixIfNeeded :: String -> String -> Maybe String -> Maybe String - stripPrefixIfNeeded _ _ j@(Just _)=j - stripPrefixIfNeeded s3 prfx _=stripPrefix prfx s3 parseCabalLine :: (Maybe (BWNote,[String]),[BWNote]) -> String ->(Maybe (BWNote,[String]),[BWNote]) parseCabalLine (currentNote,ls) l | "Error:" `isPrefixOf` l=(Just (BWNote BWError "" (BWLocation cf 1 1),[dropWhile isSpace $ drop 6 l]),addCurrent currentNote ls) @@ -233,11 +230,43 @@ then dropWhile isSpace $ drop (length cf + 1) msg else msg in (Just (BWNote BWWarning "" (BWLocation cf (extractLine msg2) 1),[msg2]),addCurrent currentNote ls) - | Just s4 <- dropPrefixes [cabalExe,setupExe] l= + | Just (bw,n)<- cabalErrorLine cf cabalExe l=(Just (bw,n),addCurrent currentNote ls) + | Just (jcn,msgs)<-currentNote= + if not $ null l + then (Just (jcn,l:msgs),ls) + else (Nothing,ls++[makeNote jcn msgs]) + | otherwise =(Nothing,ls) + extractLine el=let + (_,_,_,ls)=el =~ "\\(line ([0-9]*)\\)" :: (String,String,String,[String]) + in if null ls + then 1 + else readInt (head ls) 1 + +setupExe :: FilePath -- ^ path to cabal executable + -> FilePath +setupExe cabalExe=addExtension "setup" $ takeExtension cabalExe + +dropPrefixes :: [String] -> String -> Maybe String +dropPrefixes prfxs s2=foldr (stripPrefixIfNeeded s2) Nothing prfxs + +stripPrefixIfNeeded :: String -> String -> Maybe String -> Maybe String +stripPrefixIfNeeded _ _ j@(Just _)=j +stripPrefixIfNeeded s3 prfx _=stripPrefix prfx s3 + +addCurrent :: Maybe (BWNote, [String]) -> [BWNote] -> [BWNote] +addCurrent Nothing xs=xs +addCurrent (Just (n,msgs)) xs=xs++[makeNote n msgs] + +cabalErrorLine :: FilePath -- ^ cabal file + -> FilePath -- ^ path to cabal executable + -> String -- ^ line + -> Maybe (BWNote,[String]) +cabalErrorLine cf cabalExe l + | Just s4 <- dropPrefixes [cabalExe,setupExe cabalExe] l= let s2=dropWhile isSpace $ drop 1 s4 -- drop 1 for ":" that follows file name in if "At least the following" `isPrefixOf` s2 - then (Just (BWNote BWError "" (BWLocation cf 1 1), [s2]),addCurrent currentNote ls) + then Just (BWNote BWError "" (BWLocation cf 1 1), [s2]) else let (loc,rest)=span (/= ':') s2 @@ -248,25 +277,19 @@ (line',msg')=span (/= ':') tr in if null msg' then (loc,"1",tr) - else (loc,line',tail msg') - in (Just (BWNote BWError "" (BWLocation realloc (read line) 1),[msg]),addCurrent currentNote ls) - | Just (jcn,msgs)<-currentNote= - if not $ null l - then (Just (jcn,l:msgs),ls) - else (Nothing,ls++[makeNote jcn msgs]) - | otherwise =(Nothing,ls) - addCurrent Nothing xs=xs - addCurrent (Just (n,msgs)) xs=xs++[makeNote n msgs] - extractLine el=let - (_,_,_,ls)=el =~ "\\(line ([0-9]*)\\)" :: (String,String,String,[String]) - in if null ls - then 1 - else read $ head ls - + else if readInt line' (-1)==(-1) + then (cf,"1",s2) + else (loc,line',tail msg') + in Just (BWNote BWError "" (BWLocation realloc (readInt line 1) 1),[msg]) + | otherwise=Nothing + -- | parse messages from build -parseBuildMessages :: String -- | the build output +parseBuildMessages :: FilePath -- ^ cabal file + -> FilePath -- ^ path to cabal executable + -> FilePath -- ^ the dist directory + -> String -- ^ the build output -> [BWNote] -parseBuildMessages s=let +parseBuildMessages cf cabalExe distDir s=let (m,ls)=foldl parseBuildLine (Nothing,[]) $ lines s in (nub $ case m of @@ -276,18 +299,37 @@ parseBuildLine :: (Maybe (BWNote,[String]),[BWNote]) -> String ->(Maybe (BWNote,[String]),[BWNote]) parseBuildLine (currentNote,ls) l | Just (jcn,msgs)<-currentNote= - if not (null l) && (' ' == head l) + if not (null l) && ((' ' == head l) || (')' == last l)) then (Just (jcn,l:msgs),ls) else (Nothing,ls++[makeNote jcn msgs]) - -- | Just fp<-getBuiltPath l=(currentNote,ls,fp:fps) + -- | Just fp<-getBuiltPath l=(currentNote,ls,fp:fps) | Just n<-extractLocation l=(Just (n,[bwn_title n]),ls) + | Just (bw,n)<- cabalErrorLine cf cabalExe l=(Just (bw,n),addCurrent currentNote ls) | otherwise =(Nothing,ls) extractLocation el=let (_,_,aft,ls)=el =~ "(.+):([0-9]+):([0-9]+):" :: (String,String,String,[String]) in case ls of - (loc:line:col:[])-> Just $ BWNote BWError (dropWhile isSpace aft) (BWLocation loc (read line) (read col)) - _ -> Nothing - + (loc:line:col:[])-> Just $ BWNote BWError (dropWhile isSpace aft) (BWLocation loc (readInt line 1) (read col)) + _ -> let + (_,_,_,ls2)=el =~ "(.+)(\\(.+\\)):(.+):(.+):" :: (String,String,String,[String]) + in case ls2 of + (loc2:ext1:_:_:[])-> Just $ BWNote BWError (drop (length loc2 + length ext1 + 1) el) (BWLocation (validLoc cf distDir loc2) 1 1) + _ -> Nothing + +validLoc :: FilePath -- ^ the cabal file + -> FilePath -- ^ the dist dir + -> FilePath + -> FilePath +validLoc cf distDir f=if distDir `isPrefixOf` f + then cf + else f + +readInt :: String -> Int -> Int +readInt s def=let parses=reads s ::[(Int,String)] + in if null parses + then def + else fst $ head parses + -- | add a message to the note makeNote :: BWNote -- ^ original note -> [String] -- ^ message lines @@ -406,7 +448,6 @@ let tests=map extractFromTest $ testSuites pd mapM (\(a,b,c,isLib,d)->do mf<-copyAll d - liftIO $ print $ map snd mf return (CabalBuildInfo a b c isLib mf)) (libs ++ exes ++ tests) where extractFromLib :: Library -> [(BuildInfo,ComponentLocalBuildInfo,FilePath,Bool,[FilePath])] @@ -533,10 +574,10 @@ ) m ipis getDep :: [CabalComponent] -> [(FilePath,InstalledPackageInfo)] -> [Dependency]-> [(FilePath,CabalPackage)] -> [(FilePath,CabalPackage)] getDep _ [] _ acc= acc - getDep allC ((fp,InstalledPackageInfo{sourcePackageId=i,exposed=e,IPI.exposedModules=ems}):xs) deps acc= let + getDep allC ((fp,InstalledPackageInfo{sourcePackageId=i,exposed=e,IPI.exposedModules=ems,IPI.hiddenModules=hms}):xs) deps acc= let (ds,deps2)=partition (\(Dependency n v)->(pkgName i == n) && withinRange (pkgVersion i) v) deps -- find if version is referenced, remove the referencing component so that it doesn't match an older version cps=if null ds then [] else allC - mns=map display ems + mns=map display (ems++hms) in getDep allC xs deps2 ((fp,CabalPackage (display $ pkgName i) (display $ pkgVersion i) e cps mns): acc) -- build CabalPackage structure
src/Language/Haskell/BuildWrapper/GHC.hs view
@@ -47,6 +47,7 @@ import System.FilePath import qualified MonadUtils as GMU +import Control.Monad.IO.Class (liftIO) -- | get the GHC typechecked AST @@ -108,7 +109,7 @@ -- 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 + -- $ 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 modul @@ -194,7 +195,7 @@ ghcMessagesToNotes :: FilePath -- ^ base directory -> Messages -- ^ GHC messages -> [BWNote] -ghcMessagesToNotes base_dir (warns, errs) = map_bag2ms (ghcWarnMsgToNote base_dir) warns +++ghcMessagesToNotes base_dir (warns, errs) = map_bag2ms (ghcWarnMsgToNote base_dir) warns ++ map_bag2ms (ghcErrMsgToNote base_dir) errs where map_bag2ms f = map f . Bag.bagToList @@ -407,17 +408,15 @@ -> ([Located Token] -> [TokenDef]) -- ^ Transform function from GHC tokens to TokenDefs -> ([TokenDef] -> a) -- ^ The TokenDef filter function -> IO (Either BWNote a) -generateTokens projectRoot contents literate options xform filterFunc = - let (ppTs, ppC) = preprocessSource contents literate - in ghctokensArbitrary projectRoot ppC options - >>= (\result -> - case result of - Right toks -> - let filterResult = filterFunc $ List.sortBy (comparing td_loc) (ppTs ++ xform toks) - --liftIO $ putStrLn $ show tokenList - in return $ Right filterResult - Left n -> return $ Left n - ) +generateTokens projectRoot contents literate options xform filterFunc =do + let (ppTs, ppC) = preprocessSource contents literate + result<- ghctokensArbitrary projectRoot ppC options + case result of + Right toks ->do + let filterResult = filterFunc $ List.sortBy (comparing td_loc) (ppTs ++ xform toks) + return $ Right filterResult + Left n -> return $ Left n + -- | Preprocess some source, returning the literate and Haskell source as tuple. preprocessSource :: String -- ^ the source contents
src/Language/Haskell/BuildWrapper/GHCStorage.hs view
@@ -193,10 +193,10 @@ 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), + 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
src/Language/Haskell/BuildWrapper/Packages.hs view
@@ -88,15 +88,15 @@ -- Get the user package configuration database e_appdir <- try $ getAppUserDataDirectory "ghc" - user_conf <- case e_appdir of - Left _ -> return [] + user_conf <- case e_appdir of+ Left _ -> return [] Right appdir -> do - let subdir - = currentArch ++ '-' : currentOS ++ '-' : ghcVersion - dir = appdir </> subdir - r <- lookForPackageDBIn dir - case r of - Nothing -> return [] + let subdir+ = currentArch ++ '-' : currentOS ++ '-' : ghcVersion+ dir = appdir </> subdir+ r <- lookForPackageDBIn dir+ case r of+ Nothing -> return [] Just pkgs -> return pkgs -- Process GHC_PACKAGE_PATH, if present:
test/Language/Haskell/BuildWrapper/APITest.hs view
@@ -19,7 +19,8 @@ unitTests :: [Test] -unitTests=[testGetBuiltPath,testParseBuildMessages,testParseConfigureMessages] +unitTests=[testGetBuiltPath,testParseBuildMessages,testParseBuildMessagesLinker,testParseBuildMessagesCabal + ,testParseConfigureMessages] testGetBuiltPath :: Test testGetBuiltPath = TestLabel "testGetBuiltPath" (TestCase (do @@ -31,11 +32,28 @@ testParseBuildMessages :: Test testParseBuildMessages = TestLabel "testParseBuildMessages" (TestCase (do let s="Main.hs:2:3:Warning: Top-level binding with no type signature:\n tests :: [test-framework-0.4.1.1:Test.Framework.Core.Test]\nLinking" - let notes=Cabal.parseBuildMessages s + let notes=Cabal.parseBuildMessages "test.cabal" "cabal.exe" "" s assertEqual "not 1 note" 1 (length notes) assertEqual "not expected note" (BWNote BWWarning "Top-level binding with no type signature:\n tests :: [test-framework-0.4.1.1:Test.Framework.Core.Test]\n" (BWLocation "Main.hs" 2 3)) (head notes) )) + +testParseBuildMessagesLinker :: Test +testParseBuildMessagesLinker = TestLabel "testParseBuildMessagesLinker" (TestCase (do + let s="Linking D:\\Documents\\Perso\\workspace\\HJVM\\.dist-buildwrapper\\dist\\build\\hjvm-test\\hjvm-test.exe ...\nD:\\Documents\\Perso\\workspace\\HJVM\\.dist-buildwrapper\\dist\\build/libHSHJVM-0.1.a(hjvm.o):hjvm.c:(.text+0x1d): undefined reference to `_imp__JNI_GetCreatedJavaVMs@12'\ncollect2: ld returned 1 exit status\n" + let notes=Cabal.parseBuildMessages "test.cabal" "cabal.exe" "D:\\Documents\\Perso\\workspace\\HJVM\\.dist-buildwrapper\\dist" s + assertEqual "not 1 note" 1 (length notes) + assertEqual "not expected note" (BWNote BWError "hjvm.c:(.text+0x1d): undefined reference to `_imp__JNI_GetCreatedJavaVMs@12'\n" (BWLocation "test.cabal" 1 1)) (head notes) + )) + +testParseBuildMessagesCabal :: Test +testParseBuildMessagesCabal = TestLabel "testParseBuildMessagesCabal" (TestCase (do + let s="cabal.exe: HJVM-0.1: library-dirs: src is a relative path (use --force\nto override)\n" + let notes=Cabal.parseBuildMessages "test.cabal" "cabal.exe" "" s + assertEqual "not 1 note" 1 (length notes) + assertEqual "not expected note" (BWNote BWError "HJVM-0.1: library-dirs: src is a relative path (use --force\nto override)\n" (BWLocation "test.cabal" 1 1)) (head notes) + )) + testParseConfigureMessages :: Test testParseConfigureMessages = TestLabel "testParseConfigureMessages" (TestCase (do let s="cabal.exe: Missing dependencies on foreign libraries:\n* Missing C libraries: tinfo, tinfo\n"
test/Language/Haskell/BuildWrapper/CMDTests.hs view
@@ -37,6 +37,7 @@ synchronize1 _ r ff fp= runAPI r "synchronize1" ["--force="++show ff,"--file="++fp] write _ r fp s= runAPI r "write" ["--file="++fp,"--contents="++s] configure _ r t= runAPI r "configure" ["--cabaltarget="++ show t] + configureWithFlags _ r t fgs= runAPI r "configure" ["--cabaltarget="++ show t,"--cabalflags="++ fgs] 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]
test/Language/Haskell/BuildWrapper/Tests.hs view
@@ -34,7 +34,7 @@ tests= [ testSynchronizeAll, testConfigureWarnings , - testConfigureErrors , + testConfigureErrors, testBuildErrors, testBuildWarnings, testBuildOutput, @@ -53,7 +53,8 @@ testInPlaceReference, testCabalComponents, testCabalDependencies, - testNoSourceDir + testNoSourceDir, + testFlags ] class APIFacade a where @@ -61,6 +62,7 @@ synchronize1 :: a -> FilePath -> Bool -> FilePath -> IO (Maybe FilePath) write :: a -> FilePath -> FilePath -> String -> IO () configure :: a -> FilePath -> WhichCabal -> IO (OpResult Bool) + configureWithFlags :: a -> FilePath -> WhichCabal -> String -> IO (OpResult Bool) build :: a -> FilePath -> Bool -> WhichCabal -> IO (OpResult BuildResult) build1 :: a -> FilePath -> FilePath -> IO (OpResult Bool) getBuildFlags :: a -> FilePath -> FilePath -> IO (OpResult BuildFlags) @@ -682,7 +684,7 @@ ] (tts,nsErrors1)<-getTokenTypes api root rel assertBool ("errors or warnings on getTokenTypes:"++show nsErrors1) (null nsErrors1) - let expectedS="[{\"D\":[1,1,1,37]},{\"D\":[2,1,2,13]},{\"K\":[3,1,3,7]},{\"IC\":[3,8,3,12]},{\"K\":[3,13,3,18]},{\"IV\":[5,1,5,5]},{\"S\":[5,6,5,8]},{\"IC\":[5,9,5,11]},{\"SS\":[5,12,5,13]},{\"IC\":[5,13,5,16]},{\"SS\":[5,16,5,17]},{\"IV\":[6,1,6,5]},{\"S\":[6,6,6,7]},{\"K\":[6,8,6,10]},{\"IV\":[7,9,7,15]},{\"SS\":[7,16,7,17]},{\"LC\":[7,17,7,20]},{\"S\":[7,20,7,21]},{\"LS\":[7,21,7,34]},{\"SS\":[7,34,7,35]},{\"IV\":[8,9,8,15]},{\"SS\":[8,16,8,17]},{\"LI\":[8,17,8,18]},{\"IV\":[8,19,8,20]},{\"LI\":[8,21,8,22]},{\"SS\":[8,22,8,23]},{\"PP\":[10,1,10,11]},{\"TH\":[11,1,11,3]},{\"IV\":[11,4,11,10]},{\"IV\":[11,11,11,23]},{\"TH\":[11,24,11,26]},{\"IC\":[11,26,11,35]},{\"SS\":[11,36,11,37]},{\"PP\":[12,1,12,7]}]" + let expectedS="[{\"D\":[1,1,37]},{\"D\":[2,1,13]},{\"K\":[3,1,7]},{\"IC\":[3,8,12]},{\"K\":[3,13,18]},{\"IV\":[5,1,5]},{\"S\":[5,6,8]},{\"IC\":[5,9,11]},{\"SS\":[5,12]},{\"IC\":[5,13,16]},{\"SS\":[5,16]},{\"IV\":[6,1,5]},{\"S\":[6,6]},{\"K\":[6,8,10]},{\"IV\":[7,9,15]},{\"SS\":[7,16]},{\"LC\":[7,17,20]},{\"S\":[7,20]},{\"LS\":[7,21,34]},{\"SS\":[7,34]},{\"IV\":[8,9,15]},{\"SS\":[8,16]},{\"LI\":[8,17]},{\"IV\":[8,19]},{\"LI\":[8,21]},{\"SS\":[8,22]},{\"PP\":[10,1,11]},{\"TH\":[11,1,3]},{\"IV\":[11,4,10]},{\"IV\":[11,11,23]},{\"TH\":[11,24,26]},{\"IC\":[11,26,35]},{\"SS\":[11,36]},{\"PP\":[12,1,7]}]" assertEqual "" expectedS (encode $ toJSON tts) )) @@ -1017,6 +1019,47 @@ assertBool ".dist-buildwrapper exists after synchronize" (not d2b) )) + +testFlags :: (APIFacade a)=> a -> Test +testFlags api=TestLabel "testFlags" (TestCase (do + root<-createTestProject + let cf=testCabalFile root + writeFile cf $ unlines ["name: "++testProjectName, + "version:0.1", + "cabal-version: >= 1.8", + "build-type: Simple", + "", + "flag server", + " description: Install the scion-server.", + " default: False", + "", + "library", + " hs-source-dirs: src", + " exposed-modules: A", + " other-modules: B.C", + " build-depends: base", + "", + "executable BWTest", + " if !flag(server)", + " buildable: False", + " hs-source-dirs: src", + " main-is: Main.hs", + " other-modules: B.D", + " build-depends: base", + "" + ] + configure api root Source + build api root True Source + let exePath=root </> ".dist-buildwrapper" </> "dist" </> "build" </> testProjectName </> "BWTest.exe" + ex1<-doesFileExist exePath + assertBool "exe exists!" (not ex1) + + configureWithFlags api root Source "server" + build api root True Source + ex2<-doesFileExist exePath + assertBool "exe doesn't exists!" ex2 + + )) testProjectName :: String testProjectName="BWTest"