{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, DeriveDataTypeable #-}
{-# LANGUAGE TypeFamilies, ConstraintKinds #-}

-- | Both System.Directory and System.Environment wrappers
module Development.Shake.Internal.Rules.Directory(
    doesFileExist, doesDirectoryExist,
    getDirectoryContents, getDirectoryFiles, getDirectoryDirs,
    getEnv, getEnvWithDefault, getEnvError,
    removeFiles, removeFilesAfter,
    getDirectoryFilesIO,
    defaultRuleDirectory
    ) where

import Control.Exception.Extra
import Control.Monad.Extra
import Control.Monad.IO.Class
import Data.Maybe
import Data.Binary
import Data.List
import Data.Tuple.Extra
import qualified Data.HashSet as Set
import qualified System.Directory as IO
import qualified System.Environment as IO

import Development.Shake.Internal.Core.Types
import Development.Shake.Internal.Core.Action
import Development.Shake.Internal.Core.Rules
import Development.Shake.Internal.Core.Build
import Development.Shake.Internal.Value
import Development.Shake.Classes
import Development.Shake.FilePath
import Development.Shake.Internal.FilePattern
import General.Extra
import General.Binary


---------------------------------------------------------------------
-- KEY/VALUE TYPES

type instance RuleResult DoesFileExistQ = DoesFileExistA

newtype DoesFileExistQ = DoesFileExistQ FilePath
    deriving (Typeable,DoesFileExistQ -> DoesFileExistQ -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DoesFileExistQ -> DoesFileExistQ -> Bool
$c/= :: DoesFileExistQ -> DoesFileExistQ -> Bool
== :: DoesFileExistQ -> DoesFileExistQ -> Bool
$c== :: DoesFileExistQ -> DoesFileExistQ -> Bool
Eq,Eq DoesFileExistQ
Int -> DoesFileExistQ -> Int
DoesFileExistQ -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: DoesFileExistQ -> Int
$chash :: DoesFileExistQ -> Int
hashWithSalt :: Int -> DoesFileExistQ -> Int
$chashWithSalt :: Int -> DoesFileExistQ -> Int
Hashable,Get DoesFileExistQ
[DoesFileExistQ] -> Put
DoesFileExistQ -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [DoesFileExistQ] -> Put
$cputList :: [DoesFileExistQ] -> Put
get :: Get DoesFileExistQ
$cget :: Get DoesFileExistQ
put :: DoesFileExistQ -> Put
$cput :: DoesFileExistQ -> Put
Binary,ByteString -> DoesFileExistQ
DoesFileExistQ -> Builder
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> DoesFileExistQ
$cgetEx :: ByteString -> DoesFileExistQ
putEx :: DoesFileExistQ -> Builder
$cputEx :: DoesFileExistQ -> Builder
BinaryEx,DoesFileExistQ -> ()
forall a. (a -> ()) -> NFData a
rnf :: DoesFileExistQ -> ()
$crnf :: DoesFileExistQ -> ()
NFData)

instance Show DoesFileExistQ where
    show :: DoesFileExistQ -> FilePath
show (DoesFileExistQ FilePath
a) = FilePath
"doesFileExist " forall a. [a] -> [a] -> [a]
++ ShowS
wrapQuote FilePath
a

newtype DoesFileExistA = DoesFileExistA {DoesFileExistA -> Bool
fromDoesFileExistA :: Bool}
    deriving (Typeable,DoesFileExistA -> DoesFileExistA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DoesFileExistA -> DoesFileExistA -> Bool
$c/= :: DoesFileExistA -> DoesFileExistA -> Bool
== :: DoesFileExistA -> DoesFileExistA -> Bool
$c== :: DoesFileExistA -> DoesFileExistA -> Bool
Eq,ByteString -> DoesFileExistA
DoesFileExistA -> Builder
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> DoesFileExistA
$cgetEx :: ByteString -> DoesFileExistA
putEx :: DoesFileExistA -> Builder
$cputEx :: DoesFileExistA -> Builder
BinaryEx,DoesFileExistA -> ()
forall a. (a -> ()) -> NFData a
rnf :: DoesFileExistA -> ()
$crnf :: DoesFileExistA -> ()
NFData)

instance Show DoesFileExistA where
    show :: DoesFileExistA -> FilePath
show (DoesFileExistA Bool
a) = forall a. Show a => a -> FilePath
show Bool
a

type instance RuleResult DoesDirectoryExistQ = DoesDirectoryExistA

newtype DoesDirectoryExistQ = DoesDirectoryExistQ FilePath
    deriving (Typeable,DoesDirectoryExistQ -> DoesDirectoryExistQ -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DoesDirectoryExistQ -> DoesDirectoryExistQ -> Bool
$c/= :: DoesDirectoryExistQ -> DoesDirectoryExistQ -> Bool
== :: DoesDirectoryExistQ -> DoesDirectoryExistQ -> Bool
$c== :: DoesDirectoryExistQ -> DoesDirectoryExistQ -> Bool
Eq,Eq DoesDirectoryExistQ
Int -> DoesDirectoryExistQ -> Int
DoesDirectoryExistQ -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: DoesDirectoryExistQ -> Int
$chash :: DoesDirectoryExistQ -> Int
hashWithSalt :: Int -> DoesDirectoryExistQ -> Int
$chashWithSalt :: Int -> DoesDirectoryExistQ -> Int
Hashable,Get DoesDirectoryExistQ
[DoesDirectoryExistQ] -> Put
DoesDirectoryExistQ -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [DoesDirectoryExistQ] -> Put
$cputList :: [DoesDirectoryExistQ] -> Put
get :: Get DoesDirectoryExistQ
$cget :: Get DoesDirectoryExistQ
put :: DoesDirectoryExistQ -> Put
$cput :: DoesDirectoryExistQ -> Put
Binary,ByteString -> DoesDirectoryExistQ
DoesDirectoryExistQ -> Builder
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> DoesDirectoryExistQ
$cgetEx :: ByteString -> DoesDirectoryExistQ
putEx :: DoesDirectoryExistQ -> Builder
$cputEx :: DoesDirectoryExistQ -> Builder
BinaryEx,DoesDirectoryExistQ -> ()
forall a. (a -> ()) -> NFData a
rnf :: DoesDirectoryExistQ -> ()
$crnf :: DoesDirectoryExistQ -> ()
NFData)

instance Show DoesDirectoryExistQ where
    show :: DoesDirectoryExistQ -> FilePath
show (DoesDirectoryExistQ FilePath
a) = FilePath
"doesDirectoryExist " forall a. [a] -> [a] -> [a]
++ ShowS
wrapQuote FilePath
a

newtype DoesDirectoryExistA = DoesDirectoryExistA {DoesDirectoryExistA -> Bool
fromDoesDirectoryExistA :: Bool}
    deriving (Typeable,DoesDirectoryExistA -> DoesDirectoryExistA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DoesDirectoryExistA -> DoesDirectoryExistA -> Bool
$c/= :: DoesDirectoryExistA -> DoesDirectoryExistA -> Bool
== :: DoesDirectoryExistA -> DoesDirectoryExistA -> Bool
$c== :: DoesDirectoryExistA -> DoesDirectoryExistA -> Bool
Eq,ByteString -> DoesDirectoryExistA
DoesDirectoryExistA -> Builder
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> DoesDirectoryExistA
$cgetEx :: ByteString -> DoesDirectoryExistA
putEx :: DoesDirectoryExistA -> Builder
$cputEx :: DoesDirectoryExistA -> Builder
BinaryEx,DoesDirectoryExistA -> ()
forall a. (a -> ()) -> NFData a
rnf :: DoesDirectoryExistA -> ()
$crnf :: DoesDirectoryExistA -> ()
NFData)

instance Show DoesDirectoryExistA where
    show :: DoesDirectoryExistA -> FilePath
show (DoesDirectoryExistA Bool
a) = forall a. Show a => a -> FilePath
show Bool
a


type instance RuleResult GetEnvQ = GetEnvA

newtype GetEnvQ = GetEnvQ String
    deriving (Typeable,GetEnvQ -> GetEnvQ -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetEnvQ -> GetEnvQ -> Bool
$c/= :: GetEnvQ -> GetEnvQ -> Bool
== :: GetEnvQ -> GetEnvQ -> Bool
$c== :: GetEnvQ -> GetEnvQ -> Bool
Eq,Eq GetEnvQ
Int -> GetEnvQ -> Int
GetEnvQ -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: GetEnvQ -> Int
$chash :: GetEnvQ -> Int
hashWithSalt :: Int -> GetEnvQ -> Int
$chashWithSalt :: Int -> GetEnvQ -> Int
Hashable,Get GetEnvQ
[GetEnvQ] -> Put
GetEnvQ -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [GetEnvQ] -> Put
$cputList :: [GetEnvQ] -> Put
get :: Get GetEnvQ
$cget :: Get GetEnvQ
put :: GetEnvQ -> Put
$cput :: GetEnvQ -> Put
Binary,ByteString -> GetEnvQ
GetEnvQ -> Builder
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> GetEnvQ
$cgetEx :: ByteString -> GetEnvQ
putEx :: GetEnvQ -> Builder
$cputEx :: GetEnvQ -> Builder
BinaryEx,GetEnvQ -> ()
forall a. (a -> ()) -> NFData a
rnf :: GetEnvQ -> ()
$crnf :: GetEnvQ -> ()
NFData)

instance Show GetEnvQ where
    show :: GetEnvQ -> FilePath
show (GetEnvQ FilePath
a) = FilePath
"getEnv " forall a. [a] -> [a] -> [a]
++ ShowS
wrapQuote FilePath
a

newtype GetEnvA = GetEnvA {GetEnvA -> Maybe FilePath
fromGetEnvA :: Maybe String}
    deriving (Typeable,GetEnvA -> GetEnvA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetEnvA -> GetEnvA -> Bool
$c/= :: GetEnvA -> GetEnvA -> Bool
== :: GetEnvA -> GetEnvA -> Bool
$c== :: GetEnvA -> GetEnvA -> Bool
Eq,Eq GetEnvA
Int -> GetEnvA -> Int
GetEnvA -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: GetEnvA -> Int
$chash :: GetEnvA -> Int
hashWithSalt :: Int -> GetEnvA -> Int
$chashWithSalt :: Int -> GetEnvA -> Int
Hashable,ByteString -> GetEnvA
GetEnvA -> Builder
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> GetEnvA
$cgetEx :: ByteString -> GetEnvA
putEx :: GetEnvA -> Builder
$cputEx :: GetEnvA -> Builder
BinaryEx,GetEnvA -> ()
forall a. (a -> ()) -> NFData a
rnf :: GetEnvA -> ()
$crnf :: GetEnvA -> ()
NFData)

instance Show GetEnvA where
    show :: GetEnvA -> FilePath
show (GetEnvA Maybe FilePath
a) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"<unset>" ShowS
wrapQuote Maybe FilePath
a


type instance RuleResult GetDirectoryContentsQ = GetDirectoryA
type instance RuleResult GetDirectoryFilesQ = GetDirectoryA
type instance RuleResult GetDirectoryDirsQ = GetDirectoryA

newtype GetDirectoryContentsQ = GetDirectoryContentsQ FilePath
    deriving (Typeable,GetDirectoryContentsQ -> GetDirectoryContentsQ -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDirectoryContentsQ -> GetDirectoryContentsQ -> Bool
$c/= :: GetDirectoryContentsQ -> GetDirectoryContentsQ -> Bool
== :: GetDirectoryContentsQ -> GetDirectoryContentsQ -> Bool
$c== :: GetDirectoryContentsQ -> GetDirectoryContentsQ -> Bool
Eq,Eq GetDirectoryContentsQ
Int -> GetDirectoryContentsQ -> Int
GetDirectoryContentsQ -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: GetDirectoryContentsQ -> Int
$chash :: GetDirectoryContentsQ -> Int
hashWithSalt :: Int -> GetDirectoryContentsQ -> Int
$chashWithSalt :: Int -> GetDirectoryContentsQ -> Int
Hashable,Get GetDirectoryContentsQ
[GetDirectoryContentsQ] -> Put
GetDirectoryContentsQ -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [GetDirectoryContentsQ] -> Put
$cputList :: [GetDirectoryContentsQ] -> Put
get :: Get GetDirectoryContentsQ
$cget :: Get GetDirectoryContentsQ
put :: GetDirectoryContentsQ -> Put
$cput :: GetDirectoryContentsQ -> Put
Binary,ByteString -> GetDirectoryContentsQ
GetDirectoryContentsQ -> Builder
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> GetDirectoryContentsQ
$cgetEx :: ByteString -> GetDirectoryContentsQ
putEx :: GetDirectoryContentsQ -> Builder
$cputEx :: GetDirectoryContentsQ -> Builder
BinaryEx,GetDirectoryContentsQ -> ()
forall a. (a -> ()) -> NFData a
rnf :: GetDirectoryContentsQ -> ()
$crnf :: GetDirectoryContentsQ -> ()
NFData)

instance Show GetDirectoryContentsQ where
    show :: GetDirectoryContentsQ -> FilePath
show (GetDirectoryContentsQ FilePath
dir) = FilePath
"getDirectoryContents " forall a. [a] -> [a] -> [a]
++ ShowS
wrapQuote FilePath
dir

newtype GetDirectoryFilesQ = GetDirectoryFilesQ (FilePath, [FilePattern])
    deriving (Typeable,GetDirectoryFilesQ -> GetDirectoryFilesQ -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDirectoryFilesQ -> GetDirectoryFilesQ -> Bool
$c/= :: GetDirectoryFilesQ -> GetDirectoryFilesQ -> Bool
== :: GetDirectoryFilesQ -> GetDirectoryFilesQ -> Bool
$c== :: GetDirectoryFilesQ -> GetDirectoryFilesQ -> Bool
Eq,Eq GetDirectoryFilesQ
Int -> GetDirectoryFilesQ -> Int
GetDirectoryFilesQ -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: GetDirectoryFilesQ -> Int
$chash :: GetDirectoryFilesQ -> Int
hashWithSalt :: Int -> GetDirectoryFilesQ -> Int
$chashWithSalt :: Int -> GetDirectoryFilesQ -> Int
Hashable,Get GetDirectoryFilesQ
[GetDirectoryFilesQ] -> Put
GetDirectoryFilesQ -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [GetDirectoryFilesQ] -> Put
$cputList :: [GetDirectoryFilesQ] -> Put
get :: Get GetDirectoryFilesQ
$cget :: Get GetDirectoryFilesQ
put :: GetDirectoryFilesQ -> Put
$cput :: GetDirectoryFilesQ -> Put
Binary,ByteString -> GetDirectoryFilesQ
GetDirectoryFilesQ -> Builder
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> GetDirectoryFilesQ
$cgetEx :: ByteString -> GetDirectoryFilesQ
putEx :: GetDirectoryFilesQ -> Builder
$cputEx :: GetDirectoryFilesQ -> Builder
BinaryEx,GetDirectoryFilesQ -> ()
forall a. (a -> ()) -> NFData a
rnf :: GetDirectoryFilesQ -> ()
$crnf :: GetDirectoryFilesQ -> ()
NFData)

instance Show GetDirectoryFilesQ where
    show :: GetDirectoryFilesQ -> FilePath
show (GetDirectoryFilesQ (FilePath
dir, [FilePath]
pat)) = FilePath
"getDirectoryFiles " forall a. [a] -> [a] -> [a]
++ ShowS
wrapQuote FilePath
dir forall a. [a] -> [a] -> [a]
++ FilePath
" [" forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords (forall a b. (a -> b) -> [a] -> [b]
map ShowS
wrapQuote [FilePath]
pat) forall a. [a] -> [a] -> [a]
++ FilePath
"]"

newtype GetDirectoryDirsQ = GetDirectoryDirsQ FilePath
    deriving (Typeable,GetDirectoryDirsQ -> GetDirectoryDirsQ -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDirectoryDirsQ -> GetDirectoryDirsQ -> Bool
$c/= :: GetDirectoryDirsQ -> GetDirectoryDirsQ -> Bool
== :: GetDirectoryDirsQ -> GetDirectoryDirsQ -> Bool
$c== :: GetDirectoryDirsQ -> GetDirectoryDirsQ -> Bool
Eq,Eq GetDirectoryDirsQ
Int -> GetDirectoryDirsQ -> Int
GetDirectoryDirsQ -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: GetDirectoryDirsQ -> Int
$chash :: GetDirectoryDirsQ -> Int
hashWithSalt :: Int -> GetDirectoryDirsQ -> Int
$chashWithSalt :: Int -> GetDirectoryDirsQ -> Int
Hashable,Get GetDirectoryDirsQ
[GetDirectoryDirsQ] -> Put
GetDirectoryDirsQ -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [GetDirectoryDirsQ] -> Put
$cputList :: [GetDirectoryDirsQ] -> Put
get :: Get GetDirectoryDirsQ
$cget :: Get GetDirectoryDirsQ
put :: GetDirectoryDirsQ -> Put
$cput :: GetDirectoryDirsQ -> Put
Binary,ByteString -> GetDirectoryDirsQ
GetDirectoryDirsQ -> Builder
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> GetDirectoryDirsQ
$cgetEx :: ByteString -> GetDirectoryDirsQ
putEx :: GetDirectoryDirsQ -> Builder
$cputEx :: GetDirectoryDirsQ -> Builder
BinaryEx,GetDirectoryDirsQ -> ()
forall a. (a -> ()) -> NFData a
rnf :: GetDirectoryDirsQ -> ()
$crnf :: GetDirectoryDirsQ -> ()
NFData)

instance Show GetDirectoryDirsQ where
    show :: GetDirectoryDirsQ -> FilePath
show (GetDirectoryDirsQ FilePath
dir) = FilePath
"getDirectoryDirs " forall a. [a] -> [a] -> [a]
++ ShowS
wrapQuote FilePath
dir

newtype GetDirectoryA = GetDirectoryA {GetDirectoryA -> [FilePath]
fromGetDirectoryA :: [FilePath]}
    deriving (Typeable,GetDirectoryA -> GetDirectoryA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDirectoryA -> GetDirectoryA -> Bool
$c/= :: GetDirectoryA -> GetDirectoryA -> Bool
== :: GetDirectoryA -> GetDirectoryA -> Bool
$c== :: GetDirectoryA -> GetDirectoryA -> Bool
Eq,Eq GetDirectoryA
Int -> GetDirectoryA -> Int
GetDirectoryA -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: GetDirectoryA -> Int
$chash :: GetDirectoryA -> Int
hashWithSalt :: Int -> GetDirectoryA -> Int
$chashWithSalt :: Int -> GetDirectoryA -> Int
Hashable,ByteString -> GetDirectoryA
GetDirectoryA -> Builder
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> GetDirectoryA
$cgetEx :: ByteString -> GetDirectoryA
putEx :: GetDirectoryA -> Builder
$cputEx :: GetDirectoryA -> Builder
BinaryEx,GetDirectoryA -> ()
forall a. (a -> ()) -> NFData a
rnf :: GetDirectoryA -> ()
$crnf :: GetDirectoryA -> ()
NFData)

instance Show GetDirectoryA where
    show :: GetDirectoryA -> FilePath
show (GetDirectoryA [FilePath]
xs) = [FilePath] -> FilePath
unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ShowS
wrapQuote [FilePath]
xs


---------------------------------------------------------------------
-- RULE DEFINITIONS

queryRule :: (RuleResult key ~ value
             ,BinaryEx witness, Eq witness
             ,BinaryEx key, ShakeValue key
             ,Typeable value, NFData value, Show value, Eq value)
          => (value -> witness) -> (key -> IO value) -> Rules ()
queryRule :: forall key value witness.
(RuleResult key ~ value, BinaryEx witness, Eq witness,
 BinaryEx key, ShakeValue key, Typeable value, NFData value,
 Show value, Eq value) =>
(value -> witness) -> (key -> IO value) -> Rules ()
queryRule value -> witness
witness key -> IO value
query = forall key value.
(RuleResult key ~ value, ShakeValue key, BinaryEx key,
 Typeable value, NFData value, Show value, Partial) =>
BuiltinLint key value
-> BuiltinIdentity key value -> BuiltinRun key value -> Rules ()
addBuiltinRuleEx
    (\key
k value
old -> do
        value
new <- key -> IO value
query key
k
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if value
old forall a. Eq a => a -> a -> Bool
== value
new then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show value
new)
    (\key
_ value
v -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
runBuilder forall a b. (a -> b) -> a -> b
$ forall a. BinaryEx a => a -> Builder
putEx forall a b. (a -> b) -> a -> b
$ value -> witness
witness value
v)
    (\key
k Maybe ByteString
old RunMode
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        value
new <- key -> IO value
query key
k
        let wnew :: witness
wnew = value -> witness
witness value
new
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Maybe ByteString
old of
            Just ByteString
old | witness
wnew forall a. Eq a => a -> a -> Bool
== forall a. BinaryEx a => ByteString -> a
getEx ByteString
old -> forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedNothing ByteString
old value
new
            Maybe ByteString
_ -> forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedRecomputeDiff (Builder -> ByteString
runBuilder forall a b. (a -> b) -> a -> b
$ forall a. BinaryEx a => a -> Builder
putEx witness
wnew) value
new)


defaultRuleDirectory :: Rules ()
defaultRuleDirectory :: Rules ()
defaultRuleDirectory = do
    -- for things we are always going to rerun, and which might take up a lot of memory to store,
    -- we only store their hash, so we can compute change, but not know what changed happened
    forall key value witness.
(RuleResult key ~ value, BinaryEx witness, Eq witness,
 BinaryEx key, ShakeValue key, Typeable value, NFData value,
 Show value, Eq value) =>
(value -> witness) -> (key -> IO value) -> Rules ()
queryRule forall a. a -> a
id (\(DoesFileExistQ FilePath
x) -> Bool -> DoesFileExistA
DoesFileExistA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
IO.doesFileExist FilePath
x)
    forall key value witness.
(RuleResult key ~ value, BinaryEx witness, Eq witness,
 BinaryEx key, ShakeValue key, Typeable value, NFData value,
 Show value, Eq value) =>
(value -> witness) -> (key -> IO value) -> Rules ()
queryRule forall a. a -> a
id (\(DoesDirectoryExistQ FilePath
x) -> Bool -> DoesDirectoryExistA
DoesDirectoryExistA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
IO.doesDirectoryExist FilePath
x)
    forall key value witness.
(RuleResult key ~ value, BinaryEx witness, Eq witness,
 BinaryEx key, ShakeValue key, Typeable value, NFData value,
 Show value, Eq value) =>
(value -> witness) -> (key -> IO value) -> Rules ()
queryRule forall a. Hashable a => a -> Int
hash (\(GetEnvQ FilePath
x) -> Maybe FilePath -> GetEnvA
GetEnvA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
IO.lookupEnv FilePath
x)
    forall key value witness.
(RuleResult key ~ value, BinaryEx witness, Eq witness,
 BinaryEx key, ShakeValue key, Typeable value, NFData value,
 Show value, Eq value) =>
(value -> witness) -> (key -> IO value) -> Rules ()
queryRule forall a. Hashable a => a -> Int
hash (\(GetDirectoryContentsQ FilePath
x) -> [FilePath] -> GetDirectoryA
GetDirectoryA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
getDirectoryContentsIO FilePath
x)
    forall key value witness.
(RuleResult key ~ value, BinaryEx witness, Eq witness,
 BinaryEx key, ShakeValue key, Typeable value, NFData value,
 Show value, Eq value) =>
(value -> witness) -> (key -> IO value) -> Rules ()
queryRule forall a. Hashable a => a -> Int
hash (\(GetDirectoryFilesQ (FilePath
a,[FilePath]
b)) -> [FilePath] -> GetDirectoryA
GetDirectoryA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> IO [FilePath]
getDirectoryFilesIO FilePath
a [FilePath]
b)
    forall key value witness.
(RuleResult key ~ value, BinaryEx witness, Eq witness,
 BinaryEx key, ShakeValue key, Typeable value, NFData value,
 Show value, Eq value) =>
(value -> witness) -> (key -> IO value) -> Rules ()
queryRule forall a. Hashable a => a -> Int
hash (\(GetDirectoryDirsQ FilePath
x) -> [FilePath] -> GetDirectoryA
GetDirectoryA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
getDirectoryDirsIO FilePath
x)


---------------------------------------------------------------------
-- RULE ENTRY POINTS

-- | Returns 'True' if the file exists. The existence of the file is tracked as a
--   dependency, and if the file is created or deleted the rule will rerun in subsequent builds.
--   Usually used to implement include paths. For example, given a include path of @foo@ and @bar@,
--   and a file @hello.txt@, you might write:
--
-- @
-- b <- 'doesFileExist' \"foo\/hello.txt\"
-- let file = if b then \"foo\/hello.txt\" else "\bar\/hello.txt\"
-- @
--
--   Now if the user had a file @bar\/hello.txt@, and then creates a file @foo\/hello.txt@, the
--   rule would correctly rerun, as while the @hello.txt@ that was used didn't change, which
--   file should be used has changed.
--
--   You should not call 'doesFileExist' on files which can be created by the build system.
--   The reason is that Shake operations such as this one are both cached for the duration of the build,
--   and may be run preemptively during a recheck. That means you can't control the time at which
--   'doesFileExist' is called. For that to be consistent, 'doesFileExist' must return the same result at the
--   start and end of the build, a property that is partially checked by the @--lint@ flag. Given a
--   file created by the build system, a build from clean will return 'False' at the beginning and 'True'
--   at the end, leading to a change, and thus rebuilds in subsequent runs.
--
--   If you do want to know whether a file exists separate to the build system, e.g. you can perfectly
--   predict the files contents and can save some meaningful work if the file already exists, you should
--   use the untracked "System.Directory" version. Such calls are not tracked by the file system, and you
--   should take care not to result in unpredictable results.
doesFileExist :: FilePath -> Action Bool
doesFileExist :: FilePath -> Action Bool
doesFileExist = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DoesFileExistA -> Bool
fromDoesFileExistA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> DoesFileExistQ
DoesFileExistQ forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
toStandard

-- | Returns 'True' if the directory exists. The existence of the directory is tracked as a
--   dependency, and if the directory is created or delete the rule will rerun in subsequent builds.
--
--   You should not call 'doesDirectoryExist' on directories which can be created by the build system,
--   for reasons explained in 'doesFileExist'.
doesDirectoryExist :: FilePath -> Action Bool
doesDirectoryExist :: FilePath -> Action Bool
doesDirectoryExist = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DoesDirectoryExistA -> Bool
fromDoesDirectoryExistA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> DoesDirectoryExistQ
DoesDirectoryExistQ forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
toStandard

-- | Return 'Just' the value of the environment variable, or 'Nothing'
--   if the variable is not set. The environment variable is tracked as a
--   dependency, and if it changes the rule will rerun in subsequent builds.
--   This function is a tracked version of 'getEnv' / 'lookupEnv' from the base library.
--
-- @
-- flags <- getEnv \"CFLAGS\"
-- 'cmd' \"gcc -c\" [out] (maybe [] words flags)
-- @
getEnv :: String -> Action (Maybe String)
getEnv :: FilePath -> Action (Maybe FilePath)
getEnv = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GetEnvA -> Maybe FilePath
fromGetEnvA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> GetEnvQ
GetEnvQ

-- | @'getEnvWithDefault' def var@ returns the value of the environment variable @var@, or the
--   default value @def@ if it is not set. Similar to 'getEnv'.
--
-- @
-- flags <- getEnvWithDefault \"-Wall\" \"CFLAGS\"
-- 'cmd' \"gcc -c\" [out] flags
-- @
getEnvWithDefault :: String -> String -> Action String
getEnvWithDefault :: FilePath -> FilePath -> Action FilePath
getEnvWithDefault FilePath
def FilePath
var = forall a. a -> Maybe a -> a
fromMaybe FilePath
def forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Action (Maybe FilePath)
getEnv FilePath
var

-- | A partial variant of 'getEnv' that returns the environment variable variable or fails.
getEnvError :: Partial => String -> Action String
getEnvError :: Partial => FilePath -> Action FilePath
getEnvError FilePath
name = FilePath -> FilePath -> Action FilePath
getEnvWithDefault (forall a. Partial => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"getEnvError: Environment variable " forall a. [a] -> [a] -> [a]
++ FilePath
name forall a. [a] -> [a] -> [a]
++ FilePath
" is undefined") FilePath
name

-- | Get the contents of a directory. The result will be sorted, and will not contain
--   the entries @.@ or @..@ (unlike the standard Haskell version).
--   The resulting paths will be relative to the first argument.
--   The result itself is tracked as a dependency, but the files in the result are not.
--   If the list of files changes in subsequent builds any rule calling it will rerun.
--
--   It is usually simpler to call either 'getDirectoryFiles' or 'getDirectoryDirs'.
getDirectoryContents :: FilePath -> Action [FilePath]
getDirectoryContents :: FilePath -> Action [FilePath]
getDirectoryContents = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GetDirectoryA -> [FilePath]
fromGetDirectoryA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> GetDirectoryContentsQ
GetDirectoryContentsQ

-- | Get the files anywhere under a directory that match any of a set of patterns.
--   For the interpretation of the patterns see '?=='. All results will be
--   relative to the directory argument.
--   The result itself is tracked as a dependency, but the files in the result are not.
--   If the list of files changes in subsequent builds any rule calling it will rerun.
--   Some examples:
--
-- > getDirectoryFiles "Config" ["//*.xml"]
-- >     -- All .xml files anywhere under the Config directory
-- >     -- If Config/foo/bar.xml exists it will return ["foo/bar.xml"]
-- > getDirectoryFiles "Modules" ["*.hs","*.lhs"]
-- >     -- All .hs or .lhs in the Modules directory
-- >     -- If Modules/foo.hs and Modules/foo.lhs exist, it will return ["foo.hs","foo.lhs"]
--
--   If you require a qualified file name it is often easier to use @\"\"@ as the 'FilePath' argument,
--   for example the following two expressions are equivalent:
--
-- > fmap (map ("Config" </>)) (getDirectoryFiles "Config" ["//*.xml"])
-- > getDirectoryFiles "" ["Config//*.xml"]
--
--   If the first argument directory does not exist it will raise an error.
--   If @foo@ does not exist, then the first of these error, but the second will not.
--
-- > getDirectoryFiles "foo" ["//*"] -- error
-- > getDirectoryFiles "" ["foo//*"] -- returns []
--
--   This function is tracked and serves as a dependency. If a rule calls
--   @getDirectoryFiles \"\" [\"*.c\"]@ and someone adds @foo.c@ to the
--   directory, that rule will rebuild. If someone changes one of the @.c@ files,
--   but the /list/ of @.c@ files doesn't change, then it will not rebuild.
--   As a consequence of being tracked, if the contents change during the build
--   (e.g. you are generating @.c@ files in this directory) then the build not reach
--   a stable point, which is an error - detected by running with @--lint@.
--   You should normally only call this function returning source files.
--
--   For an untracked variant see 'getDirectoryFilesIO'.
getDirectoryFiles :: FilePath -> [FilePattern] -> Action [FilePath]
getDirectoryFiles :: FilePath -> [FilePath] -> Action [FilePath]
getDirectoryFiles FilePath
dir [FilePath]
pat = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GetDirectoryA -> [FilePath]
fromGetDirectoryA forall a b. (a -> b) -> a -> b
$ forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 forall a b. (a -> b) -> a -> b
$ (FilePath, [FilePath]) -> GetDirectoryFilesQ
GetDirectoryFilesQ (FilePath
dir,[FilePath]
pat)

-- | Get the directories in a directory, not including @.@ or @..@.
--   All directories are relative to the argument directory.
--   The result itself is tracked as a dependency, but the directories in the result are not.
--   If the list of directories changes in subsequent builds any rule calling it will rerun.

--   The rules about creating entries described in 'getDirectoryFiles' also apply here.
--
-- > getDirectoryDirs "/Users"
-- >    -- Return all directories in the /Users directory
-- >    -- e.g. ["Emily","Henry","Neil"]
getDirectoryDirs :: FilePath -> Action [FilePath]
getDirectoryDirs :: FilePath -> Action [FilePath]
getDirectoryDirs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GetDirectoryA -> [FilePath]
fromGetDirectoryA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> GetDirectoryDirsQ
GetDirectoryDirsQ


---------------------------------------------------------------------
-- IO ROUTINES

getDirectoryContentsIO :: FilePath -> IO [FilePath]
-- getDirectoryContents "" is equivalent to getDirectoryContents "." on Windows,
-- but raises an error on Linux. We smooth out the difference.
getDirectoryContentsIO :: FilePath -> IO [FilePath]
getDirectoryContentsIO FilePath
dir = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Char
'.'))) forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
IO.getDirectoryContents forall a b. (a -> b) -> a -> b
$ if FilePath
dir forall a. Eq a => a -> a -> Bool
== FilePath
"" then FilePath
"." else FilePath
dir


getDirectoryDirsIO :: FilePath -> IO [FilePath]
getDirectoryDirsIO :: FilePath -> IO [FilePath]
getDirectoryDirsIO FilePath
dir = forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
getDirectoryContentsIO FilePath
dir
    where f :: FilePath -> IO Bool
f FilePath
x = FilePath -> IO Bool
IO.doesDirectoryExist forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> ShowS
</> FilePath
x


-- | A version of 'getDirectoryFiles' that is in IO, and thus untracked.
getDirectoryFilesIO :: FilePath -> [FilePattern] -> IO [FilePath]
-- Known infelicity: on Windows, if you search for "foo", but have the file "FOO",
-- it will match if on its own, or not if it is paired with "*", since that forces
-- a full directory scan, and then it uses Haskell equality (case sensitive)
getDirectoryFilesIO :: FilePath -> [FilePath] -> IO [FilePath]
getDirectoryFilesIO FilePath
root [FilePath]
pat = FilePath -> Walk -> IO [FilePath]
f FilePath
"" forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ [FilePath] -> (Bool, Walk)
walk [FilePath]
pat
    where
        -- Even after we know they are there because we called contents, we still have to check they are directories/files
        -- as required
        f :: FilePath -> Walk -> IO [FilePath]
f FilePath
dir (Walk [FilePath] -> ([FilePath], [(FilePath, Walk)])
op) = FilePath -> Walk -> IO [FilePath]
f FilePath
dir forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath], [(FilePath, Walk)]) -> Walk
WalkTo forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> ([FilePath], [(FilePath, Walk)])
op forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
getDirectoryContentsIO (FilePath
root FilePath -> ShowS
</> FilePath
dir)
        f FilePath
dir (WalkTo ([FilePath]
files, [(FilePath, Walk)]
dirs)) = do
            [FilePath]
files <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
IO.doesFileExist forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
root FilePath -> ShowS
</>)) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (FilePath
dir FilePath -> ShowS
</>) [FilePath]
files
            [FilePath]
dirs <- forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> Walk -> IO [FilePath]
f) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
IO.doesDirectoryExist forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
root FilePath -> ShowS
</>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall a b. (a -> b) -> [a] -> [b]
map (forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (FilePath
dir FilePath -> ShowS
</>)) [(FilePath, Walk)]
dirs)
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [FilePath]
files forall a. [a] -> [a] -> [a]
++ [FilePath]
dirs


---------------------------------------------------------------------
-- REMOVE UTILITIES

-- | Remove all files and directories that match any of the patterns within a directory.
--   Some examples:
--
-- @
-- 'removeFiles' \"output\" [\"\/\/*\"]        -- delete everything inside \'output\'
-- 'removeFiles' \"output\" [\"\/\/\"]         -- delete \'output\' itself
-- 'removeFiles' \".\" [\"\/\/*.hi\",\"\/\/*.o\"] -- delete all \'.hi\' and \'.o\' files
-- @
--
--   If the argument directory is missing no error is raised.
--   This function will follow symlinks, so should be used with care.
--
--   This function is often useful when writing a @clean@ action for your build system,
--   often as a 'phony' rule.
removeFiles :: FilePath -> [FilePattern] -> IO ()
removeFiles :: FilePath -> [FilePath] -> IO ()
removeFiles FilePath
dir [FilePath]
pat =
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (FilePath -> IO Bool
IO.doesDirectoryExist FilePath
dir) forall a b. (a -> b) -> a -> b
$ do
        let (Bool
b,Walk
w) = [FilePath] -> (Bool, Walk)
walk [FilePath]
pat
        if Bool
b then FilePath -> IO ()
removeDir FilePath
dir else FilePath -> Walk -> IO ()
f FilePath
dir Walk
w
    where
        f :: FilePath -> Walk -> IO ()
f FilePath
dir (Walk [FilePath] -> ([FilePath], [(FilePath, Walk)])
op) = FilePath -> Walk -> IO ()
f FilePath
dir forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath], [(FilePath, Walk)]) -> Walk
WalkTo forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> ([FilePath], [(FilePath, Walk)])
op forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
getDirectoryContentsIO FilePath
dir
        f FilePath
dir (WalkTo ([FilePath]
files, [(FilePath, Walk)]
dirs)) = do
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
files forall a b. (a -> b) -> a -> b
$ \FilePath
fil ->
                forall a. IO a -> IO (Either IOException a)
tryIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeItem forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> ShowS
</> FilePath
fil
            let done :: HashSet FilePath
done = forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList [FilePath]
files
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
Set.member HashSet FilePath
done forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(FilePath, Walk)]
dirs) forall a b. (a -> b) -> a -> b
$ \(FilePath
d,Walk
w) -> do
                let dir2 :: FilePath
dir2 = FilePath
dir FilePath -> ShowS
</> FilePath
d
                forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (FilePath -> IO Bool
IO.doesDirectoryExist FilePath
dir2) forall a b. (a -> b) -> a -> b
$ FilePath -> Walk -> IO ()
f FilePath
dir2 Walk
w

        removeItem :: FilePath -> IO ()
        removeItem :: FilePath -> IO ()
removeItem FilePath
x = FilePath -> IO ()
IO.removeFile FilePath
x forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> FilePath -> IO ()
removeDir FilePath
x

        -- In newer GHC's removeDirectoryRecursive is probably better, but doesn't follow
        -- symlinks, so it's got different behaviour
        removeDir :: FilePath -> IO ()
        removeDir :: FilePath -> IO ()
removeDir FilePath
x = do
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> IO ()
removeItem forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
x FilePath -> ShowS
</>)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
getDirectoryContentsIO FilePath
x
            FilePath -> IO ()
IO.removeDirectory FilePath
x


-- | Remove files, like 'removeFiles', but executed after the build completes successfully using 'runAfter'.
--   Useful for implementing @clean@ actions that delete files Shake may have open for building, e.g. 'shakeFiles'.
--   Where possible, delete the files as a normal part of the build, e.g. using @'liftIO' $ 'removeFiles' dir pats@.
removeFilesAfter :: FilePath -> [FilePattern] -> Action ()
removeFilesAfter :: FilePath -> [FilePath] -> Action ()
removeFilesAfter FilePath
a [FilePath]
b = do
    FilePath -> Action ()
putVerbose forall a b. (a -> b) -> a -> b
$ FilePath
"Will remove " forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
b forall a. [a] -> [a] -> [a]
++ FilePath
" from " forall a. [a] -> [a] -> [a]
++ FilePath
a
    IO () -> Action ()
runAfter forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> IO ()
removeFiles FilePath
a [FilePath]
b