Automerge.hs

import Test.HUnit
import ProjectM36.Client
import ProjectM36.Relation
import qualified Data.Set as S
import TutorialD.Interpreter.TestBase

import System.Exit
import System.IO.Temp
import System.FilePath
import Control.Exception.Base
import System.Random

{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}
main :: IO ()           
main = do 
  tcounts <- runTestTT testList
  if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
  
testList :: Test
testList = TestList [testAutomergeSuccess,
                     testAutomergeFailure,
                     testAutomergeReconnect
                     ]
           
checkEither :: IO (Either RelationalError a) -> IO a
checkEither io = do
  ret <- io
  case ret of
    Left err -> assertFailure (show err) >> undefined
    Right a -> pure a

testAutomergeSuccess :: Test
testAutomergeSuccess = TestCase $ do
  --create two sessions, diverge from the head, and automerge back
  (sessionId, conn) <- dateExamplesConnection emptyNotificationCallback
  let headn = "master"
  sessionPastId <- checkEither $ createSessionAtHead conn headn
  executeTutorialD sessionId conn "insert s relation{tuple{city \"New City\", s# \"S6\", sname \"Samuels\", status 50}}"
  checkEither $ commit sessionId conn
  
  executeTutorialD sessionPastId conn "insert s relation{tuple{city \"Merge City\", s# \"S7\", sname \"Mr. Merge\", status 60}}"
  
  checkEither $ autoMergeToHead sessionPastId conn UnionMergeStrategy headn
  
  --validate that both tuples are now in the head transaction
  
  let predi = eqAttr
      eqAttr key = AttributeEqualityPredicate "s#" (NakedAtomExpr (TextAtom key))
  result <- checkEither $ executeRelationalExpr sessionPastId conn (Project (AttributeNames S.empty) (Restrict (predi "S6") (RelationVariable "s" ())))
  assertEqual "new S6" relationTrue result

  result' <- checkEither $ executeRelationalExpr sessionPastId conn (Project (AttributeNames S.empty) (Restrict (predi "S7") (RelationVariable "s" ())))
  
  assertEqual "new S7" relationTrue result'
  
  eCurrentHead <- currentHead sessionPastId conn
  assertEqual "back on master" (Right (CurrentHeadBranch "master")) eCurrentHead
  
testAutomergeFailure :: Test  
testAutomergeFailure = TestCase $ do
  --create two sessions, diverge from the head, but create a union merge strategy failure
  (sessionId, conn) <- dateExamplesConnection emptyNotificationCallback
  let headn = "master"
  sessionPastId <- checkEither $ createSessionAtHead conn headn
  executeTutorialD sessionId conn "insert s relation{tuple{city \"New City\", s# \"S6\", sname \"Samuels\", status 50}}"
  checkEither $ commit sessionId conn
  
  --reuse the same id, violating the uniqueness constraint
  executeTutorialD sessionPastId conn "insert s relation{tuple{city \"Merge City\", s# \"S6\", sname \"Mr. Merge\", status 60}}"
  
  --validate that both tuples are now in the head transaction
  --should fail
  mergeRes <- autoMergeToHead sessionPastId conn UnionMergeStrategy headn
  
  _ <- checkEither $ executeRelationalExpr sessionPastId conn (RelationVariable "s" ())
  
  assertEqual "merge failure" (Left (InclusionDependencyCheckError "s_pkey" Nothing)) mergeRes
  
--reported as #128
testAutomergeReconnect :: Test
testAutomergeReconnect = TestCase $ withSystemTempDirectory "m36testdb" $ \tempdir -> do
  let repro = do
          rando <- initStdGen
          conn <- unsafeLeftCrash =<< connectProjectM36 (InProcessConnectionInfo (CrashSafePersistence (tempdir </> "test.db")) emptyNotificationCallback [] basicDatabaseContext rando adminRoleName)
          sess <- unsafeLeftCrash =<< createSessionAtHead conn "master"
          autoMergeToHead sess conn UnionMergeStrategy "master"
        -- commit sess conn
                  
      unsafeLeftCrash :: Show e => Either e a -> IO a
      unsafeLeftCrash = either (throwIO . userError . show) pure
  _ <- repro 
  _ <- repro
  pure ()