forked from filipg/gonito
Refactor towards changing evaluation records
This commit is contained in:
parent
4c9e8357c8
commit
770c167753
@ -8,7 +8,6 @@ import Import
|
||||
import qualified Data.IntMap as IntMap
|
||||
|
||||
import Handler.Runner
|
||||
import Handler.Common
|
||||
import System.Exit
|
||||
|
||||
import qualified Data.Text as T
|
||||
@ -525,6 +524,12 @@ formatVersion (major, minor, patch) = (T.pack $ show major)
|
||||
<> "." <> (T.pack $ show patch)
|
||||
|
||||
|
||||
checkWhetherGivenUserRepo :: (PersistStoreRead backend, MonadIO m, BaseBackend backend ~ SqlBackend)
|
||||
=> Key User -> Key Submission -> ReaderT backend m Bool
|
||||
checkWhetherGivenUserRepo userId submissionId = do
|
||||
submission <- get404 submissionId
|
||||
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)
|
||||
|
@ -584,7 +584,7 @@ checkOrInsertEvaluation :: FilePath -> Channel -> Out -> Handler ()
|
||||
checkOrInsertEvaluation repoDir chan out = do
|
||||
test <- runDB $ get404 $ outTest out
|
||||
challenge <- runDB $ get404 $ testChallenge test
|
||||
maybeEvaluation <- runDB $ getBy $ UniqueEvaluationTestChecksum (outTest out) (outChecksum out)
|
||||
maybeEvaluation <- runDB $ fetchTheEvaluation out undefined
|
||||
case maybeEvaluation of
|
||||
Just (Entity _ evaluation) -> do
|
||||
msg chan $ concat ["Already evaluated with score ", (fromMaybe "???" $ formatNonScientifically <$> evaluationScore evaluation)]
|
||||
|
@ -343,7 +343,7 @@ getEvaluationMap :: (MonadIO m, PersistQueryRead backend, PersistUniqueRead back
|
||||
getEvaluationMap (rank, (s@(Entity submissionId submission), v@(Entity variantId _))) = do
|
||||
outs <- selectList [OutVariant ==. variantId] []
|
||||
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 pairs = map (\(Entity _ e) -> (evaluationTest e, e)) evaluations
|
||||
pairs' <- mapM (\(testId, e) -> do
|
||||
|
Loading…
Reference in New Issue
Block a user