do evaluation with GEval

This commit is contained in:
Filip Gralinski 2015-09-29 18:23:11 +02:00
parent d30e61961f
commit 23f8df8961
4 changed files with 30 additions and 3 deletions

View File

@ -9,6 +9,7 @@ import Handler.Extract
import System.Directory (doesFileExist) import System.Directory (doesFileExist)
import System.FilePath.Find as SFF import System.FilePath.Find as SFF
import System.FilePath
import qualified Data.Text as T import qualified Data.Text as T
import PersistSHA1 import PersistSHA1
@ -94,7 +95,7 @@ checkTestDir chan challengeId commit testDir = do
checksum <- liftIO $ gatherSHA1 testDir checksum <- liftIO $ gatherSHA1 testDir
testId <- runDB $ insert $ Test { testId <- runDB $ insert $ Test {
testChallenge=challengeId, testChallenge=challengeId,
testName=T.pack testDir, testName=T.pack $ takeFileName testDir,
testChecksum=(SHA1 checksum), testChecksum=(SHA1 checksum),
testCommit=commit, testCommit=commit,
testActive=True } testActive=True }

View File

@ -13,6 +13,9 @@ import qualified Data.Text as T
import Handler.Extract import Handler.Extract
import Handler.Shared import Handler.Shared
import GEval.Core
import GEval.OptionsParser
import PersistSHA1 import PersistSHA1
getShowChallengeR :: Text -> Handler Html getShowChallengeR :: Text -> Handler Html
@ -57,7 +60,8 @@ doCreateSubmission challengeId description url branch chan = do
Just repoId -> do Just repoId -> do
repo <- runDB $ get404 repoId repo <- runDB $ get404 repoId
submissionId <- getSubmission repoId (repoCurrentCommit repo) challengeId description chan submissionId <- getSubmission repoId (repoCurrentCommit repo) challengeId description chan
msg chan "HAHA" _ <- getOuts chan submissionId
msg chan "Done"
Nothing -> return () Nothing -> return ()
getSubmission :: Key Repo -> SHA1 -> Key Challenge -> Text -> Channel -> Handler (Key Submission) getSubmission :: Key Repo -> SHA1 -> Key Challenge -> Text -> Channel -> Handler (Key Submission)
@ -112,12 +116,31 @@ checkOrInsertOut out = do
checkOrInsertEvaluation :: FilePath -> Channel -> Out -> Handler () checkOrInsertEvaluation :: FilePath -> Channel -> Out -> Handler ()
checkOrInsertEvaluation repoDir chan out = do checkOrInsertEvaluation repoDir chan out = do
test <- runDB $ get404 $ outTest out test <- runDB $ get404 $ outTest out
challenge <- runDB $ get404 $ testChallenge test
maybeEvaluation <- runDB $ getBy $ UniqueEvaluationTestChecksum (outTest out) (outChecksum out) maybeEvaluation <- runDB $ getBy $ UniqueEvaluationTestChecksum (outTest out) (outChecksum out)
case maybeEvaluation of case maybeEvaluation of
Just (Entity _ evaluation) -> do Just (Entity _ evaluation) -> do
msg chan $ concat ["Already evaluated with score ", (T.pack $ fromMaybe "???" $ show <$> evaluationScore evaluation)] msg chan $ concat ["Already evaluated with score ", (T.pack $ fromMaybe "???" $ show <$> evaluationScore evaluation)]
Nothing -> do Nothing -> do
msg chan $ "Start evaluation..." msg chan $ "Start evaluation..."
result <- liftIO $ runGEvalGetOptions ["--expected-directory", (getRepoDir $ challengePrivateRepo challenge),
"--out-directory", repoDir]
case result of
Left parseResult -> do
err chan "Cannot parse options, check the challenge repo"
Right (opts, Just result) -> do
msg chan $ concat [ "Evaluated! Score ", (T.pack $ show result) ]
time <- liftIO getCurrentTime
runDB $ insert $ Evaluation {
evaluationTest=outTest out,
evaluationChecksum=outChecksum out,
evaluationScore=Just result,
evaluationErrorMessage=Nothing,
evaluationStamp=time }
msg chan "Evaluation done"
Right (_, Nothing) -> do
err chan "Error during the evaluation"
getSubmissionRepo :: Key Challenge -> Text -> Text -> Channel -> Handler (Maybe (Key Repo)) getSubmissionRepo :: Key Challenge -> Text -> Text -> Channel -> Handler (Maybe (Key Repo))
getSubmissionRepo challengeId url branch chan = do getSubmissionRepo challengeId url branch chan = do

View File

@ -102,6 +102,8 @@ library
, filemanip , filemanip
, cryptohash , cryptohash
, markdown , markdown
, geval
, filepath
executable gonito executable gonito
if flag(library-only) if flag(library-only)

View File

@ -4,5 +4,6 @@ flags:
dev: false dev: false
packages: packages:
- '.' - '.'
extra-deps: [markdown-0.1.13.2] - '../geval'
extra-deps: [markdown-0.1.13.2,geval-0.1.0.0]
resolver: nightly-2015-08-20 resolver: nightly-2015-08-20