Dependency.x

{
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module Language.C.Dependency ( getIncludes
                             , getIncludesText
                             , getCDepends
                             , getAll
                             ) where

import Control.Monad (filterM)
import qualified Data.ByteString.Lazy as BSL
import Data.Foldable (fold)
import Data.List (groupBy, group, sort)
import Data.Maybe (fromMaybe)
import qualified Data.Text.Lazy as TL
import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)
import Control.Monad.IO.Class
import System.Directory (doesFileExist)
import System.FilePath ((</>), takeDirectory)
import System.Environment (lookupEnv)

}

%wrapper "monad-bytestring"

$special_char = [\\ntrba\"]
$inner_char = [^\\]

@esc_char = \\ $special_char
@string = \" (@esc_char | $inner_char)* \"

@include = "#include" | "#include" $white+ \\\n

@comment_inner_char = ([^\*] | \* [^\/])

tokens :-

    $white+                      ;
    "//".*                       ;

    -- FIXME: no nested comments in C
    "/*" @comment_inner_char* "*/" ;

    @include                     { \_ _ -> alex Include }
    @string                      { tok (\_ s -> alex (StringTok (TL.unpack (decodeUtf8 s)))) }

    $printable                   ;

{

data Token = Include
           | StringTok String
           | End

tok f (p,_,s,_) len = f p (BSL.take len s)

alex :: a -> Alex a
alex = pure

alexEOF :: Alex Token
alexEOF = pure End

-- | Given a 'ByteString' containing C, return a list of filepaths it @#include@s.
getIncludes :: BSL.ByteString -> Either String [FilePath]
getIncludes = fmap extractDeps . lexC

getIncludesText :: TL.Text -> Either String [FilePath]
getIncludesText = getIncludes . encodeUtf8

extractDeps :: [Token] -> [FilePath]
extractDeps [] = []
extractDeps (Include:StringTok s:xs) = toInclude s : extractDeps xs
extractDeps (_:xs) = extractDeps xs

toInclude :: String -> FilePath
toInclude = tail . init

lexC :: BSL.ByteString -> Either String [Token]
lexC = flip runAlex loop

loop :: Alex [Token]
loop = do
    tok' <- alexMonadScan
    case tok' of
        End -> pure []
        _ -> (tok' :) <$> loop

includes' :: BSL.ByteString -> [FilePath]
includes' = either error id . getIncludes

split :: String -> [String]
split = filter (/= ":") . groupBy g
    where g ':' _ = False
          g _ ':' = False
          g _ _   = True

-- | Get any filepaths that were @#include@-ed in a C source file.
getCDepends :: MonadIO m
            => [FilePath] -- ^ Directories to search in
            -> FilePath -- ^ Path to C source file
            -> m [FilePath]
getCDepends incls src = liftIO $ do
    contents <- BSL.readFile src
    envPath <- lookupEnv "C_INCLUDE_PATH"
    let incl = includes' contents
        dir = takeDirectory src
        allDirs = dir : incls ++ fromMaybe [] (split <$> envPath)
    filterM doesFileExist ((</>) <$> allDirs <*> incl)

-- | Get transitive dependencies of a C source file.
getAll :: MonadIO m
       => [FilePath] -- ^ Directories for included header/source files
       -> FilePath -- ^ File name
       -> m [FilePath]
getAll incls src = do
    deps <- getCDepends incls src
    level <- traverse (getAll incls) deps
    let rmdups = fmap head . group . sort
        next = rmdups (fold (deps : level))
    pure $ if null level then deps else next

}