extractRatings

src/Handler/Utils/Zip/Rating.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -13,7 +14,10 @@ module Handler.Utils.Zip.Rating
   ( Rating(..)
   , getRating
   , formatRating
+  , RatingException(..)
+  , UnicodeException(..)
   , parseRating
+  , extractRatings
   ) where
 
 import Import hiding ((</>))
@@ -25,6 +29,7 @@ import Control.Monad.Trans.Maybe
 import Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
+import Data.Text.Encoding.Error (UnicodeException(..))
 
 import qualified Data.Text.Lazy.Encoding as Lazy.Text
 
@@ -48,6 +53,18 @@ data Rating = Rating
   , ratingPoints :: Maybe Points
   } deriving (Read, Show, Eq, Generic, Typeable)
 
+type Rating' = ( Maybe Points
+               , Maybe Text -- ^ Rating comment
+               )
+
+data RatingException = RatingNotUnicode UnicodeException -- ^ Rating failed to parse as unicode
+                     | RatingMissingSeparator -- ^ Could not split rating header from comments
+                     | RatingMultiple -- ^ Encountered multiple point values in rating
+                     | RatingInvalid String -- ^ Failed to parse rating point value
+  deriving (Show, Eq, Generic, Typeable)
+
+instance Exception RatingException
+
 
 getRating :: SubmissionId -> YesodDB UniWorX (Maybe Rating)
 getRating ratingSubmissionId = runMaybeT $ do
@@ -76,32 +93,39 @@ formatRating Rating{..} = let
     ]
   in Lazy.Text.encodeUtf8 $ displayT doc
 
-  
-parseRating :: ByteString
-            -> Either Text ( Maybe Points
-                           , Maybe Text -- ^ Rating comment
-                           )
+parseRating :: MonadThrow m => ByteString -> m Rating'
 parseRating input = do
-  inputText <- first tshow $ Text.decodeUtf8' input
+  inputText <- either (throw . RatingNotUnicode) return $ 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 <> "”"
+    (_:commentLines') -> return . Text.strip $ Text.unlines commentLines'
+    _ -> throw RatingMissingSeparator
   let
     comment
       | Text.null comment' = Nothing
       | otherwise = Just comment'
   ratingLine' <- case ratingLines of
-    [l] -> Right l
-    _ -> Left $ "Multiple occurances of “" <> rating <> "”"
+    [l] -> return l
+    _ -> throw RatingMultiple
   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
+      | otherwise -> either (throw . RatingInvalid) return $ Just <$> readEither ratingStr
   return (rating, comment)
+
+
+extractRatings :: MonadThrow m => (FilePath -> Maybe SubmissionId) -> Conduit File m (Either File (SubmissionId, Rating'))
+extractRatings isRating = void . runMaybeT $ do
+  f@(File{..}) <- MaybeT await
+  
+  lift $ case () of
+    _ | Just sId <- isRating fileTitle
+      , Just content' <- fileContent
+        -> yieldM $ Right . (sId, ) <$> parseRating content'
+      | otherwise -> yield $ Left f

test/Handler/Utils/Zip/RatingSpec.hs

@@ -22,7 +22,7 @@ instance Arbitrary Rating where
     ratingCourseName <- arbitrary
     ratingSheetName <- arbitrary
     ratingSubmissionId <- SubmissionKey . SqlBackendKey <$> arbitrary
-    ratingComment <- fmap Text.strip <$> arbitrary `suchThat` maybe True (not . Text.null)
+    ratingComment <- (fmap Text.strip <$> arbitrary) `suchThat` maybe True (not . Text.null)
     ratingPoints <- arbitrary
     return Rating{..}
 
@@ -30,4 +30,4 @@ instance Arbitrary Rating where
 spec :: Spec
 spec = describe "Rating files" $ do
   it "have compatible formatting/parsing" . property $ 
-    \rating@(Rating{..}) -> parseRating (Lazy.ByteString.toStrict $ formatRating rating) `shouldBe` Right (ratingPoints, ratingComment)
+    \rating@(Rating{..}) -> parseRating (Lazy.ByteString.toStrict $ formatRating rating) >>= (`shouldBe` (ratingPoints, ratingComment))