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

-- | Utility functions for formatting data.
module Codeforces.App.Format where

import           Codeforces.Types        hiding ( RankColor(..) )
import qualified Codeforces.Types.Rank         as R

import           Codeforces.App.Table

import           Data.Fixed
import           Data.Text                      ( Text )
import qualified Data.Text                     as T
import           Data.Time

import           System.Console.ANSI

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

-- | 'showText' @x@ is a 'Data.Text' version of 'show'
showText :: Show a => a -> Text
showText :: a -> Text
showText = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | 'colored' @color text@ wraps some text around SGR codes to display it in
-- the given color.
colored :: Color -> Text -> Text
colored :: Color -> Text -> Text
colored Color
c Text
s = [Text] -> Text
T.concat
    [ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [SGR] -> String
setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
c]
    , Text
s
    , String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [SGR] -> String
setSGRCode [SGR
Reset]
    ]

rankColored :: R.RankColor -> Text -> Text
rankColored :: RankColor -> Text -> Text
rankColored = Color -> Text -> Text
colored (Color -> Text -> Text)
-> (RankColor -> Color) -> RankColor -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankColor -> Color
convertRankColor

convertRankColor :: R.RankColor -> Color
convertRankColor :: RankColor -> Color
convertRankColor RankColor
R.Gray   = Color
White
convertRankColor RankColor
R.Green  = Color
Green
convertRankColor RankColor
R.Cyan   = Color
Cyan
convertRankColor RankColor
R.Blue   = Color
Blue
convertRankColor RankColor
R.Violet = Color
Magenta
convertRankColor RankColor
R.Orange = Color
Yellow
convertRankColor RankColor
R.Red    = Color
Red

-- | Like 'differenceCell' but returns a 'Text' rather than a 'Cell'.
diffColored :: Int -> Text
diffColored :: Int -> Text
diffColored Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0     = Color -> Text -> Text
colored Color
Green (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showText Int
x
              | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showText Int
x
              | Bool
otherwise = Color -> Text -> Text
colored Color
Red (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
showText Int
x

indent :: Text
indent :: Text
indent = Int -> Text -> Text
T.replicate Int
6 Text
" "

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

fmtTimeConsumed :: Int -> Text
fmtTimeConsumed :: Int -> Text
fmtTimeConsumed Int
x = Int -> Text
forall a. Show a => a -> Text
showText Int
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ms"

fmtMemoryConsumed :: Int -> Text
fmtMemoryConsumed :: Int -> Text
fmtMemoryConsumed Int
x = Int -> Text
forall a. Show a => a -> Text
showText (Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
1000) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" KB"

-- | Returns an approximate and human-friendly time difference.
--
-- Possible options are:
--  * "just now"
--  * "5 seconds ago"
--  * "X seconds ago" where X is a multiple of 10
--  * "X minutes ago"
--
fmtDiffTime :: NominalDiffTime -> Text
fmtDiffTime :: NominalDiffTime -> Text
fmtDiffTime NominalDiffTime
diff = Pico -> Text
forall a. Real a => a -> Text
go (NominalDiffTime -> Pico
nominalDiffTimeToSeconds NominalDiffTime
diff)
  where
    go :: a -> Text
go a
x | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
5     = Text
"just now"
         | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10    = Text
"5 seconds ago"
         | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
60    = Int -> Text
forall a. Show a => a -> Text
showText (a
x a -> a -> Int
forall a b. (Real a, Integral b) => a -> a -> b
`div'` a
10 :: Int) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"0 seconds ago"
         | Bool
otherwise = Int -> Text
forall a. Show a => a -> Text
showText (a
x a -> a -> Int
forall a b. (Real a, Integral b) => a -> a -> b
`div'` a
60 :: Int) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" minutes ago"

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

plainCell :: Text -> Cell
plainCell :: Text -> Cell
plainCell = [SGR] -> Text -> Cell
Cell [SGR
Reset]

coloredCell :: Color -> Text -> Cell
coloredCell :: Color -> Text -> Cell
coloredCell Color
c = [SGR] -> Text -> Cell
Cell [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
c]

blankCell :: Cell
blankCell :: Cell
blankCell = Text -> Cell
plainCell Text
""

ratingCell :: Rating -> Cell
ratingCell :: Int -> Cell
ratingCell Int
x =
    let color :: Color
color = RankColor -> Color
convertRankColor (RankColor -> Color) -> RankColor -> Color
forall a b. (a -> b) -> a -> b
$ Rank -> RankColor
rankColor (Rank -> RankColor) -> Rank -> RankColor
forall a b. (a -> b) -> a -> b
$ Int -> Rank
getRank Int
x
    in  Color -> Text -> Cell
coloredCell Color
color (Int -> Text
forall a. Show a => a -> Text
showText Int
x)

-- | 'differenceCell' @diff@ colors a number red, white or green, depending on
-- whether it's negative, 0, or positive.
differenceCell :: Int -> Cell
differenceCell :: Int -> Cell
differenceCell Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0     = Color -> Text -> Cell
coloredCell Color
Green (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Text
"+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showText Int
x
                 | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = Text -> Cell
plainCell (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showText Int
x
                 | Bool
otherwise = Color -> Text -> Cell
coloredCell Color
Red (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
showText Int
x

-- | 'verdictCell' @testset passedTestCount points verdict@ returns a cell
-- displaying the status of a submission, such as "Accepted" or "Wrong answer on
-- pretest 2".
verdictCell :: Testset -> Int -> Maybe Points -> Maybe Verdict -> Cell
verdictCell :: Testset -> Int -> Maybe Points -> Maybe Verdict -> Cell
verdictCell Testset
_       Int
_      Maybe Points
_      Maybe Verdict
Nothing  = Text -> Cell
plainCell Text
"In queue"
verdictCell Testset
testset Int
passed Maybe Points
points (Just Verdict
v) = case Verdict
v of
    Verdict
Ok -> case Testset
testset of
        Testset
Tests      -> Color -> Text -> Cell
coloredCell Color
Green Text
"Accepted"
        Testset
Samples    -> Color -> Text -> Cell
coloredCell Color
Green Text
"Samples passed"
        Testset
Pretests   -> Color -> Text -> Cell
coloredCell Color
Green Text
"Pretests passed"
        Testset
Challenges -> Color -> Text -> Cell
coloredCell Color
Green Text
"Challenges passed"
    Verdict
Partial -> Color -> Text -> Cell
coloredCell Color
Yellow (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Text -> (Points -> Text) -> Maybe Points -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        Text
"Partial result"
        (\Points
pts -> [Text] -> Text
T.concat [Text
"Partial result: ", Points -> Text
forall a. Show a => a -> Text
showText Points
pts, Text
" points"])
        Maybe Points
points
    Verdict
Challenged              -> Color -> Text -> Cell
coloredCell Color
Red Text
"Hacked"
    Verdict
CompilationError        -> Text -> Cell
plainCell (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Verdict -> Text
verdictText Verdict
v
    Verdict
Skipped                 -> Text -> Cell
plainCell (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Verdict -> Text
verdictText Verdict
v
    Verdict
SecurityViolated        -> Text -> Cell
plainCell (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Verdict -> Text
verdictText Verdict
v
    Verdict
Crashed                 -> Text -> Cell
plainCell (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Verdict -> Text
verdictText Verdict
v
    Verdict
InputPreparationCrashed -> Text -> Cell
plainCell (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Verdict -> Text
verdictText Verdict
v
    Verdict
Rejected                -> Text -> Cell
plainCell (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Verdict -> Text
verdictText Verdict
v
    Verdict
_ ->
        let currTest :: Int
currTest = Int
passed Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            clr :: Color
clr      = if Verdict
v Verdict -> Verdict -> Bool
forall a. Eq a => a -> a -> Bool
== Verdict
Testing then Color
White else Color
Blue
            text :: Text
text     = [Text] -> Text
T.concat
                [ Verdict -> Text
verdictText Verdict
v
                , Text
" on "
                , Text -> Text
T.toLower (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.init (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Testset -> Text
forall a. Show a => a -> Text
showText Testset
testset
                , Text
" "
                , Int -> Text
forall a. Show a => a -> Text
showText Int
currTest
                ]
        in  Color -> Text -> Cell
coloredCell Color
clr Text
text

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