-- | 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 = ((ByteString, [ByteString]) -> (String, [String]))
-> [(ByteString, [ByteString])] -> [(String, [String])]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> String
BS.unpack (ByteString -> String)
-> ([ByteString] -> [String])
-> (ByteString, [ByteString])
-> (String, [String])
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
*** (ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
BS.unpack) ([(ByteString, [ByteString])] -> [(String, [String])])
-> (String -> [(ByteString, [ByteString])])
-> String
-> [(String, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [(ByteString, [ByteString])]
BS.parseMakefile (ByteString -> [(ByteString, [ByteString])])
-> (String -> ByteString) -> String -> [(ByteString, [ByteString])]
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 file :: String
file = Partial => [ByteString] -> Action ()
[ByteString] -> Action ()
needBS ([ByteString] -> Action ())
-> (ByteString -> [ByteString]) -> ByteString -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, [ByteString]) -> [ByteString])
-> [(ByteString, [ByteString])] -> [ByteString]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ByteString, [ByteString]) -> [ByteString]
forall a b. (a, b) -> b
snd ([(ByteString, [ByteString])] -> [ByteString])
-> (ByteString -> [(ByteString, [ByteString])])
-> ByteString
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [(ByteString, [ByteString])]
BS.parseMakefile (ByteString -> Action ()) -> Action ByteString -> Action ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ByteString -> Action ByteString
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 file :: String
file = Partial => [ByteString] -> Action ()
[ByteString] -> Action ()
neededBS ([ByteString] -> Action ())
-> (ByteString -> [ByteString]) -> ByteString -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, [ByteString]) -> [ByteString])
-> [(ByteString, [ByteString])] -> [ByteString]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ByteString, [ByteString]) -> [ByteString]
forall a b. (a, b) -> b
snd ([(ByteString, [ByteString])] -> [ByteString])
-> (ByteString -> [(ByteString, [ByteString])])
-> ByteString
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [(ByteString, [ByteString])]
BS.parseMakefile (ByteString -> Action ()) -> Action ByteString -> Action ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ByteString -> Action ByteString
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 :: ShakeOptions
-> [OptDescr (Either String (a -> a))]
-> a
-> (a -> [String] -> IO (Maybe (Rules ())))
-> IO ()
shakeArgsAccumulate opts :: ShakeOptions
opts flags :: [OptDescr (Either String (a -> a))]
flags def :: a
def f :: a -> [String] -> IO (Maybe (Rules ()))
f = ShakeOptions
-> [OptDescr (Either String (a -> a))]
-> ([a -> a] -> [String] -> IO (Maybe (Rules ())))
-> IO ()
forall a.
ShakeOptions
-> [OptDescr (Either String a)]
-> ([a] -> [String] -> IO (Maybe (Rules ())))
-> IO ()
shakeArgsWith ShakeOptions
opts [OptDescr (Either String (a -> a))]
flags (([a -> a] -> [String] -> IO (Maybe (Rules ()))) -> IO ())
-> ([a -> a] -> [String] -> IO (Maybe (Rules ()))) -> IO ()
forall a b. (a -> b) -> a -> b
$ \flags :: [a -> a]
flags targets :: [String]
targets -> a -> [String] -> IO (Maybe (Rules ()))
f ((a -> (a -> a) -> a) -> a -> [a -> a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((a -> a) -> a -> a) -> a -> (a -> a) -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> a) -> a -> a
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 opts :: ShakeOptions
opts prune :: [String] -> IO ()
prune rules :: Rules ()
rules = ShakeOptions
-> ([String] -> IO ())
-> [OptDescr (Either String Any)]
-> ([Any] -> [String] -> IO (Maybe (Rules ())))
-> IO ()
forall a.
ShakeOptions
-> ([String] -> IO ())
-> [OptDescr (Either String a)]
-> ([a] -> [String] -> IO (Maybe (Rules ())))
-> IO ()
shakeArgsPruneWith ShakeOptions
opts [String] -> IO ()
prune [] [Any] -> [String] -> IO (Maybe (Rules ()))
forall (f :: * -> *) p.
Applicative f =>
p -> [String] -> f (Maybe (Rules ()))
f
    where f :: p -> [String] -> f (Maybe (Rules ()))
f _ files :: [String]
files = Maybe (Rules ()) -> f (Maybe (Rules ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Rules ()) -> f (Maybe (Rules ())))
-> Maybe (Rules ()) -> f (Maybe (Rules ()))
forall a b. (a -> b) -> a -> b
$ Rules () -> Maybe (Rules ())
forall a. a -> Maybe a
Just (Rules () -> Maybe (Rules ())) -> Rules () -> Maybe (Rules ())
forall a b. (a -> b) -> a -> b
$ if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
files then Rules ()
rules else Partial => [String] -> Rules ()
[String] -> Rules ()
want [String]
files Rules () -> Rules () -> Rules ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Rules () -> Rules ()
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 :: ShakeOptions
-> ([String] -> IO ())
-> [OptDescr (Either String a)]
-> ([a] -> [String] -> IO (Maybe (Rules ())))
-> IO ()
shakeArgsPruneWith opts :: ShakeOptions
opts prune :: [String] -> IO ()
prune flags :: [OptDescr (Either String a)]
flags act :: [a] -> [String] -> IO (Maybe (Rules ()))
act = do
    let flags2 :: [OptDescr (Either String (Maybe a))]
flags2 = String
-> [String]
-> ArgDescr (Either String (Maybe a))
-> String
-> OptDescr (Either String (Maybe a))
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "P" ["prune"] (Either String (Maybe a) -> ArgDescr (Either String (Maybe a))
forall a. a -> ArgDescr a
NoArg (Either String (Maybe a) -> ArgDescr (Either String (Maybe a)))
-> Either String (Maybe a) -> ArgDescr (Either String (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing) "Remove stale files" OptDescr (Either String (Maybe a))
-> [OptDescr (Either String (Maybe a))]
-> [OptDescr (Either String (Maybe a))]
forall a. a -> [a] -> [a]
: (OptDescr (Either String a) -> OptDescr (Either String (Maybe a)))
-> [OptDescr (Either String a)]
-> [OptDescr (Either String (Maybe a))]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Maybe a)
-> OptDescr (Either String a) -> OptDescr (Either String (Maybe a))
forall a b.
(a -> b)
-> OptDescr (Either String a) -> OptDescr (Either String b)
fmapFmapOptDescr a -> Maybe a
forall a. a -> Maybe a
Just) [OptDescr (Either String a)]
flags
    IORef Bool
pruning <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
    ShakeOptions
-> [OptDescr (Either String (Maybe a))]
-> ([Maybe a] -> [String] -> IO (Maybe (Rules ())))
-> IO ()
forall a.
ShakeOptions
-> [OptDescr (Either String a)]
-> ([a] -> [String] -> IO (Maybe (Rules ())))
-> IO ()
shakeArgsWith ShakeOptions
opts [OptDescr (Either String (Maybe a))]
flags2 (([Maybe a] -> [String] -> IO (Maybe (Rules ()))) -> IO ())
-> ([Maybe a] -> [String] -> IO (Maybe (Rules ()))) -> IO ()
forall a b. (a -> b) -> a -> b
$ \opts :: [Maybe a]
opts args :: [String]
args ->
        case [Maybe a] -> Maybe [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Maybe a]
opts of
            Nothing -> do
                IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
pruning Bool
True
                Maybe (Rules ()) -> IO (Maybe (Rules ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Rules ())
forall a. Maybe a
Nothing
            Just opts :: [a]
opts -> [a] -> [String] -> IO (Maybe (Rules ()))
act [a]
opts [String]
args
    IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
pruning) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        (String -> IO ()) -> IO ()
forall a. (String -> IO a) -> IO a
IO.withTempFile ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \file :: String
file -> do
            ShakeOptions
-> [OptDescr (Either String (Maybe a))]
-> ([Maybe a] -> [String] -> IO (Maybe (Rules ())))
-> IO ()
forall a.
ShakeOptions
-> [OptDescr (Either String a)]
-> ([a] -> [String] -> IO (Maybe (Rules ())))
-> IO ()
shakeArgsWith ShakeOptions
opts{shakeLiveFiles :: [String]
shakeLiveFiles=String
file String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ShakeOptions -> [String]
shakeLiveFiles ShakeOptions
opts} [OptDescr (Either String (Maybe a))]
flags2 (([Maybe a] -> [String] -> IO (Maybe (Rules ()))) -> IO ())
-> ([Maybe a] -> [String] -> IO (Maybe (Rules ()))) -> IO ()
forall a b. (a -> b) -> a -> b
$ \opts :: [Maybe a]
opts args :: [String]
args ->
                [a] -> [String] -> IO (Maybe (Rules ()))
act ([Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes [Maybe a]
opts) [String]
args
            [String]
src <- String -> [String]
lines (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
IO.readFile' String
file
            [String] -> IO ()
prune [String]
src