diff --git a/Command/AddComputed.hs b/Command/AddComputed.hs index 9ff13f1f70..f27932405e 100644 --- a/Command/AddComputed.hs +++ b/Command/AddComputed.hs @@ -21,11 +21,9 @@ import Types.KeySource import Messages.Progress import Logs.Location import Utility.Metered -import Utility.MonotonicClock import Backend.URL (fromUrl) import qualified Data.Map as M -import Data.Time.Clock cmd :: Command cmd = notBareRepo $ @@ -92,17 +90,14 @@ perform o r = do , Remote.Compute.computeReproducible = False } fast <- Annex.getRead Annex.fast - starttime <- liftIO currentMonotonicTimestamp showOutput Remote.Compute.runComputeProgram program state (Remote.Compute.ImmutableState False) (getInputContent fast) - (go starttime fast) + (go fast) next $ return True where - go starttime fast state tmpdir = do - endtime <- liftIO currentMonotonicTimestamp - let ts = calcduration starttime endtime + go fast state tmpdir ts = do let outputs = Remote.Compute.computeOutputs state when (M.null outputs) $ giveup "The computation succeeded, but it did not generate any files." @@ -151,9 +146,6 @@ perform o r = do , checkWritePerms = True } - calcduration (MonotonicTimestamp starttime) (MonotonicTimestamp endtime) = - fromIntegral (endtime - starttime) :: NominalDiffTime - isreproducible state = case reproducible o of Just v -> isReproducible v Nothing -> Remote.Compute.computeReproducible state diff --git a/Command/Recompute.hs b/Command/Recompute.hs index 95f8f3e16f..42a313ee75 100644 --- a/Command/Recompute.hs +++ b/Command/Recompute.hs @@ -10,26 +10,21 @@ module Command.Recompute where import Command -import qualified Git import qualified Annex import qualified Remote.Compute import qualified Remote import qualified Types.Remote as Remote import Annex.CatFile -import Annex.Content.Presence import Annex.Ingest import Git.FilePath -import Types.RemoteConfig import Types.KeySource import Messages.Progress import Logs.Location import Utility.Metered -import Utility.MonotonicClock import Backend.URL (fromUrl) import Command.AddComputed (Reproducible(..), parseReproducible, getInputContent) import qualified Data.Map as M -import Data.Time.Clock cmd :: Command cmd = notBareRepo $ @@ -127,12 +122,11 @@ perform o r file key oldstate = do , Remote.Compute.computeOutputs = mempty } fast <- Annex.getRead Annex.fast - starttime <- liftIO currentMonotonicTimestamp showOutput Remote.Compute.runComputeProgram program recomputestate (Remote.Compute.ImmutableState False) (getinputcontent program fast) - (go starttime fast) + (go fast) next $ return True where getinputcontent program fast p @@ -143,9 +137,7 @@ perform o r file key oldstate = do "requesting a new input file" p | otherwise = getInputContent fast p - go starttime fast state tmpdir = do - endtime <- liftIO currentMonotonicTimestamp - let ts = calcduration starttime endtime + go fast state tmpdir ts = do let outputs = Remote.Compute.computeOutputs state when (M.null outputs) $ giveup "The computation succeeded, but it did not generate any files." @@ -194,9 +186,6 @@ perform o r file key oldstate = do , checkWritePerms = True } - calcduration (MonotonicTimestamp starttime) (MonotonicTimestamp endtime) = - fromIntegral (endtime - starttime) :: NominalDiffTime - isreproducible state = case reproducible o of Just v -> isReproducible v Nothing -> Remote.Compute.computeReproducible state diff --git a/Remote/Compute.hs b/Remote/Compute.hs index b412fc4df6..e3ec2a8fdd 100644 --- a/Remote/Compute.hs +++ b/Remote/Compute.hs @@ -41,6 +41,7 @@ import Utility.TimeStamp import Utility.Env import Utility.Tmp.Dir import Utility.Url +import Utility.MonotonicClock import qualified Git import qualified Utility.SimpleProtocol as Proto @@ -338,7 +339,7 @@ runComputeProgram -> ComputeState -> ImmutableState -> (OsPath -> Annex (Key, Maybe OsPath)) - -> (ComputeState -> OsPath -> Annex v) + -> (ComputeState -> OsPath -> NominalDiffTime -> Annex v) -> Annex v runComputeProgram (ComputeProgram program) state (ImmutableState immutablestate) getinputcontent cont = withOtherTmp $ \othertmpdir -> @@ -353,11 +354,13 @@ runComputeProgram (ComputeProgram program) state (ImmutableState immutablestate) , std_out = CreatePipe , env = Just environ } + starttime <- liftIO currentMonotonicTimestamp state' <- bracket (liftIO $ createProcess pr) (liftIO . cleanupProcess) (getinput state tmpdir subdir) - cont state' subdir + endtime <- liftIO currentMonotonicTimestamp + cont state' subdir (calcduration starttime endtime) getsubdir tmpdir = do let subdir = tmpdir computeSubdir state @@ -435,6 +438,9 @@ runComputeProgram (ComputeProgram program) state (ImmutableState immutablestate) checkimmutable False requestdesc p a | not immutablestate = a | otherwise = computationBehaviorChangeError (ComputeProgram program) requestdesc p + + calcduration (MonotonicTimestamp starttime) (MonotonicTimestamp endtime) = + fromIntegral (endtime - starttime) :: NominalDiffTime computationBehaviorChangeError :: ComputeProgram -> String -> OsPath -> Annex a computationBehaviorChangeError (ComputeProgram program) requestdesc p = @@ -469,7 +475,7 @@ computeKey rs (ComputeProgram program) k af dest p vc = (keyfile : _) -> Just keyfile [] -> Nothing - go keyfile state tmpdir = do + go keyfile state tmpdir ts = do let keyfile' = tmpdir keyfile unlessM (liftIO $ doesFileExist keyfile') $ giveup $ program ++ " exited sucessfully, but failed to write the computed file"