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

module Handler.Utils.Rating.Format.Legacy
  ( parseRating, formatRating
  ) where

import Import

import Text.PrettyPrint.Leijen.Text hiding ((<$>))

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

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

import qualified Data.CaseInsensitive as CI

import qualified Data.Conduit.Combinators as C


import Text.Read (readEither)

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 :: MonadCatch m => File m -> m Rating'
parseRating File{ fileContent = Just input, .. } = handle (throwM . RatingParseLegacyException) $ do
  inputText <- either (throwM . RatingNotUnicode) return . Text.decodeUtf8' =<< runConduit (input .| C.fold)
  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'{ ratingDone = False, ratingTime = Just fileModified, .. }
parseRating _ = throwM RatingFileIsDirectory
