refactor: move correct interfaces to utils

src/Handler/Exam/Correct.hs

@@ -6,7 +6,6 @@ import Import
 
 import qualified Data.Set as Set
 import qualified Data.CaseInsensitive as CI
-import qualified Data.Aeson as JSON
 
 import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Utils as E
@@ -15,63 +14,7 @@ import Database.Persist.Sql (transactionUndo)
 import Handler.Utils
 import Handler.Utils.Exam (fetchExam)
 
-import qualified Data.HashMap.Strict as HashMap
-
-
-data CorrectInterfaceUser
-  = CorrectInterfaceUser
-    { ciuSurname     :: Text
-    , ciuDisplayName :: Text
-    , ciuMatNr       :: Maybe UserMatriculation
-    , ciuId          :: CryptoUUIDUser
-    } deriving (Eq,Ord)
-deriveJSON defaultOptions
-  { fieldLabelModifier = camelToPathPiece' 1
-  } ''CorrectInterfaceUser
-
-data CorrectInterfaceResponse
-  = CorrectInterfaceResponseSuccess
-    { cirsUser       :: CorrectInterfaceUser
-    , cirsResults    :: Map ExamPartNumber (Maybe ExamResultPoints)
-    , cirsGrade      :: Maybe (Maybe ExamResultPassedGrade)
-    , cirsTime       :: UTCTime
-    }
-  | CorrectInterfaceResponseAmbiguous
-    { ciraUsers      :: Set CorrectInterfaceUser
-    , ciraMessage    :: Text
-    }
-  | CorrectInterfaceResponseFailure
-    { cirfUser       :: Maybe CorrectInterfaceUser
-    , cirfMessage    :: Text
-    }
-  | CorrectInterfaceResponseNoOp
-    { cirnUsers      :: Set CorrectInterfaceUser
-    }
-deriveToJSON defaultOptions
-  { constructorTagModifier = camelToPathPiece' 3
-  , fieldLabelModifier     = camelToPathPiece' 1
-  , sumEncoding            = TaggedObject "status" "results"
-  , omitNothingFields      = True
-  } ''CorrectInterfaceResponse
-
-data CorrectInterfaceRequest
-  = CorrectInterfaceRequest
-    { ciqUser        :: Either Text (CryptoID UUID (Key User))
-    , ciqResults     :: Maybe (NonNull (Map ExamPartNumber (Maybe Points)))
-    , ciqGrade       :: Maybe (Maybe ExamResultPassedGrade)
-    }
-
-instance FromJSON CorrectInterfaceRequest where
-  parseJSON = JSON.withObject "CorrectInterfaceRequest" $ \o -> do
-    ciqUser <- Right <$> o JSON..: "user" <|> Left <$> o JSON..: "user"
-    results <- o JSON..:? "results"
-    ciqResults <- for results $ maybe (fail "Results may not be nullable") return . fromNullable
-    ciqGrade <- if
-      | "grade" `HashMap.member` o
-        -> Just <$> o JSON..: "grade"
-      | otherwise
-        -> pure Nothing
-    return CorrectInterfaceRequest{..}
+import Utils.Exam
 
 
 getECorrectR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html

src/Utils/Exam.hs

@@ -0,0 +1,70 @@
+module Utils.Exam
+  ( CorrectInterfaceRequest(..)
+  , CorrectInterfaceResponse(..)
+  , CorrectInterfaceUser(..)
+  ) where
+
+import Import.NoFoundation
+
+import qualified Data.Aeson as JSON
+import qualified Data.HashMap.Strict as HashMap
+
+
+data CorrectInterfaceUser
+  = CorrectInterfaceUser
+    { ciuSurname     :: Text
+    , ciuDisplayName :: Text
+    , ciuMatNr       :: Maybe UserMatriculation
+    , ciuId          :: CryptoUUIDUser
+    } deriving (Eq,Ord)
+
+deriveJSON defaultOptions
+  { fieldLabelModifier = camelToPathPiece' 1
+  } ''CorrectInterfaceUser
+
+
+data CorrectInterfaceResponse
+  = CorrectInterfaceResponseSuccess
+    { cirsUser       :: CorrectInterfaceUser
+    , cirsResults    :: Map ExamPartNumber (Maybe ExamResultPoints)
+    , cirsGrade      :: Maybe (Maybe ExamResultPassedGrade)
+    , cirsTime       :: UTCTime
+    }
+  | CorrectInterfaceResponseAmbiguous
+    { ciraUsers      :: Set CorrectInterfaceUser
+    , ciraMessage    :: Text
+    }
+  | CorrectInterfaceResponseFailure
+    { cirfUser       :: Maybe CorrectInterfaceUser
+    , cirfMessage    :: Text
+    }
+  | CorrectInterfaceResponseNoOp
+    { cirnUsers      :: Set CorrectInterfaceUser
+    }
+
+deriveToJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece' 3
+  , fieldLabelModifier     = camelToPathPiece' 1
+  , sumEncoding            = TaggedObject "status" "results"
+  , omitNothingFields      = True
+  } ''CorrectInterfaceResponse
+
+
+data CorrectInterfaceRequest
+  = CorrectInterfaceRequest
+    { ciqUser        :: Either Text (CryptoID UUID (Key User))
+    , ciqResults     :: Maybe (NonNull (Map ExamPartNumber (Maybe Points)))
+    , ciqGrade       :: Maybe (Maybe ExamResultPassedGrade)
+    }
+
+instance FromJSON CorrectInterfaceRequest where
+  parseJSON = JSON.withObject "CorrectInterfaceRequest" $ \o -> do
+    ciqUser <- Right <$> o JSON..: "user" <|> Left <$> o JSON..: "user"
+    results <- o JSON..:? "results"
+    ciqResults <- for results $ maybe (fail "Results may not be nullable") return . fromNullable
+    ciqGrade <- if
+      | "grade" `HashMap.member` o
+        -> Just <$> o JSON..: "grade"
+      | otherwise
+        -> pure Nothing
+    return CorrectInterfaceRequest{..}