{-# LANGUAGE ScopedTypeVariables #-}
module Development.Shake.Internal.Derived(
copyFile', copyFileChanged,
readFile', readFileLines,
writeFile', writeFileLines, writeFileChanged,
withTempFile, withTempDir,
withTempFileWithin, withTempDirWithin,
getHashedShakeVersion,
getShakeExtra, getShakeExtraRules, addShakeExtra,
par, forP,
newResource, newThrottle, withResources,
newCache
) where
import Control.Monad.Extra
import Control.Monad.IO.Class
import System.Directory
import System.FilePath (takeDirectory)
import System.IO (IOMode (..), hGetContents, withFile)
import qualified System.IO.Extra as IO
import Development.Shake.Internal.Errors
import Development.Shake.Internal.Resource
import Development.Shake.Internal.Core.Types
import Development.Shake.Internal.Core.Action
import Development.Shake.Internal.Core.Rules
import Development.Shake.Internal.Options
import Development.Shake.Internal.Rules.File
import qualified Data.ByteString as BS
import qualified Data.HashMap.Strict as Map
import General.Extra
import Data.List.Extra
import Data.Hashable
import Data.Typeable
import Data.Dynamic
getHashedShakeVersion :: [FilePath] -> IO String
getHashedShakeVersion :: [FilePath] -> IO FilePath
getHashedShakeVersion [FilePath]
files = do
[Int]
hashes <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
BS.readFile) [FilePath]
files
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath
"hash-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
0 [Int]
hashes)
getShakeExtra :: Typeable a => Action (Maybe a)
= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typeable a => HashMap TypeRep Dynamic -> IO (Maybe a)
lookupShakeExtra forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShakeOptions -> HashMap TypeRep Dynamic
shakeExtra forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Action ShakeOptions
getShakeOptions
getShakeExtraRules :: Typeable a => Rules (Maybe a)
= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typeable a => HashMap TypeRep Dynamic -> IO (Maybe a)
lookupShakeExtra forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShakeOptions -> HashMap TypeRep Dynamic
shakeExtra forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Rules ShakeOptions
getShakeOptionsRules
lookupShakeExtra :: forall a . Typeable a => Map.HashMap TypeRep Dynamic -> IO (Maybe a)
HashMap TypeRep Dynamic
mp =
case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup TypeRep
want HashMap TypeRep Dynamic
mp of
Just Dynamic
dyn
| Just a
x <- forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
dyn -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
x
| Bool
otherwise -> forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM forall a b. (a -> b) -> a -> b
$ FilePath
-> [(FilePath, Maybe FilePath)] -> FilePath -> SomeException
errorStructured
FilePath
"shakeExtra value is malformed, all keys and values must agree"
[(FilePath
"Key", forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show TypeRep
want)
,(FilePath
"Value", forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ Dynamic -> TypeRep
dynTypeRep Dynamic
dyn)]
FilePath
"Use addShakeExtra to ensure shakeExtra is well-formed"
Maybe Dynamic
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
where want :: TypeRep
want = forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
addShakeExtra :: Typeable a => a -> Map.HashMap TypeRep Dynamic -> Map.HashMap TypeRep Dynamic
a
x = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Map.insert (forall a. Typeable a => a -> TypeRep
typeOf a
x) (forall a. Typeable a => a -> Dynamic
toDyn a
x)
copyFile' :: Partial => FilePath -> FilePath -> Action ()
copyFile' :: Partial => FilePath -> FilePath -> Action ()
copyFile' FilePath
old FilePath
new = do
Partial => [FilePath] -> Action ()
need [FilePath
old]
FilePath -> Action ()
putVerbose forall a b. (a -> b) -> a -> b
$ FilePath
"Copying from " forall a. [a] -> [a] -> [a]
++ FilePath
old forall a. [a] -> [a] -> [a]
++ FilePath
" to " forall a. [a] -> [a] -> [a]
++ FilePath
new
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
FilePath -> IO ()
createDirectoryRecursive forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
new
FilePath -> IO ()
removeFile_ FilePath
new
FilePath -> FilePath -> IO ()
copyFile FilePath
old FilePath
new
copyFileChanged :: Partial => FilePath -> FilePath -> Action ()
copyFileChanged :: Partial => FilePath -> FilePath -> Action ()
copyFileChanged FilePath
old FilePath
new = do
Partial => [FilePath] -> Action ()
need [FilePath
old]
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
new forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
&&^ FilePath -> FilePath -> IO Bool
IO.fileEq FilePath
old FilePath
new) forall a b. (a -> b) -> a -> b
$ do
FilePath -> Action ()
putVerbose forall a b. (a -> b) -> a -> b
$ FilePath
"Copying from " forall a. [a] -> [a] -> [a]
++ FilePath
old forall a. [a] -> [a] -> [a]
++ FilePath
" to " forall a. [a] -> [a] -> [a]
++ FilePath
new
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
FilePath -> IO ()
createDirectoryRecursive forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
new
FilePath -> IO ()
removeFile_ FilePath
new
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
copyFile FilePath
old FilePath
new
readFile' :: Partial => FilePath -> Action String
readFile' :: Partial => FilePath -> Action FilePath
readFile' FilePath
x = Partial => [FilePath] -> Action ()
need [FilePath
x] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO FilePath
readFile FilePath
x)
writeFile' :: (MonadIO m, Partial) => FilePath -> String -> m ()
writeFile' :: forall (m :: * -> *).
(MonadIO m, Partial) =>
FilePath -> FilePath -> m ()
writeFile' FilePath
name FilePath
x = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
FilePath -> IO ()
createDirectoryRecursive forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
name
FilePath -> IO ()
removeFile_ FilePath
name
FilePath -> FilePath -> IO ()
writeFile FilePath
name FilePath
x
readFileLines :: Partial => FilePath -> Action [String]
readFileLines :: Partial => FilePath -> Action [FilePath]
readFileLines = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> [FilePath]
lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Partial => FilePath -> Action FilePath
readFile'
writeFileLines :: (MonadIO m, Partial) => FilePath -> [String] -> m ()
writeFileLines :: forall (m :: * -> *).
(MonadIO m, Partial) =>
FilePath -> [FilePath] -> m ()
writeFileLines FilePath
name = forall (m :: * -> *).
(MonadIO m, Partial) =>
FilePath -> FilePath -> m ()
writeFile' FilePath
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unlines
writeFileChanged :: (MonadIO m, Partial) => FilePath -> String -> m ()
writeFileChanged :: forall (m :: * -> *).
(MonadIO m, Partial) =>
FilePath -> FilePath -> m ()
writeFileChanged FilePath
name FilePath
x = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
FilePath -> IO ()
createDirectoryRecursive forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
name
Bool
b <- FilePath -> IO Bool
doesFileExist FilePath
name
if Bool -> Bool
not Bool
b then FilePath -> FilePath -> IO ()
writeFile FilePath
name FilePath
x else do
Bool
b <- forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
name IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
FilePath
src <- Handle -> IO FilePath
hGetContents Handle
h
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! FilePath
src forall a. Eq a => a -> a -> Bool
/= FilePath
x
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b forall a b. (a -> b) -> a -> b
$ do
FilePath -> IO ()
removeFile_ FilePath
name
FilePath -> FilePath -> IO ()
writeFile FilePath
name FilePath
x
withTempFile :: (FilePath -> Action a) -> Action a
withTempFile :: forall a. (FilePath -> Action a) -> Action a
withTempFile FilePath -> Action a
act = do
(FilePath
file, IO ()
del) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (FilePath, IO ())
IO.newTempFile
FilePath -> Action a
act FilePath
file forall a b. Action a -> IO b -> Action a
`actionFinally` IO ()
del
withTempFileWithin :: FilePath -> (FilePath -> Action a) -> Action a
withTempFileWithin :: forall a. FilePath -> (FilePath -> Action a) -> Action a
withTempFileWithin FilePath
tdir FilePath -> Action a
act = do
(FilePath
file, IO ()
del) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO (FilePath, IO ())
IO.newTempFileWithin FilePath
tdir
FilePath -> Action a
act FilePath
file forall a b. Action a -> IO b -> Action a
`actionFinally` IO ()
del
withTempDir :: (FilePath -> Action a) -> Action a
withTempDir :: forall a. (FilePath -> Action a) -> Action a
withTempDir FilePath -> Action a
act = do
(FilePath
dir,IO ()
del) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (FilePath, IO ())
IO.newTempDir
FilePath -> Action a
act FilePath
dir forall a b. Action a -> IO b -> Action a
`actionFinally` IO ()
del
withTempDirWithin :: FilePath -> (FilePath -> Action a) -> Action a
withTempDirWithin :: forall a. FilePath -> (FilePath -> Action a) -> Action a
withTempDirWithin FilePath
tdir FilePath -> Action a
act = do
(FilePath
dir,IO ()
del) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO (FilePath, IO ())
IO.newTempDirWithin FilePath
tdir
FilePath -> Action a
act FilePath
dir forall a b. Action a -> IO b -> Action a
`actionFinally` IO ()
del
forP :: [a] -> (a -> Action b) -> Action [b]
forP :: forall a b. [a] -> (a -> Action b) -> Action [b]
forP [a]
xs a -> Action b
f = forall a. [Action a] -> Action [a]
parallel forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map a -> Action b
f [a]
xs
par :: Action a -> Action b -> Action (a,b)
par :: forall a b. Action a -> Action b -> Action (a, b)
par Action a
a Action b
b = (\[Left a
a, Right b
b] -> (a
a,b
b)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [Action a] -> Action [a]
parallel [forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action a
a, forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action b
b]
newResource :: String -> Int -> Rules Resource
newResource :: FilePath -> Int -> Rules Resource
newResource FilePath
name Int
mx = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> Int -> IO Resource
newResourceIO FilePath
name Int
mx
newThrottle :: String -> Int -> Double -> Rules Resource
newThrottle :: FilePath -> Int -> Double -> Rules Resource
newThrottle FilePath
name Int
count Double
period = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> Int -> Double -> IO Resource
newThrottleIO FilePath
name Int
count Double
period
withResources :: [(Resource, Int)] -> Action a -> Action a
withResources :: forall a. [(Resource, Int)] -> Action a -> Action a
withResources [(Resource, Int)]
res Action a
act
| (Resource
r,Int
i):[(Resource, Int)]
_ <- forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
< Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Resource, Int)]
res = forall a. Partial => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"You cannot acquire a negative quantity of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Resource
r forall a. [a] -> [a] -> [a]
++ FilePath
", requested " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
i
| Bool
otherwise = forall {t :: * -> *}. Foldable t => [(Resource, t Int)] -> Action a
f forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => [(k, v)] -> [(k, [v])]
groupSort [(Resource, Int)]
res
where
f :: [(Resource, t Int)] -> Action a
f [] = Action a
act
f ((Resource
r,t Int
xs):[(Resource, t Int)]
rs) = forall a. Resource -> Int -> Action a -> Action a
withResource Resource
r (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum t Int
xs) forall a b. (a -> b) -> a -> b
$ [(Resource, t Int)] -> Action a
f [(Resource, t Int)]
rs
newCache :: (Eq k, Hashable k) => (k -> Action v) -> Rules (k -> Action v)
newCache :: forall k v.
(Eq k, Hashable k) =>
(k -> Action v) -> Rules (k -> Action v)
newCache = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(Eq k, Hashable k) =>
(k -> Action v) -> IO (k -> Action v)
newCacheIO