{-# 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 = Shared -> IO Shared
forall (f :: * -> *) a. Applicative f => a -> f a
pure Shared :: Ver -> BinaryOp Key -> FilePath -> Bool -> Shared
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
(Int -> Entry -> ShowS)
-> (Entry -> FilePath) -> ([Entry] -> ShowS) -> Show Entry
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
(Entry -> Entry -> Bool) -> (Entry -> Entry -> Bool) -> Eq Entry
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
..} =
    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
    where
        putDepend :: (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 :: Key
-> Ver
-> Ver
-> Ver
-> [[(Key, BS_Identity)]]
-> BS_Identity
-> [(FilePath, FileHash)]
-> Entry
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]
map BS_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]
map BS_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
        }
    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 = (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, Show 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
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
</> 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 = do
    Bool
b <- FilePath -> IO Bool
doesDirectoryExist_ (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> ShowS
</> FilePath
"_key"
    if Bool -> Bool
not Bool
b then [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [] else FilePath -> 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 (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 =
    (FilePath -> IO (Maybe Entry)) -> [FilePath] -> [IO (Maybe Entry)]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> 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)
    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 (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.readFile FilePath
file
            let valid :: 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 (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
$ if Bool
valid then Entry -> Maybe Entry
forall a. a -> Maybe a
Just Entry
e else Maybe Entry
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 <- IO [IO (Maybe Entry)] -> Wait Locked [IO (Maybe Entry)]
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 -> do
        Maybe Entry
me <- IO (Maybe Entry) -> Wait Locked (Maybe Entry)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Maybe Entry)
act
        case Maybe Entry
me of
            Maybe Entry
Nothing -> Maybe (BS_Identity, [[Key]], IO ())
-> Wait Locked (Maybe (BS_Identity, [[Key]], IO ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (BS_Identity, [[Key]], IO ())
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 Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
x then Maybe (BS_Identity, [[Key]], IO ())
forall a. Maybe a
Nothing else (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
$ do
                        let dir :: 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
show FileHash
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)
firstJustM Wait 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
                        , let test :: 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 -> if BS_Identity
i1 BS_Identity -> BS_Identity -> Bool
forall a. Eq a => a -> a -> Bool
== BS_Identity
i2 then Maybe ()
forall a. Maybe a
Nothing else () -> 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 = do
    let dir :: 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
show FileHash
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
show FileHash
hash)
    -- Write key after files to make sure cache is always useable
    let v :: 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
    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 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> FilePath -> IO ()
renameFile FilePath
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)
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 :: Key
-> Ver
-> Ver
-> Ver
-> [[(Key, BS_Identity)]]
-> BS_Identity
-> [(FilePath, FileHash)]
-> Entry
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 (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 out
        Bool
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
show SomeException
e) IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
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.readFile FilePath
file
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removePathForcibly FilePath
dir
        Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
    IO () -> IO ()
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 (t :: * -> *) a. Foldable t => t a -> Int
length ((Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
filter Bool -> 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
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 (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 -> do
        FilePath -> 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
show SomeException
e) (IO () -> IO ()) -> IO () -> IO ()
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 (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.readFile FilePath
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
show 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
_) ->
                    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
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 (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 -> do
        FilePath -> 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
show SomeException
e) (IO () -> IO ()) -> IO () -> IO ()
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 (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.readFile FilePath
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
show Key
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
    where
      checkFile :: FilePath -> FilePath -> FileHash -> IO ()
checkFile FilePath
filename FilePath
dir FileHash
keyHash = do
          let cachefile :: FilePath
cachefile = FilePath
dir FilePath -> ShowS
</> FileHash -> FilePath
forall a. Show a => a -> FilePath
show FileHash
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 ()
putStrLn FilePath
"      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 ()
putStrLn FilePath
"      Error: cache file hash does not match stored hash")
                  (FilePath -> IO ()
putStrLn FilePath
"      OK")