Switch to an incompatible DB scheme

Evaluation is uniquely identified by test, output checksum
and version checksum.

Handler/Evaluate.hs

@@ -205,13 +205,7 @@ checkOrInsertEvaluation :: FilePath -> Bool -> Channel -> SHA1 -> Out -> Handler
 checkOrInsertEvaluation repoDir forceEvaluation chan version out = do
   test <- runDB $ get404 $ outTest out
   challenge <- runDB $ get404 $ testChallenge test
-  maybeEvaluation' <- runDB $ fetchTheEvaluation out version
+  maybeEvaluation <- runDB $ fetchTheEvaluation out version
-
-  let maybeEvaluation = case maybeEvaluation' of
-        Just (Entity _ evaluation) -> case evaluationVersion evaluation of
-          Just _ -> maybeEvaluation'
-          Nothing -> Nothing
-        Nothing -> Nothing
 
   if not forceEvaluation && isJust maybeEvaluation
    then
@@ -238,7 +232,7 @@ checkOrInsertEvaluation repoDir forceEvaluation chan version out = do
             runDB $ deleteWhere [
               EvaluationTest ==. outTest out,
               EvaluationChecksum ==. outChecksum out,
-              EvaluationVersion ==. Just version ]
+              EvaluationVersion ==. version ]
            else
             return ()
           _ <- runDB $ insert $ let (pointResult, errorBound) = extractResult result
@@ -249,7 +243,7 @@ checkOrInsertEvaluation repoDir forceEvaluation chan version out = do
                                    evaluationErrorBound=errorBound,
                                    evaluationErrorMessage=Nothing,
                                    evaluationStamp=time,
-                                   evaluationVersion=Just version }
+                                   evaluationVersion=version }
           msg chan "Evaluation done"
         Right (Right (_, Just _)) -> do
           err chan "Unexpected multiple results (???)"

Handler/Query.hs

@@ -230,7 +230,7 @@ doGetScoreForOut mMetricName submission sha1code = do
                             E.&&. evaluation ^. EvaluationTest E.==. test ^. TestId
                             E.&&. out ^. OutChecksum E.==. evaluation ^. EvaluationChecksum
                             E.&&. out ^. OutChecksum E.==. E.val sha1code
-                            E.&&. (evaluation ^. EvaluationVersion E.==. E.just (version ^. VersionCommit)))
+                            E.&&. (evaluation ^. EvaluationVersion E.==. version ^. VersionCommit))
                   E.orderBy [E.asc (test ^. TestPriority),
                              E.desc (version ^. VersionMajor),
                              E.desc (version ^. VersionMinor),
@@ -637,7 +637,7 @@ lineByLineTable (Entity testId test) theStamp = mempty
           evaluationErrorBound = Nothing,
           evaluationErrorMessage = Nothing,
           evaluationStamp = theStamp,
-          evaluationVersion = Nothing }
+          evaluationVersion = undefined }
 
 resultTable :: Entity Submission -> WidgetFor App ()
 resultTable (Entity submissionId submission) = do

Handler/Shared.hs

@@ -602,25 +602,7 @@ checkWhetherGivenUserRepo userId submissionId = do
   submission <- get404 submissionId
   return $ userId == submissionSubmitter submission
 
-fetchTheEvaluation :: (PersistQueryRead backend, MonadIO m, BaseBackend backend ~ SqlBackend)
+fetchTheEvaluation :: (MonadIO m, PersistUniqueRead backend, BaseBackend backend ~ SqlBackend)
                      => Out -> SHA1 -> ReaderT backend m (Maybe (Entity Evaluation))
-fetchTheEvaluation out version = do
+fetchTheEvaluation out version =
-  -- It's complicated due to legacy issues - should be
+  getBy $ UniqueEvaluationTestChecksumVersion (outTest out) (outChecksum out) version
-  -- done by simply running UniqueEvaluationTestChecksumVersion
-
-  evals <- selectList [EvaluationTest ==. outTest out,
-                      EvaluationChecksum ==. outChecksum out,
-                      EvaluationVersion ==. Just version] []
-  case evals of
-    [eval] -> return $ Just eval
-    [] -> do
-      evals' <- selectList [EvaluationTest ==. outTest out,
-                           EvaluationChecksum ==. outChecksum out,
-                           EvaluationVersion ==. Nothing] []
-      case evals' of
-        [eval] -> return $ Just eval
-        [] -> return Nothing
-        _ -> error ("More than 1 evaluation for the same test and version!" ++ (show evals))
-    (eval:_) -> return $ Just eval
-
---      -> error ("More than 1 evaluation for the same test, checksum and version!" ++ (show evals))

Handler/ShowChallenge.hs

@@ -721,8 +721,7 @@ doCreateSubmission' _ userId challengeId challengeSubmissionData chan = do
                         E.&&. test ^. TestName E.==. E.val (testName mainTest)
                         E.&&. test ^. TestMetric E.==. E.val (testMetric mainTest)
                         E.&&. test ^. TestActive
-                        E.&&. (evaluation ^. EvaluationVersion E.==. E.just (theVersion ^. VersionCommit)
+                        E.&&. (evaluation ^. EvaluationVersion E.==. theVersion ^. VersionCommit)
-                               E.||. E.isNothing (evaluation ^. EvaluationVersion))
                         E.&&. theVersion ^. VersionCommit E.==. test ^. TestCommit
                         E.&&. theVersion ^. VersionMajor E.>=. E.val submittedMajorVersion)
               E.orderBy [orderDirection (evaluation ^. EvaluationScore)]

Handler/Tables.hs

@@ -472,8 +472,7 @@ getScore testId variantId = do
                             E.&&. out ^. OutChecksum E.==. evaluation ^. EvaluationChecksum
                             -- all this complication here and with orderBy due
                             -- to the legacy issue with evaluation version sometimes missing
-                            E.&&. (evaluation ^. EvaluationVersion E.==. E.just (submission ^. SubmissionVersion)
+                            E.&&. (evaluation ^. EvaluationVersion E.==. submission ^. SubmissionVersion)
-                                   E.||. E.isNothing (evaluation ^. EvaluationVersion))
                             E.&&. evaluation ^. EvaluationTest E.==. E.val testId)
                   E.orderBy [E.asc (evaluation ^. EvaluationScore)]
                   return evaluation

app/upgrade-to-0-2.hs

@@ -1,92 +0,0 @@
-{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, OverloadedStrings #-}
-{-# LANGUAGE GADTs, FlexibleContexts #-}
-{-# LANGUAGE Arrows, NoMonomorphismRestriction #-}
-{-# LANGUAGE MultiParamTypeClasses, PartialTypeSignatures #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving, EmptyDataDecls #-}
-
-import Prelude hiding (FilePath)
-
-import Control.Monad.Reader (ReaderT)
-import Database.Persist
-import Database.Persist.Postgresql
-import Control.Monad.Logger (runNoLoggingT)
-import Control.Monad.Trans.Resource (runResourceT)
-
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.UTF8 as BSU
-
-import qualified Database.Esqueleto      as E
-import           Database.Esqueleto      ((^.))
-
-import Model
---share [mkPersist sqlSettings, mkMigrate "migrateAll"]
---    $(persistFileWith lowerCaseSettings "config/models")
-
-dbSpecification dbName = BS.concat ["host=localhost dbname=", BSU.fromString dbName]
-
-dbConnection dbName = withPostgresqlConn (dbSpecification dbName)
-
-runOnDb :: String -> ReaderT SqlBackend _ a -> IO a
-runOnDb dbName = runNoLoggingT . runResourceT . (dbConnection dbName) . runSqlConn
-
-process :: String -> IO ()
-process dbName = do
-  Prelude.putStrLn "Getting all variants…"
-  variants <- runOnDb dbName
-             $ E.select $ E.from $ \(challenge, submission, variant, test, out) -> do
-                          E.where_ (submission ^. SubmissionChallenge E.==. challenge ^. ChallengeId
-                                    E.&&. variant ^. VariantSubmission E.==. submission ^. SubmissionId
-                                    E.&&. test ^. TestChallenge E.==. challenge ^. ChallengeId
-                                    E.&&. out ^. OutTest E.==. test ^. TestId
-                                    E.&&. out ^. OutVariant E.==. variant ^. VariantId)
-                          return (variant, submission, out, test)
-
-  Prelude.putStrLn "Adding evaluations…"
-  let total = length variants
-  putStrLn $ "TOTAL " ++ (show total)
-  _ <- mapM (\(v, ix) -> processVariant total ix dbName v) $ zip variants [1..]
-
-  putStrLn "DELETING"
-  runOnDb dbName $ deleteWhere [EvaluationVersion ==. Nothing]
-
-  return ()
-
-processVariant :: Int -> Int -> String -> (Entity Variant, Entity Submission, Entity Out, Entity Test) -> IO ()
-processVariant total ix dbName (variant, Entity _ submission, Entity _ out, Entity testId _) = do
-  Prelude.putStrLn (show $ entityKey variant)
-  Prelude.putStrLn ((show ix) ++ "/" ++ (show total))
-
-  evaluations <- runOnDb dbName
-                $ E.select $ E.from $ \evaluation -> do
-                             E.where_ (E.val (outChecksum out) E.==. evaluation ^. EvaluationChecksum
-                                       -- all this complication here and with orderBy due
-                                       -- to the legacy issue with evaluation version sometimes missing
-                                       E.&&. (evaluation ^. EvaluationVersion E.==. E.just (E.val (submissionVersion submission))
-                                              E.||. E.isNothing (evaluation ^. EvaluationVersion))
-                                       E.&&. evaluation ^. EvaluationTest E.==. E.val testId)
-                             E.orderBy [E.desc (E.isNothing (evaluation ^. EvaluationVersion))]
-                             return evaluation
-
-  case evaluations of
-    (Entity _ e:_) -> do
-      case evaluationVersion e of
-        Just _ -> putStrLn "OK found!"
-        Nothing -> do
-          putStrLn "NONE FOUND INSERTING"
-          _ <- runOnDb dbName $ insert $ Evaluation testId
-                                                   (outChecksum out)
-                                                   (evaluationScore e)
-                                                   (evaluationErrorBound e)
-                                                   (evaluationErrorMessage e)
-                                                   (evaluationStamp e)
-                                                   (Just $ submissionVersion submission)
-          return ()
-    [] -> do
-      putStrLn "MISSING EVALUATION"
-
-  return ()
-
-main :: IO ()
-main = do
-  let dbName = "gonito"
-  process dbName

config/models

@@ -129,7 +129,8 @@ Evaluation
     errorMessage Text Maybe
     stamp UTCTime default=now()
     -- Should be just SHA1 (without Maybe) - Maybe is just a legacy
-    version SHA1 Maybe
+    version SHA1
+    UniqueEvaluationTestChecksumVersion test checksum version
     deriving Show
 Comment
     challenge ChallengeId

gonito.cabal

@@ -181,27 +181,6 @@ executable         gonito-bin
 
     ghc-options:       -threaded -O2 -rtsopts -with-rtsopts=-N
 
-executable         upgrade-to-0-2
-    if flag(library-only)
-        Buildable: False
-
-    main-is:           upgrade-to-0-2.hs
-    hs-source-dirs:    app
-    build-depends:     base
-                       , gonito
-                       , esqueleto
-                       , text
-                       , monad-logger
-                       , persistent
-                       , persistent-postgresql
-                       , resourcet
-                       , bytestring
-                       , persistent-template
-                       , mtl
-                       , utf8-string
-
-    ghc-options:       -threaded -O2 -rtsopts -with-rtsopts=-N
-
 test-suite test
     type:              exitcode-stdio-1.0
     main-is:           Spec.hs