chore: fix tests

src/Handler/Exam/Edit.hs

@@ -51,7 +51,7 @@ postEEditR tid ssh csh examn = do
               | Just (Entity previousStatementId _) <- mPreviousStatement
                 -> update previousStatementId [ AuthorshipStatementDefinitionContent =. newStatementContent ] >> return (Just previousStatementId)
               | otherwise
-                -> fmap Just $ insert AuthorshipStatementDefinition { authorshipStatementDefinitionContent = newStatementContent }
+                -> Just <$> insert AuthorshipStatementDefinition { authorshipStatementDefinitionContent = newStatementContent }
 
         insertRes <- myReplaceUnique eId Exam
           { examCourse           = cid

src/Handler/Exam/Form.hs

@@ -151,7 +151,7 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do
           reqContentField :: (FieldSettings UniWorX -> FieldSettings UniWorX) -> AForm Handler StoredMarkup
           reqContentField ttip = areq htmlField
                                  (fslI MsgExamAuthorshipStatementContent & ttip)
-                                 (     (join $ efAuthorshipStatement <$> template)
+                                 (     (efAuthorshipStatement =<< template)
                                    <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement)
                                  )
           forcedContentField   = aforced htmlField

src/Handler/Sheet/Form.hs

@@ -111,7 +111,7 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS
             reqContentField :: (FieldSettings UniWorX -> FieldSettings UniWorX) -> AForm Handler StoredMarkup
             reqContentField ttip = areq htmlField
                                    (fslI MsgSheetAuthorshipStatementContent & ttip)
-                                   (     (join $ sfAuthorshipStatement <$> template)
+                                   (     (sfAuthorshipStatement =<< template)
                                      <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement)
                                    )
             forcedContentField   = aforced htmlField

src/Model/Types/School.hs

@@ -25,7 +25,7 @@ data SchoolAuthorshipStatementMode
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
   deriving anyclass (Universe, Finite, NFData)
 
-nullaryPathPiece ''SchoolAuthorshipStatementMode $ camelToPathPiece' 4
+finitePathPiece ''SchoolAuthorshipStatementMode [ "no-statement", "optional", "required" ]
 pathPieceJSON ''SchoolAuthorshipStatementMode
 pathPieceJSONKey ''SchoolAuthorshipStatementMode
 derivePersistFieldPathPiece ''SchoolAuthorshipStatementMode

test/Model/TypesSpec.hs

@@ -340,6 +340,9 @@ instance Arbitrary UploadNonce where
   arbitrary = pure $ unsafePerformIO newUploadNonce
 
 
+instance Arbitrary SchoolAuthorshipStatementMode where
+  arbitrary = genericArbitrary
+
 
 spec :: Spec
 spec = do
@@ -448,6 +451,8 @@ spec = do
       [ eqLaws, ordLaws, showLaws, showReadLaws, pathPieceLaws, jsonLaws, persistFieldLaws, binaryLaws ]
     lawsCheckHspec (Proxy @UploadNonce)
       [ eqLaws, ordLaws, showLaws, showReadLaws, pathPieceLaws, jsonLaws, jsonKeyLaws, persistFieldLaws ]
+    lawsCheckHspec (Proxy @SchoolAuthorshipStatementMode)
+      [ eqLaws, ordLaws, showLaws, showReadLaws, boundedEnumLaws, finiteLaws, pathPieceLaws, jsonLaws, jsonKeyLaws, persistFieldLaws, binaryLaws ]
 
   describe "TermIdentifier" $ do
     it "has compatible encoding/decoding to/from Text" . property $

test/ModelSpec.hs

@@ -68,8 +68,9 @@ instance Arbitrary Sheet where
     <*> arbitrary
     <*> arbitrary
     <*> arbitrary
-    <*> return Nothing
+    <*> pure Nothing
     <*> arbitrary
+    <*> pure Nothing
   shrink = genericShrink
 
 instance Arbitrary Tutorial where
@@ -164,6 +165,12 @@ instance Arbitrary School where
     schoolExamRequireModeForRegistration <- arbitrary
     schoolExamDiscouragedModes <- arbitrary
     schoolExamCloseMode <- arbitrary
+    schoolSheetAuthorshipStatementMode <- arbitrary
+    let schoolSheetAuthorshipStatementDefinition = Nothing
+    schoolSheetAuthorshipStatementAllowOther <- arbitrary
+    schoolSheetExamAuthorshipStatementMode <- arbitrary
+    let schoolSheetExamAuthorshipStatementDefinition = Nothing
+    schoolSheetExamAuthorshipStatementAllowOther <- arbitrary
     return School{..}
 
 instance Arbitrary Term where