preprocessor (empty) → 0.1.0.0
raw patch · 8 files changed
+655/−0 lines, 8 filesdep +Cabaldep +basedep +directorysetup-changed
Dependencies added: Cabal, base, directory, extra, filemanip, filepath, ghc, ghc-paths, haskell-src-exts, hspec, microlens, preprocessor, process, template-haskell, temporary
Files
- LICENSE +7/−0
- Setup.hs +2/−0
- preprocessor.cabal +58/−0
- src/Language/C/Preprocessor/Remover.hs +128/−0
- src/Language/C/Preprocessor/Remover/Internal/AddPadding.hs +137/−0
- src/Language/C/Preprocessor/Remover/Internal/Preprocess.hs +110/−0
- src/Language/C/Preprocessor/Remover/Internal/Types.hs +56/−0
- test/Main.hs +157/−0
+ LICENSE view
@@ -0,0 +1,7 @@+Copyright (c) 2016 Carlo Nucera++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ preprocessor.cabal view
@@ -0,0 +1,58 @@+name: preprocessor+version: 0.1.0.0+cabal-version: >=1.10+build-type: Simple+license: MIT+license-file: LICENSE+copyright: 2016 Carlo Nucera+maintainer: meditans@gmail.com+homepage: http://github.com/meditans/preprocessor#readme+synopsis: Remove cpp annotations to get the source ready for static analysis.+description:+ Remove cpp annotations using the configuration with which you build the package, to get the source ready for static analysis with a parsing library like haskell-src-exts.+category: Source Code Analysis, CPP+author: Carlo Nucera++source-repository head+ type: git+ location: https://github.com/meditans/preprocessor++library+ + if impl(ghc >=8.0)+ build-depends:+ template-haskell >=2.10.0.0 && <2.11+ exposed-modules:+ Language.C.Preprocessor.Remover+ Language.C.Preprocessor.Remover.Internal.Preprocess+ Language.C.Preprocessor.Remover.Internal.Types+ Language.C.Preprocessor.Remover.Internal.AddPadding+ build-depends:+ base >=4.7 && <5,+ Cabal >=1.22.8.0 && <1.23,+ directory >=1.2.2.0 && <1.3,+ extra >=1.4.10 && <1.5,+ filemanip >=0.3.6.3 && <0.4,+ filepath >=1.4.0.0 && <1.5,+ ghc >=7.10.3 && <7.11,+ ghc-paths >=0.1.0.9 && <0.2,+ microlens >=0.4.4.3 && <0.5,+ process >=1.2.3.0 && <1.3+ default-language: Haskell2010+ hs-source-dirs: src+ ghc-options: -Wall++test-suite preprocessor-test+ type: exitcode-stdio-1.0+ main-is: Main.hs+ build-depends:+ base >=4.7 && <5,+ directory >=1.2.2.0 && <1.3,+ haskell-src-exts >=1.18.2 && <1.19,+ hspec >=2.2.3 && <2.3,+ preprocessor >=0.1.0.0 && <0.2,+ process >=1.2.3.0 && <1.3,+ temporary >=1.2.0.4 && <1.3+ default-language: Haskell2010+ hs-source-dirs: test+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -Wall
+ src/Language/C/Preprocessor/Remover.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE ViewPatterns #-}++{-|+Module : Language.C.Preprocessor.Remover+Description : Preprocess cpp directives in haskell source code.+Copyright : (c) Carlo Nucera, 2016+License : BSD3+Maintainer : meditans@gmail.com+Stability : experimental+Portability : POSIX++This library preprocesses the cpp directives in haskell source code (a task not+usually done by parsing libraries), to prepare it for static analysis, e.g. with+<http://hackage.haskell.org/package/haskell-src-exts haskell-src-exts>.++The design of the library is guided by two principles:++ * Line numbering with the original file should be preserved: if a line isn't+related to cpp preprocessing, it conserves its position. This is done to make+eventual failings with the parsing library easier to locate.++ * It should offer a very simple API, shielding the user from the understandings+of how cabal options are passed around, and trying to automatically find all the+required information in the project. The user is expected to use only the two+functions in this module.++Currently this tool __requires__ the library to have been built with stack (it+searches for some files generated in @.stack-work@). In the future I'll+probably lift this restriction (if you need it before, please open a ticket).+The files marked as internal are exported for documentation purposes only.+-}++module Language.C.Preprocessor.Remover+ ( getLibExposedModulesPath+ , preprocessFile+ ) where++import Language.C.Preprocessor.Remover.Internal.AddPadding (addPadding)+import Language.C.Preprocessor.Remover.Internal.Preprocess (parseModuleWithCpp)+import Language.C.Preprocessor.Remover.Internal.Types (CabalFilePath,+ CppOptions (..),+ ProjectDir,+ emptyCppOptions)++import Control.Monad (filterM, (>=>))+import Data.List (inits, isSuffixOf)+import Data.Maybe (catMaybes)+import Data.Monoid ((<>))+import Distribution.ModuleName (toFilePath)+import Distribution.PackageDescription (condLibrary, condTreeData,+ exposedModules, hsSourceDirs,+ libBuildInfo)+import Distribution.PackageDescription.Parse (readPackageDescription)+import Distribution.Verbosity (silent)+import System.Directory (findFile, makeAbsolute)+import System.Directory.Extra (listContents)+import System.FilePath.Find (always, extension, fileName, find,+ (&&?), (/=?), (==?))+import System.FilePath.Posix (joinPath, splitPath,+ takeDirectory, (</>))+import System.Process (readCreateProcess, shell)++-- | Given the path to the cabal file, this returns the paths to all the exposed+-- modules of the @library@ section.+getLibExposedModulesPath :: CabalFilePath -> IO [FilePath]+getLibExposedModulesPath cabalPath = do+ packageDesc <- readPackageDescription silent cabalPath+ let Just lib = condTreeData <$> condLibrary packageDesc+ modules = map (++ ".hs") . map toFilePath . exposedModules $ lib+ sourceDirs =+ map (takeDirectory cabalPath </>) . ("" :) . hsSourceDirs $+ libBuildInfo lib+ mbModulesPath <- mapM (findFile sourceDirs) modules+ return (catMaybes mbModulesPath)++-- | Given the path to a file in a stack-build project, returns the content of+-- the preprocessed file. The line numbering of the original file is preserved.+preprocessFile :: FilePath -> IO String+preprocessFile fp = do+ projectDir <- findProjectDirectory fp+ macroFile <- fromGenericFileToCppMacroFile fp+ includeDirs <-+ allDotHFiles projectDir >>= mapM (\x -> takeDirectory <$> makeAbsolute x)+ rawString <-+ parseModuleWithCpp+ (emptyCppOptions+ { cppFile = [macroFile]+ , cppInclude = includeDirs+ })+ fp+ return $ addPadding fp rawString++--------------------------------------------------------------------------------+-- Functions to locate the various paths+--------------------------------------------------------------------------------++-- | From a file position, it locates the cabal macro file (cabal_macros.h) to+-- use.+fromGenericFileToCppMacroFile :: FilePath -> IO FilePath+fromGenericFileToCppMacroFile fp = do+ distDir <- (findProjectDirectory >=> findDistDir) fp+ return $ distDir <> "/build/autogen/cabal_macros.h"++-- | The project directory is the one that contains the .cabal file. Takes a+-- filepath of a file in the project.+findProjectDirectory :: FilePath -> IO ProjectDir+findProjectDirectory fileInProject = do+ let splittedPath = splitPath fileInProject+ possiblePaths = map joinPath $ init $ tail $ inits splittedPath+ head <$> filterM containsCabalFile possiblePaths+ where+ containsCabalFile :: FilePath -> IO Bool+ containsCabalFile dir = any (".cabal" `isSuffixOf`) <$> listContents dir++-- | Given a directory (which is meant to be the project directory), gives back+-- the dist-dir contained in it (it's important because it contains all the+-- macros).+findDistDir :: ProjectDir -> IO FilePath+findDistDir fp = init <$> readCreateProcess (shell cmd) ""+ where+ cmd = "cd " ++ fp ++ "; " ++ "cd $(stack path --dist-dir)" ++ "; pwd"++-- | Given the project directory, finds the directories in which additional .h+-- files (which could be additional macros) are stored.+allDotHFiles :: ProjectDir -> IO [FilePath]+allDotHFiles root = find always isDotH root+ where+ isDotH = (extension ==? ".h" &&? fileName /=? "cabal_macros.h")
+ src/Language/C/Preprocessor/Remover/Internal/AddPadding.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE ViewPatterns #-}++{-|+Module : Language.C.Preprocessor.Remover.Internal.AddPadding+Description : Padding of the Cpp output+Copyright : (c) Carlo Nucera, 2016+License : BSD3+Maintainer : meditans@gmail.com+Stability : experimental+Portability : POSIX++After cpp preprocessing, the file is left by the compilation pipeline in the+output format of the @cpp@ program, described in+<https://gcc.gnu.org/onlinedocs/cpp/Preprocessor-Output.html this section> of+the C Preprocessor manual.++By default, the @cpp@ program inserts blank lines to preserve line numbering,+but only if the number of blank lines to be created is not too high (<6 or so).+Otherwise a linemarker is created, to reduce the size of the generated file, of+the form:++@+# linenum filename flags+@++As cpp doesn't have an option to output only blank lines and keeping the line+numbering, the following functions parse a file with linemarkers separating it+in `CppOutputComponents` (the source chunks between the linemarkers), and pad+them with the appropriate amount of blank lines.+-}++module Language.C.Preprocessor.Remover.Internal.AddPadding+ (+ -- * Entry point for padding+ addPadding+ -- * Data Types+ , LineMarker (..)+ , isLineMarker+ , parseLineMarker+ , CppOutputComponent (..)+ -- * Stages of padding+ , parseCppOutputComponents+ , discardUnusefulComponents+ , reconstructSource+ ) where++import Data.Char (isDigit)+import Data.List (isPrefixOf, isSuffixOf)+import Data.List.Extra (repeatedly)++--------------------------------------------------------------------------------+-- Entry point for padding+--------------------------------------------------------------------------------++-- | Substitutes the lineMarker in the content of a file with the appropriate+-- blank line padding.+addPadding :: FilePath -> String -> String+addPadding fp = unlines+ . reconstructSource+ . discardUnusefulComponents fp+ . parseCppOutputComponents+ . lines++--------------------------------------------------------------------------------+-- Data Types+--------------------------------------------------------------------------------++-- | A 'LineMarker' follows the structure described+-- <https://gcc.gnu.org/onlinedocs/cpp/Preprocessor-Output.html here>. We only+-- retain the linenumber and the file the line is referring to. Note that the+-- filename is surrounded by quotation marks in the cpp output, but not in this+-- representation.+data LineMarker = LineMarker { beginsAtLine :: Int+ , filePath :: FilePath+ } deriving (Show)+-- |+-- >>> isLineMarker "# 42 \"/path/to/file\""+-- True+isLineMarker :: String -> Bool+isLineMarker (words -> hash:number:fp:_) = hash == "#"+ && all isDigit number+ && isPrefixOf "\"" fp+ && isSuffixOf "\"" fp+isLineMarker _ = False++-- |+-- >>> parseLineMarker "# 42 \"/path/to/file\""+-- LineMarker {beginsAtLine = 42, filePath = "/path/to/file"}+parseLineMarker :: String -> LineMarker+parseLineMarker s = LineMarker (read $ words s !! 1) (unquote $ words s !! 2)+ where+ unquote = tail . init++-- | A 'CppOutputComponent' is constituted by a 'LineMarker' and the block of+-- code till the next 'LineMarker'.+data CppOutputComponent = CppOutputComponent { lineMarker :: LineMarker+ , sourceBlock :: [String]+ } deriving (Show)++--------------------------------------------------------------------------------+-- Stages of padding+--------------------------------------------------------------------------------++-- | Given the lines of a file, parses the CppOutputComponents. Note that a file+-- that doesn't need cpp preprocessing doesn't have any 'LineMarker'. In that+-- case a dummy component is created, with an empty path.++parseCppOutputComponents :: [String] -> [CppOutputComponent]+parseCppOutputComponents ss+ | any isLineMarker ss =+ flip repeatedly ss $+ \ls ->+ let (content, rest) = span (not . isLineMarker) (tail ls)+ cppComponent = CppOutputComponent (parseLineMarker $ head ls) content+ in (cppComponent, rest)+ | otherwise = [CppOutputComponent (LineMarker 1 "") ss]++-- | Discard the parts of cpp output which correspond to cpp include files. If+-- there's a unique component then we return that one, otherwise we return all+-- the components relative to our file other than the first (which has no real+-- meaning).+discardUnusefulComponents :: FilePath -> [CppOutputComponent] -> [CppOutputComponent]+discardUnusefulComponents _ [] =+ error+ "The function discardUnusefulComponents expects a non-empty list of components"+discardUnusefulComponents _ [c] = [c]+discardUnusefulComponents fp cs = filter ((== fp) . filePath . lineMarker) cs++-- | Adds padding to the source blocks to mantain the correct line numbers of+-- the source code.+reconstructSource :: [CppOutputComponent] -> [String]+reconstructSource = sourceBlock . foldr1 combine+ where+ combine (CppOutputComponent lm1 c1) (CppOutputComponent lm2 c2) =+ let padding = (beginsAtLine lm2 - beginsAtLine lm1 - length c1)+ in CppOutputComponent lm1 (c1 ++ replicate padding "" ++ c2)+
+ src/Language/C/Preprocessor/Remover/Internal/Preprocess.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE CPP, RecordWildCards #-}++{-|+Module : Language.C.Preprocessor.Remover.Internal.Preprocess+Description : Call GHC.preprocess at the Cpp phase+Copyright : (c) Carlo Nucera, 2016+License : BSD3+Maintainer : meditans@gmail.com+Stability : experimental+Portability : POSIX+-}++module Language.C.Preprocessor.Remover.Internal.Preprocess+ (+ -- * Entry point for parsing+ parseModuleWithCpp+ -- * Wrapper around GHC's preprocess+ , getPreprocessedSrcDirect+ ) where++import Control.Monad (void)+import Data.Tuple.Extra (fst3)+import Lens.Micro+import Language.C.Preprocessor.Remover.Internal.Types++#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>))+#endif++import qualified DriverPhases as GHC+import qualified DriverPipeline as GHC+import qualified DynFlags as GHC+import qualified GHC+import qualified GHC.Paths as GHC+import qualified HeaderInfo as GHC+import qualified HscTypes as GHC+import qualified MonadUtils as GHC++# if __GLASGOW_HASKELL__ >= 800+import qualified Language.Haskell.TH.LanguageExtensions as LE+# endif++--------------------------------------------------------------------------------+-- Entry point for parsing+--------------------------------------------------------------------------------++-- | Parse a module with specific instructions for the C pre-processor.+parseModuleWithCpp :: CppOptions -> FilePath -> IO String+parseModuleWithCpp cppOptions file = GHC.runGhc (Just GHC.libdir) $ do+ dflags <- initDynFlags file+#if __GLASGOW_HASKELL__ >= 800+ let useCpp = GHC.xopt LE.Cpp dflags+#else+ let useCpp = GHC.xopt GHC.Opt_Cpp dflags+#endif+ if useCpp+ then getPreprocessedSrcDirect cppOptions file+ else GHC.liftIO (readFile file)++-- | Given a config and a file, this function returns the correct dynFlags. For+-- now, this is only used to check if the Cpp extension is enabled (see the test+-- in parseModuleWithCpp), and thus it could be implemented differently. I'm+-- keeping this version to have all the flags, in case I decide later to offer+-- an entry point for ghc-api based analysis.+initDynFlags :: GHC.GhcMonad m => FilePath -> m GHC.DynFlags+initDynFlags file = do+ dflags0 <- GHC.getSessionDynFlags+ src_opts <- GHC.liftIO $ GHC.getOptionsFromFile dflags0 file+ dflags1 <- fst3 <$> GHC.parseDynamicFilePragma dflags0 src_opts+ let dflags2 = dflags1 {GHC.log_action = GHC.defaultLogAction}+ void $ GHC.setSessionDynFlags dflags2+ return dflags2++--------------------------------------------------------------------------------+-- Wrapper around GHC's preprocess+--------------------------------------------------------------------------------++-- | Invoke GHC's 'GHC.preprocess' function at the cpp phase, adding the+-- options specified in the first argument.+getPreprocessedSrcDirect :: GHC.GhcMonad m => CppOptions -> FilePath -> m String+getPreprocessedSrcDirect cppOptions file = do+ hscEnv <- injectCppOptions cppOptions <$> GHC.getSession+ (_, tempFile) <- GHC.liftIO $ GHC.preprocess hscEnv (file, cppPhase)+ GHC.liftIO (readFile tempFile)+ where+ cppPhase = Just (GHC.Cpp GHC.HsSrcFile)++injectCppOptions :: CppOptions -> GHC.HscEnv -> GHC.HscEnv+injectCppOptions CppOptions{..} = over (_hsc_dflags . _settings . _sOpt_P)+ (encodedOptions ++)+ where+ encodedOptions = map ("-D" ++) cppDefine+ ++ map ("-I" ++) cppInclude+ ++ map ("-include" ++) cppFile++--------------------------------------------------------------------------------+-- Some lenses to manipulate conveniently a HscEnv value+--------------------------------------------------------------------------------++_hsc_dflags :: Lens' GHC.HscEnv GHC.DynFlags+_hsc_dflags = lens GHC.hsc_dflags+ (\hscEnv dynFlags -> hscEnv {GHC.hsc_dflags = dynFlags})++_settings :: Lens' GHC.DynFlags GHC.Settings+_settings = lens GHC.settings+ (\dynFlags setting -> dynFlags {GHC.settings = setting})++_sOpt_P :: Lens' GHC.Settings [String]+_sOpt_P = lens GHC.sOpt_P+ (\setting strings -> setting {GHC.sOpt_P = strings})
+ src/Language/C/Preprocessor/Remover/Internal/Types.hs view
@@ -0,0 +1,56 @@+{-|+Module : Language.C.Preprocessor.Remover.Internal.Types+Description : Common types+Copyright : (c) Carlo Nucera, 2016+License : BSD3+Maintainer : meditans@gmail.com+Stability : experimental+Portability : POSIX+-}++module Language.C.Preprocessor.Remover.Internal.Types+ (+ -- * Options for the cpp preprocessor+ CppOptions (..)+ , emptyCppOptions+ -- * Aliases for the type signatures+ , ProjectDir+ , CabalFilePath+ ) where++--------------------------------------------------------------------------------+-- Options for the preprocessor+--------------------------------------------------------------------------------++-- | `CppOptions` represent the options which are passed, through the ghc api,+-- to the cpp preprocessing program. For reference,+-- <https://gcc.gnu.org/onlinedocs/gcc/Preprocessor-Options.html here> is the+-- part of the gcc manual corresponding to the preprocessing options.+data CppOptions = CppOptions+ { cppDefine :: [String]+ -- ^ CPP #define macros. Corresponds to a @-D@ option for the+ -- cpp program.+ , cppInclude :: [FilePath]+ -- ^ CPP Includes directory. Corresponds to a @-I@ option for+ -- the cpp program.+ , cppFile :: [FilePath]+ -- ^ CPP pre-include file. Corresponds to a @-include@ option+ -- for the cpp program.+ } deriving (Show)+++-- |+-- >>> emptyCppOptions+-- CppOptions {cppDefine = [], cppInclude = [], cppFile = []}+emptyCppOptions :: CppOptions+emptyCppOptions = CppOptions [] [] []++--------------------------------------------------------------------------------+-- Convenient aliases for the type signatures+--------------------------------------------------------------------------------++-- | ProjectDir is the directory which contains the .cabal file for the project.+type ProjectDir = FilePath++-- | The path of the main @.cabal@ file of the project.+type CabalFilePath = FilePath
+ test/Main.hs view
@@ -0,0 +1,157 @@+module Main where++import Language.Haskell.Exts+import Language.C.Preprocessor.Remover+import Language.C.Preprocessor.Remover.Internal.Types (CabalFilePath)+import Test.Hspec++import Control.Exception (bracket)+import Control.Monad (void)+import Data.List ((\\))+import System.Directory (getCurrentDirectory, setCurrentDirectory)+import System.IO.Temp (withSystemTempDirectory)+import System.Process (readCreateProcessWithExitCode, shell)++{- Note [Structure of the test suite]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++We are checking two properties for each libraries:++- every line which begins with # in the original file is either unchanged (maybe+ it's part of a comment or drawing, like in pipes) or has been substituted in+ the new file with a blank line. The relevant function is hashesAreProcessed.+- after preprocessing, the files are parsed without errors by haskell-src-exts+ (which can't parse cpp by itself). The relevant function is+ isParsedByHaskellSrcExts.++For comparison, here are some tests which don't work naively:++- checking that every line not starting with # is preserved (cpp may rightfully+ alter the lines, like it does in the lens library).+- checking that the files have the same number of lines: this may fail because+ the file is not padded after the end of the source.++These tests could be adapted, for example setting a limit on the edit distance+for the first one, or manually padding the end of the file for the second one.+For the moment I'll keep the simple tests I outlined earlier.+-}++-- Check some important libraries. I still have a problem in processing "text",+-- due to the enabling of some flags in the cabal file.+main :: IO ()+main = mapM_ testPackage testLibraries+ where+ testLibraries = [ "lens", "varying", "aeson", "pipes"+ , "conduit", "wreq", "haskell-src-exts" ]++-- Given the name of the package, builds it in a temporary location and executes+-- the tests.+testPackage :: String -> IO ()+testPackage packageName =+ withStackInstalledPackage packageName $ \cabalPath -> hspec $+ describe ("Testing " ++ packageName) $ do+ it "The lines beginning with # have been substituted with blank lines" $+ and <$> onAllFiles cabalPath hashesAreProcessed `shouldReturn` True+ it "The package is be parseable with haskell-src-exts" $+ and <$> onAllFiles cabalPath isParsedByHaskellSrcExts `shouldReturn` True++-- Wrapper function (in the spirit of bracket) which, given a package to install+-- and something to do with the cabal file path, initialize a temp directory,+-- does the action and cleans up.+withStackInstalledPackage :: String -> (FilePath -> IO ()) -> IO ()+withStackInstalledPackage packageName action =+ withSystemTempDirectory "preprocessorTest" $ \dir ->+ withCurrentDirectory dir $ do+ execCmd ("\nUnpacking " ++ packageName)+ ("stack unpack " ++ packageName)+ setCurrentDirectory =<< uniqueOutputOf "ls"+ execCmd ("Initializing " ++ packageName)+ ("stack init --solver --ignore-subdirs --silent")+ execCmd ("Building " ++ packageName)+ ("stack build --silent")+ action =<< uniqueOutputOf "ls *.cabal"++-- This function belongs to a new version on System.Directory, which is not yet+-- on hackage. When it's released, I should import it from that package.+withCurrentDirectory :: FilePath -- ^ Directory to execute in+ -> IO a -- ^ Action to be executed+ -> IO a+withCurrentDirectory dir action =+ bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do+ setCurrentDirectory dir+ action++-- Executes an action on every file listed as exported library file by the cabal+-- file.+onAllFiles :: CabalFilePath -> (FilePath -> IO a) -> IO [a]+onAllFiles cabalFilePath action = do+ sourceFiles <- getLibExposedModulesPath cabalFilePath+ mapM action sourceFiles++-- Convenience function to retrieve the result of a shell command, assuming it+-- fits in a single line (otherwise it takes the first line).+uniqueOutputOf :: String -> IO String+uniqueOutputOf cmd = do+ (_, stdout, _) <- readCreateProcessWithExitCode (shell cmd) ""+ return . head . lines $ stdout++-- Convenience function to execute the command in a bash-like fashion. The first+-- argument is a message to be printed, the second one the actual command like+-- it would be typed in shell.+execCmd :: String -> String -> IO ()+execCmd message cmd = do+ putStrLn message+ void $ readCreateProcessWithExitCode (shell cmd) ""++--------------------------------------------------------------------+-- Test: Checking that lines beginning with # have been processed --+--------------------------------------------------------------------++hashesAreProcessed :: FilePath -> IO Bool+hashesAreProcessed fp = do+ originFile <- readFile fp+ parsedFile <- preprocessFile fp+ return . and $ zipWith compatible (lines originFile) (lines parsedFile)+ where+ compatible s1@('#':_) s2 = null s2 || s1 == s2+ compatible _ _ = True++--------------------------------------------------------------------+-- Test: check that the files are parseable with haskell-src-exts --+--------------------------------------------------------------------++isParsedByHaskellSrcExts :: FilePath -> IO Bool+isParsedByHaskellSrcExts f = isParseResultOk+ . parseFileContentsWithComments parseMode+ <$> preprocessFile f+ where+ isParseResultOk :: ParseResult a -> Bool+ isParseResultOk (ParseOk _) = True+ isParseResultOk _ = False++{- Note [Passing extensions to the haskell-src-exts parser]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++The parser contained in haskell-src-exts may fail for the absence of the right+extensions coming from the cabal file. A common trick, used for example by:+https://github.com/ndmitchell/hlint/blob/e1c22030721999d4505eb14b19e6f8560a87507a/src/Util.hs+is to import all possible reasonable extensions by default. This solution is+temporary, until I find a better replacement.+-}++parseMode :: ParseMode+parseMode = defaultParseMode { fixities = Nothing, extensions = defaultExtensions }+ where+ defaultExtensions :: [Extension]+ defaultExtensions = [e | e@EnableExtension{} <- knownExtensions]+ \\ map EnableExtension badExtensions++badExtensions :: [KnownExtension]+badExtensions =+ [ Arrows -- steals proc+ , TransformListComp -- steals the group keyword+ , XmlSyntax, RegularPatterns -- steals a-b+ , UnboxedTuples -- breaks (#) lens operator+ , QuasiQuotes -- breaks [x| ...], making whitespace free list comps break+ , DoRec, RecursiveDo -- breaks rec+ ]