Formatting & parsing of rating files

models

@@ -52,7 +52,7 @@ CourseParticipant
 Sheet
     courseId        CourseId
     name            Text
-    sheetType       SheetType
+    type            SheetType
     markingText     Text Maybe
     activeFrom      UTCTime
     activeTo        UTCTime

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.

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)