module Main (main) where

import           Prelude
import           Test.Tasty
import           Test.Tasty.QuickCheck

import           CircularBuffer
import qualified CrudWebserverDb       as WS
import           DieHard
import           MemoryReference
import           TicketDispenser

------------------------------------------------------------------------

tests :: TestTree
tests = testGroup "Tests"
  [ testProperty "Die Hard"
      (expectFailure (withMaxSuccess 1000 prop_dieHard))
  , testGroup "Memory reference"
      [ testProperty "No bug"                             (prop_sequential None)
      , testProperty "Logic bug"           (expectFailure (prop_sequential Logic))
      , testProperty "Race bug sequential"                (prop_sequential Race)
      , testProperty "Race bug parallel"   (expectFailure (prop_parallel   Race))
      ]
  , testGroup "Crud webserver"
      [ webServer WS.None  8800 "No bug"                       WS.prop_crudWebserverDb
      , webServer WS.Logic 8801 "Logic bug"   (expectFailure . WS.prop_crudWebserverDb)
      , webServer WS.Race  8802 "No race bug"                  WS.prop_crudWebserverDb
      , webServer WS.Race  8803 "Race bug"    (expectFailure . WS.prop_crudWebserverDbParallel)
      ]
  , testGroup "Ticket dispenser"
      [ ticketDispenser "sequential"                   prop_ticketDispenser
      , ticketDispenser "parallel with exclusive lock" (withMaxSuccess 30 .
                                                        prop_ticketDispenserParallelOK)
      , ticketDispenser "parallel with shared lock"    (expectFailure .
                                                        prop_ticketDispenserParallelBad)
      ]
  , testGroup "Circular buffer"
      [ testProperty "`unpropNoSizeCheck`: the first bug is found"
          (expectFailure unpropNoSizeCheck)
      , testProperty "`unpropFullIsEmpty`: the second bug is found"
          (expectFailure unpropFullIsEmpty)
      , testProperty "`unpropBadRem`: the third bug is found"
          (expectFailure unpropBadRem)
      , testProperty "`unpropStillBadRem`: the fourth bug is found"
          (expectFailure unpropStillBadRem)
      , testProperty "`prop_circularBuffer`: the fixed version is correct"
          prop_circularBuffer
      ]
  ]
  where
    webServer bug port test prop =
      withResource (WS.setup bug WS.connectionString port) WS.cleanup
        (const (testProperty test (prop port)))

    ticketDispenser test prop =
      withResource setupLock cleanupLock
        (\ioLock -> testProperty test (ioProperty (prop <$> ioLock)))

------------------------------------------------------------------------

main :: IO ()
main = defaultMain tests