-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE OverloadedStrings #-}
module Shake.CcDeps (enableDefines, includesOf, transitiveIncludesOf) where
import Control.Monad
import qualified Control.Monad.Trans as Trans
import qualified Data.ByteString.Char8 as B
import qualified Data.Char as Char
import qualified Data.Either as Either
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set

import qualified Development.Shake as Shake
import qualified System.Directory as Directory
import qualified System.FilePath as FilePath
import System.FilePath ((</>))

import qualified Shake.Util as Util


-- * defines

-- | Rewrite a file, switching @#define@s to @#undef@s and vice versa.
enableDefines :: FilePath -> [String] -> [String] -> IO ()
enableDefines :: FilePath -> [FilePath] -> [FilePath] -> IO ()
enableDefines FilePath
fn [FilePath]
defines [FilePath]
undefs = do
    ByteString
orig <- FilePath -> IO ByteString
B.readFile FilePath
fn
    let out :: ByteString
out = [ByteString] -> ByteString
B.unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
process forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
B.lines ByteString
orig
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
orig forall a. Eq a => a -> a -> Bool
/= ByteString
out) forall a b. (a -> b) -> a -> b
$
        FilePath -> ByteString -> IO ()
B.writeFile FilePath
fn ByteString
out
    where
    trans :: Map ByteString ByteString
trans = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
        [(ByteString
"#undef " forall a. Semigroup a => a -> a -> a
<> ByteString
define, ByteString
"#define " forall a. Semigroup a => a -> a -> a
<> ByteString
define)
            | ByteString
define <- forall a b. (a -> b) -> [a] -> [b]
map FilePath -> ByteString
B.pack [FilePath]
defines]
        forall a. [a] -> [a] -> [a]
++ [(ByteString
"#define " forall a. Semigroup a => a -> a -> a
<> ByteString
undef, ByteString
"#undef " forall a. Semigroup a => a -> a -> a
<> ByteString
undef)
            | ByteString
undef <- forall a b. (a -> b) -> [a] -> [b]
map FilePath -> ByteString
B.pack [FilePath]
undefs]
    process :: ByteString -> ByteString
process ByteString
line = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault ByteString
line ByteString
line Map ByteString ByteString
trans

-- * includes

-- | Same as 'Shake.HsDeps.Generated'.
type Generated = Set.Set FilePath

-- | Unlike HsDeps.importsOf, I return the not-found paths instead of ignoring
-- them.  This is because I assume not-found haskell imports are from external
-- packages, while #include with double-quotes is a sign it should be found
-- locally.
includesOf :: Generated -> [FilePath] -> FilePath
    -> Shake.Action ([FilePath], [FilePath])
    -- ^ (foundIncludes, notFoundIncludes)
includesOf :: Generated
-> [FilePath] -> FilePath -> Action ([FilePath], [FilePath])
includesOf Generated
generated [FilePath]
dirs FilePath
fn =
    Partial => [FilePath] -> Action ()
Shake.need [FilePath
fn] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadIO m => IO a -> m a
Trans.liftIO (Generated -> [FilePath] -> FilePath -> IO ([FilePath], [FilePath])
includesOfIO Generated
generated [FilePath]
dirs FilePath
fn)

-- | Find files this files includes, transitively.  Includes the given file.
--
-- Can also be used for .hsc files since it looks for @^#include@.  There isn't
-- an IO version because it 'Shake.need's the intermediate files.
transitiveIncludesOf :: Generated -> [FilePath] -> FilePath
    -> Shake.Action ([FilePath], [FilePath]) -- ^ ([found], [notFound])
transitiveIncludesOf :: Generated
-> [FilePath] -> FilePath -> Action ([FilePath], [FilePath])
transitiveIncludesOf Generated
generated [FilePath]
dirs FilePath
fn = Generated
-> Generated -> [FilePath] -> Action ([FilePath], [FilePath])
go forall a. Set a
Set.empty forall a. Set a
Set.empty [FilePath
fn]
    where
    go :: Generated
-> Generated -> [FilePath] -> Action ([FilePath], [FilePath])
go Generated
checked Generated
notFound (FilePath
fn:[FilePath]
fns)
        | FilePath
fn forall a. Ord a => a -> Set a -> Bool
`Set.member` Generated
checked Bool -> Bool -> Bool
|| FilePath
fn forall a. Ord a => a -> Set a -> Bool
`Set.member` Generated
notFound =
            Generated
-> Generated -> [FilePath] -> Action ([FilePath], [FilePath])
go Generated
checked Generated
notFound [FilePath]
fns
        | Bool
otherwise = do
            ([FilePath]
includes, [FilePath]
notFounds) <- Generated
-> [FilePath] -> FilePath -> Action ([FilePath], [FilePath])
includesOf Generated
generated [FilePath]
dirs FilePath
fn
            let checked' :: Generated
checked' = forall a. Ord a => a -> Set a -> Set a
Set.insert FilePath
fn Generated
checked
            Generated
-> Generated -> [FilePath] -> Action ([FilePath], [FilePath])
go Generated
checked' (forall a. Ord a => Set a -> Set a -> Set a
Set.union Generated
notFound (forall a. Ord a => [a] -> Set a
Set.fromList [FilePath]
notFounds))
                ([FilePath]
fns forall a. [a] -> [a] -> [a]
++ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Generated
checked') [FilePath]
includes)
    go Generated
checked Generated
notFound [] = forall (m :: * -> *) a. Monad m => a -> m a
return
        (forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
FilePath.normalise (forall a. Set a -> [a]
Set.toList Generated
checked), forall a. Set a -> [a]
Set.toList Generated
notFound)

includesOfIO :: Generated -> [FilePath] -> FilePath
    -> IO ([FilePath], [FilePath]) -- ^ (foundIncludes, notFoundIncludes)
includesOfIO :: Generated -> [FilePath] -> FilePath -> IO ([FilePath], [FilePath])
includesOfIO Generated
generated [FilePath]
dirs FilePath
fn = do
    [FilePath]
includes <- FilePath -> IO [FilePath]
readIncludes FilePath
fn
    -- @#include "x"@ starts searching from the same directory as the source
    -- file.
    [Maybe FilePath]
paths <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO (Maybe FilePath)
find1 [FilePath]
includes
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. [Either a b] -> ([a], [b])
Either.partitionEithers
        [forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. b -> Either a b
Right FilePath
inc) forall a b. a -> Either a b
Left Maybe FilePath
path | (Maybe FilePath
path, FilePath
inc) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe FilePath]
paths [FilePath]
includes]
    where
    find1 :: FilePath -> IO (Maybe FilePath)
find1 FilePath
include
        | FilePath
include forall a. Ord a => a -> Set a -> Bool
`Set.member` Generated
generated = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just FilePath
include
        | Bool
otherwise = [FilePath] -> FilePath -> IO (Maybe FilePath)
find (FilePath -> FilePath
FilePath.dropFileName FilePath
fn forall a. a -> [a] -> [a]
: [FilePath]
dirs) FilePath
include

find :: [FilePath] -> FilePath -> IO (Maybe FilePath)
find :: [FilePath] -> FilePath -> IO (Maybe FilePath)
find [] FilePath
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
find (FilePath
dir:[FilePath]
dirs) FilePath
fn = forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
Util.ifM (FilePath -> IO Bool
Directory.doesFileExist (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
fn))
    (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
FilePath.normalise forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
fn)
    ([FilePath] -> FilePath -> IO (Maybe FilePath)
find [FilePath]
dirs FilePath
fn)

-- | TODO #includes can be anywhere, but stop parsing as soon as a function
-- definition is hit
readIncludes :: FilePath -> IO [FilePath]
readIncludes :: FilePath -> IO [FilePath]
readIncludes = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe ByteString -> Maybe FilePath
parseLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.lines) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
B.readFile

-- | Intentionally ignore @#include <x>@ lines, they are just system includes.
parseLine :: B.ByteString -> Maybe FilePath
parseLine :: ByteString -> Maybe FilePath
parseLine ByteString
line
    | ByteString
include ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
line = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> FilePath
B.unpack (ByteString -> Maybe ByteString
extract ByteString
line)
    | Bool
otherwise = forall a. Maybe a
Nothing
    where
    extract :: ByteString -> Maybe ByteString
extract = ByteString -> Maybe ByteString
quotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
B.dropWhile Char -> Bool
Char.isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
include)
    quotes :: ByteString -> Maybe ByteString
quotes ByteString
s
        | Bool -> Bool
not (ByteString -> Bool
B.null ByteString
s) Bool -> Bool -> Bool
&& ByteString -> Int -> Char
B.index ByteString
s Int
0 forall a. Eq a => a -> a -> Bool
== Char
'"' =
            forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
B.takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
'"') (Int -> ByteString -> ByteString
B.drop Int
1 ByteString
s)
        | Bool
otherwise = forall a. Maybe a
Nothing
    include :: ByteString
include = ByteString
"#include "