fix: tests
This commit is contained in:
parent
f9c50c80f2
commit
65e06882d2
@ -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
|
||||||
|
|||||||
@ -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};
|
||||||
|]
|
|]
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user