{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TupleSections #-}

module Development.Shake.Internal.History.Shared(
    Shared, newShared,
    addShared, lookupShared,
    removeShared, listShared,
    sanityShared
    ) where

import Control.Exception
import Development.Shake.Internal.Value
import Development.Shake.Internal.History.Types
import Development.Shake.Internal.History.Symlink
import Development.Shake.Internal.Core.Database
import Development.Shake.Classes
import General.Binary
import General.Extra
import Data.List
import Control.Monad.Extra
import System.Directory.Extra
import System.FilePath
import System.IO.Extra
import Numeric
import Development.Shake.Internal.FileInfo
import General.Wait
import Development.Shake.Internal.FileName
import Data.Monoid
import Control.Monad.IO.Class
import Data.Maybe
import qualified Data.ByteString as BS
import Prelude


data Shared = 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 -> IO Shared
newShared :: Bool -> BinaryOp Key -> Ver -> FilePath -> IO Shared
newShared Bool
useSymlink BinaryOp Key
keyOp Ver
globalVersion FilePath
sharedRoot = forall (f :: * -> *) a. Applicative f => a -> f a
pure Shared{Bool
FilePath
BinaryOp Key
Ver
sharedRoot :: FilePath
globalVersion :: Ver
keyOp :: BinaryOp Key
useSymlink :: Bool
useSymlink :: Bool
sharedRoot :: FilePath
keyOp :: BinaryOp Key
globalVersion :: Ver
..}


data Entry = 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
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Entry] -> ShowS
$cshowList :: [Entry] -> ShowS
show :: Entry -> FilePath
$cshow :: Entry -> FilePath
showsPrec :: Int -> Entry -> ShowS
$cshowsPrec :: Int -> Entry -> ShowS
Show, Entry -> Entry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entry -> Entry -> Bool
$c/= :: Entry -> Entry -> Bool
== :: Entry -> Entry -> Bool
$c== :: 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
entryFiles :: [(FilePath, FileHash)]
entryResult :: BS_Identity
entryDepends :: [[(Key, BS_Identity)]]
entryUserVersion :: Ver
entryBuiltinVersion :: Ver
entryGlobalVersion :: Ver
entryKey :: Key
entryFiles :: Entry -> [(FilePath, FileHash)]
entryResult :: Entry -> BS_Identity
entryDepends :: Entry -> [[(Key, BS_Identity)]]
entryUserVersion :: Entry -> Ver
entryBuiltinVersion :: Entry -> Ver
entryGlobalVersion :: Entry -> Ver
entryKey :: Entry -> Key
..} =
    forall a. Storable a => a -> Builder
putExStorable Ver
entryGlobalVersion forall a. Semigroup a => a -> a -> a
<>
    forall a. Storable a => a -> Builder
putExStorable Ver
entryBuiltinVersion forall a. Semigroup a => a -> a -> a
<>
    forall a. Storable a => a -> Builder
putExStorable Ver
entryUserVersion forall a. Semigroup a => a -> a -> a
<>
    Builder -> Builder
putExN (forall v. BinaryOp v -> v -> Builder
putOp BinaryOp Key
binop Key
entryKey) forall a. Semigroup a => a -> a -> a
<>
    Builder -> Builder
putExN ([Builder] -> Builder
putExList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ([Builder] -> Builder
putExList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}. BinaryEx a => (Key, a) -> Builder
putDepend) [[(Key, BS_Identity)]]
entryDepends) forall a. Semigroup a => a -> a -> a
<>
    Builder -> Builder
putExN ([Builder] -> Builder
putExList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. (Storable a, BinaryEx a) => (a, a) -> Builder
putFile [(FilePath, FileHash)]
entryFiles) forall a. Semigroup a => a -> a -> a
<>
    forall a. BinaryEx a => a -> Builder
putEx BS_Identity
entryResult
    where
        putDepend :: (Key, a) -> Builder
putDepend (Key
a,a
b) = Builder -> Builder
putExN (forall v. BinaryOp v -> v -> Builder
putOp BinaryOp Key
binop Key
a) forall a. Semigroup a => a -> a -> a
<> forall a. BinaryEx a => a -> Builder
putEx a
b
        putFile :: (a, a) -> Builder
putFile (a
a,a
b) = forall a. Storable a => a -> Builder
putExStorable a
b forall a. Semigroup a => a -> a -> a
<> 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) <- 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 = forall v. BinaryOp v -> BS_Identity -> v
getOp BinaryOp Key
binop BS_Identity
x4
        ,entryDepends :: [[(Key, BS_Identity)]]
entryDepends = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall {b}. BinaryEx b => BS_Identity -> (Key, b)
getDepend forall b c a. (b -> c) -> (a -> b) -> a -> c
. BS_Identity -> [BS_Identity]
getExList) forall a b. (a -> b) -> a -> b
$ BS_Identity -> [BS_Identity]
getExList BS_Identity
x5
        ,entryFiles :: [(FilePath, FileHash)]
entryFiles = forall a b. (a -> b) -> [a] -> [b]
map forall {b} {a}. (Storable b, BinaryEx a) => BS_Identity -> (a, b)
getFile forall a b. (a -> b) -> a -> b
$ BS_Identity -> [BS_Identity]
getExList BS_Identity
x6
        ,entryResult :: BS_Identity
entryResult = forall a. BinaryEx a => BS_Identity -> a
getEx BS_Identity
x7
        }
    where
        getDepend :: BS_Identity -> (Key, b)
getDepend BS_Identity
x | (BS_Identity
a, BS_Identity
b) <- BS_Identity -> (BS_Identity, BS_Identity)
getExN BS_Identity
x = (forall v. BinaryOp v -> BS_Identity -> v
getOp BinaryOp Key
binop BS_Identity
a, 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) <- forall a. Storable a => BS_Identity -> (a, BS_Identity)
binarySplit BS_Identity
x = (forall a. BinaryEx a => BS_Identity -> a
getEx BS_Identity
a, b
b)

hexed :: a -> FilePath
hexed a
x = forall a. (Integral a, Show a) => a -> ShowS
showHex (forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$ forall a. Hashable a => a -> Int
hash a
x) FilePath
""

-- | The path under which everything relating to a Key lives
sharedFileDir :: Shared -> Key -> FilePath
sharedFileDir :: Shared -> Key -> FilePath
sharedFileDir Shared
shared Key
key = Shared -> FilePath
sharedRoot Shared
shared FilePath -> ShowS
</> FilePath
".shake.cache" FilePath -> ShowS
</> 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 = do
    Bool
b <- FilePath -> IO Bool
doesDirectoryExist_ forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> ShowS
</> FilePath
"_key"
    if Bool -> Bool
not Bool
b then forall (f :: * -> *) a. Applicative f => a -> f a
pure [] else FilePath -> IO [FilePath]
listFiles forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> ShowS
</> FilePath
"_key"

loadSharedEntry :: Shared -> Key -> Ver -> Ver -> IO [IO (Maybe Entry)]
loadSharedEntry :: Shared -> Key -> Ver -> Ver -> IO [IO (Maybe Entry)]
loadSharedEntry shared :: Shared
shared@Shared{Bool
FilePath
BinaryOp Key
Ver
useSymlink :: Bool
sharedRoot :: FilePath
keyOp :: BinaryOp Key
globalVersion :: Ver
useSymlink :: Shared -> Bool
sharedRoot :: Shared -> FilePath
keyOp :: Shared -> BinaryOp Key
globalVersion :: Shared -> Ver
..} Key
key Ver
builtinVersion Ver
userVersion =
    forall a b. (a -> b) -> [a] -> [b]
map FilePath -> IO (Maybe Entry)
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
sharedFileKeys (Shared -> Key -> FilePath
sharedFileDir Shared
shared Key
key)
    where
        f :: FilePath -> IO (Maybe Entry)
f FilePath
file = do
            e :: Entry
e@Entry{[[(Key, BS_Identity)]]
[(FilePath, FileHash)]
BS_Identity
Ver
Key
entryFiles :: [(FilePath, FileHash)]
entryResult :: BS_Identity
entryDepends :: [[(Key, BS_Identity)]]
entryUserVersion :: Ver
entryBuiltinVersion :: Ver
entryGlobalVersion :: Ver
entryKey :: Key
entryFiles :: Entry -> [(FilePath, FileHash)]
entryResult :: Entry -> BS_Identity
entryDepends :: Entry -> [[(Key, BS_Identity)]]
entryUserVersion :: Entry -> Ver
entryBuiltinVersion :: Entry -> Ver
entryGlobalVersion :: Entry -> Ver
entryKey :: Entry -> Key
..} <- BinaryOp Key -> BS_Identity -> Entry
getEntry BinaryOp Key
keyOp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO BS_Identity
BS.readFile FilePath
file
            let valid :: Bool
valid = Key
entryKey forall a. Eq a => a -> a -> Bool
== Key
key Bool -> Bool -> Bool
&& Ver
entryGlobalVersion forall a. Eq a => a -> a -> Bool
== Ver
globalVersion Bool -> Bool -> Bool
&& Ver
entryBuiltinVersion forall a. Eq a => a -> a -> Bool
== Ver
builtinVersion Bool -> Bool -> Bool
&& Ver
entryUserVersion forall a. Eq a => a -> a -> Bool
== Ver
userVersion
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Bool
valid then forall a. a -> Maybe a
Just Entry
e else forall a. Maybe a
Nothing


-- | Given a way to get the identity, see if you can find a stored cloud version
lookupShared :: Shared -> (Key -> Wait Locked (Maybe BS_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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Shared -> Key -> Ver -> Ver -> IO [IO (Maybe Entry)]
loadSharedEntry Shared
shared Key
key Ver
builtinVersion Ver
userVersion
    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a b.
MonadIO m =>
(a -> Wait m (Maybe b)) -> [a] -> Wait m (Maybe b)
firstJustWaitUnordered [IO (Maybe Entry)]
ents forall a b. (a -> b) -> a -> b
$ \IO (Maybe Entry)
act -> do
        Maybe Entry
me <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Maybe Entry)
act
        case Maybe Entry
me of
            Maybe Entry
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
            Just Entry{[[(Key, BS_Identity)]]
[(FilePath, FileHash)]
BS_Identity
Ver
Key
entryFiles :: [(FilePath, FileHash)]
entryResult :: BS_Identity
entryDepends :: [[(Key, BS_Identity)]]
entryUserVersion :: Ver
entryBuiltinVersion :: Ver
entryGlobalVersion :: Ver
entryKey :: Key
entryFiles :: Entry -> [(FilePath, FileHash)]
entryResult :: Entry -> BS_Identity
entryDepends :: Entry -> [[(Key, BS_Identity)]]
entryUserVersion :: Entry -> Ver
entryBuiltinVersion :: Entry -> Ver
entryGlobalVersion :: Entry -> Ver
entryKey :: Entry -> Key
..} -> do
                -- use Nothing to indicate success, Just () to bail out early on mismatch
                let result :: Maybe a -> Maybe (BS_Identity, [[Key]], IO ())
result Maybe a
x = if forall a. Maybe a -> Bool
isJust Maybe a
x then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (BS_Identity
entryResult, forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst) [[(Key, BS_Identity)]]
entryDepends, ) forall a b. (a -> b) -> a -> b
$ do
                        let dir :: FilePath
dir = Shared -> Key -> FilePath
sharedFileDir Shared
shared Key
entryKey
                        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(FilePath, FileHash)]
entryFiles 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
</> forall a. Show a => a -> FilePath
show FileHash
hash) FilePath
file
                forall {a}. Maybe a -> Maybe (BS_Identity, [[Key]], IO ())
result forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstJustM forall a. a -> a
id
                    [ forall (m :: * -> *) a b.
MonadIO m =>
(a -> Wait m (Maybe b)) -> [a] -> Wait m (Maybe b)
firstJustWaitUnordered forall a. a -> a
id
                        [ Maybe BS_Identity -> Maybe ()
test 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
                        , let test :: Maybe BS_Identity -> Maybe ()
test = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. a -> Maybe a
Just ()) (\BS_Identity
i2 -> if BS_Identity
i1 forall a. Eq a => a -> a -> Bool
== BS_Identity
i2 then forall a. Maybe a
Nothing else 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 = do
    let dir :: FilePath
dir = Shared -> Key -> FilePath
sharedFileDir Shared
shared (Entry -> Key
entryKey Entry
entry)
    FilePath -> IO ()
createDirectoryRecursive FilePath
dir
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Entry -> [(FilePath, FileHash)]
entryFiles Entry
entry) forall a b. (a -> b) -> a -> b
$ \(FilePath
file, FileHash
hash) ->
        forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (FilePath -> IO Bool
doesFileExist_ forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> ShowS
</> forall a. Show a => a -> FilePath
show FileHash
hash) forall a b. (a -> b) -> a -> b
$
            Bool -> FilePath -> FilePath -> IO ()
copyFileLink (Shared -> Bool
useSymlink Shared
shared) FilePath
file (FilePath
dir FilePath -> ShowS
</> forall a. Show a => a -> FilePath
show FileHash
hash)
    -- Write key after files to make sure cache is always useable
    let v :: BS_Identity
v = Builder -> BS_Identity
runBuilder forall a b. (a -> b) -> a -> b
$ BinaryOp Key -> Entry -> Builder
putEntry (Shared -> BinaryOp Key
keyOp Shared
shared) Entry
entry
    let dirName :: 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 ())
newTempFileWithin FilePath
dir
    (FilePath -> BS_Identity -> IO ()
BS.writeFile FilePath
tempFile BS_Identity
v forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> FilePath -> IO ()
renameFile FilePath
tempFile (FilePath
dirName FilePath -> ShowS
</> forall {a}. Hashable a => a -> FilePath
hexed BS_Identity
v)) 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 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\FilePath
x -> (FilePath
x,) 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
entryResult :: BS_Identity
entryDepends :: [[(Key, BS_Identity)]]
entryUserVersion :: Ver
entryBuiltinVersion :: Ver
entryKey :: Key
entryResult :: BS_Identity
entryDepends :: [[(Key, BS_Identity)]]
entryUserVersion :: Ver
entryBuiltinVersion :: Ver
entryKey :: Key
..}

removeShared :: Shared -> (Key -> Bool) -> IO ()
removeShared :: Shared -> (Key -> Bool) -> IO ()
removeShared Shared{Bool
FilePath
BinaryOp Key
Ver
useSymlink :: Bool
sharedRoot :: FilePath
keyOp :: BinaryOp Key
globalVersion :: Ver
useSymlink :: Shared -> Bool
sharedRoot :: Shared -> FilePath
keyOp :: Shared -> BinaryOp Key
globalVersion :: Shared -> Ver
..} Key -> Bool
test = do
    [FilePath]
dirs <- FilePath -> IO [FilePath]
listDirectories forall a b. (a -> b) -> a -> b
$ FilePath
sharedRoot FilePath -> ShowS
</> FilePath
".shake.cache"
    [Bool]
deleted <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
dirs 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 out
        Bool
b <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM [FilePath]
files forall a b. (a -> b) -> a -> b
$ \FilePath
file -> forall a. (SomeException -> IO a) -> IO a -> IO a
handleSynchronous (\SomeException
e -> FilePath -> IO ()
putStrLn (FilePath
"Warning: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show SomeException
e) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) forall a b. (a -> b) -> a -> b
$
            forall a. a -> IO a
evaluate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Bool
test forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> Key
entryKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryOp Key -> BS_Identity -> Entry
getEntry BinaryOp Key
keyOp forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO BS_Identity
BS.readFile FilePath
file
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removePathForcibly FilePath
dir
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"Deleted " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter forall a. a -> a
id [Bool]
deleted)) forall a. [a] -> [a] -> [a]
++ FilePath
" entries"

listShared :: Shared -> IO ()
listShared :: Shared -> IO ()
listShared Shared{Bool
FilePath
BinaryOp Key
Ver
useSymlink :: Bool
sharedRoot :: FilePath
keyOp :: BinaryOp Key
globalVersion :: Ver
useSymlink :: Shared -> Bool
sharedRoot :: Shared -> FilePath
keyOp :: Shared -> BinaryOp Key
globalVersion :: Shared -> Ver
..} = do
    [FilePath]
dirs <- FilePath -> IO [FilePath]
listDirectories forall a b. (a -> b) -> a -> b
$ FilePath
sharedRoot FilePath -> ShowS
</> FilePath
".shake.cache"
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
dirs forall a b. (a -> b) -> a -> b
$ \FilePath
dir -> do
        FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"Directory: " forall a. [a] -> [a] -> [a]
++ FilePath
dir
        [FilePath]
keys <- FilePath -> IO [FilePath]
sharedFileKeys FilePath
dir
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
keys forall a b. (a -> b) -> a -> b
$ \FilePath
key ->
            forall a. (SomeException -> IO a) -> IO a -> IO a
handleSynchronous (\SomeException
e -> FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"Warning: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show SomeException
e) forall a b. (a -> b) -> a -> b
$ do
                Entry{[[(Key, BS_Identity)]]
[(FilePath, FileHash)]
BS_Identity
Ver
Key
entryFiles :: [(FilePath, FileHash)]
entryResult :: BS_Identity
entryDepends :: [[(Key, BS_Identity)]]
entryUserVersion :: Ver
entryBuiltinVersion :: Ver
entryGlobalVersion :: Ver
entryKey :: Key
entryFiles :: Entry -> [(FilePath, FileHash)]
entryResult :: Entry -> BS_Identity
entryDepends :: Entry -> [[(Key, BS_Identity)]]
entryUserVersion :: Entry -> Ver
entryBuiltinVersion :: Entry -> Ver
entryGlobalVersion :: Entry -> Ver
entryKey :: Entry -> Key
..} <- BinaryOp Key -> BS_Identity -> Entry
getEntry BinaryOp Key
keyOp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO BS_Identity
BS.readFile FilePath
key
                FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"  Key: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Key
entryKey
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(FilePath, FileHash)]
entryFiles forall a b. (a -> b) -> a -> b
$ \(FilePath
file,FileHash
_) ->
                    FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"    File: " forall a. [a] -> [a] -> [a]
++ FilePath
file

sanityShared :: Shared -> IO ()
sanityShared :: Shared -> IO ()
sanityShared Shared{Bool
FilePath
BinaryOp Key
Ver
useSymlink :: Bool
sharedRoot :: FilePath
keyOp :: BinaryOp Key
globalVersion :: Ver
useSymlink :: Shared -> Bool
sharedRoot :: Shared -> FilePath
keyOp :: Shared -> BinaryOp Key
globalVersion :: Shared -> Ver
..} = do
    [FilePath]
dirs <- FilePath -> IO [FilePath]
listDirectories forall a b. (a -> b) -> a -> b
$ FilePath
sharedRoot FilePath -> ShowS
</> FilePath
".shake.cache"
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
dirs forall a b. (a -> b) -> a -> b
$ \FilePath
dir -> do
        FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"Directory: " forall a. [a] -> [a] -> [a]
++ FilePath
dir
        [FilePath]
keys <- FilePath -> IO [FilePath]
sharedFileKeys FilePath
dir
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
keys forall a b. (a -> b) -> a -> b
$ \FilePath
key ->
            forall a. (SomeException -> IO a) -> IO a -> IO a
handleSynchronous (\SomeException
e -> FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"Warning: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show SomeException
e) forall a b. (a -> b) -> a -> b
$ do
                Entry{[[(Key, BS_Identity)]]
[(FilePath, FileHash)]
BS_Identity
Ver
Key
entryFiles :: [(FilePath, FileHash)]
entryResult :: BS_Identity
entryDepends :: [[(Key, BS_Identity)]]
entryUserVersion :: Ver
entryBuiltinVersion :: Ver
entryGlobalVersion :: Ver
entryKey :: Key
entryFiles :: Entry -> [(FilePath, FileHash)]
entryResult :: Entry -> BS_Identity
entryDepends :: Entry -> [[(Key, BS_Identity)]]
entryUserVersion :: Entry -> Ver
entryBuiltinVersion :: Entry -> Ver
entryGlobalVersion :: Entry -> Ver
entryKey :: Entry -> Key
..} <- BinaryOp Key -> BS_Identity -> Entry
getEntry BinaryOp Key
keyOp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO BS_Identity
BS.readFile FilePath
key
                FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"  Key: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Key
entryKey
                FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"  Key file: " forall a. [a] -> [a] -> [a]
++ FilePath
key
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(FilePath, FileHash)]
entryFiles forall a b. (a -> b) -> a -> b
$ \(FilePath
file,FileHash
hash) ->
                    FilePath -> FilePath -> FileHash -> IO ()
checkFile FilePath
file FilePath
dir FileHash
hash
    where
      checkFile :: FilePath -> FilePath -> FileHash -> IO ()
checkFile FilePath
filename FilePath
dir FileHash
keyHash = do
          let cachefile :: FilePath
cachefile = FilePath
dir FilePath -> ShowS
</> forall a. Show a => a -> FilePath
show FileHash
keyHash
          FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"    File: " forall a. [a] -> [a] -> [a]
++ FilePath
filename
          FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"    Cache file: " forall a. [a] -> [a] -> [a]
++ FilePath
cachefile
          forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesFileExist_ FilePath
cachefile)
              (FilePath -> IO ()
putStrLn FilePath
"      Error: cache file does not exist") forall a b. (a -> b) -> a -> b
$
              forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM ((forall a. Eq a => a -> a -> Bool
/= FileHash
keyHash) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileName -> IO FileHash
getFileHash (FilePath -> FileName
fileNameFromString FilePath
cachefile))
                  (FilePath -> IO ()
putStrLn FilePath
"      Error: cache file hash does not match stored hash")
                  (FilePath -> IO ()
putStrLn FilePath
"      OK")