-- | 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 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 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 ShakeOptions
opts [OptDescr (Either String (a -> a))]
flags a
def 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
$ \[a -> a]
flags [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 ShakeOptions
opts [String] -> IO ()
prune 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 p
_ [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 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 = String
-> [String]
-> ArgDescr (Either String (Maybe a))
-> String
-> OptDescr (Either String (Maybe a))
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"P" [String
"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) String
"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
$ \[Maybe a]
opts [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
            Maybe [a]
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 [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
$ \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
$ \[Maybe a]
opts [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