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