--------------------------------------------------------------------------------

module Codeforces.Types.Submission where

import           Codeforces.Types.Common
import           Codeforces.Types.Party         ( Party )
import           Codeforces.Types.Problem       ( Problem )

import           Data.Aeson
import           Data.Text                      ( Text )
import qualified Data.Text                     as T
import           Data.Time
import           Data.Time.Clock.POSIX          ( posixSecondsToUTCTime )

--------------------------------------------------------------------------------

data Verdict
    = Failed
    | Ok
    | Partial
    | CompilationError
    | RuntimeError
    | WrongAnswer
    | PresentationError
    | TimeLimitExceeded
    | MemoryLimitExceeded
    | IdlenessLimitExceeded
    | SecurityViolated
    | Crashed
    | InputPreparationCrashed
    | Challenged
    | Skipped
    | Testing
    | Rejected
    deriving (Int -> Verdict -> ShowS
[Verdict] -> ShowS
Verdict -> String
(Int -> Verdict -> ShowS)
-> (Verdict -> String) -> ([Verdict] -> ShowS) -> Show Verdict
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Verdict] -> ShowS
$cshowList :: [Verdict] -> ShowS
show :: Verdict -> String
$cshow :: Verdict -> String
showsPrec :: Int -> Verdict -> ShowS
$cshowsPrec :: Int -> Verdict -> ShowS
Show, Verdict -> Verdict -> Bool
(Verdict -> Verdict -> Bool)
-> (Verdict -> Verdict -> Bool) -> Eq Verdict
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verdict -> Verdict -> Bool
$c/= :: Verdict -> Verdict -> Bool
== :: Verdict -> Verdict -> Bool
$c== :: Verdict -> Verdict -> Bool
Eq)

instance FromJSON Verdict where
    parseJSON :: Value -> Parser Verdict
parseJSON = String -> (Text -> Parser Verdict) -> Value -> Parser Verdict
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Verdict" ((Text -> Parser Verdict) -> Value -> Parser Verdict)
-> (Text -> Parser Verdict) -> Value -> Parser Verdict
forall a b. (a -> b) -> a -> b
$ \case
        Text
"FAILED"                    -> Verdict -> Parser Verdict
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verdict
Failed
        Text
"OK"                        -> Verdict -> Parser Verdict
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verdict
Ok
        Text
"PARTIAL"                   -> Verdict -> Parser Verdict
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verdict
Partial
        Text
"COMPILATION_ERROR"         -> Verdict -> Parser Verdict
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verdict
CompilationError
        Text
"RUNTIME_ERROR"             -> Verdict -> Parser Verdict
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verdict
RuntimeError
        Text
"WRONG_ANSWER"              -> Verdict -> Parser Verdict
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verdict
WrongAnswer
        Text
"PRESENTATION_ERROR"        -> Verdict -> Parser Verdict
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verdict
PresentationError
        Text
"TIME_LIMIT_EXCEEDED"       -> Verdict -> Parser Verdict
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verdict
TimeLimitExceeded
        Text
"MEMORY_LIMIT_EXCEEDED"     -> Verdict -> Parser Verdict
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verdict
MemoryLimitExceeded
        Text
"IDLENESS_LIMIT_EXCEEDED"   -> Verdict -> Parser Verdict
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verdict
IdlenessLimitExceeded
        Text
"SECURITY_VIOLATED"         -> Verdict -> Parser Verdict
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verdict
SecurityViolated
        Text
"CRASHED"                   -> Verdict -> Parser Verdict
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verdict
Crashed
        Text
"INPUT_PREPARATION_CRASHED" -> Verdict -> Parser Verdict
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verdict
InputPreparationCrashed
        Text
"CHALLENGED"                -> Verdict -> Parser Verdict
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verdict
Challenged
        Text
"SKIPPED"                   -> Verdict -> Parser Verdict
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verdict
Skipped
        Text
"TESTING"                   -> Verdict -> Parser Verdict
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verdict
Testing
        Text
"REJECTED"                  -> Verdict -> Parser Verdict
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verdict
Rejected
        Text
_                           -> String -> Parser Verdict
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid Verdict"

-- | 'verdictText' @verdict@ returns a user-friendly text representation of the
-- Verdict.
verdictText :: Verdict -> Text
verdictText :: Verdict -> Text
verdictText Verdict
Failed                  = Text
"Failed"
verdictText Verdict
Ok                      = Text
"Ok"
verdictText Verdict
Partial                 = Text
"Partial"
verdictText Verdict
CompilationError        = Text
"Compilation error"
verdictText Verdict
RuntimeError            = Text
"Runtime error"
verdictText Verdict
WrongAnswer             = Text
"Wrong answer"
verdictText Verdict
PresentationError       = Text
"Presentation error"
verdictText Verdict
TimeLimitExceeded       = Text
"Time limit exceeded"
verdictText Verdict
MemoryLimitExceeded     = Text
"Memory limit exceeded"
verdictText Verdict
IdlenessLimitExceeded   = Text
"Idleness limit exceeded"
verdictText Verdict
SecurityViolated        = Text
"Security violated"
verdictText Verdict
Crashed                 = Text
"Crashed"
verdictText Verdict
InputPreparationCrashed = Text
"Input preparation crashed"
verdictText Verdict
Challenged              = Text
"Challenged"
verdictText Verdict
Skipped                 = Text
"Skipped"
verdictText Verdict
Testing                 = Text
"Testing"
verdictText Verdict
Rejected                = Text
"Rejected"

-- | Testset used for judging a submission.
data Testset
    = Samples
    | Pretests
    | Tests
    | Challenges
    deriving Int -> Testset -> ShowS
[Testset] -> ShowS
Testset -> String
(Int -> Testset -> ShowS)
-> (Testset -> String) -> ([Testset] -> ShowS) -> Show Testset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Testset] -> ShowS
$cshowList :: [Testset] -> ShowS
show :: Testset -> String
$cshow :: Testset -> String
showsPrec :: Int -> Testset -> ShowS
$cshowsPrec :: Int -> Testset -> ShowS
Show

instance FromJSON Testset where
    parseJSON :: Value -> Parser Testset
parseJSON = String -> (Text -> Parser Testset) -> Value -> Parser Testset
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Testset" ((Text -> Parser Testset) -> Value -> Parser Testset)
-> (Text -> Parser Testset) -> Value -> Parser Testset
forall a b. (a -> b) -> a -> b
$ \case
        Text
"SAMPLES"    -> Testset -> Parser Testset
forall (f :: * -> *) a. Applicative f => a -> f a
pure Testset
Samples
        Text
"PRETESTS"   -> Testset -> Parser Testset
forall (f :: * -> *) a. Applicative f => a -> f a
pure Testset
Pretests
        Text
"TESTS"      -> Testset -> Parser Testset
forall (f :: * -> *) a. Applicative f => a -> f a
pure Testset
Tests
        Text
"CHALLENGES" -> Testset -> Parser Testset
forall (f :: * -> *) a. Applicative f => a -> f a
pure Testset
Challenges
        Text
x            -> if Text
"TESTS" Text -> Text -> Bool
`T.isPrefixOf` Text
x
            then Testset -> Parser Testset
forall (f :: * -> *) a. Applicative f => a -> f a
pure Testset
Tests
            else String -> Parser Testset
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Testset) -> String -> Parser Testset
forall a b. (a -> b) -> a -> b
$ String
"Invalid Testset: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
x

data Submission = Submission
    { Submission -> Int
submissionId                  :: Int
    , Submission -> Maybe ContestId
submissionContestId           :: Maybe ContestId
      -- | Time when the solution was submitted.
    , Submission -> UTCTime
submissionTime                :: UTCTime
      -- | The time passed after the start of the contest (or a virtual start
      -- for virtual parties), before the submission.
    , Submission -> DiffTime
submissionRelativeTime        :: DiffTime
    , Submission -> Problem
submissionProblem             :: Problem
    , Submission -> Party
submissionAuthor              :: Party
    , Submission -> Text
submissionProgrammingLanguage :: Text
    , Submission -> Maybe Verdict
submissionVerdict             :: Maybe Verdict
    , Submission -> Testset
submissionTestset             :: Testset
    , Submission -> Int
submissionPassedTestCount     :: Int
      -- | Maximum time (in ms) consumed by the submission for one test.
    , Submission -> Int
submissionTimeConsumed        :: Int
      -- | Maximum memory (in bytes) consumed by the submission for one test.
    , Submission -> Int
submissionMemoryConsumed      :: Int
      -- | Number of scored points for IOI-like contests.
    , Submission -> Maybe Points
submissionPoints              :: Maybe Points
    }
    deriving Int -> Submission -> ShowS
[Submission] -> ShowS
Submission -> String
(Int -> Submission -> ShowS)
-> (Submission -> String)
-> ([Submission] -> ShowS)
-> Show Submission
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Submission] -> ShowS
$cshowList :: [Submission] -> ShowS
show :: Submission -> String
$cshow :: Submission -> String
showsPrec :: Int -> Submission -> ShowS
$cshowsPrec :: Int -> Submission -> ShowS
Show

instance FromJSON Submission where
    parseJSON :: Value -> Parser Submission
parseJSON = String
-> (Object -> Parser Submission) -> Value -> Parser Submission
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Submission" ((Object -> Parser Submission) -> Value -> Parser Submission)
-> (Object -> Parser Submission) -> Value -> Parser Submission
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Int
-> Maybe ContestId
-> UTCTime
-> DiffTime
-> Problem
-> Party
-> Text
-> Maybe Verdict
-> Testset
-> Int
-> Int
-> Int
-> Maybe Points
-> Submission
Submission
            (Int
 -> Maybe ContestId
 -> UTCTime
 -> DiffTime
 -> Problem
 -> Party
 -> Text
 -> Maybe Verdict
 -> Testset
 -> Int
 -> Int
 -> Int
 -> Maybe Points
 -> Submission)
-> Parser Int
-> Parser
     (Maybe ContestId
      -> UTCTime
      -> DiffTime
      -> Problem
      -> Party
      -> Text
      -> Maybe Verdict
      -> Testset
      -> Int
      -> Int
      -> Int
      -> Maybe Points
      -> Submission)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id")
            Parser
  (Maybe ContestId
   -> UTCTime
   -> DiffTime
   -> Problem
   -> Party
   -> Text
   -> Maybe Verdict
   -> Testset
   -> Int
   -> Int
   -> Int
   -> Maybe Points
   -> Submission)
-> Parser (Maybe ContestId)
-> Parser
     (UTCTime
      -> DiffTime
      -> Problem
      -> Party
      -> Text
      -> Maybe Verdict
      -> Testset
      -> Int
      -> Int
      -> Int
      -> Maybe Points
      -> Submission)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser (Maybe ContestId)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"contestId")
            Parser
  (UTCTime
   -> DiffTime
   -> Problem
   -> Party
   -> Text
   -> Maybe Verdict
   -> Testset
   -> Int
   -> Int
   -> Int
   -> Maybe Points
   -> Submission)
-> Parser UTCTime
-> Parser
     (DiffTime
      -> Problem
      -> Party
      -> Text
      -> Maybe Verdict
      -> Testset
      -> Int
      -> Int
      -> Int
      -> Maybe Points
      -> Submission)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> Parser POSIXTime -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser POSIXTime
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"creationTimeSeconds")
            Parser
  (DiffTime
   -> Problem
   -> Party
   -> Text
   -> Maybe Verdict
   -> Testset
   -> Int
   -> Int
   -> Int
   -> Maybe Points
   -> Submission)
-> Parser DiffTime
-> Parser
     (Problem
      -> Party
      -> Text
      -> Maybe Verdict
      -> Testset
      -> Int
      -> Int
      -> Int
      -> Maybe Points
      -> Submission)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer -> DiffTime
secondsToDiffTime (Integer -> DiffTime) -> Parser Integer -> Parser DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"relativeTimeSeconds")
            Parser
  (Problem
   -> Party
   -> Text
   -> Maybe Verdict
   -> Testset
   -> Int
   -> Int
   -> Int
   -> Maybe Points
   -> Submission)
-> Parser Problem
-> Parser
     (Party
      -> Text
      -> Maybe Verdict
      -> Testset
      -> Int
      -> Int
      -> Int
      -> Maybe Points
      -> Submission)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Problem
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"problem")
            Parser
  (Party
   -> Text
   -> Maybe Verdict
   -> Testset
   -> Int
   -> Int
   -> Int
   -> Maybe Points
   -> Submission)
-> Parser Party
-> Parser
     (Text
      -> Maybe Verdict
      -> Testset
      -> Int
      -> Int
      -> Int
      -> Maybe Points
      -> Submission)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Party
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"author")
            Parser
  (Text
   -> Maybe Verdict
   -> Testset
   -> Int
   -> Int
   -> Int
   -> Maybe Points
   -> Submission)
-> Parser Text
-> Parser
     (Maybe Verdict
      -> Testset -> Int -> Int -> Int -> Maybe Points -> Submission)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"programmingLanguage")
            Parser
  (Maybe Verdict
   -> Testset -> Int -> Int -> Int -> Maybe Points -> Submission)
-> Parser (Maybe Verdict)
-> Parser
     (Testset -> Int -> Int -> Int -> Maybe Points -> Submission)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser (Maybe Verdict)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"verdict")
            Parser (Testset -> Int -> Int -> Int -> Maybe Points -> Submission)
-> Parser Testset
-> Parser (Int -> Int -> Int -> Maybe Points -> Submission)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Testset
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"testset")
            Parser (Int -> Int -> Int -> Maybe Points -> Submission)
-> Parser Int -> Parser (Int -> Int -> Maybe Points -> Submission)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"passedTestCount")
            Parser (Int -> Int -> Maybe Points -> Submission)
-> Parser Int -> Parser (Int -> Maybe Points -> Submission)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"timeConsumedMillis")
            Parser (Int -> Maybe Points -> Submission)
-> Parser Int -> Parser (Maybe Points -> Submission)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"memoryConsumedBytes")
            Parser (Maybe Points -> Submission)
-> Parser (Maybe Points) -> Parser Submission
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser (Maybe Points)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"points")

--------------------------------------------------------------------------------