fix(test): fix test problem and add tests for UserEyeExam and UserDrivingPermit

src/Model/Types/User.hs

@@ -38,6 +38,9 @@ instance Show UserDrivingPermit where
   show UserDrivingPermitB   = "B"
   show UserDrivingPermitB01 = "B01"
 
+instance RenderMessage a UserDrivingPermit where
+  renderMessage _foundation _languages = tshow
+
 deriveJSON defaultOptions
   { constructorTagModifier = camelToPathPiece' 3
   } ''UserDrivingPermit
@@ -52,9 +55,10 @@ instance Show UserEyeExam where
   show UserEyeExamSX  = "SX"
   show UserEyeExamS01 = "S01"
 
+instance RenderMessage a UserEyeExam where
+  renderMessage _foundation _languages = tshow
+
 deriveJSON defaultOptions
   { constructorTagModifier = camelToPathPiece' 3
   } ''UserEyeExam
 derivePersistFieldJSON ''UserEyeExam
-
-

test/Handler/Utils/SubmissionSpec.hs

@@ -196,7 +196,7 @@ spec = withApp . describe "Submission distribution" $ do
             void . insert $ Tutor tutId sheetCorrectorUser
             E.insertSelect . E.from $ \submissionUser -> do
               E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val subId
-              return $ TutorialParticipant E.<# E.val tutId E.<&> (submissionUser E.^. SubmissionUserUser) E.<&> E.nothing
+              return $ TutorialParticipant E.<# E.val tutId E.<&> (submissionUser E.^. SubmissionUserUser) E.<&> E.nothing E.<&> E.nothing E.<&> E.nothing E.<&> E.nothing
       )
       (\result -> do
           let countResult = Map.map Set.size result

test/Model/TypesSpec.hs

@@ -51,6 +51,7 @@ import Text.Blaze.TestInstances ()
 import qualified Data.Text.Lazy as LT
 
 import Text.Blaze.Html.Renderer.Text (renderHtml)
+import Text.Shakespeare.I18N (renderMessage)
 
 import qualified Data.SemVer as SemVer
 import qualified Data.SemVer.Constraint as SemVer (Constraint)
@@ -417,6 +418,12 @@ instance Arbitrary LmsDay where
 
 deriving newtype instance Arbitrary LmsIdent
 
+instance Arbitrary UserDrivingPermit where
+  arbitrary = genericArbitrary
+
+instance Arbitrary UserEyeExam where
+  arbitrary = genericArbitrary
+
 spec :: Spec
 spec = do
   parallel $ do
@@ -538,6 +545,10 @@ spec = do
       [ eqLaws, ordLaws, showLaws, showReadLaws, boundedEnumLaws, finiteLaws, csvFieldLaws ]
     lawsCheckHspec (Proxy @LmsDay)
       [ eqLaws, ordLaws, showLaws, showReadLaws, csvFieldLaws ]
+    lawsCheckHspec (Proxy @UserDrivingPermit)
+      [ eqLaws, ordLaws, showLaws, boundedEnumLaws, finiteLaws, persistFieldLaws ]
+    lawsCheckHspec (Proxy @UserEyeExam)
+      [ eqLaws, ordLaws, showLaws, boundedEnumLaws, finiteLaws, persistFieldLaws ]
 
   describe "TermIdentifier" $ do
     it "has compatible encoding/decoding to/from Text" . property $
@@ -642,6 +653,20 @@ spec = do
       showCompactCorrectorLoad Load{ byTutorial = Nothing,    byProportion = 0, byDeficit = 0 } CorrectorNormal  `shouldBe` "-D"
       showCompactCorrectorLoad Load{ byTutorial = Nothing,    byProportion = 1, byDeficit = 0 } CorrectorMissing `shouldBe` "[1.0 - D]"
       showCompactCorrectorLoad Load{ byTutorial = Nothing,    byProportion = 1, byDeficit = 0 } CorrectorExcused `shouldBe` "{1.0 - D}"
+  describe "UserDrivingPermit" $ do
+    it "encodes to DB as shown to user" . property $
+      \(v :: UserDrivingPermit) ->
+        let tv = tshow v
+        in  cmpJsonStringCI v tv && tv == renderMessage (error "renderMessage: foundation inspected") [] v
+  describe "UserEyeExam" $ do
+    it "encodes to DB as shown to user" . property $
+      \(v :: UserEyeExam) ->
+        let tv = tshow v
+        in  cmpJsonStringCI v tv && tv == renderMessage (error "renderMessage: foundation inspected") [] v
+  where
+    cmpJsonStringCI :: Aeson.ToJSON a => a -> Text -> Bool
+    cmpJsonStringCI (Aeson.toJSON -> Aeson.String s) t = CI.mk s == CI.mk t
+    cmpJsonStringCI _ _ = False
 
 termExample :: (TermIdentifier, Text) -> Expectation
 termExample (term, encoded) = example $ do

test/Utils/TypesSpec.hs

@@ -63,7 +63,7 @@ instance Arbitrary AvsResponsePerson where
   shrink = genericShrink
 
 instance Arbitrary AvsResponseStatus where
-  arbitrary = genericArbitrary
+  arbitrary = resize 5 genericArbitrary
   shrink = genericShrink
 
 instance Arbitrary AvsResponseSetLicences where