{-# LANGUAGE QuasiQuotes, TemplateHaskell, CPP, GADTs, TypeFamilies, OverloadedStrings, FlexibleContexts, EmptyDataDecls, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}

module UniqueTest where

import Init

#ifndef WITH_NOSQL

import Control.Monad (void)

#endif

#ifdef WITH_NOSQL

mkPersist persistSettings [persistUpperCase|

#else

share [mkPersist sqlSettings, mkMigrate "uniqueMigrate"] [persistLowerCase|

#endif

TestNonNull

fieldA Int

UniqueTestNonNull fieldA

deriving Eq Show

TestNull

fieldA Int

fieldB Int Maybe

UniqueTestNull fieldA fieldB !force

deriving Eq Show

#ifndef WITH_NOSQL

TestCheckmark

name Text

value Text

active Checkmark nullable

UniqueTestCheckmark name active !force

deriving Eq Show

#endif

|]

#ifdef WITH_NOSQL

cleanDB :: (MonadIO m, PersistQuery backend, PersistEntityBackend TestNonNull ~ backend) => ReaderT backend m ()

cleanDB = do

deleteWhere ([] :: [Filter TestNonNull])

deleteWhere ([] :: [Filter TestNull])

db :: Action IO () -> Assertion

db = db' cleanDB

#endif

specs :: Spec

specs = describe "uniqueness constraints" $

#ifdef WITH_NOSQL

return ()

#else

do

it "are respected for non-nullable Ints" $ do

let ins = insert . TestNonNull

(db $ void $ ins 1 >> ins 2)

(db $ void $ ins 1 >> ins 2 >> ins 1) `shouldThrow` anyException

(db $ void $ ins 1 >>= \k -> ins 2 >> delete k >> ins 1)

it "are respected for nullable Ints" $ do

let ins a b = insert $ TestNull a b

ctx = ins 1 Nothing >> ins 1 Nothing >> ins 1 Nothing >>

ins 1 (Just 3) >> ins 1 (Just 4)

(db $ void ctx)

(db $ void $ ctx >> ins 1 (Just 3)) `shouldThrow` anyException

(db $ void $ ctx >> ins 1 (Just 4)) `shouldThrow` anyException

(db $ void $ ctx >>= \k -> delete k >> ins 1 (Just 4))

it "work for Checkmark" $ do

let ins k v a = insert $ TestCheckmark k v a

ctx = ins "name" "John" Inactive

>> ins "name" "Stewart" Inactive

>> ins "name" "Doroty" Active

>> ins "color" "blue" Inactive

(db $ void ctx)

(db $ void $ ctx >> ins "name" "Melissa" Active) `shouldThrow` anyException

(db $ void $ ctx >> ins "name" "Melissa" Inactive)

(db $ void $ ctx >>= flip update [TestCheckmarkActive =. Active])

(db $ void $ do

void ctx

updateWhere [TestCheckmarkName ==. "name"]

[TestCheckmarkActive =. Inactive]

ins "name" "Melissa" Active)

#endif