From 69c61a4bb425074a04eb09c6df65474b73ec409c Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 16 Jun 2020 11:44:42 +0200 Subject: [PATCH] refactor(rating): move formatting/parsing of rating files --- src/Handler/Utils/Rating.hs | 84 +---------------------------- src/Handler/Utils/Rating/Format.hs | 86 ++++++++++++++++++++++++++++++ 2 files changed, 88 insertions(+), 82 deletions(-) create mode 100644 src/Handler/Utils/Rating/Format.hs diff --git a/src/Handler/Utils/Rating.hs b/src/Handler/Utils/Rating.hs index 26652c707..1a605e49f 100644 --- a/src/Handler/Utils/Rating.hs +++ b/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 - -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 ) +import Handler.Utils.Rating.Format 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 diff --git a/src/Handler/Utils/Rating/Format.hs b/src/Handler/Utils/Rating/Format.hs new file mode 100644 index 000000000..8235cbc2f --- /dev/null +++ b/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