diff --git a/Command/AddComputed.hs b/Command/AddComputed.hs index f54f2de802..226f2c0c08 100644 --- a/Command/AddComputed.hs +++ b/Command/AddComputed.hs @@ -95,6 +95,7 @@ perform o r = do , Remote.Compute.computeOutputs = mempty , Remote.Compute.computeSubdir = subdir , Remote.Compute.computeReproducible = False + , Remote.Compute.computeInputsUnavailable = False } fast <- Annex.getRead Annex.fast Remote.Compute.runComputeProgram program state diff --git a/Remote/Compute.hs b/Remote/Compute.hs index 9e821ff9eb..b54a196e6f 100644 --- a/Remote/Compute.hs +++ b/Remote/Compute.hs @@ -218,6 +218,7 @@ data ComputeState = ComputeState , computeOutputs :: M.Map OsPath (Maybe Key) , computeSubdir :: OsPath , computeReproducible :: Bool + , computeInputsUnavailable :: Bool } deriving (Show, Eq) @@ -261,7 +262,7 @@ parseComputeState k b = let st = go emptycomputestate (parseQuery b) in if st == emptycomputestate then Nothing else Just st where - emptycomputestate = ComputeState mempty mempty mempty "." False + emptycomputestate = ComputeState mempty mempty mempty "." False False go :: ComputeState -> [QueryItem] -> ComputeState go c [] = c { computeParams = reverse (computeParams c) } go c ((f, v):rest) = @@ -363,8 +364,8 @@ runComputeProgram -> ComputeState -> ImmutableState -> (OsPath -> Annex (Key, Maybe (Either Git.Sha OsPath))) - -- ^ get input file's content, or Nothing when adding a computation - -- without actually performing it + -- ^ get input file's content, or Nothing the input file's + -- content is not available -> (ComputeState -> OsPath -> NominalDiffTime -> Annex v) -> Annex v runComputeProgram (ComputeProgram program) state (ImmutableState immutablestate) getinputcontent cont = @@ -431,9 +432,13 @@ runComputeProgram (ComputeProgram program) state (ImmutableState immutablestate) liftIO $ hPutStrLn (stdinHandle p) $ maybe "" fromOsPath mp liftIO $ hFlush (stdinHandle p) + let state'' = state' + { computeInputsUnavailable = + isNothing mp || computeInputsUnavailable state' + } return $ if immutablestate - then state - else state' + then state'' + else state'' { computeInputs = M.insert f' k (computeInputs state') @@ -444,7 +449,7 @@ runComputeProgram (ComputeProgram program) state (ImmutableState immutablestate) let knownoutput = M.member f' (computeOutputs state') checkimmutable knownoutput "outputting" f' $ return $ if immutablestate - then state + then state' else state' { computeOutputs = M.insert f' Nothing @@ -488,7 +493,7 @@ computeKey rs (ComputeProgram program) k _af dest p vc = state (ImmutableState True) (getinputcontent state) - (go keyfile) + (postcompute keyfile) Nothing -> missingstate Nothing -> missingstate where @@ -503,9 +508,10 @@ computeKey rs (ComputeProgram program) k _af dest p vc = return (inputkey, Just (Right obj)) in ifM (inAnnex inputkey) ( retkey - , do - getinputcontent' f inputkey - retkey + , ifM (getinputcontent' f inputkey) + ( retkey + , return (inputkey, Nothing) + ) ) Just gitsha -> return (inputkey, Just (Left gitsha)) @@ -515,9 +521,7 @@ computeKey rs (ComputeProgram program) k _af dest p vc = remotelist <- Annex.getState Annex.remotes locs <- loggedLocations inputkey remotes <- keyPossibilities' (IncludeIgnored False) inputkey locs remotelist - if null remotes - then return () - else void $ firstM (getinputcontentfrom f inputkey) remotes + anyM (getinputcontentfrom f inputkey) remotes -- TODO cycle prevention getinputcontentfrom f inputkey r = do @@ -533,7 +537,12 @@ computeKey rs (ComputeProgram program) k _af dest p vc = (keyfile : _) -> Just keyfile [] -> Nothing - go keyfile state tmpdir _ts = do + postcompute keyfile state tmpdir _ts + | computeInputsUnavailable state = + giveup "Input file(s) unavailable." + | otherwise = postcompute' keyfile state tmpdir + + postcompute' keyfile state tmpdir = do hb <- hashBackend let updatevurl key getobj = if (fromKey keyVariety key == VURLKey)