filipg/gonito
1
0
Fork 1
Code Issues 1 Pull Requests Releases Wiki Activity

Refactor towards changing evaluation records

Browse Source
This commit is contained in:
Filip Gralinski 2019-12-14 11:58:52 +01:00
parent 4c9e8357c8
commit 770c167753
3 changed files with 8 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
Handler/Shared.hs
View File

@ -8,7 +8,6 @@ import Import
import qualified Data.IntMap as IntMap import qualified Data.IntMap as IntMap
import Handler.Runner import Handler.Runner
import Handler.Common
import System.Exit import System.Exit
import qualified Data.Text as T import qualified Data.Text as T
@ -525,6 +524,12 @@ formatVersion (major, minor, patch) = (T.pack $ show major)
<> "." <> (T.pack $ show patch) <> "." <> (T.pack $ show patch)
checkWhetherGivenUserRepo :: (PersistStoreRead backend, MonadIO m, BaseBackend backend ~ SqlBackend)
=> Key User -> Key Submission -> ReaderT backend m Bool
checkWhetherGivenUserRepo userId submissionId = do checkWhetherGivenUserRepo userId submissionId = do
submission <- get404 submissionId submission <- get404 submissionId
return $ userId == submissionSubmitter submission return $ userId == submissionSubmitter submission
fetchTheEvaluation :: (MonadIO m, PersistUniqueRead backend, BaseBackend backend ~ SqlBackend)
=> Out -> SHA1 -> ReaderT backend m (Maybe (Entity Evaluation))
fetchTheEvaluation out _ = getBy $ UniqueEvaluationTestChecksum (outTest out) (outChecksum out)

2
Handler/ShowChallenge.hs
View File

@ -584,7 +584,7 @@ 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 challenge <- runDB $ get404 $ testChallenge test
maybeEvaluation <- runDB $ getBy $ UniqueEvaluationTestChecksum (outTest out) (outChecksum out) maybeEvaluation <- runDB $ fetchTheEvaluation out undefined
case maybeEvaluation of case maybeEvaluation of
Just (Entity _ evaluation) -> do Just (Entity _ evaluation) -> do
msg chan $ concat ["Already evaluated with score ", (fromMaybe "???" $ formatNonScientifically <$> evaluationScore evaluation)] msg chan $ concat ["Already evaluated with score ", (fromMaybe "???" $ formatNonScientifically <$> evaluationScore evaluation)]

2
Handler/Tables.hs
View File

@ -343,7 +343,7 @@ getEvaluationMap :: (MonadIO m, PersistQueryRead backend, PersistUniqueRead back
getEvaluationMap (rank, (s@(Entity submissionId submission), v@(Entity variantId _))) = do getEvaluationMap (rank, (s@(Entity submissionId submission), v@(Entity variantId _))) = do
outs <- selectList [OutVariant ==. variantId] [] outs <- selectList [OutVariant ==. variantId] []
user <- get404 $ submissionSubmitter submission user <- get404 $ submissionSubmitter submission
maybeEvaluations <- mapM (\(Entity _ o) -> getBy $ UniqueEvaluationTestChecksum (outTest o) (outChecksum o)) outs maybeEvaluations <- mapM (\(Entity _ o) -> fetchTheEvaluation o undefined) outs
let evaluations = catMaybes maybeEvaluations let evaluations = catMaybes maybeEvaluations
let pairs = map (\(Entity _ e) -> (evaluationTest e, e)) evaluations let pairs = map (\(Entity _ e) -> (evaluationTest e, e)) evaluations
pairs' <- mapM (\(testId, e) -> do pairs' <- mapM (\(testId, e) -> do