fix: tests

This commit is contained in:
Gregor Kleen 2020-09-17 13:31:41 +02:00
parent f9c50c80f2
commit 65e06882d2
4 changed files with 22 additions and 3 deletions

View File

@ -12,6 +12,7 @@
- ignore: { name: "Use ***" } - ignore: { name: "Use ***" }
- ignore: { name: "Redundant void" } - ignore: { name: "Redundant void" }
- ignore: { name: "Too strict maybe" } - ignore: { name: "Too strict maybe" }
- ignore: { name: "Use Just" }
- arguments: - arguments:
- -XQuasiQuotes - -XQuasiQuotes

View File

@ -952,11 +952,11 @@ customMigrations = Map.fromListWith (>>)
) )
, ( AppliedMigrationKey [migrationVersion|41.0.0|] [version|42.0.0|] , ( AppliedMigrationKey [migrationVersion|41.0.0|] [version|42.0.0|]
, do , do
whenM (tableExists "exam") $ whenM (tableExists "exam")
[executeQQ| [executeQQ|
ALTER TABLE exam ADD COLUMN "exam_mode" jsonb NOT NULL DEFAULT #{ExamMode Nothing Nothing Nothing Nothing}; ALTER TABLE exam ADD COLUMN "exam_mode" jsonb NOT NULL DEFAULT #{ExamMode Nothing Nothing Nothing Nothing};
|] |]
whenM (tableExists "school") $ whenM (tableExists "school")
[executeQQ| [executeQQ|
ALTER TABLE school ADD COLUMN "exam_discouraged_modes" jsonb NOT NULL DEFAULT #{ExamModeDNF predDNFFalse}; ALTER TABLE school ADD COLUMN "exam_discouraged_modes" jsonb NOT NULL DEFAULT #{ExamModeDNF predDNFFalse};
|] |]

View File

@ -185,7 +185,7 @@ dnfAssumeValue var val
disagrees PLVariable{..} = plVar == var && not val disagrees PLVariable{..} = plVar == var && not val
predDNFFalse :: PredDNF a predDNFFalse :: PredDNF a
predDNFFalse = PredDNF $ Set.empty predDNFFalse = PredDNF Set.empty
data UserGroupName data UserGroupName

View File

@ -39,6 +39,8 @@ import qualified Data.Conduit.Combinators as C
import Data.Ratio ((%)) import Data.Ratio ((%))
import Data.Universe
instance Arbitrary EmailAddress where instance Arbitrary EmailAddress where
arbitrary = do arbitrary = do
@ -167,6 +169,18 @@ instance Monad m => Arbitrary (File m) where
| otherwise | otherwise
= False = False
instance Arbitrary ExamModePredicate where
arbitrary = elements universeF
instance Arbitrary p => Arbitrary (PredLiteral p) where
arbitrary = elements [PLVariable, PLNegated] <*> arbitrary
instance (Arbitrary p, Ord p) => Arbitrary (PredDNF p) where
arbitrary = PredDNF . Set.fromList . mapMaybe (fromNullable . Set.fromList) <$> arbitrary
shrink = fmap (PredDNF . Set.fromList . mapMaybe (fromNullable . Set.fromList)) . shrink . map otoList . otoList . dnfTerms
deriving newtype instance Arbitrary ExamModeDNF
instance Arbitrary School where instance Arbitrary School where
arbitrary = do arbitrary = do
names <- listOf1 $ pack . getPrintableString <$> arbitrary names <- listOf1 $ pack . getPrintableString <$> arbitrary
@ -174,6 +188,10 @@ instance Arbitrary School where
name = Text.toTitle $ unwords names name = Text.toTitle $ unwords names
schoolShorthand = CI.mk $ Text.filter Char.isUpper name schoolShorthand = CI.mk $ Text.filter Char.isUpper name
schoolName = CI.mk name schoolName = CI.mk name
schoolExamMinimumRegisterBeforeStart <- arbitrary
schoolExamMinimumRegisterDuration <- arbitrary
schoolExamRequireModeForRegistration <- arbitrary
schoolExamDiscouragedModes <- arbitrary
return School{..} return School{..}
instance Arbitrary Term where instance Arbitrary Term where