hscope 0.1.2 → 0.2
raw patch · 3 files changed
+39/−26 lines, 3 filesdep +cpphs
Dependencies added: cpphs
Files
- HScope.hs +32/−23
- hscope.cabal +2/−2
- t/Build.hs +5/−1
HScope.hs view
@@ -20,11 +20,14 @@ import Data.Generics.Uniplate.Data (transformBiM) import System.Directory (doesFileExist) import Data.Data+import Language.Preprocessor.Cpphs (runCpphs, defaultCpphsOptions, CpphsOptions(..)) -data Flag = Build Bool | File FilePath | Line | Query String | CPPInclude String deriving (Show)+data Flag = Build Bool | File FilePath | Line | Query String+ | CPPInclude String | OExtension String deriving (Show) data Config = Config { cBuild :: Bool, cFile :: FilePath, cLine :: Bool- , cQuery :: Maybe String, cCPPIncludes :: [String] } deriving Show+ , cQuery :: Maybe String, cCPPIncludes :: [String]+ , cExtensions :: [String] } deriving Show data IType = Definition | Call deriving (Enum, Show, Eq) data Info = Info IType String Int B.ByteString deriving Show@@ -53,25 +56,31 @@ , Option ['f'] [ "file" ] (ReqArg File "REFFILE") $ "Use REFFILE as the cross-reference file name instead of the default" ++ " \"hscope.out\""- , Option ['1'] [ "definition" ] (ReqArg (Query . ('1':)) "SYMBOL") $ "Find the definition of the SYMBOL"- , Option ['3'] [ "callers" ] (ReqArg (Query . ('3':)) "SYMBOL") $ "Find SYMBOLs calling this SYMBOL"+ , Option ['1'] [ "definition" ] (ReqArg (Query . ('1':)) "SYMBOL")+ $ "Find the definition of the SYMBOL"+ , Option ['3'] [ "callers" ] (ReqArg (Query . ('3':)) "SYMBOL")+ $ "Find SYMBOLs calling this SYMBOL" , Option ['4'] [ "text" ] (ReqArg (Query . ('4':)) "TEXT") $ "Find TEXT in files"- , Option ['7'] [ "file" ] (ReqArg (Query . ('7':)) "FILE") $ "Find files matching FILE"- , Option ['I'] [ "cpp-include" ] (ReqArg CPPInclude "DIRECTORY") $ "Include path for CPP preprocessor"+ , Option ['7'] [ "file" ] (ReqArg (Query . ('7':)) "FILE")+ $ "Find files matching FILE"+ , Option ['I'] [ "cpp-include" ] (ReqArg CPPInclude "DIRECTORY")+ $ "Include path for CPP preprocessor"+ , Option ['X'] [ "extension" ] (ReqArg OExtension "EXTENSION") $ "Add GHC extension" ] parseFlags :: [Flag] -> Config-parseFlags = foldl' go $ Config False "hscope.out" False Nothing [] where+parseFlags = foldl' go $ Config False "hscope.out" False Nothing [] [] where go c (Build b) = c { cBuild = b } go c (File f) = c { cFile = f } go c Line = c { cLine = True } go c (Query q) = c { cQuery = Just q } go c (CPPInclude i) = c { cCPPIncludes = i:(cCPPIncludes c) }+ go c (OExtension i) = c { cExtensions = i:(cExtensions c) } addInfo :: Lines -> IType -> Name SrcSpanInfo -> CDBMake addInfo vec ity n = cdbAdd f $ encode $ Info ity (fileName src) (fst lp) (snd lp) where l = startLine src- lp = maybe (error $ "Bad line: " ++ show n ++ ", " ++ show vec) id $ vec V.!? (l - 1)+ lp = maybe (error $ "Bad line: " ++ show n ++ ", " ++ show vec) id $ vec V.!? (l - 2) (src, f) = case n of (Ident src' f') -> (src', f') (Symbol src' f') -> (src', f')@@ -104,31 +113,30 @@ mapLines :: Show a => FilePath -> [a] -> [String] -> [a] mapLines f to = reverse . snd . foldl' go ((to, True), []) where- go ((xs@(x:_), _), res) ('#':str) = ((xs, isInfixOf f str), x:res)- go (((x:xs), True), res) _ = ((xs, True), x:res)- go ((xs@(x:_), False), res) _ = ((xs, False), x:res)- go t l = error $ "mapLines: " ++ show t ++ " at " ++ l+ go t ('#':str) = let ((xs, _), res) = ret t in ((xs, isInfixOf f str), res)+ go t _ = ret t+ ret ((a@(x:xs), b), res) = ((if b then xs else a, b), x:res)+ ret t = t preprocess :: [String] -> FilePath -> IO (String, Lines) preprocess idirs f = do- origs <- B.lines <$> (liftIO $ B.readFile f)- flns <- fmap lines $ readProcess "cpp" (incs ++ [ "-traditional-cpp", f ]) ""- return (fconts flns, V.fromList $ mapLines f (zip [1 ..] origs) flns)+ rf <- B.readFile f+ flns <- fmap lines $ runCpphs cpphsOpts f $ B.unpack rf+ return (fconts flns, V.fromList $ mapLines f (zip [1 ..] $ B.lines rf) flns) where fconts = intercalate "\n" . map cmnt cmnt ('#':_) = "" cmnt x = x- incs = concatMap (\i -> [ "-I", i ]) idirs+ cpphsOpts = defaultCpphsOptions { includes = idirs } -parseCurrentFile :: FilePath -> String -> Either String (Module SrcSpanInfo)-parseCurrentFile f fstr = go [] where- go exts = case parseFileContentsWithMode (pmode exts) fstr of+parseCurrentFile :: FilePath -> String -> [Extension] -> Either String (Module SrcSpanInfo)+parseCurrentFile f fstr exts = case parseFileContentsWithMode (pmode exts) fstr of ParseOk m -> Right m ParseFailed src str -> let (ext, rest) = break (== ' ') str in if rest == " is not enabled"- then go ((classifyExtension ext):exts)- else Left $ str ++ " for " ++ f ++ " at " ++ show src- pmode exts = defaultParseMode { fixities = Just []- , extensions = exts+ then parseCurrentFile f fstr ((classifyExtension ext):exts)+ else Left $ str ++ " for " ++ f ++ " at " ++ show src ++ " with " ++ show exts+ where pmode exs = defaultParseMode { fixities = Just []+ , extensions = exs , parseFilename = f } buildOne :: Config -> FilePath -> CDBMake@@ -136,6 +144,7 @@ cdbAdd "0_hs_files" f (fstr, lns) <- liftIO $ preprocess (cCPPIncludes cfg) f either (liftIO . putStrLn) (go lns) $ parseCurrentFile f fstr+ $ map classifyExtension $ cExtensions cfg where go lns modul = do traverseAST (handleDefinitions lns) modul traverseAST (handleCalls lns) modul
hscope.cabal view
@@ -1,5 +1,5 @@ Name: hscope-Version: 0.1.2+Version: 0.2 License: BSD3 License-File: COPYING Category: source-tools@@ -38,7 +38,7 @@ Main-Is: HScope.hs GHC-Options: -Wall Build-Depends: base (< 5), hs-cdb, haskell-src-exts, mtl, uniplate, cereal- , vector, bytestring, process, directory+ , vector, bytestring, process, directory, cpphs Default-Language: Haskell2010 test-suite Build
t/Build.hs view
@@ -23,7 +23,7 @@ main :: IO () main = withTemporaryDirectory "/tmp/hscope_test_XXXXXX" $ \td -> testSimpleMain $ do- plan 45+ plan 46 hpath <- liftIO $ canonicalizePath "./dist/build/hscope/hscope" tfile <- liftIO $ canonicalizePath "./t/files/Simple.hs" ec1 <- liftIO $ system $ "cd " ++ td ++ " && " ++ hpath ++ " -b " ++ tfile@@ -136,5 +136,9 @@ res19 <- liftIO $ readProcess hpath [ "-d", "-f", td ++ "/foo.out" , "-3", "==>" ] "" like res19 "0 ==>"++ res20 <- liftIO $ readProcess hpath [ "--build", "-f", td ++ "/foo.out"+ , "-X", "MagicHash", "t/files/Unbox.hs" ] ""+ is res20 $ "" return ()