[QA] add trivial CPP by filtering line that starts by #.
doesn't really works without considering line escape
This commit is contained in:
parent
f86b493e32
commit
63cd28e3c2
31
QA.hs
31
QA.hs
@ -25,8 +25,17 @@ disallowedModules =
|
|||||||
[ (ModuleName "System.IO.Unsafe", ModuleName "Crypto.Internal.Compat")
|
[ (ModuleName "System.IO.Unsafe", ModuleName "Crypto.Internal.Compat")
|
||||||
, (ModuleName "Data.Byteable", ModuleName "Crypto.Internal.ByteArray")
|
, (ModuleName "Data.Byteable", ModuleName "Crypto.Internal.ByteArray")
|
||||||
, (ModuleName "Data.SecureMem", ModuleName "Crypto.Internal.ByteArray")
|
, (ModuleName "Data.SecureMem", ModuleName "Crypto.Internal.ByteArray")
|
||||||
|
, (ModuleName "Control.Applicative", ModuleName "Crypto.Internal.Imports")
|
||||||
]
|
]
|
||||||
|
|
||||||
|
perModuleAllowedModules =
|
||||||
|
[ ("Crypto/Internal/Imports.hs",
|
||||||
|
[ ModuleName "Control.Applicative"
|
||||||
|
]
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
main = do
|
main = do
|
||||||
modules <- findAllModules
|
modules <- findAllModules
|
||||||
mapM_ qa modules
|
mapM_ qa modules
|
||||||
@ -38,9 +47,13 @@ main = do
|
|||||||
Nothing -> printError "failed to parsed extensions"
|
Nothing -> printError "failed to parsed extensions"
|
||||||
Just (_, exts) -> qaExts file content exts
|
Just (_, exts) -> qaExts file content exts
|
||||||
|
|
||||||
qaExts file content exts = do
|
qaExts file contentRaw exts = do
|
||||||
printInfo "extensions" (intercalate ", " $ map show (getEnabledExts exts))
|
printInfo "extensions" (intercalate ", " $ map show (getEnabledExts exts))
|
||||||
|
|
||||||
|
let hasCPP = EnableExtension CPP `elem` exts
|
||||||
|
|
||||||
|
content <- if hasCPP then processCPP file contentRaw else return contentRaw
|
||||||
|
|
||||||
let mode = defaultParseMode { parseFilename = file, extensions = exts }
|
let mode = defaultParseMode { parseFilename = file, extensions = exts }
|
||||||
|
|
||||||
case parseModuleWithMode mode content of
|
case parseModuleWithMode mode content of
|
||||||
@ -60,7 +73,11 @@ main = do
|
|||||||
case lookup impMod disallowedModules of
|
case lookup impMod disallowedModules of
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
Just newMod | file == moduleToFile impMod -> return ()
|
Just newMod | file == moduleToFile impMod -> return ()
|
||||||
| otherwise -> printWarningImport impMod newMod
|
| otherwise -> do
|
||||||
|
let allowed = case lookup file perModuleAllowedModules of
|
||||||
|
Nothing -> False
|
||||||
|
Just allowedMods -> elem impMod allowedMods
|
||||||
|
unless allowed $ printWarningImport impMod newMod
|
||||||
|
|
||||||
moduleToFile (ModuleName m) =
|
moduleToFile (ModuleName m) =
|
||||||
intercalate "/" (wordsWhen (== '.') m) ++ ".hs"
|
intercalate "/" (wordsWhen (== '.') m) ++ ".hs"
|
||||||
@ -70,6 +87,16 @@ main = do
|
|||||||
"" -> []
|
"" -> []
|
||||||
s' -> w : wordsWhen p s'' where (w, s'') = break p s'
|
s' -> w : wordsWhen p s'' where (w, s'') = break p s'
|
||||||
|
|
||||||
|
processCPP file content = return $ simpleCPP
|
||||||
|
where
|
||||||
|
-- simple CPP just strip # starting line
|
||||||
|
simpleCPP = unlines $ filter (not . isHashStart) $ lines content
|
||||||
|
where
|
||||||
|
isHashStart s = case dropWhile (flip elem " \t\v") s of
|
||||||
|
[] -> False
|
||||||
|
'#':_ -> True
|
||||||
|
_ -> False
|
||||||
|
|
||||||
------------------------------------------------------------------------
|
------------------------------------------------------------------------
|
||||||
|
|
||||||
printHeader s =
|
printHeader s =
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user