{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, DeriveDataTypeable #-}
{-# LANGUAGE TypeFamilies, TypeOperators, 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
(DoesFileExistQ -> DoesFileExistQ -> Bool)
-> (DoesFileExistQ -> DoesFileExistQ -> Bool) -> Eq DoesFileExistQ
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DoesFileExistQ -> DoesFileExistQ -> Bool
== :: DoesFileExistQ -> DoesFileExistQ -> Bool
$c/= :: DoesFileExistQ -> DoesFileExistQ -> Bool
/= :: DoesFileExistQ -> DoesFileExistQ -> Bool
Eq,Eq DoesFileExistQ
Eq DoesFileExistQ =>
(Int -> DoesFileExistQ -> Int)
-> (DoesFileExistQ -> Int) -> Hashable DoesFileExistQ
Int -> DoesFileExistQ -> Int
DoesFileExistQ -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> DoesFileExistQ -> Int
hashWithSalt :: Int -> DoesFileExistQ -> Int
$chash :: DoesFileExistQ -> Int
hash :: DoesFileExistQ -> Int
Hashable,Get DoesFileExistQ
[DoesFileExistQ] -> Put
DoesFileExistQ -> Put
(DoesFileExistQ -> Put)
-> Get DoesFileExistQ
-> ([DoesFileExistQ] -> Put)
-> Binary DoesFileExistQ
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: DoesFileExistQ -> Put
put :: DoesFileExistQ -> Put
$cget :: Get DoesFileExistQ
get :: Get DoesFileExistQ
$cputList :: [DoesFileExistQ] -> Put
putList :: [DoesFileExistQ] -> Put
Binary,ByteString -> DoesFileExistQ
DoesFileExistQ -> Builder
(DoesFileExistQ -> Builder)
-> (ByteString -> DoesFileExistQ) -> BinaryEx DoesFileExistQ
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
$cputEx :: DoesFileExistQ -> Builder
putEx :: DoesFileExistQ -> Builder
$cgetEx :: ByteString -> DoesFileExistQ
getEx :: ByteString -> DoesFileExistQ
BinaryEx,DoesFileExistQ -> ()
(DoesFileExistQ -> ()) -> NFData DoesFileExistQ
forall a. (a -> ()) -> NFData a
$crnf :: DoesFileExistQ -> ()
rnf :: DoesFileExistQ -> ()
NFData)

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

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

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

type instance RuleResult DoesDirectoryExistQ = DoesDirectoryExistA

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

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

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

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


type instance RuleResult GetEnvQ = GetEnvA

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

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

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

instance Show GetEnvA where
    show :: GetEnvA -> FilePath
show (GetEnvA Maybe FilePath
a) = FilePath -> ShowS -> Maybe FilePath -> FilePath
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
(GetDirectoryContentsQ -> GetDirectoryContentsQ -> Bool)
-> (GetDirectoryContentsQ -> GetDirectoryContentsQ -> Bool)
-> Eq GetDirectoryContentsQ
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetDirectoryContentsQ -> GetDirectoryContentsQ -> Bool
== :: GetDirectoryContentsQ -> GetDirectoryContentsQ -> Bool
$c/= :: GetDirectoryContentsQ -> GetDirectoryContentsQ -> Bool
/= :: GetDirectoryContentsQ -> GetDirectoryContentsQ -> Bool
Eq,Eq GetDirectoryContentsQ
Eq GetDirectoryContentsQ =>
(Int -> GetDirectoryContentsQ -> Int)
-> (GetDirectoryContentsQ -> Int) -> Hashable GetDirectoryContentsQ
Int -> GetDirectoryContentsQ -> Int
GetDirectoryContentsQ -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> GetDirectoryContentsQ -> Int
hashWithSalt :: Int -> GetDirectoryContentsQ -> Int
$chash :: GetDirectoryContentsQ -> Int
hash :: GetDirectoryContentsQ -> Int
Hashable,Get GetDirectoryContentsQ
[GetDirectoryContentsQ] -> Put
GetDirectoryContentsQ -> Put
(GetDirectoryContentsQ -> Put)
-> Get GetDirectoryContentsQ
-> ([GetDirectoryContentsQ] -> Put)
-> Binary GetDirectoryContentsQ
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: GetDirectoryContentsQ -> Put
put :: GetDirectoryContentsQ -> Put
$cget :: Get GetDirectoryContentsQ
get :: Get GetDirectoryContentsQ
$cputList :: [GetDirectoryContentsQ] -> Put
putList :: [GetDirectoryContentsQ] -> Put
Binary,ByteString -> GetDirectoryContentsQ
GetDirectoryContentsQ -> Builder
(GetDirectoryContentsQ -> Builder)
-> (ByteString -> GetDirectoryContentsQ)
-> BinaryEx GetDirectoryContentsQ
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
$cputEx :: GetDirectoryContentsQ -> Builder
putEx :: GetDirectoryContentsQ -> Builder
$cgetEx :: ByteString -> GetDirectoryContentsQ
getEx :: ByteString -> GetDirectoryContentsQ
BinaryEx,GetDirectoryContentsQ -> ()
(GetDirectoryContentsQ -> ()) -> NFData GetDirectoryContentsQ
forall a. (a -> ()) -> NFData a
$crnf :: GetDirectoryContentsQ -> ()
rnf :: GetDirectoryContentsQ -> ()
NFData)

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

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

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

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

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

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

instance Show GetDirectoryA where
    show :: GetDirectoryA -> FilePath
show (GetDirectoryA [FilePath]
xs) = [FilePath] -> FilePath
unwords ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ ShowS -> [FilePath] -> [FilePath]
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 = BuiltinLint key value
-> BuiltinIdentity key value -> BuiltinRun key value -> Rules ()
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
        Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ if value
old value -> value -> Bool
forall a. Eq a => a -> a -> Bool
== value
new then Maybe FilePath
forall a. Maybe a
Nothing else FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ value -> FilePath
forall a. Show a => a -> FilePath
show value
new)
    (\key
_ value
v -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
runBuilder (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ witness -> Builder
forall a. BinaryEx a => a -> Builder
putEx (witness -> Builder) -> witness -> Builder
forall a b. (a -> b) -> a -> b
$ value -> witness
witness value
v)
    (\key
k Maybe ByteString
old RunMode
_ -> IO (RunResult value) -> Action (RunResult value)
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (RunResult value) -> Action (RunResult value))
-> IO (RunResult value) -> Action (RunResult value)
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
        RunResult value -> IO (RunResult value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult value -> IO (RunResult value))
-> RunResult value -> IO (RunResult value)
forall a b. (a -> b) -> a -> b
$ case Maybe ByteString
old of
            Just ByteString
old | witness
wnew witness -> witness -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> witness
forall a. BinaryEx a => ByteString -> a
getEx ByteString
old -> RunChanged -> ByteString -> value -> RunResult value
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedNothing ByteString
old value
new
            Maybe ByteString
_ -> RunChanged -> ByteString -> value -> RunResult value
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedRecomputeDiff (Builder -> ByteString
runBuilder (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ witness -> Builder
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
    (DoesFileExistA -> DoesFileExistA)
-> (DoesFileExistQ -> IO DoesFileExistA) -> Rules ()
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 DoesFileExistA -> DoesFileExistA
forall a. a -> a
id (\(DoesFileExistQ FilePath
x) -> Bool -> DoesFileExistA
DoesFileExistA (Bool -> DoesFileExistA) -> IO Bool -> IO DoesFileExistA
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
IO.doesFileExist FilePath
x)
    (DoesDirectoryExistA -> DoesDirectoryExistA)
-> (DoesDirectoryExistQ -> IO DoesDirectoryExistA) -> Rules ()
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 DoesDirectoryExistA -> DoesDirectoryExistA
forall a. a -> a
id (\(DoesDirectoryExistQ FilePath
x) -> Bool -> DoesDirectoryExistA
DoesDirectoryExistA (Bool -> DoesDirectoryExistA) -> IO Bool -> IO DoesDirectoryExistA
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
IO.doesDirectoryExist FilePath
x)
    (GetEnvA -> Int) -> (GetEnvQ -> IO GetEnvA) -> Rules ()
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 GetEnvA -> Int
forall a. Hashable a => a -> Int
hash (\(GetEnvQ FilePath
x) -> Maybe FilePath -> GetEnvA
GetEnvA (Maybe FilePath -> GetEnvA) -> IO (Maybe FilePath) -> IO GetEnvA
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
IO.lookupEnv FilePath
x)
    (GetDirectoryA -> Int)
-> (GetDirectoryContentsQ -> IO GetDirectoryA) -> Rules ()
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 GetDirectoryA -> Int
forall a. Hashable a => a -> Int
hash (\(GetDirectoryContentsQ FilePath
x) -> [FilePath] -> GetDirectoryA
GetDirectoryA ([FilePath] -> GetDirectoryA) -> IO [FilePath] -> IO GetDirectoryA
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
getDirectoryContentsIO FilePath
x)
    (GetDirectoryA -> Int)
-> (GetDirectoryFilesQ -> IO GetDirectoryA) -> Rules ()
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 GetDirectoryA -> Int
forall a. Hashable a => a -> Int
hash (\(GetDirectoryFilesQ (FilePath
a,[FilePath]
b)) -> [FilePath] -> GetDirectoryA
GetDirectoryA ([FilePath] -> GetDirectoryA) -> IO [FilePath] -> IO GetDirectoryA
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> IO [FilePath]
getDirectoryFilesIO FilePath
a [FilePath]
b)
    (GetDirectoryA -> Int)
-> (GetDirectoryDirsQ -> IO GetDirectoryA) -> Rules ()
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 GetDirectoryA -> Int
forall a. Hashable a => a -> Int
hash (\(GetDirectoryDirsQ FilePath
x) -> [FilePath] -> GetDirectoryA
GetDirectoryA ([FilePath] -> GetDirectoryA) -> IO [FilePath] -> IO 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 = (DoesFileExistA -> Bool) -> Action DoesFileExistA -> Action Bool
forall a b. (a -> b) -> Action a -> Action b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DoesFileExistA -> Bool
fromDoesFileExistA (Action DoesFileExistA -> Action Bool)
-> (FilePath -> Action DoesFileExistA) -> FilePath -> Action Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DoesFileExistQ -> Action DoesFileExistA
forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 (DoesFileExistQ -> Action DoesFileExistA)
-> (FilePath -> DoesFileExistQ)
-> FilePath
-> Action DoesFileExistA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> DoesFileExistQ
DoesFileExistQ (FilePath -> DoesFileExistQ) -> ShowS -> FilePath -> 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 = (DoesDirectoryExistA -> Bool)
-> Action DoesDirectoryExistA -> Action Bool
forall a b. (a -> b) -> Action a -> Action b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DoesDirectoryExistA -> Bool
fromDoesDirectoryExistA (Action DoesDirectoryExistA -> Action Bool)
-> (FilePath -> Action DoesDirectoryExistA)
-> FilePath
-> Action Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DoesDirectoryExistQ -> Action DoesDirectoryExistA
forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 (DoesDirectoryExistQ -> Action DoesDirectoryExistA)
-> (FilePath -> DoesDirectoryExistQ)
-> FilePath
-> Action DoesDirectoryExistA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> DoesDirectoryExistQ
DoesDirectoryExistQ (FilePath -> DoesDirectoryExistQ)
-> ShowS -> FilePath -> 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 = (GetEnvA -> Maybe FilePath)
-> Action GetEnvA -> Action (Maybe FilePath)
forall a b. (a -> b) -> Action a -> Action b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GetEnvA -> Maybe FilePath
fromGetEnvA (Action GetEnvA -> Action (Maybe FilePath))
-> (FilePath -> Action GetEnvA)
-> FilePath
-> Action (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetEnvQ -> Action GetEnvA
forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 (GetEnvQ -> Action GetEnvA)
-> (FilePath -> GetEnvQ) -> FilePath -> Action GetEnvA
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 = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
def (Maybe FilePath -> FilePath)
-> Action (Maybe FilePath) -> Action FilePath
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 (ShowS
forall a. Partial => FilePath -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FilePath
"getEnvError: Environment variable " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> ShowS
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 = (GetDirectoryA -> [FilePath])
-> Action GetDirectoryA -> Action [FilePath]
forall a b. (a -> b) -> Action a -> Action b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GetDirectoryA -> [FilePath]
fromGetDirectoryA (Action GetDirectoryA -> Action [FilePath])
-> (FilePath -> Action GetDirectoryA)
-> FilePath
-> Action [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetDirectoryContentsQ -> Action GetDirectoryA
forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 (GetDirectoryContentsQ -> Action GetDirectoryA)
-> (FilePath -> GetDirectoryContentsQ)
-> FilePath
-> Action GetDirectoryA
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 = (GetDirectoryA -> [FilePath])
-> Action GetDirectoryA -> Action [FilePath]
forall a b. (a -> b) -> Action a -> Action b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GetDirectoryA -> [FilePath]
fromGetDirectoryA (Action GetDirectoryA -> Action [FilePath])
-> Action GetDirectoryA -> Action [FilePath]
forall a b. (a -> b) -> a -> b
$ GetDirectoryFilesQ -> Action GetDirectoryA
forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 (GetDirectoryFilesQ -> Action GetDirectoryA)
-> GetDirectoryFilesQ -> Action GetDirectoryA
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 = (GetDirectoryA -> [FilePath])
-> Action GetDirectoryA -> Action [FilePath]
forall a b. (a -> b) -> Action a -> Action b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GetDirectoryA -> [FilePath]
fromGetDirectoryA (Action GetDirectoryA -> Action [FilePath])
-> (FilePath -> Action GetDirectoryA)
-> FilePath
-> Action [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetDirectoryDirsQ -> Action GetDirectoryA
forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 (GetDirectoryDirsQ -> Action GetDirectoryA)
-> (FilePath -> GetDirectoryDirsQ)
-> FilePath
-> Action GetDirectoryA
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 = ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'))) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
IO.getDirectoryContents (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ if FilePath
dir FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"" then FilePath
"." else FilePath
dir


getDirectoryDirsIO :: FilePath -> IO [FilePath]
getDirectoryDirsIO :: FilePath -> IO [FilePath]
getDirectoryDirsIO FilePath
dir = (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
f ([FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
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 (FilePath -> IO Bool) -> FilePath -> IO Bool
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
"" (Walk -> IO [FilePath]) -> Walk -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (Bool, Walk) -> Walk
forall a b. (a, b) -> b
snd ((Bool, Walk) -> Walk) -> (Bool, Walk) -> Walk
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 (Walk -> IO [FilePath])
-> ([FilePath] -> Walk) -> [FilePath] -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath], [(FilePath, Walk)]) -> Walk
WalkTo (([FilePath], [(FilePath, Walk)]) -> Walk)
-> ([FilePath] -> ([FilePath], [(FilePath, Walk)]))
-> [FilePath]
-> Walk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> ([FilePath], [(FilePath, Walk)])
op ([FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
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 <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
IO.doesFileExist (FilePath -> IO Bool) -> ShowS -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
root FilePath -> ShowS
</>)) ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
dir FilePath -> ShowS
</>) [FilePath]
files
            [FilePath]
dirs <- ((FilePath, Walk) -> IO [FilePath])
-> [(FilePath, Walk)] -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM ((FilePath -> Walk -> IO [FilePath])
-> (FilePath, Walk) -> IO [FilePath]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> Walk -> IO [FilePath]
f) ([(FilePath, Walk)] -> IO [FilePath])
-> IO [(FilePath, Walk)] -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((FilePath, Walk) -> IO Bool)
-> [(FilePath, Walk)] -> IO [(FilePath, Walk)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
IO.doesDirectoryExist (FilePath -> IO Bool)
-> ((FilePath, Walk) -> FilePath) -> (FilePath, Walk) -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
root FilePath -> ShowS
</>) ShowS
-> ((FilePath, Walk) -> FilePath) -> (FilePath, Walk) -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, Walk) -> FilePath
forall a b. (a, b) -> a
fst) (((FilePath, Walk) -> (FilePath, Walk))
-> [(FilePath, Walk)] -> [(FilePath, Walk)]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS -> (FilePath, Walk) -> (FilePath, Walk)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (FilePath
dir FilePath -> ShowS
</>)) [(FilePath, Walk)]
dirs)
            [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
files [FilePath] -> [FilePath] -> [FilePath]
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 =
    IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (FilePath -> IO Bool
IO.doesDirectoryExist FilePath
dir) (IO () -> IO ()) -> IO () -> IO ()
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 (Walk -> IO ()) -> ([FilePath] -> Walk) -> [FilePath] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath], [(FilePath, Walk)]) -> Walk
WalkTo (([FilePath], [(FilePath, Walk)]) -> Walk)
-> ([FilePath] -> ([FilePath], [(FilePath, Walk)]))
-> [FilePath]
-> Walk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> ([FilePath], [(FilePath, Walk)])
op ([FilePath] -> IO ()) -> IO [FilePath] -> IO ()
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
            [FilePath] -> (FilePath -> IO (Either IOException ())) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
files ((FilePath -> IO (Either IOException ())) -> IO ())
-> (FilePath -> IO (Either IOException ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
fil ->
                IO () -> IO (Either IOException ())
forall a. IO a -> IO (Either IOException a)
tryIO (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeItem (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> ShowS
</> FilePath
fil
            let done :: HashSet FilePath
done = [FilePath] -> HashSet FilePath
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList [FilePath]
files
            [(FilePath, Walk)] -> ((FilePath, Walk) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (((FilePath, Walk) -> Bool)
-> [(FilePath, Walk)] -> [(FilePath, Walk)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((FilePath, Walk) -> Bool) -> (FilePath, Walk) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> HashSet FilePath -> Bool)
-> HashSet FilePath -> FilePath -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> HashSet FilePath -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
Set.member HashSet FilePath
done (FilePath -> Bool)
-> ((FilePath, Walk) -> FilePath) -> (FilePath, Walk) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, Walk) -> FilePath
forall a b. (a, b) -> a
fst) [(FilePath, Walk)]
dirs) (((FilePath, Walk) -> IO ()) -> IO ())
-> ((FilePath, Walk) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(FilePath
d,Walk
w) -> do
                let dir2 :: FilePath
dir2 = FilePath
dir FilePath -> ShowS
</> FilePath
d
                IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (FilePath -> IO Bool
IO.doesDirectoryExist FilePath
dir2) (IO () -> IO ()) -> IO () -> IO ()
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 IO () -> (IOException -> IO ()) -> IO ()
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
            (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> IO ()
removeItem (FilePath -> IO ()) -> ShowS -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
x FilePath -> ShowS
</>)) ([FilePath] -> IO ()) -> IO [FilePath] -> IO ()
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 (FilePath -> Action ()) -> FilePath -> Action ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Will remove " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
b FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" from " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
a
    IO () -> Action ()
runAfter (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> IO ()
removeFiles FilePath
a [FilePath]
b