diff --git a/models b/models index d8ca30dcf..3f756ae62 100644 --- a/models +++ b/models @@ -52,7 +52,7 @@ CourseParticipant Sheet courseId CourseId name Text - sheetType SheetType + type SheetType markingText Text Maybe activeFrom UTCTime activeTo UTCTime diff --git a/package.yaml b/package.yaml index 3ad63a9f2..9ef1ecd1b 100644 --- a/package.yaml +++ b/package.yaml @@ -56,6 +56,8 @@ dependencies: - blaze-markup - zip-stream - filepath +- transformers +- wl-pprint-text # The library contains all of our application code. The executable # defined below is just a thin wrapper. diff --git a/src/Handler/Utils/Zip/Rating.hs b/src/Handler/Utils/Zip/Rating.hs new file mode 100644 index 000000000..79ef3775e --- /dev/null +++ b/src/Handler/Utils/Zip/Rating.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} + +module Handler.Utils.Zip.Rating + ( getRating + , formatRating + , parseRating + ) where + +import Import hiding (()) + +import Text.PrettyPrint.Leijen.Text hiding ((<$>)) + +import Control.Monad.Trans.Maybe + +import Data.Text (Text) +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 Text.Read (readEither) + + +instance HasResolution prec => Pretty (Fixed prec) where + pretty = pretty . show + + +data Rating = Rating + { ratingCourseName :: Text + , ratingSheetName :: Text + , ratingSubmissionId :: SubmissionId + , ratingComment :: Maybe Text + , ratingPoints :: Maybe Points + } + + + +getRating :: SubmissionId -> YesodDB UniWorX (Maybe Rating) +getRating ratingSubmissionId = runMaybeT $ do + Submission{ submissionSheetId, submissionRatingComment = ratingComment, submissionRatingPoints = ratingPoints } <- MaybeT $ get ratingSubmissionId + Sheet{ sheetCourseId, sheetName = ratingSheetName } <- MaybeT $ get submissionSheetId + Course{ courseName = ratingCourseName } <- MaybeT $ get sheetCourseId + return Rating{..} + +formatRating :: Rating -> Lazy.ByteString +formatRating Rating{..} = let + doc = renderPretty 1 45 $ foldr (<$$>) mempty + [ "= Bitte nur Bewertung und Kommentare ändern =" + , "=============================================" + , "========== UniWorx Bewertungsdatei ==========" + , "======= diese Datei ist UTF8 encodiert ======" + , "Informationen zum Übungsblatt:" + , indent 2 $ foldr (<$$>) mempty + [ "Veranstaltung:" <+> pretty ratingCourseName + , "Blatt:" <+> pretty ratingSheetName + ] + , "Abgabe-Id:" <+> pretty (show ratingSubmissionId) -- FIXME + , "=============================================" + , "Bewertung:" <+> pretty ratingPoints + , "=========== Beginn der Kommentare ===========" + , pretty ratingComment + ] + in Lazy.Text.encodeUtf8 $ displayT doc + + +parseRating :: ByteString + -> Either Text ( Maybe Points + , Maybe Text -- ^ Rating comment + ) +parseRating input = do + inputText <- first tshow $ Text.decodeUtf8' input + let + (headerLines, commentLines) = break (sep `Text.isInfixOf`) $ Text.lines inputText + ratingLines = filter (rating `Text.isInfixOf`) headerLines + sep = "Beginn der Kommentare" + rating = "Bewertung:" + comment' <- case commentLines of + (_:commentLines') -> Right . Text.strip $ Text.unlines commentLines' + _ -> Left $ "Missing separator “" <> sep <> "”" + let + comment + | Text.null comment' = Nothing + | otherwise = Just comment' + ratingLine' <- case ratingLines of + [l] -> Right l + _ -> Left $ "Multiple occurances of “" <> rating <> "”" + let + (_, ratingLine) = Text.breakOnEnd rating ratingLine' + ratingStr = Text.unpack $ Text.strip ratingLine + rating <- case () of + _ | null ratingStr -> return Nothing + | otherwise -> first tshow $ Just <$> readEither ratingStr + return (rating, comment)