refactor(rating): move formatting/parsing of rating files
This commit is contained in:
Gregor Kleen
parent
b1055c2ca8
commit
69c61a4bb4
@ -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
|
||||
|
||||
86
src/Handler/Utils/Rating/Format.hs
Normal file
86
src/Handler/Utils/Rating/Format.hs
Normal file
@ -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
|
||||
Loading…
Reference in New Issue
Block a user