{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

module Handler.Utils.Zip.Rating
  ( Rating(..)
  , getRating
  , formatRating
  , RatingException(..)
  , UnicodeException(..)
  , parseRating
  , extractRatings
  ) 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 Data.Text.Encoding.Error (UnicodeException(..))

import qualified Data.Text.Lazy.Encoding as Lazy.Text

import qualified Data.ByteString.Lazy as Lazy (ByteString)
import qualified Data.ByteString.Lazy as Lazy.ByteString

import Text.Read (readEither)

import GHC.Generics (Generic)
import Data.Typeable (Typeable)

import Data.Binary (encode, decode)
import qualified Data.CryptoID.Poly as Poly


instance HasResolution prec => Pretty (Fixed prec) where
  pretty = pretty . show


data Rating = Rating
  { ratingCourseName :: Text
  , ratingSheetName :: Text
  , ratingSubmissionId :: CryptoIDSubmission ByteString -- ^ 'SubmissionId'
  , ratingComment :: Maybe Text
  , 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 submissionId = runMaybeT $ do
  Submission{ submissionSheetId, submissionRatingComment = ratingComment, submissionRatingPoints = ratingPoints } <- MaybeT $ get submissionId
  Sheet{ sheetCourseId, sheetName = ratingSheetName } <- MaybeT $ get submissionSheetId
  Course{ courseName = ratingCourseName } <- MaybeT $ get sheetCourseId
  cIDKey <- getsYesod appCryptoIDKey
  ratingSubmissionId <- Poly.encrypt cIDKey . Lazy.ByteString.toStrict $ encode submissionId
  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 :: MonadThrow m => ByteString -> m Rating'
parseRating input = do
  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') -> return . Text.strip $ Text.unlines commentLines'
    _ -> throw RatingMissingSeparator
  let
    comment
      | Text.null comment' = Nothing
      | otherwise = Just comment'
  ratingLine' <- case ratingLines of
    [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 -> 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