diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Command/Extract.hs | 25 | ||||
| -rw-r--r-- | src/Job.hs | 31 |
2 files changed, 40 insertions, 16 deletions
diff --git a/src/Command/Extract.hs b/src/Command/Extract.hs index bb4498d..366128c 100644 --- a/src/Command/Extract.hs +++ b/src/Command/Extract.hs @@ -79,25 +79,17 @@ cmdExtract (ExtractCommand ExtractOptions {..} ExtractArguments {..}) = do _:_:_ -> tfail $ "destination ‘" <> T.pack extractDestination <> "’ is not a directory" _ -> return False - forM_ extractArtifacts $ \( ref, ArtifactName aname ) -> do - [ jid@(JobId ids) ] <- either tfail (return . map jobId) =<< + forM_ extractArtifacts $ \( ref, aname ) -> do + [ jid ] <- either tfail (return . map jobId) =<< return . either (Left . textEvalError) (first T.pack . jobsetJobsEither) =<< liftIO (runEval (evalJobReference ref) einput) - let jdir = joinPath $ (storageDir :) $ ("jobs" :) $ map (T.unpack . textJobIdPart) ids - adir = jdir </> "artifacts" </> T.unpack aname + tpath <- if + | isdir -> do + wpath <- either tfail return =<< runExceptT (getArtifactWorkPath storageDir jid aname) + return $ extractDestination </> takeFileName wpath + | otherwise -> return extractDestination - liftIO (doesDirectoryExist jdir) >>= \case - True -> return () - False -> tfail $ "job ‘" <> textJobId jid <> "’ not yet executed" - - liftIO (doesDirectoryExist adir) >>= \case - True -> return () - False -> tfail $ "artifact ‘" <> aname <> "’ of job ‘" <> textJobId jid <> "’ not found" - - wpath <- liftIO $ readFile (adir </> "path") - let tpath | isdir = extractDestination </> takeFileName wpath - | otherwise = extractDestination liftIO (doesPathExist tpath) >>= \case True | extractForce -> liftIO (doesDirectoryExist tpath) >>= \case @@ -105,4 +97,5 @@ cmdExtract (ExtractCommand ExtractOptions {..} ExtractArguments {..}) = do False -> liftIO $ removeFile tpath | otherwise -> tfail $ "destination ‘" <> T.pack tpath <> "’ already exists" False -> return () - liftIO $ copyRecursive (adir </> "data") tpath + + either tfail return =<< runExceptT (copyArtifact storageDir jid aname tpath) @@ -8,7 +8,11 @@ module Job ( jobStatusFinished, jobStatusFailed, JobManager(..), newJobManager, cancelAllJobs, runJobs, waitForRemainingTasks, + prepareJob, + getArtifactWorkPath, + copyArtifact, + jobStorageSubdir, copyRecursive, @@ -374,6 +378,7 @@ updateStatusFile JobManager {..} jdir outVar = liftIO $ do jobStorageSubdir :: JobId -> FilePath jobStorageSubdir (JobId jidParts) = "jobs" </> joinPath (map (T.unpack . textJobIdPart) (jidParts)) + prepareJob :: (MonadIO m, MonadMask m, MonadFail m) => FilePath -> Job -> (FilePath -> m a) -> m a prepareJob dir job inner = do withSystemTempDirectory "minici" $ \checkoutPath -> do @@ -385,6 +390,32 @@ prepareJob dir job inner = do liftIO $ createDirectoryIfMissing True jdir inner checkoutPath +getArtifactStoredPath :: (MonadIO m, MonadError Text m) => FilePath -> JobId -> ArtifactName -> m FilePath +getArtifactStoredPath storageDir jid@(JobId ids) (ArtifactName aname) = do + let jdir = joinPath $ (storageDir :) $ ("jobs" :) $ map (T.unpack . textJobIdPart) ids + adir = jdir </> "artifacts" </> T.unpack aname + + liftIO (doesDirectoryExist jdir) >>= \case + True -> return () + False -> throwError $ "job ‘" <> textJobId jid <> "’ not yet executed" + + liftIO (doesDirectoryExist adir) >>= \case + True -> return () + False -> throwError $ "artifact ‘" <> aname <> "’ of job ‘" <> textJobId jid <> "’ not found" + + return adir + +getArtifactWorkPath :: (MonadIO m, MonadError Text m) => FilePath -> JobId -> ArtifactName -> m FilePath +getArtifactWorkPath storageDir jid aname = do + adir <- getArtifactStoredPath storageDir jid aname + liftIO $ readFile (adir </> "path") + +copyArtifact :: (MonadIO m, MonadError Text m) => FilePath -> JobId -> ArtifactName -> FilePath -> m () +copyArtifact storageDir jid aname tpath = do + adir <- getArtifactStoredPath storageDir jid aname + liftIO $ copyRecursive (adir </> "data") tpath + + runJob :: Job -> [ ( ArtifactSpec, ArtifactOutput) ] -> FilePath -> FilePath -> ExceptT (JobStatus JobOutput) IO JobOutput runJob job uses checkoutPath jdir = do liftIO $ forM_ (filter ((`elem` jobUses job) . fst) uses) $ \( _, aout ) -> do |