fix updating repos, evaluation non-default test sets

This commit is contained in:
Filip Gralinski 2015-11-11 10:24:03 +01:00
parent 17d32aa8e7
commit bd8fc83c05
3 changed files with 25 additions and 22 deletions

View File

@ -43,10 +43,11 @@ postCreateChallengeR = do
doCreateChallenge :: Text -> Text -> Text -> Text -> Text -> Channel -> Handler ()
doCreateChallenge name publicUrl publicBranch privateUrl privateBranch chan = do
maybePublicRepoId <- cloneRepo publicUrl publicBranch chan
maybePublicRepoId <- cloneRepo publicUrl publicBranch publicUrl publicBranch chan
case maybePublicRepoId of
Just publicRepoId -> do
maybePrivateRepoId <- cloneRepo privateUrl privateBranch chan
publicRepo <- runDB $ get404 publicRepoId
maybePrivateRepoId <- cloneRepo privateUrl privateBranch (T.pack $ getRepoDir publicRepoId) (repoBranch publicRepo) chan
case maybePrivateRepoId of
Just privateRepoId -> addChallenge name publicRepoId privateRepoId chan
Nothing -> return ()

View File

@ -65,40 +65,41 @@ err = msg
raw :: Channel -> Text -> Handler ()
raw = msg
doRepoCloning :: Text -> Text -> Channel -> Handler ()
doRepoCloning url branch chan = do
msg chan "Did something"
_ <- cloneRepo url branch chan
return ()
validGitProtocols :: [String]
validGitProtocols = ["git", "http", "https", "ssh"]
validGitProtocolsAsText :: Text
validGitProtocolsAsText = T.pack $ intercalate ", " $ map (++"://") validGitProtocols
cloneRepo :: Text -> Text -> Channel -> Handler (Maybe (Key Repo))
cloneRepo url branch chan = do
cloneRepo :: Text -> Text -> Text -> Text -> Channel -> Handler (Maybe (Key Repo))
cloneRepo url branch referenceUrl referenceBranch chan = do
maybeRepo <- runDB $ getBy $ UniqueUrlBranch url branch
case maybeRepo of
Just _ -> do
err chan "Repo already there"
return Nothing
Nothing -> cloneRepo' url branch url branch chan
Nothing -> cloneRepo' url branch referenceUrl referenceBranch chan
updateRepo :: Key Repo -> Channel -> Handler Bool
updateRepo repoId chan = do
repo <- runDB $ get404 repoId
let repoDir = getRepoDir repoId
(exitCode, _) <- runProgram (Just repoDir) gitPath ["pull", "--progress"] chan
(exitCode, _) <- runProgram (Just repoDir) gitPath ["fetch", "--progress"] chan
case exitCode of
ExitSuccess -> do
maybeHeadCommit <- getHeadCommit repoDir chan
case maybeHeadCommit of
Just headCommit -> do
runDB $ update repoId [RepoCurrentCommit =. headCommit]
return True
Nothing -> return False
(exitCode, _) <- runProgram (Just repoDir) gitPath ["reset",
"--hard",
"FETCH_HEAD"] chan
case exitCode of
ExitSuccess -> do
maybeHeadCommit <- getHeadCommit repoDir chan
case maybeHeadCommit of
Just headCommit -> do
runDB $ update repoId [RepoCurrentCommit =. headCommit]
return True
Nothing -> return False
_ -> return False
_ -> return False
getHeadCommit :: FilePath -> Channel -> Handler (Maybe SHA1)
getHeadCommit repoDir chan = do

View File

@ -134,7 +134,7 @@ checkOrInsertEvaluation repoDir chan out = do
msg chan $ concat ["Already evaluated with score ", (T.pack $ fromMaybe "???" $ show <$> evaluationScore evaluation)]
Nothing -> do
msg chan $ "Start evaluation..."
resultOrException <- liftIO $ rawEval challenge repoDir
resultOrException <- liftIO $ rawEval challenge repoDir (testName test)
case resultOrException of
Right (Left parseResult) -> do
err chan "Cannot parse options, check the challenge repo"
@ -153,10 +153,11 @@ checkOrInsertEvaluation repoDir chan out = do
Left exception -> do
err chan $ "Evaluation failed: " ++ (T.pack $ show exception)
rawEval :: Challenge -> FilePath -> IO (Either GEvalException (Either (ParserResult GEvalOptions) (GEvalOptions, Maybe MetricValue)))
rawEval challenge repoDir = try (runGEvalGetOptions [
rawEval :: Challenge -> FilePath -> Text -> IO (Either GEvalException (Either (ParserResult GEvalOptions) (GEvalOptions, Maybe MetricValue)))
rawEval challenge repoDir name = try (runGEvalGetOptions [
"--expected-directory", (getRepoDir $ challengePrivateRepo challenge),
"--out-directory", repoDir])
"--out-directory", repoDir,
"--test-name", (T.unpack name)])
getSubmissionRepo :: Key Challenge -> Text -> Text -> Channel -> Handler (Maybe (Key Repo))
getSubmissionRepo challengeId url branch chan = do