refactor(rating): move formatting/parsing of rating files

src/Handler/Utils/Rating.hs

@@ -1,54 +1,29 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
 module Handler.Utils.Rating
   ( Rating(..), Rating'(..)
   , validateRating
   , getRating
-  , formatRating
   , ratingFile
   , RatingException(..)
   , UnicodeException(..)
   , isRatingFile
-  , parseRating
   , SubmissionContent
   , extractRatings
+  , module Handler.Utils.Rating.Format
   ) where
 
 import Import
 
-import Text.PrettyPrint.Leijen.Text hiding ((<$>))
-
 import qualified Data.Text as Text
-import qualified Data.Text.Encoding as Text
 
-import qualified Data.Text.Lazy.Encoding as Lazy.Text
-
-import qualified Data.CaseInsensitive as CI
-
-import qualified Data.ByteString.Lazy as Lazy (ByteString)
 import qualified Data.ByteString.Lazy as Lazy.ByteString
 
-import Text.Read (readEither)
-
 import qualified System.FilePath.Cryptographic as FilePath (decrypt)
 
 import qualified Database.Esqueleto as E
 
 import qualified Data.Conduit.List as Conduit
 
-
+import Handler.Utils.Rating.Format
-instance HasResolution prec => Pretty (Fixed prec) where
-  pretty = pretty . show
-
-instance Pretty x => Pretty (CI x) where
-  pretty = pretty . CI.original
-
-
-instance Pretty SheetGrading where
-  pretty Points{..}     = pretty ( "Maximal " <> show maxPoints <> " Punkt(e)" :: String)
-  pretty PassPoints{..} = pretty ( "Maximal " <> show maxPoints <> " Punkt(e), bestanden ab " <> show passingPoints <> " Punkt(en)" :: String )
-  pretty PassBinary     = pretty ( "Bestanden (1) /  Nicht bestanden (0)" :: String )
-  pretty PassAlways     = pretty ( "Automatisch bestanden, sobald korrigiert" :: String )
 
 
 validateRating :: SheetType -> Rating' -> [RatingException]
@@ -101,28 +76,6 @@ getRating submissionId = runMaybeT $ do
 
   return Rating{ ratingValues = Rating'{..}, .. }
 
-formatRating :: CryptoFileNameSubmission -> Rating -> Lazy.ByteString
-formatRating cID Rating{ ratingValues = Rating'{..}, ..} = let
-  doc = renderPretty 1 45 . foldr (<$$>) mempty $ catMaybes
-    [ pure "= Bitte nur Bewertung und Kommentare ändern ="
-    , pure "============================================="
-    , pure "========== Uni2work Bewertungsdatei ========="
-    , pure "======= diese Datei ist UTF8 encodiert ======"
-    , pure "Informationen zum Übungsblatt:"
-    , pure . indent 2 . foldr (<$$>) mempty . catMaybes $
-      [ Just $ "Veranstaltung:" <+> pretty ratingCourseName
-      , Just $ "Blatt:" <+> pretty ratingSheetName
-      , ("Korrektor:" <+>) . pretty <$> ratingCorrectorName
-      , ("Bewertungsschema:" <+>) . pretty <$> (ratingSheetType ^? _grading)
-      ]
-    , pure $ "Abgabe-Id:" <+> pretty (Text.unpack $ toPathPiece cID)
-    , guardOn (hasn't (_grading . _PassAlways) ratingSheetType)   "============================================="
-    , guardOn (hasn't (_grading . _PassAlways) ratingSheetType) $ "Bewertung:" <+> pretty ratingPoints
-    , pure   "=========== Beginn der Kommentare ==========="
-    , pure $ pretty ratingComment
-    ]
-  in Lazy.Text.encodeUtf8 . (<> "\n") $ displayT doc
-
 ratingFile :: MonadIO m => CryptoFileNameSubmission -> Rating -> m File
 ratingFile cID rating@Rating{ ratingValues = Rating'{..}, .. } = do
   fileModified <- maybe (liftIO getCurrentTime) return ratingTime
@@ -131,39 +84,6 @@ ratingFile cID rating@Rating{ ratingValues = Rating'{..}, .. } = do
     fileContent = Just . Lazy.ByteString.toStrict $ formatRating cID rating
   return File{..}
 
-parseRating :: MonadThrow m => File -> m Rating'
-parseRating File{ fileContent = Just input, .. } = do
-  inputText <- either (throwM . RatingNotUnicode) return $ Text.decodeUtf8' input
-  let
-    (headerLines', commentLines) = break (commentSep `Text.isInfixOf`) $ Text.lines inputText
-    (reverse -> ratingLines, reverse -> _headerLines) = break (sep' `Text.isInfixOf`) $ reverse headerLines'
-    ratingLines' = filter (rating `Text.isInfixOf`) ratingLines
-    commentSep :: Text
-    commentSep = "Beginn der Kommentare"
-    sep' = Text.pack $ replicate 40 '='
-    rating :: Text
-    rating = "Bewertung:"
-  comment' <- case commentLines of
-    (_:commentLines') -> return . Text.strip $ Text.unlines commentLines'
-    _ -> throwM RatingMissingSeparator
-  let
-    ratingComment
-      | Text.null comment' = Nothing
-      | otherwise = Just comment'
-  ratingLine' <- case ratingLines' of
-    [] -> return Text.empty
-    [l] -> return l
-    _ -> throwM RatingMultiple
-  let
-    (_, ratingLine) = Text.breakOnEnd rating ratingLine'
-    ratingStr = Text.unpack $ Text.strip ratingLine
-  ratingPoints <- case () of
-    _ | null ratingStr -> return Nothing
-      | otherwise -> either (throwM . RatingInvalid . pack) return $ Just <$> readEither ratingStr
-  return Rating'{ ratingTime = Just fileModified, .. }
-parseRating _ = throwM RatingFileIsDirectory
-
-
 type SubmissionContent = Either File (SubmissionId, Rating')
 
 extractRatings :: ( MonadHandler m

src/Handler/Utils/Rating/Format.hs

@@ -0,0 +1,86 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Handler.Utils.Rating.Format
+  ( parseRating, formatRating
+  ) where
+
+import Import
+
+import Text.PrettyPrint.Leijen.Text hiding ((<$>))
+import Text.Read (readEither)
+
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text
+import qualified Data.Text.Lazy.Encoding as Lazy.Text
+
+import qualified Data.ByteString.Lazy as Lazy (ByteString)
+
+import qualified Data.CaseInsensitive as CI
+
+instance HasResolution prec => Pretty (Fixed prec) where
+  pretty = pretty . show
+
+instance Pretty x => Pretty (CI x) where
+  pretty = pretty . CI.original
+
+
+instance Pretty SheetGrading where
+  pretty Points{..}     = pretty ( "Maximal " <> show maxPoints <> " Punkt(e)" :: String)
+  pretty PassPoints{..} = pretty ( "Maximal " <> show maxPoints <> " Punkt(e), bestanden ab " <> show passingPoints <> " Punkt(en)" :: String )
+  pretty PassBinary     = pretty ( "Bestanden (1) /  Nicht bestanden (0)" :: String )
+  pretty PassAlways     = pretty ( "Automatisch bestanden, sobald korrigiert" :: String )
+
+
+formatRating :: CryptoFileNameSubmission -> Rating -> Lazy.ByteString
+formatRating cID Rating{ ratingValues = Rating'{..}, ..} = let
+  doc = renderPretty 1 45 . foldr (<$$>) mempty $ catMaybes
+    [ pure "= Bitte nur Bewertung und Kommentare ändern ="
+    , pure "============================================="
+    , pure "========== Uni2work Bewertungsdatei ========="
+    , pure "======= diese Datei ist UTF8 encodiert ======"
+    , pure "Informationen zum Übungsblatt:"
+    , pure . indent 2 . foldr (<$$>) mempty . catMaybes $
+      [ Just $ "Veranstaltung:" <+> pretty ratingCourseName
+      , Just $ "Blatt:" <+> pretty ratingSheetName
+      , ("Korrektor:" <+>) . pretty <$> ratingCorrectorName
+      , ("Bewertungsschema:" <+>) . pretty <$> (ratingSheetType ^? _grading)
+      ]
+    , pure $ "Abgabe-Id:" <+> pretty (Text.unpack $ toPathPiece cID)
+    , guardOn (hasn't (_grading . _PassAlways) ratingSheetType)   "============================================="
+    , guardOn (hasn't (_grading . _PassAlways) ratingSheetType) $ "Bewertung:" <+> pretty ratingPoints
+    , pure   "=========== Beginn der Kommentare ==========="
+    , pure $ pretty ratingComment
+    ]
+  in Lazy.Text.encodeUtf8 . (<> "\n") $ displayT doc
+
+parseRating :: MonadThrow m => File -> m Rating'
+parseRating File{ fileContent = Just input, .. } = do
+  inputText <- either (throwM . RatingNotUnicode) return $ Text.decodeUtf8' input
+  let
+    (headerLines', commentLines) = break (commentSep `Text.isInfixOf`) $ Text.lines inputText
+    (reverse -> ratingLines, reverse -> _headerLines) = break (sep' `Text.isInfixOf`) $ reverse headerLines'
+    ratingLines' = filter (rating `Text.isInfixOf`) ratingLines
+    commentSep :: Text
+    commentSep = "Beginn der Kommentare"
+    sep' = Text.pack $ replicate 40 '='
+    rating :: Text
+    rating = "Bewertung:"
+  comment' <- case commentLines of
+    (_:commentLines') -> return . Text.strip $ Text.unlines commentLines'
+    _ -> throwM RatingMissingSeparator
+  let
+    ratingComment
+      | Text.null comment' = Nothing
+      | otherwise = Just comment'
+  ratingLine' <- case ratingLines' of
+    [] -> return Text.empty
+    [l] -> return l
+    _ -> throwM RatingMultiple
+  let
+    (_, ratingLine) = Text.breakOnEnd rating ratingLine'
+    ratingStr = Text.unpack $ Text.strip ratingLine
+  ratingPoints <- case () of
+    _ | null ratingStr -> return Nothing
+      | otherwise -> either (throwM . RatingInvalid . pack) return $ Just <$> readEither ratingStr
+  return Rating'{ ratingTime = Just fileModified, .. }
+parseRating _ = throwM RatingFileIsDirectory