-- | A module for useful utility functions for Shake build systems.
module Development.Shake.Util(
    parseMakefile, needMakefileDependencies, neededMakefileDependencies,
    shakeArgsAccumulate, shakeArgsPrune, shakeArgsPruneWith,
    ) where

import Development.Shake
import Development.Shake.Internal.Rules.File
import qualified Data.ByteString.Char8 as BS
import qualified General.Makefile as BS
import Data.Tuple.Extra
import Data.List
import General.GetOpt
import Data.IORef
import Data.Maybe
import Control.Monad.Extra
import System.IO.Extra as IO


-- | Given the text of a Makefile, extract the list of targets and dependencies. Assumes a
--   small subset of Makefile syntax, mostly that generated by @gcc -MM@.
--
-- > parseMakefile "a: b c\nd : e" == [("a",["b","c"]),("d",["e"])]
parseMakefile :: String -> [(FilePath, [FilePath])]
parseMakefile :: String -> [(String, [String])]
parseMakefile = forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> String
BS.unpack forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
*** forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
BS.unpack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [(ByteString, [ByteString])]
BS.parseMakefile forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack


-- | Depend on the dependencies listed in a Makefile. Does not depend on the Makefile itself.
--
-- > needMakefileDependencies file = need . concatMap snd . parseMakefile =<< liftIO (readFile file)
needMakefileDependencies :: FilePath -> Action ()
needMakefileDependencies :: String -> Action ()
needMakefileDependencies String
file = Partial => [ByteString] -> Action ()
needBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [(ByteString, [ByteString])]
BS.parseMakefile forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ByteString
BS.readFile String
file)


-- | Depend on the dependencies listed in a Makefile. Does not depend on the Makefile itself.
--   Use this function to indicate that you have /already/ used the files in question.
--
-- > neededMakefileDependencies file = needed . concatMap snd . parseMakefile =<< liftIO (readFile file)
neededMakefileDependencies :: FilePath -> Action ()
neededMakefileDependencies :: String -> Action ()
neededMakefileDependencies String
file = Partial => [ByteString] -> Action ()
neededBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [(ByteString, [ByteString])]
BS.parseMakefile forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ByteString
BS.readFile String
file)


-- | Like `shakeArgsWith`, but instead of accumulating a list of flags, apply functions to a default value.
--   Usually used to populate a record structure. As an example of a build system that can use either @gcc@ or @distcc@ for compiling:
--
-- @
-- import System.Console.GetOpt
--
-- data Flags = Flags {distCC :: Bool} deriving Eq
-- flags = [Option \"\" [\"distcc\"] (NoArg $ Right $ \\x -> x{distCC=True}) \"Run distributed.\"]
--
-- main = 'shakeArgsAccumulate' 'shakeOptions' flags (Flags False) $ \\flags targets -> pure $ Just $ do
--     if null targets then 'want' [\"result.exe\"] else 'want' targets
--     let compiler = if distCC flags then \"distcc\" else \"gcc\"
--     \"*.o\" '%>' \\out -> do
--         'need' ...
--         'cmd' compiler ...
--     ...
-- @
--
--   Now you can pass @--distcc@ to use the @distcc@ compiler.
shakeArgsAccumulate :: ShakeOptions -> [OptDescr (Either String (a -> a))] -> a -> (a -> [String] -> IO (Maybe (Rules ()))) -> IO ()
shakeArgsAccumulate :: forall a.
ShakeOptions
-> [OptDescr (Either String (a -> a))]
-> a
-> (a -> [String] -> IO (Maybe (Rules ())))
-> IO ()
shakeArgsAccumulate ShakeOptions
opts [OptDescr (Either String (a -> a))]
flags a
def a -> [String] -> IO (Maybe (Rules ()))
f = forall a.
ShakeOptions
-> [OptDescr (Either String a)]
-> ([a] -> [String] -> IO (Maybe (Rules ())))
-> IO ()
shakeArgsWith ShakeOptions
opts [OptDescr (Either String (a -> a))]
flags forall a b. (a -> b) -> a -> b
$ \[a -> a]
flags [String]
targets -> a -> [String] -> IO (Maybe (Rules ()))
f (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
($)) a
def [a -> a]
flags) [String]
targets


-- | Like 'shakeArgs' but also takes a pruning function. If @--prune@ is passed, then after the build has completed,
--   the second argument is called with a list of the files that the build checked were up-to-date.
shakeArgsPrune :: ShakeOptions -> ([FilePath] -> IO ()) -> Rules () -> IO ()
shakeArgsPrune :: ShakeOptions -> ([String] -> IO ()) -> Rules () -> IO ()
shakeArgsPrune ShakeOptions
opts [String] -> IO ()
prune Rules ()
rules = forall a.
ShakeOptions
-> ([String] -> IO ())
-> [OptDescr (Either String a)]
-> ([a] -> [String] -> IO (Maybe (Rules ())))
-> IO ()
shakeArgsPruneWith ShakeOptions
opts [String] -> IO ()
prune [] forall {f :: * -> *} {p}.
Applicative f =>
p -> [String] -> f (Maybe (Rules ()))
f
    where f :: p -> [String] -> f (Maybe (Rules ()))
f p
_ [String]
files = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
files then Rules ()
rules else Partial => [String] -> Rules ()
want [String]
files forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Rules a -> Rules a
withoutActions Rules ()
rules


-- | A version of 'shakeArgsPrune' that also takes a list of extra options to use.
shakeArgsPruneWith :: ShakeOptions -> ([FilePath] -> IO ()) -> [OptDescr (Either String a)] -> ([a] -> [String] -> IO (Maybe (Rules ()))) -> IO ()
shakeArgsPruneWith :: forall a.
ShakeOptions
-> ([String] -> IO ())
-> [OptDescr (Either String a)]
-> ([a] -> [String] -> IO (Maybe (Rules ())))
-> IO ()
shakeArgsPruneWith ShakeOptions
opts [String] -> IO ()
prune [OptDescr (Either String a)]
flags [a] -> [String] -> IO (Maybe (Rules ()))
act = do
    let flags2 :: [OptDescr (Either String (Maybe a))]
flags2 = forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"P" [String
"prune"] (forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a. Maybe a
Nothing) String
"Remove stale files" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a b.
(a -> b)
-> OptDescr (Either String a) -> OptDescr (Either String b)
fmapFmapOptDescr forall a. a -> Maybe a
Just) [OptDescr (Either String a)]
flags
    IORef Bool
pruning <- forall a. a -> IO (IORef a)
newIORef Bool
False
    forall a.
ShakeOptions
-> [OptDescr (Either String a)]
-> ([a] -> [String] -> IO (Maybe (Rules ())))
-> IO ()
shakeArgsWith ShakeOptions
opts [OptDescr (Either String (Maybe a))]
flags2 forall a b. (a -> b) -> a -> b
$ \[Maybe a]
opts [String]
args ->
        case forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Maybe a]
opts of
            Maybe [a]
Nothing -> do
                forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
pruning Bool
True
                forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
            Just [a]
opts -> [a] -> [String] -> IO (Maybe (Rules ()))
act [a]
opts [String]
args
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (forall a. IORef a -> IO a
readIORef IORef Bool
pruning) forall a b. (a -> b) -> a -> b
$
        forall a. (String -> IO a) -> IO a
IO.withTempFile forall a b. (a -> b) -> a -> b
$ \String
file -> do
            forall a.
ShakeOptions
-> [OptDescr (Either String a)]
-> ([a] -> [String] -> IO (Maybe (Rules ())))
-> IO ()
shakeArgsWith ShakeOptions
opts{shakeLiveFiles :: [String]
shakeLiveFiles=String
file forall a. a -> [a] -> [a]
: ShakeOptions -> [String]
shakeLiveFiles ShakeOptions
opts} [OptDescr (Either String (Maybe a))]
flags2 forall a b. (a -> b) -> a -> b
$ \[Maybe a]
opts [String]
args ->
                [a] -> [String] -> IO (Maybe (Rules ()))
act (forall a. [Maybe a] -> [a]
catMaybes [Maybe a]
opts) [String]
args
            [String]
src <- String -> [String]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
IO.readFile' String
file
            [String] -> IO ()
prune [String]
src