{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TupleSections #-}moduleDevelopment.Shake.Internal.History.Shared(Shared ,newShared ,addShared ,lookupShared ,removeShared ,listShared ,sanityShared )whereimportControl.ExceptionimportDevelopment.Shake.Internal.Value importDevelopment.Shake.Internal.History.Types importDevelopment.Shake.Internal.History.Symlink importDevelopment.Shake.Internal.Core.Database importDevelopment.Shake.Classes importGeneral.Binary importGeneral.Extra importData.ListimportControl.Monad.ExtraimportSystem.Directory.ExtraimportSystem.FilePathimportSystem.IO.ExtraimportNumericimportDevelopment.Shake.Internal.FileInfo importGeneral.Wait importDevelopment.Shake.Internal.FileName importData.MonoidimportControl.Monad.IO.ClassimportData.MaybeimportqualifiedData.ByteStringasBSimportPreludedataShared =Shared {Shared -> Ver
globalVersion ::!Ver ,Shared -> BinaryOp Key
keyOp ::BinaryOp Key ,Shared -> FilePath
sharedRoot ::FilePath,Shared -> Bool
useSymlink ::Bool}newShared ::Bool->BinaryOp Key ->Ver ->FilePath->IOShared newShared :: Bool -> BinaryOp Key -> Ver -> FilePath -> IO Shared
newShared Bool
useSymlink BinaryOp Key
keyOp Ver
globalVersion FilePath
sharedRoot =Shared -> IO Shared
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pureShared {Bool
FilePath
BinaryOp Key
Ver
globalVersion :: Ver
keyOp :: BinaryOp Key
sharedRoot :: FilePath
useSymlink :: Bool
useSymlink :: Bool
keyOp :: BinaryOp Key
globalVersion :: Ver
sharedRoot :: FilePath
.. }dataEntry =Entry {Entry -> Key
entryKey ::Key ,Entry -> Ver
entryGlobalVersion ::!Ver ,Entry -> Ver
entryBuiltinVersion ::!Ver ,Entry -> Ver
entryUserVersion ::!Ver ,Entry -> [[(Key, BS_Identity)]]
entryDepends ::[[(Key ,BS_Identity )]],Entry -> BS_Identity
entryResult ::BS_Store ,Entry -> [(FilePath, FileHash)]
entryFiles ::[(FilePath,FileHash )]}deriving(Int -> Entry -> ShowS
[Entry] -> ShowS
Entry -> FilePath
(Int -> Entry -> ShowS)
-> (Entry -> FilePath) -> ([Entry] -> ShowS) -> Show Entry
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Entry -> ShowS
showsPrec :: Int -> Entry -> ShowS
$cshow :: Entry -> FilePath
show :: Entry -> FilePath
$cshowList :: [Entry] -> ShowS
showList :: [Entry] -> ShowS
Show,Entry -> Entry -> Bool
(Entry -> Entry -> Bool) -> (Entry -> Entry -> Bool) -> Eq Entry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Entry -> Entry -> Bool
== :: Entry -> Entry -> Bool
$c/= :: Entry -> Entry -> Bool
/= :: Entry -> Entry -> Bool
Eq)putEntry ::BinaryOp Key ->Entry ->Builder putEntry :: BinaryOp Key -> Entry -> Builder
putEntry BinaryOp Key
binop Entry {[[(Key, BS_Identity)]]
[(FilePath, FileHash)]
BS_Identity
Ver
Key
entryKey :: Entry -> Key
entryGlobalVersion :: Entry -> Ver
entryBuiltinVersion :: Entry -> Ver
entryUserVersion :: Entry -> Ver
entryDepends :: Entry -> [[(Key, BS_Identity)]]
entryResult :: Entry -> BS_Identity
entryFiles :: Entry -> [(FilePath, FileHash)]
entryKey :: Key
entryGlobalVersion :: Ver
entryBuiltinVersion :: Ver
entryUserVersion :: Ver
entryDepends :: [[(Key, BS_Identity)]]
entryResult :: BS_Identity
entryFiles :: [(FilePath, FileHash)]
.. }=Ver -> Builder
forall a. Storable a => a -> Builder
putExStorable Ver
entryGlobalVersion Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Ver -> Builder
forall a. Storable a => a -> Builder
putExStorable Ver
entryBuiltinVersion Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Ver -> Builder
forall a. Storable a => a -> Builder
putExStorable Ver
entryUserVersion Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Builder -> Builder
putExN (BinaryOp Key -> Key -> Builder
forall v. BinaryOp v -> v -> Builder
putOp BinaryOp Key
binop Key
entryKey )Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Builder -> Builder
putExN ([Builder] -> Builder
putExList ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$([(Key, BS_Identity)] -> Builder)
-> [[(Key, BS_Identity)]] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map([Builder] -> Builder
putExList ([Builder] -> Builder)
-> ([(Key, BS_Identity)] -> [Builder])
-> [(Key, BS_Identity)]
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Key, BS_Identity) -> Builder)
-> [(Key, BS_Identity)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map(Key, BS_Identity) -> Builder
forall {a}. BinaryEx a => (Key, a) -> Builder
putDepend )[[(Key, BS_Identity)]]
entryDepends )Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Builder -> Builder
putExN ([Builder] -> Builder
putExList ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$((FilePath, FileHash) -> Builder)
-> [(FilePath, FileHash)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map(FilePath, FileHash) -> Builder
forall {a} {a}. (Storable a, BinaryEx a) => (a, a) -> Builder
putFile [(FilePath, FileHash)]
entryFiles )Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>BS_Identity -> Builder
forall a. BinaryEx a => a -> Builder
putEx BS_Identity
entryResult whereputDepend :: (Key, a) -> Builder
putDepend (Key
a ,a
b )=Builder -> Builder
putExN (BinaryOp Key -> Key -> Builder
forall v. BinaryOp v -> v -> Builder
putOp BinaryOp Key
binop Key
a )Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>a -> Builder
forall a. BinaryEx a => a -> Builder
putEx a
b putFile :: (a, a) -> Builder
putFile (a
a ,a
b )=a -> Builder
forall a. Storable a => a -> Builder
putExStorable a
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>a -> Builder
forall a. BinaryEx a => a -> Builder
putEx a
a getEntry ::BinaryOp Key ->BS.ByteString->Entry getEntry :: BinaryOp Key -> BS_Identity -> Entry
getEntry BinaryOp Key
binop BS_Identity
x |(Ver
x1 ,Ver
x2 ,Ver
x3 ,BS_Identity
x )<-BS_Identity -> (Ver, Ver, Ver, BS_Identity)
forall a b c.
(Storable a, Storable b, Storable c) =>
BS_Identity -> (a, b, c, BS_Identity)
binarySplit3 BS_Identity
x ,(BS_Identity
x4 ,BS_Identity
x )<-BS_Identity -> (BS_Identity, BS_Identity)
getExN BS_Identity
x ,(BS_Identity
x5 ,BS_Identity
x )<-BS_Identity -> (BS_Identity, BS_Identity)
getExN BS_Identity
x ,(BS_Identity
x6 ,BS_Identity
x7 )<-BS_Identity -> (BS_Identity, BS_Identity)
getExN BS_Identity
x =Entry {entryGlobalVersion :: Ver
entryGlobalVersion =Ver
x1 ,entryBuiltinVersion :: Ver
entryBuiltinVersion =Ver
x2 ,entryUserVersion :: Ver
entryUserVersion =Ver
x3 ,entryKey :: Key
entryKey =BinaryOp Key -> BS_Identity -> Key
forall v. BinaryOp v -> BS_Identity -> v
getOp BinaryOp Key
binop BS_Identity
x4 ,entryDepends :: [[(Key, BS_Identity)]]
entryDepends =(BS_Identity -> [(Key, BS_Identity)])
-> [BS_Identity] -> [[(Key, BS_Identity)]]
forall a b. (a -> b) -> [a] -> [b]
map((BS_Identity -> (Key, BS_Identity))
-> [BS_Identity] -> [(Key, BS_Identity)]
forall a b. (a -> b) -> [a] -> [b]
mapBS_Identity -> (Key, BS_Identity)
forall {b}. BinaryEx b => BS_Identity -> (Key, b)
getDepend ([BS_Identity] -> [(Key, BS_Identity)])
-> (BS_Identity -> [BS_Identity])
-> BS_Identity
-> [(Key, BS_Identity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.BS_Identity -> [BS_Identity]
getExList )([BS_Identity] -> [[(Key, BS_Identity)]])
-> [BS_Identity] -> [[(Key, BS_Identity)]]
forall a b. (a -> b) -> a -> b
$BS_Identity -> [BS_Identity]
getExList BS_Identity
x5 ,entryFiles :: [(FilePath, FileHash)]
entryFiles =(BS_Identity -> (FilePath, FileHash))
-> [BS_Identity] -> [(FilePath, FileHash)]
forall a b. (a -> b) -> [a] -> [b]
mapBS_Identity -> (FilePath, FileHash)
forall {b} {a}. (Storable b, BinaryEx a) => BS_Identity -> (a, b)
getFile ([BS_Identity] -> [(FilePath, FileHash)])
-> [BS_Identity] -> [(FilePath, FileHash)]
forall a b. (a -> b) -> a -> b
$BS_Identity -> [BS_Identity]
getExList BS_Identity
x6 ,entryResult :: BS_Identity
entryResult =BS_Identity -> BS_Identity
forall a. BinaryEx a => BS_Identity -> a
getEx BS_Identity
x7 }wheregetDepend :: BS_Identity -> (Key, b)
getDepend BS_Identity
x |(BS_Identity
a ,BS_Identity
b )<-BS_Identity -> (BS_Identity, BS_Identity)
getExN BS_Identity
x =(BinaryOp Key -> BS_Identity -> Key
forall v. BinaryOp v -> BS_Identity -> v
getOp BinaryOp Key
binop BS_Identity
a ,BS_Identity -> b
forall a. BinaryEx a => BS_Identity -> a
getEx BS_Identity
b )getFile :: BS_Identity -> (a, b)
getFile BS_Identity
x |(b
b ,BS_Identity
a )<-BS_Identity -> (b, BS_Identity)
forall a. Storable a => BS_Identity -> (a, BS_Identity)
binarySplit BS_Identity
x =(BS_Identity -> a
forall a. BinaryEx a => BS_Identity -> a
getEx BS_Identity
a ,b
b )hexed :: a -> FilePath
hexed a
x =Int -> ShowS
forall a. Integral a => a -> ShowS
showHex(Int -> Int
forall a. Num a => a -> a
abs(Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$a -> Int
forall a. Hashable a => a -> Int
hasha
x )FilePath
""-- | The path under which everything relating to a Key livessharedFileDir ::Shared ->Key ->FilePathsharedFileDir :: Shared -> Key -> FilePath
sharedFileDir Shared
shared Key
key =Shared -> FilePath
sharedRoot Shared
shared FilePath -> ShowS
</>FilePath
".shake.cache"FilePath -> ShowS
</>Key -> FilePath
forall {a}. Hashable a => a -> FilePath
hexed Key
key -- | The list of files containing Entry values, given a result of 'sharedFileDir'sharedFileKeys ::FilePath->IO[FilePath]sharedFileKeys :: FilePath -> IO [FilePath]
sharedFileKeys FilePath
dir =doBool
b <-FilePath -> IO Bool
doesDirectoryExist_ (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$FilePath
dir FilePath -> ShowS
</>FilePath
"_key"ifBool -> Bool
notBool
b then[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure[]elseFilePath -> IO [FilePath]
listFiles(FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$FilePath
dir FilePath -> ShowS
</>FilePath
"_key"loadSharedEntry ::Shared ->Key ->Ver ->Ver ->IO[IO(MaybeEntry )]loadSharedEntry :: Shared -> Key -> Ver -> Ver -> IO [IO (Maybe Entry)]
loadSharedEntry shared :: Shared
shared @Shared {Bool
FilePath
BinaryOp Key
Ver
globalVersion :: Shared -> Ver
keyOp :: Shared -> BinaryOp Key
sharedRoot :: Shared -> FilePath
useSymlink :: Shared -> Bool
globalVersion :: Ver
keyOp :: BinaryOp Key
sharedRoot :: FilePath
useSymlink :: Bool
.. }Key
key Ver
builtinVersion Ver
userVersion =(FilePath -> IO (Maybe Entry)) -> [FilePath] -> [IO (Maybe Entry)]
forall a b. (a -> b) -> [a] -> [b]
mapFilePath -> IO (Maybe Entry)
f ([FilePath] -> [IO (Maybe Entry)])
-> IO [FilePath] -> IO [IO (Maybe Entry)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>FilePath -> IO [FilePath]
sharedFileKeys (Shared -> Key -> FilePath
sharedFileDir Shared
shared Key
key )wheref :: FilePath -> IO (Maybe Entry)
f FilePath
file =doe :: Entry
e @Entry {[[(Key, BS_Identity)]]
[(FilePath, FileHash)]
BS_Identity
Ver
Key
entryKey :: Entry -> Key
entryGlobalVersion :: Entry -> Ver
entryBuiltinVersion :: Entry -> Ver
entryUserVersion :: Entry -> Ver
entryDepends :: Entry -> [[(Key, BS_Identity)]]
entryResult :: Entry -> BS_Identity
entryFiles :: Entry -> [(FilePath, FileHash)]
entryKey :: Key
entryGlobalVersion :: Ver
entryBuiltinVersion :: Ver
entryUserVersion :: Ver
entryDepends :: [[(Key, BS_Identity)]]
entryResult :: BS_Identity
entryFiles :: [(FilePath, FileHash)]
.. }<-BinaryOp Key -> BS_Identity -> Entry
getEntry BinaryOp Key
keyOp (BS_Identity -> Entry) -> IO BS_Identity -> IO Entry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>FilePath -> IO BS_Identity
BS.readFileFilePath
file letvalid :: Bool
valid =Key
entryKey Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
==Key
key Bool -> Bool -> Bool
&&Ver
entryGlobalVersion Ver -> Ver -> Bool
forall a. Eq a => a -> a -> Bool
==Ver
globalVersion Bool -> Bool -> Bool
&&Ver
entryBuiltinVersion Ver -> Ver -> Bool
forall a. Eq a => a -> a -> Bool
==Ver
builtinVersion Bool -> Bool -> Bool
&&Ver
entryUserVersion Ver -> Ver -> Bool
forall a. Eq a => a -> a -> Bool
==Ver
userVersion Maybe Entry -> IO (Maybe Entry)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure(Maybe Entry -> IO (Maybe Entry))
-> Maybe Entry -> IO (Maybe Entry)
forall a b. (a -> b) -> a -> b
$ifBool
valid thenEntry -> Maybe Entry
forall a. a -> Maybe a
JustEntry
e elseMaybe Entry
forall a. Maybe a
Nothing-- | Given a way to get the identity, see if you can find a stored cloud versionlookupShared ::Shared ->(Key ->Wait Locked (MaybeBS_Identity ))->Key ->Ver ->Ver ->Wait Locked (Maybe(BS_Store ,[[Key ]],IO()))lookupShared :: Shared
-> (Key -> Wait Locked (Maybe BS_Identity))
-> Key
-> Ver
-> Ver
-> Wait Locked (Maybe (BS_Identity, [[Key]], IO ()))
lookupShared Shared
shared Key -> Wait Locked (Maybe BS_Identity)
ask Key
key Ver
builtinVersion Ver
userVersion =do[IO (Maybe Entry)]
ents <-IO [IO (Maybe Entry)] -> Wait Locked [IO (Maybe Entry)]
forall a. IO a -> Wait Locked a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO(IO [IO (Maybe Entry)] -> Wait Locked [IO (Maybe Entry)])
-> IO [IO (Maybe Entry)] -> Wait Locked [IO (Maybe Entry)]
forall a b. (a -> b) -> a -> b
$Shared -> Key -> Ver -> Ver -> IO [IO (Maybe Entry)]
loadSharedEntry Shared
shared Key
key Ver
builtinVersion Ver
userVersion ((IO (Maybe Entry)
 -> Wait Locked (Maybe (BS_Identity, [[Key]], IO ())))
 -> [IO (Maybe Entry)]
 -> Wait Locked (Maybe (BS_Identity, [[Key]], IO ())))
-> [IO (Maybe Entry)]
-> (IO (Maybe Entry)
 -> Wait Locked (Maybe (BS_Identity, [[Key]], IO ())))
-> Wait Locked (Maybe (BS_Identity, [[Key]], IO ()))
forall a b c. (a -> b -> c) -> b -> a -> c
flip(IO (Maybe Entry)
 -> Wait Locked (Maybe (BS_Identity, [[Key]], IO ())))
-> [IO (Maybe Entry)]
-> Wait Locked (Maybe (BS_Identity, [[Key]], IO ()))
forall (m :: * -> *) a b.
MonadIO m =>
(a -> Wait m (Maybe b)) -> [a] -> Wait m (Maybe b)
firstJustWaitUnordered [IO (Maybe Entry)]
ents ((IO (Maybe Entry)
 -> Wait Locked (Maybe (BS_Identity, [[Key]], IO ())))
 -> Wait Locked (Maybe (BS_Identity, [[Key]], IO ())))
-> (IO (Maybe Entry)
 -> Wait Locked (Maybe (BS_Identity, [[Key]], IO ())))
-> Wait Locked (Maybe (BS_Identity, [[Key]], IO ()))
forall a b. (a -> b) -> a -> b
$\IO (Maybe Entry)
act ->doMaybe Entry
me <-IO (Maybe Entry) -> Wait Locked (Maybe Entry)
forall a. IO a -> Wait Locked a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOIO (Maybe Entry)
act caseMaybe Entry
me ofMaybe Entry
Nothing->Maybe (BS_Identity, [[Key]], IO ())
-> Wait Locked (Maybe (BS_Identity, [[Key]], IO ()))
forall a. a -> Wait Locked a
forall (f :: * -> *) a. Applicative f => a -> f a
pureMaybe (BS_Identity, [[Key]], IO ())
forall a. Maybe a
NothingJustEntry {[[(Key, BS_Identity)]]
[(FilePath, FileHash)]
BS_Identity
Ver
Key
entryKey :: Entry -> Key
entryGlobalVersion :: Entry -> Ver
entryBuiltinVersion :: Entry -> Ver
entryUserVersion :: Entry -> Ver
entryDepends :: Entry -> [[(Key, BS_Identity)]]
entryResult :: Entry -> BS_Identity
entryFiles :: Entry -> [(FilePath, FileHash)]
entryKey :: Key
entryGlobalVersion :: Ver
entryBuiltinVersion :: Ver
entryUserVersion :: Ver
entryDepends :: [[(Key, BS_Identity)]]
entryResult :: BS_Identity
entryFiles :: [(FilePath, FileHash)]
.. }->do-- use Nothing to indicate success, Just () to bail out early on mismatchletresult :: Maybe a -> Maybe (BS_Identity, [[Key]], IO ())
result Maybe a
x =ifMaybe a -> Bool
forall a. Maybe a -> Bool
isJustMaybe a
x thenMaybe (BS_Identity, [[Key]], IO ())
forall a. Maybe a
Nothingelse(BS_Identity, [[Key]], IO ())
-> Maybe (BS_Identity, [[Key]], IO ())
forall a. a -> Maybe a
Just((BS_Identity, [[Key]], IO ())
 -> Maybe (BS_Identity, [[Key]], IO ()))
-> (BS_Identity, [[Key]], IO ())
-> Maybe (BS_Identity, [[Key]], IO ())
forall a b. (a -> b) -> a -> b
$(BS_Identity
entryResult ,([(Key, BS_Identity)] -> [Key])
-> [[(Key, BS_Identity)]] -> [[Key]]
forall a b. (a -> b) -> [a] -> [b]
map(((Key, BS_Identity) -> Key) -> [(Key, BS_Identity)] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map(Key, BS_Identity) -> Key
forall a b. (a, b) -> a
fst)[[(Key, BS_Identity)]]
entryDepends ,)(IO () -> (BS_Identity, [[Key]], IO ()))
-> IO () -> (BS_Identity, [[Key]], IO ())
forall a b. (a -> b) -> a -> b
$doletdir :: FilePath
dir =Shared -> Key -> FilePath
sharedFileDir Shared
shared Key
entryKey [(FilePath, FileHash)] -> ((FilePath, FileHash) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_[(FilePath, FileHash)]
entryFiles (((FilePath, FileHash) -> IO ()) -> IO ())
-> ((FilePath, FileHash) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\(FilePath
file ,FileHash
hash )->Bool -> FilePath -> FilePath -> IO ()
copyFileLink (Shared -> Bool
useSymlink Shared
shared )(FilePath
dir FilePath -> ShowS
</>FileHash -> FilePath
forall a. Show a => a -> FilePath
showFileHash
hash )FilePath
file Maybe () -> Maybe (BS_Identity, [[Key]], IO ())
forall {a}. Maybe a -> Maybe (BS_Identity, [[Key]], IO ())
result (Maybe () -> Maybe (BS_Identity, [[Key]], IO ()))
-> Wait Locked (Maybe ())
-> Wait Locked (Maybe (BS_Identity, [[Key]], IO ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(Wait Locked (Maybe ()) -> Wait Locked (Maybe ()))
-> [Wait Locked (Maybe ())] -> Wait Locked (Maybe ())
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstJustMWait Locked (Maybe ()) -> Wait Locked (Maybe ())
forall a. a -> a
id[(Wait Locked (Maybe ()) -> Wait Locked (Maybe ()))
-> [Wait Locked (Maybe ())] -> Wait Locked (Maybe ())
forall (m :: * -> *) a b.
MonadIO m =>
(a -> Wait m (Maybe b)) -> [a] -> Wait m (Maybe b)
firstJustWaitUnordered Wait Locked (Maybe ()) -> Wait Locked (Maybe ())
forall a. a -> a
id[Maybe BS_Identity -> Maybe ()
test (Maybe BS_Identity -> Maybe ())
-> Wait Locked (Maybe BS_Identity) -> Wait Locked (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>Key -> Wait Locked (Maybe BS_Identity)
ask Key
k |(Key
k ,BS_Identity
i1 )<-[(Key, BS_Identity)]
kis ,lettest :: Maybe BS_Identity -> Maybe ()
test =Maybe ()
-> (BS_Identity -> Maybe ()) -> Maybe BS_Identity -> Maybe ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe(() -> Maybe ()
forall a. a -> Maybe a
Just())(\BS_Identity
i2 ->ifBS_Identity
i1 BS_Identity -> BS_Identity -> Bool
forall a. Eq a => a -> a -> Bool
==BS_Identity
i2 thenMaybe ()
forall a. Maybe a
Nothingelse() -> Maybe ()
forall a. a -> Maybe a
Just())]|[(Key, BS_Identity)]
kis <-[[(Key, BS_Identity)]]
entryDepends ]saveSharedEntry ::Shared ->Entry ->IO()saveSharedEntry :: Shared -> Entry -> IO ()
saveSharedEntry Shared
shared Entry
entry =doletdir :: FilePath
dir =Shared -> Key -> FilePath
sharedFileDir Shared
shared (Entry -> Key
entryKey Entry
entry )FilePath -> IO ()
createDirectoryRecursive FilePath
dir [(FilePath, FileHash)] -> ((FilePath, FileHash) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_(Entry -> [(FilePath, FileHash)]
entryFiles Entry
entry )(((FilePath, FileHash) -> IO ()) -> IO ())
-> ((FilePath, FileHash) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\(FilePath
file ,FileHash
hash )->IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM(FilePath -> IO Bool
doesFileExist_ (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$FilePath
dir FilePath -> ShowS
</>FileHash -> FilePath
forall a. Show a => a -> FilePath
showFileHash
hash )(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$Bool -> FilePath -> FilePath -> IO ()
copyFileLink (Shared -> Bool
useSymlink Shared
shared )FilePath
file (FilePath
dir FilePath -> ShowS
</>FileHash -> FilePath
forall a. Show a => a -> FilePath
showFileHash
hash )-- Write key after files to make sure cache is always useableletv :: BS_Identity
v =Builder -> BS_Identity
runBuilder (Builder -> BS_Identity) -> Builder -> BS_Identity
forall a b. (a -> b) -> a -> b
$BinaryOp Key -> Entry -> Builder
putEntry (Shared -> BinaryOp Key
keyOp Shared
shared )Entry
entry letdirName :: FilePath
dirName =FilePath
dir FilePath -> ShowS
</>FilePath
"_key"FilePath -> IO ()
createDirectoryRecursive FilePath
dirName -- #757, make sure we write this file atomically(FilePath
tempFile ,IO ()
cleanUp )<-FilePath -> IO (FilePath, IO ())
newTempFileWithinFilePath
dir (FilePath -> BS_Identity -> IO ()
BS.writeFileFilePath
tempFile BS_Identity
v IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>FilePath -> FilePath -> IO ()
renameFileFilePath
tempFile (FilePath
dirName FilePath -> ShowS
</>BS_Identity -> FilePath
forall {a}. Hashable a => a -> FilePath
hexed BS_Identity
v ))IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`onException`IO ()
cleanUp addShared ::Shared ->Key ->Ver ->Ver ->[[(Key ,BS_Identity )]]->BS_Store ->[FilePath]->IO()addShared :: Shared
-> Key
-> Ver
-> Ver
-> [[(Key, BS_Identity)]]
-> BS_Identity
-> [FilePath]
-> IO ()
addShared Shared
shared Key
entryKey Ver
entryBuiltinVersion Ver
entryUserVersion [[(Key, BS_Identity)]]
entryDepends BS_Identity
entryResult [FilePath]
files =do[(FilePath, FileHash)]
files <-(FilePath -> IO (FilePath, FileHash))
-> [FilePath] -> IO [(FilePath, FileHash)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM(\FilePath
x ->(FilePath
x ,)(FileHash -> (FilePath, FileHash))
-> IO FileHash -> IO (FilePath, FileHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>FileName -> IO FileHash
getFileHash (FilePath -> FileName
fileNameFromString FilePath
x ))[FilePath]
files Shared -> Entry -> IO ()
saveSharedEntry Shared
shared Entry {entryFiles :: [(FilePath, FileHash)]
entryFiles =[(FilePath, FileHash)]
files ,entryGlobalVersion :: Ver
entryGlobalVersion =Shared -> Ver
globalVersion Shared
shared ,[[(Key, BS_Identity)]]
BS_Identity
Ver
Key
entryKey :: Key
entryBuiltinVersion :: Ver
entryUserVersion :: Ver
entryDepends :: [[(Key, BS_Identity)]]
entryResult :: BS_Identity
entryKey :: Key
entryBuiltinVersion :: Ver
entryUserVersion :: Ver
entryDepends :: [[(Key, BS_Identity)]]
entryResult :: BS_Identity
.. }removeShared ::Shared ->(Key ->Bool)->IO()removeShared :: Shared -> (Key -> Bool) -> IO ()
removeShared Shared {Bool
FilePath
BinaryOp Key
Ver
globalVersion :: Shared -> Ver
keyOp :: Shared -> BinaryOp Key
sharedRoot :: Shared -> FilePath
useSymlink :: Shared -> Bool
globalVersion :: Ver
keyOp :: BinaryOp Key
sharedRoot :: FilePath
useSymlink :: Bool
.. }Key -> Bool
test =do[FilePath]
dirs <-FilePath -> IO [FilePath]
listDirectories(FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$FilePath
sharedRoot FilePath -> ShowS
</>FilePath
".shake.cache"[Bool]
deleted <-[FilePath] -> (FilePath -> IO Bool) -> IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM[FilePath]
dirs ((FilePath -> IO Bool) -> IO [Bool])
-> (FilePath -> IO Bool) -> IO [Bool]
forall a b. (a -> b) -> a -> b
$\FilePath
dir ->do[FilePath]
files <-FilePath -> IO [FilePath]
sharedFileKeys FilePath
dir -- if any key matches, clean them all outBool
b <-((FilePath -> IO Bool) -> [FilePath] -> IO Bool)
-> [FilePath] -> (FilePath -> IO Bool) -> IO Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip(FilePath -> IO Bool) -> [FilePath] -> IO Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM[FilePath]
files ((FilePath -> IO Bool) -> IO Bool)
-> (FilePath -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$\FilePath
file ->(SomeException -> IO Bool) -> IO Bool -> IO Bool
forall a. (SomeException -> IO a) -> IO a -> IO a
handleSynchronous (\SomeException
e ->FilePath -> IO ()
putStrLn(FilePath
"Warning: "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++SomeException -> FilePath
forall a. Show a => a -> FilePath
showSomeException
e )IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pureBool
False)(IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$Bool -> IO Bool
forall a. a -> IO a
evaluate(Bool -> IO Bool)
-> (BS_Identity -> Bool) -> BS_Identity -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Key -> Bool
test (Key -> Bool) -> (BS_Identity -> Key) -> BS_Identity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Entry -> Key
entryKey (Entry -> Key) -> (BS_Identity -> Entry) -> BS_Identity -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
.BinaryOp Key -> BS_Identity -> Entry
getEntry BinaryOp Key
keyOp (BS_Identity -> IO Bool) -> IO BS_Identity -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<FilePath -> IO BS_Identity
BS.readFileFilePath
file Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenBool
b (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$FilePath -> IO ()
removePathForciblyFilePath
dir Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pureBool
b IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$FilePath -> IO ()
putStrLn(FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$FilePath
"Deleted "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> FilePath
forall a. Show a => a -> FilePath
show([Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length((Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
filterBool -> Bool
forall a. a -> a
id[Bool]
deleted ))FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
" entries"listShared ::Shared ->IO()listShared :: Shared -> IO ()
listShared Shared {Bool
FilePath
BinaryOp Key
Ver
globalVersion :: Shared -> Ver
keyOp :: Shared -> BinaryOp Key
sharedRoot :: Shared -> FilePath
useSymlink :: Shared -> Bool
globalVersion :: Ver
keyOp :: BinaryOp Key
sharedRoot :: FilePath
useSymlink :: Bool
.. }=do[FilePath]
dirs <-FilePath -> IO [FilePath]
listDirectories(FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$FilePath
sharedRoot FilePath -> ShowS
</>FilePath
".shake.cache"[FilePath] -> (FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_[FilePath]
dirs ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\FilePath
dir ->doFilePath -> IO ()
putStrLn(FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$FilePath
"Directory: "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
dir [FilePath]
keys <-FilePath -> IO [FilePath]
sharedFileKeys FilePath
dir [FilePath] -> (FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_[FilePath]
keys ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\FilePath
key ->(SomeException -> IO ()) -> IO () -> IO ()
forall a. (SomeException -> IO a) -> IO a -> IO a
handleSynchronous (\SomeException
e ->FilePath -> IO ()
putStrLn(FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$FilePath
"Warning: "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++SomeException -> FilePath
forall a. Show a => a -> FilePath
showSomeException
e )(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$doEntry {[[(Key, BS_Identity)]]
[(FilePath, FileHash)]
BS_Identity
Ver
Key
entryKey :: Entry -> Key
entryGlobalVersion :: Entry -> Ver
entryBuiltinVersion :: Entry -> Ver
entryUserVersion :: Entry -> Ver
entryDepends :: Entry -> [[(Key, BS_Identity)]]
entryResult :: Entry -> BS_Identity
entryFiles :: Entry -> [(FilePath, FileHash)]
entryKey :: Key
entryGlobalVersion :: Ver
entryBuiltinVersion :: Ver
entryUserVersion :: Ver
entryDepends :: [[(Key, BS_Identity)]]
entryResult :: BS_Identity
entryFiles :: [(FilePath, FileHash)]
.. }<-BinaryOp Key -> BS_Identity -> Entry
getEntry BinaryOp Key
keyOp (BS_Identity -> Entry) -> IO BS_Identity -> IO Entry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>FilePath -> IO BS_Identity
BS.readFileFilePath
key FilePath -> IO ()
putStrLn(FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$FilePath
" Key: "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++Key -> FilePath
forall a. Show a => a -> FilePath
showKey
entryKey [(FilePath, FileHash)] -> ((FilePath, FileHash) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_[(FilePath, FileHash)]
entryFiles (((FilePath, FileHash) -> IO ()) -> IO ())
-> ((FilePath, FileHash) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\(FilePath
file ,FileHash
_)->FilePath -> IO ()
putStrLn(FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$FilePath
" File: "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
file sanityShared ::Shared ->IO()sanityShared :: Shared -> IO ()
sanityShared Shared {Bool
FilePath
BinaryOp Key
Ver
globalVersion :: Shared -> Ver
keyOp :: Shared -> BinaryOp Key
sharedRoot :: Shared -> FilePath
useSymlink :: Shared -> Bool
globalVersion :: Ver
keyOp :: BinaryOp Key
sharedRoot :: FilePath
useSymlink :: Bool
.. }=do[FilePath]
dirs <-FilePath -> IO [FilePath]
listDirectories(FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$FilePath
sharedRoot FilePath -> ShowS
</>FilePath
".shake.cache"[FilePath] -> (FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_[FilePath]
dirs ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\FilePath
dir ->doFilePath -> IO ()
putStrLn(FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$FilePath
"Directory: "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
dir [FilePath]
keys <-FilePath -> IO [FilePath]
sharedFileKeys FilePath
dir [FilePath] -> (FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_[FilePath]
keys ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\FilePath
key ->(SomeException -> IO ()) -> IO () -> IO ()
forall a. (SomeException -> IO a) -> IO a -> IO a
handleSynchronous (\SomeException
e ->FilePath -> IO ()
putStrLn(FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$FilePath
"Warning: "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++SomeException -> FilePath
forall a. Show a => a -> FilePath
showSomeException
e )(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$doEntry {[[(Key, BS_Identity)]]
[(FilePath, FileHash)]
BS_Identity
Ver
Key
entryKey :: Entry -> Key
entryGlobalVersion :: Entry -> Ver
entryBuiltinVersion :: Entry -> Ver
entryUserVersion :: Entry -> Ver
entryDepends :: Entry -> [[(Key, BS_Identity)]]
entryResult :: Entry -> BS_Identity
entryFiles :: Entry -> [(FilePath, FileHash)]
entryKey :: Key
entryGlobalVersion :: Ver
entryBuiltinVersion :: Ver
entryUserVersion :: Ver
entryDepends :: [[(Key, BS_Identity)]]
entryResult :: BS_Identity
entryFiles :: [(FilePath, FileHash)]
.. }<-BinaryOp Key -> BS_Identity -> Entry
getEntry BinaryOp Key
keyOp (BS_Identity -> Entry) -> IO BS_Identity -> IO Entry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>FilePath -> IO BS_Identity
BS.readFileFilePath
key FilePath -> IO ()
putStrLn(FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$FilePath
" Key: "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++Key -> FilePath
forall a. Show a => a -> FilePath
showKey
entryKey FilePath -> IO ()
putStrLn(FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$FilePath
" Key file: "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
key [(FilePath, FileHash)] -> ((FilePath, FileHash) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_[(FilePath, FileHash)]
entryFiles (((FilePath, FileHash) -> IO ()) -> IO ())
-> ((FilePath, FileHash) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\(FilePath
file ,FileHash
hash )->FilePath -> FilePath -> FileHash -> IO ()
checkFile FilePath
file FilePath
dir FileHash
hash wherecheckFile :: FilePath -> FilePath -> FileHash -> IO ()
checkFile FilePath
filename FilePath
dir FileHash
keyHash =doletcachefile :: FilePath
cachefile =FilePath
dir FilePath -> ShowS
</>FileHash -> FilePath
forall a. Show a => a -> FilePath
showFileHash
keyHash FilePath -> IO ()
putStrLn(FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$FilePath
" File: "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
filename FilePath -> IO ()
putStrLn(FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$FilePath
" Cache file: "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
cachefile IO Bool -> IO () -> IO () -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM(Bool -> Bool
not(Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>FilePath -> IO Bool
doesFileExist_ FilePath
cachefile )(FilePath -> IO ()
putStrLnFilePath
" Error: cache file does not exist")(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$IO Bool -> IO () -> IO () -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM((FileHash -> FileHash -> Bool
forall a. Eq a => a -> a -> Bool
/=FileHash
keyHash )(FileHash -> Bool) -> IO FileHash -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>FileName -> IO FileHash
getFileHash (FilePath -> FileName
fileNameFromString FilePath
cachefile ))(FilePath -> IO ()
putStrLnFilePath
" Error: cache file hash does not match stored hash")(FilePath -> IO ()
putStrLnFilePath
" OK")