find-always-undefined-symbols.hs

import System.Directory
import System.Environment
import System.FilePath
import Control.Applicative ((<$>))
import Control.Arrow (first, second)
import Control.Monad (void)
import Data.Either (rights)
import Data.List (isSuffixOf)
import Data.Set (Set, (\\), empty, fromList, insert, singleton, toList, union)
import Text.Parsec
import Text.Parsec.ByteString

type Symbol = String

eol :: GenParser Char st Char
eol = char '\n'

skipManyTill :: GenParser Char st a -> GenParser Char st ()
skipManyTill end = void $ manyTill anyChar end

comment :: GenParser Char st ()
comment =
    let newStyle = string "//" >> skipMany (noneOf "\n")
        oldStyle = string "/*" >> skipManyTill (string "*/")
    in  try newStyle <|> try oldStyle <?> "comment"

lineSpaces :: GenParser Char st ()
lineSpaces = skipMany (char ' ' <|> char '\t')

symbol :: GenParser Char st Symbol
symbol = many1 (alphaNum <|> char '_')

ifdef :: GenParser Char st (Set Symbol)
ifdef = do
    char '#'
    lineSpaces
    try simple <|> try complex <?> "ifdef or if"
    where
        simple = do
            string "if"
            optional $ char 'n'
            string "def"
            lineSpaces
            fmap singleton symbol
        complex = string "if" >> fmap fromList (manyTill complexPart eol)
        complexPart = do
            lineSpaces
            optional $ char '!'
            string "defined"
            char '('
            sym <- symbol
            char ')'
            lineSpaces
            optional $ string "&&" <|> string "||"
            lineSpaces
            optional $ char '\\' >> lineSpaces >> eol
            return sym

define :: GenParser Char st Symbol
define = do
    char '#'
    lineSpaces
    string "define"
    lineSpaces
    symbol

cParser :: GenParser Char st (Set Symbol, Set Symbol)
cParser =
    try (eof >> return (empty, empty))
    <|> try (comment >> cParser)
    <|> try (ifdef >>= \syms -> fmap (first $ union syms) cParser)
    <|> try (define >>= \sym -> fmap (second $ insert sym) cParser)
    <|> (anyChar >> cParser)

findCFiles :: FilePath -> IO [FilePath]
findCFiles root =
    getDirectoryContents root >>=
        fmap concat . mapM check . filter ((/= '.') . head)
    where
        check path = do
            isDirectory <- doesDirectoryExist $ root </> path
            let isSource = ".c" `isSuffixOf` path || ".h" `isSuffixOf` path
            case (isDirectory, isSource) of
                (True, _) -> findCFiles $ root </> path
                (_, True) -> return [root </> path]
                _         -> return []

foldTuples :: (a -> a -> a) -> [(a, a)] -> (a, a)
foldTuples f xs = (foldl1 f $ map fst xs, foldl1 f $ map snd xs)

getSymbols ::
    Ord a => GenParser Char () (Set a, Set a) -> [FilePath] -> IO (Set a, Set a)
getSymbols parser =
    fmap (foldTuples union . rights) . mapM (parseFromFile parser)

main :: IO ()
main = do
    [projectRoot] <- getArgs
    let config = projectRoot </> "config/config.h.in"
    cFiles <- (config:) <$> findCFiles projectRoot
    (used, defined) <- getSymbols cParser cFiles
    mapM_ putStrLn $ toList $ used \\ defined