{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
-- | High score table operations.
module Game.LambdaHack.Common.HighScore
  ( ScoreTable, ScoreDict
  , empty, register, showScore, showAward
  , getTable, unTable, getRecord, getStatus, getDate
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , ScoreRecord, insertPos
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Binary
import qualified Data.EnumMap.Strict as EM
import qualified Data.Text as T
import           Data.Time.Clock.POSIX
import           Data.Time.LocalTime
import           GHC.Generics (Generic)
import qualified NLP.Miniutter.English as MU

import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Content.ItemKind (ItemKind)
import Game.LambdaHack.Content.ModeKind
import Game.LambdaHack.Definition.Defs

-- | A single score record. Records are ordered in the highscore table,
-- from the best to the worst, in lexicographic ordering wrt the fields below.
data ScoreRecord = ScoreRecord
  { ScoreRecord -> Int
points       :: Int        -- ^ the score
  , ScoreRecord -> Time
negTime      :: Time       -- ^ game time spent (negated, so less better)
  , ScoreRecord -> POSIXTime
date         :: POSIXTime  -- ^ date of the last game interruption
  , ScoreRecord -> Status
status       :: Status     -- ^ reason of the game interruption
  , ScoreRecord -> Challenge
challenge    :: Challenge  -- ^ challenge setup of the game
  , ScoreRecord -> Text
gplayerName  :: Text       -- ^ name of the faction's gplayer
  , ScoreRecord -> EnumMap (ContentId ItemKind) Int
ourVictims   :: EM.EnumMap (ContentId ItemKind) Int  -- ^ allies lost
  , ScoreRecord -> EnumMap (ContentId ItemKind) Int
theirVictims :: EM.EnumMap (ContentId ItemKind) Int  -- ^ foes killed
  }
  deriving (ScoreRecord -> ScoreRecord -> Bool
(ScoreRecord -> ScoreRecord -> Bool)
-> (ScoreRecord -> ScoreRecord -> Bool) -> Eq ScoreRecord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScoreRecord -> ScoreRecord -> Bool
$c/= :: ScoreRecord -> ScoreRecord -> Bool
== :: ScoreRecord -> ScoreRecord -> Bool
$c== :: ScoreRecord -> ScoreRecord -> Bool
Eq, Eq ScoreRecord
Eq ScoreRecord
-> (ScoreRecord -> ScoreRecord -> Ordering)
-> (ScoreRecord -> ScoreRecord -> Bool)
-> (ScoreRecord -> ScoreRecord -> Bool)
-> (ScoreRecord -> ScoreRecord -> Bool)
-> (ScoreRecord -> ScoreRecord -> Bool)
-> (ScoreRecord -> ScoreRecord -> ScoreRecord)
-> (ScoreRecord -> ScoreRecord -> ScoreRecord)
-> Ord ScoreRecord
ScoreRecord -> ScoreRecord -> Bool
ScoreRecord -> ScoreRecord -> Ordering
ScoreRecord -> ScoreRecord -> ScoreRecord
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ScoreRecord -> ScoreRecord -> ScoreRecord
$cmin :: ScoreRecord -> ScoreRecord -> ScoreRecord
max :: ScoreRecord -> ScoreRecord -> ScoreRecord
$cmax :: ScoreRecord -> ScoreRecord -> ScoreRecord
>= :: ScoreRecord -> ScoreRecord -> Bool
$c>= :: ScoreRecord -> ScoreRecord -> Bool
> :: ScoreRecord -> ScoreRecord -> Bool
$c> :: ScoreRecord -> ScoreRecord -> Bool
<= :: ScoreRecord -> ScoreRecord -> Bool
$c<= :: ScoreRecord -> ScoreRecord -> Bool
< :: ScoreRecord -> ScoreRecord -> Bool
$c< :: ScoreRecord -> ScoreRecord -> Bool
compare :: ScoreRecord -> ScoreRecord -> Ordering
$ccompare :: ScoreRecord -> ScoreRecord -> Ordering
$cp1Ord :: Eq ScoreRecord
Ord, (forall x. ScoreRecord -> Rep ScoreRecord x)
-> (forall x. Rep ScoreRecord x -> ScoreRecord)
-> Generic ScoreRecord
forall x. Rep ScoreRecord x -> ScoreRecord
forall x. ScoreRecord -> Rep ScoreRecord x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScoreRecord x -> ScoreRecord
$cfrom :: forall x. ScoreRecord -> Rep ScoreRecord x
Generic)

instance Binary ScoreRecord

-- | The list of scores, in decreasing order.
newtype ScoreTable = ScoreTable {ScoreTable -> [ScoreRecord]
unTable :: [ScoreRecord]}
  deriving (ScoreTable -> ScoreTable -> Bool
(ScoreTable -> ScoreTable -> Bool)
-> (ScoreTable -> ScoreTable -> Bool) -> Eq ScoreTable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScoreTable -> ScoreTable -> Bool
$c/= :: ScoreTable -> ScoreTable -> Bool
== :: ScoreTable -> ScoreTable -> Bool
$c== :: ScoreTable -> ScoreTable -> Bool
Eq, Get ScoreTable
[ScoreTable] -> Put
ScoreTable -> Put
(ScoreTable -> Put)
-> Get ScoreTable -> ([ScoreTable] -> Put) -> Binary ScoreTable
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ScoreTable] -> Put
$cputList :: [ScoreTable] -> Put
get :: Get ScoreTable
$cget :: Get ScoreTable
put :: ScoreTable -> Put
$cput :: ScoreTable -> Put
Binary)

instance Show ScoreTable where
  show :: ScoreTable -> String
show ScoreTable
_ = String
"a score table"

-- | A dictionary from game mode IDs to scores tables.
type ScoreDict = EM.EnumMap (ContentId ModeKind) ScoreTable

-- | Empty score table
empty :: ScoreDict
empty :: ScoreDict
empty = ScoreDict
forall k a. EnumMap k a
EM.empty

-- | Insert a new score into the table, Return new table and the ranking.
-- Make sure the table doesn't grow too large.
insertPos :: ScoreRecord -> ScoreTable -> (ScoreTable, Int)
insertPos :: ScoreRecord -> ScoreTable -> (ScoreTable, Int)
insertPos ScoreRecord
s (ScoreTable [ScoreRecord]
table) =
  let ([ScoreRecord]
prefix, [ScoreRecord]
suffix) = (ScoreRecord -> Bool)
-> [ScoreRecord] -> ([ScoreRecord], [ScoreRecord])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (ScoreRecord -> ScoreRecord -> Bool
forall a. Ord a => a -> a -> Bool
> ScoreRecord
s) [ScoreRecord]
table
      pos :: Int
pos = [ScoreRecord] -> Int
forall a. [a] -> Int
length [ScoreRecord]
prefix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  in ([ScoreRecord] -> ScoreTable
ScoreTable ([ScoreRecord] -> ScoreTable) -> [ScoreRecord] -> ScoreTable
forall a b. (a -> b) -> a -> b
$ [ScoreRecord]
prefix [ScoreRecord] -> [ScoreRecord] -> [ScoreRecord]
forall a. [a] -> [a] -> [a]
++ [ScoreRecord
s] [ScoreRecord] -> [ScoreRecord] -> [ScoreRecord]
forall a. [a] -> [a] -> [a]
++ Int -> [ScoreRecord] -> [ScoreRecord]
forall a. Int -> [a] -> [a]
take (Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos) [ScoreRecord]
suffix, Int
pos)

-- | Register a new score in a score table.
register :: ScoreTable  -- ^ old table
         -> Int         -- ^ the total value of faction items
         -> Int         -- ^ the total value of dungeon items
         -> Time        -- ^ game time spent
         -> Status      -- ^ reason of the game interruption
         -> POSIXTime   -- ^ current date
         -> Challenge   -- ^ challenge setup
         -> Text        -- ^ name of the faction's gplayer
         -> EM.EnumMap (ContentId ItemKind) Int  -- ^ allies lost
         -> EM.EnumMap (ContentId ItemKind) Int  -- ^ foes killed
         -> HiCondPoly
         -> (Bool, (ScoreTable, Int))
register :: ScoreTable
-> Int
-> Int
-> Time
-> Status
-> POSIXTime
-> Challenge
-> Text
-> EnumMap (ContentId ItemKind) Int
-> EnumMap (ContentId ItemKind) Int
-> HiCondPoly
-> (Bool, (ScoreTable, Int))
register ScoreTable
table Int
total Int
dungeonTotal Time
time status :: Status
status@Status{Outcome
stOutcome :: Status -> Outcome
stOutcome :: Outcome
stOutcome}
         POSIXTime
date Challenge
challenge Text
gplayerName EnumMap (ContentId ItemKind) Int
ourVictims EnumMap (ContentId ItemKind) Int
theirVictims HiCondPoly
hiCondPoly =
  let turnsSpent :: Double
turnsSpent = Int -> Double
intToDouble (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Time -> Time -> Int
timeFitUp Time
time Time
timeTurn
      hiInValue :: (HiIndeterminant, Double) -> Double
hiInValue (HiIndeterminant
hi, Double
c) = Bool -> Double -> Double
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
total Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dungeonTotal) (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ case HiIndeterminant
hi of
        HiIndeterminant
HiConst -> Double
c
        HiIndeterminant
HiLoot | Int
dungeonTotal Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Double
c  -- a fluke; no gold generated
        HiIndeterminant
HiLoot -> Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
intToDouble Int
total Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
intToDouble Int
dungeonTotal
        HiIndeterminant
HiSprint -> -- Up to -c turns matter.
                    Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (-Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
turnsSpent)
        HiIndeterminant
HiBlitz -> -- Up to 1000000/-c turns matter.
                   Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double
1000000 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
turnsSpent)
        HiIndeterminant
HiSurvival -> -- Up to 1000000/c turns matter.
                      Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
1000000 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
turnsSpent)
        HiIndeterminant
HiKill -> Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
intToDouble ([Int] -> Int
forall a. Num a => [a] -> a
sum (EnumMap (ContentId ItemKind) Int -> [Int]
forall k a. EnumMap k a -> [a]
EM.elems EnumMap (ContentId ItemKind) Int
theirVictims))
        HiIndeterminant
HiLoss -> Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
intToDouble ([Int] -> Int
forall a. Num a => [a] -> a
sum (EnumMap (ContentId ItemKind) Int -> [Int]
forall k a. EnumMap k a -> [a]
EM.elems EnumMap (ContentId ItemKind) Int
ourVictims))
      hiPolynomialValue :: [(HiIndeterminant, Double)] -> Double
hiPolynomialValue = [Double] -> Double
forall a. Num a => [a] -> a
sum ([Double] -> Double)
-> ([(HiIndeterminant, Double)] -> [Double])
-> [(HiIndeterminant, Double)]
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HiIndeterminant, Double) -> Double)
-> [(HiIndeterminant, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (HiIndeterminant, Double) -> Double
hiInValue
      hiSummandValue :: ([(HiIndeterminant, Double)], [Outcome]) -> Double
hiSummandValue ([(HiIndeterminant, Double)]
hiPoly, [Outcome]
outcomes) =
        if Outcome
stOutcome Outcome -> [Outcome] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Outcome]
outcomes
        then Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 ([(HiIndeterminant, Double)] -> Double
hiPolynomialValue [(HiIndeterminant, Double)]
hiPoly)
        else Double
0
      hiCondValue :: HiCondPoly -> Double
hiCondValue = [Double] -> Double
forall a. Num a => [a] -> a
sum ([Double] -> Double)
-> (HiCondPoly -> [Double]) -> HiCondPoly -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([(HiIndeterminant, Double)], [Outcome]) -> Double)
-> HiCondPoly -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ([(HiIndeterminant, Double)], [Outcome]) -> Double
hiSummandValue
      -- Other challenges than HP difficulty are not reflected in score.
      points :: Int
points = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling
               (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ HiCondPoly -> Double
hiCondValue HiCondPoly
hiCondPoly
                 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1.5 Double -> Int -> Double
forall a b. (Fractional a, Integral b) => a -> b -> a
^^ (- (Int -> Int
difficultyCoeff (Challenge -> Int
cdiff Challenge
challenge)))
      negTime :: Time
negTime = Time -> Time
absoluteTimeNegate Time
time
      score :: ScoreRecord
score = ScoreRecord :: Int
-> Time
-> POSIXTime
-> Status
-> Challenge
-> Text
-> EnumMap (ContentId ItemKind) Int
-> EnumMap (ContentId ItemKind) Int
-> ScoreRecord
ScoreRecord{Int
EnumMap (ContentId ItemKind) Int
Text
POSIXTime
Time
Challenge
Status
negTime :: Time
points :: Int
theirVictims :: EnumMap (ContentId ItemKind) Int
ourVictims :: EnumMap (ContentId ItemKind) Int
gplayerName :: Text
challenge :: Challenge
date :: POSIXTime
status :: Status
theirVictims :: EnumMap (ContentId ItemKind) Int
ourVictims :: EnumMap (ContentId ItemKind) Int
gplayerName :: Text
challenge :: Challenge
status :: Status
date :: POSIXTime
negTime :: Time
points :: Int
..}
  in (Int
points Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0, ScoreRecord -> ScoreTable -> (ScoreTable, Int)
insertPos ScoreRecord
score ScoreTable
table)

-- | Show a single high score, from the given ranking in the high score table.
showScore :: TimeZone -> Int -> ScoreRecord -> [Text]
showScore :: TimeZone -> Int -> ScoreRecord -> [Text]
showScore TimeZone
tz Int
pos ScoreRecord
score =
  let Status{Outcome
stOutcome :: Outcome
stOutcome :: Status -> Outcome
stOutcome, Int
stDepth :: Status -> Int
stDepth :: Int
stDepth} = ScoreRecord -> Status
status ScoreRecord
score
      died :: Text
died = Outcome -> Text
nameOutcomePast Outcome
stOutcome Text -> Text -> Text
<+> case Outcome
stOutcome of
        Outcome
Killed -> Text
"on level" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Int
forall a. Num a => a -> a
abs Int
stDepth)
        Outcome
_ -> Text
""
      curDate :: Text
curDate = Int -> Text -> Text
T.take Int
19 (Text -> Text) -> (ScoreRecord -> Text) -> ScoreRecord -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> Text
forall a. Show a => a -> Text
tshow (LocalTime -> Text)
-> (ScoreRecord -> LocalTime) -> ScoreRecord -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
tz
                (UTCTime -> LocalTime)
-> (ScoreRecord -> UTCTime) -> ScoreRecord -> LocalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (ScoreRecord -> POSIXTime) -> ScoreRecord -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScoreRecord -> POSIXTime
date (ScoreRecord -> Text) -> ScoreRecord -> Text
forall a b. (a -> b) -> a -> b
$ ScoreRecord
score
      turns :: Int
turns = Time -> Time
absoluteTimeNegate (ScoreRecord -> Time
negTime ScoreRecord
score) Time -> Time -> Int
`timeFitUp` Time
timeTurn
      tpos :: Text
tpos = Int -> Char -> Text -> Text
T.justifyRight Int
3 Char
' ' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
pos
      tscore :: Text
tscore = Int -> Char -> Text -> Text
T.justifyRight Int
6 Char
' ' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ ScoreRecord -> Int
points ScoreRecord
score
      victims :: Text
victims = let nkilled :: Int
nkilled = [Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ EnumMap (ContentId ItemKind) Int -> [Int]
forall k a. EnumMap k a -> [a]
EM.elems (EnumMap (ContentId ItemKind) Int -> [Int])
-> EnumMap (ContentId ItemKind) Int -> [Int]
forall a b. (a -> b) -> a -> b
$ ScoreRecord -> EnumMap (ContentId ItemKind) Int
theirVictims ScoreRecord
score
                    nlost :: Int
nlost = [Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ EnumMap (ContentId ItemKind) Int -> [Int]
forall k a. EnumMap k a -> [a]
EM.elems (EnumMap (ContentId ItemKind) Int -> [Int])
-> EnumMap (ContentId ItemKind) Int -> [Int]
forall a b. (a -> b) -> a -> b
$ ScoreRecord -> EnumMap (ContentId ItemKind) Int
ourVictims ScoreRecord
score
                in Text
"killed" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
nkilled Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", lost" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
nlost
      -- This may overfill the screen line, but with default fonts
      -- it's very unlikely and not a big problem in any case.
      chalText :: Text
chalText | ScoreRecord -> Challenge
challenge ScoreRecord
score Challenge -> Challenge -> Bool
forall a. Eq a => a -> a -> Bool
== Challenge
defaultChallenge = Text
""
               | Bool
otherwise = Challenge -> Text
tshowChallenge (ScoreRecord -> Challenge
challenge ScoreRecord
score)
      tturns :: Text
tturns = [Part] -> Text
makePhrase [Int -> Part -> Part
MU.CarWs Int
turns Part
"turn"]
  in [ Text
tpos Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
<+> Text
tscore Text -> Text -> Text
<+> ScoreRecord -> Text
gplayerName ScoreRecord
score
       Text -> Text -> Text
<+> Text
died Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
<+> Text
victims Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
","
     , Text
"           "
       Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"after" Text -> Text -> Text
<+> Text
tturns Text -> Text -> Text
<+> Text
chalText Text -> Text -> Text
<+> Text
"on" Text -> Text -> Text
<+> Text
curDate Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
     ]

getTable :: ContentId ModeKind -> ScoreDict -> ScoreTable
getTable :: ContentId ModeKind -> ScoreDict -> ScoreTable
getTable = ScoreTable -> ContentId ModeKind -> ScoreDict -> ScoreTable
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault ([ScoreRecord] -> ScoreTable
ScoreTable [])

getRecord :: Int -> ScoreTable -> ScoreRecord
getRecord :: Int -> ScoreTable -> ScoreRecord
getRecord Int
pos (ScoreTable [ScoreRecord]
table) =
  ScoreRecord -> Maybe ScoreRecord -> ScoreRecord
forall a. a -> Maybe a -> a
fromMaybe (String -> ScoreRecord
forall a. (?callStack::CallStack) => String -> a
error (String -> ScoreRecord) -> String -> ScoreRecord
forall a b. (a -> b) -> a -> b
$ String
"" String -> Int -> String
forall v. Show v => String -> v -> String
`showFailure` Int
pos)
  (Maybe ScoreRecord -> ScoreRecord)
-> Maybe ScoreRecord -> ScoreRecord
forall a b. (a -> b) -> a -> b
$ [ScoreRecord] -> Maybe ScoreRecord
forall a. [a] -> Maybe a
listToMaybe ([ScoreRecord] -> Maybe ScoreRecord)
-> [ScoreRecord] -> Maybe ScoreRecord
forall a b. (a -> b) -> a -> b
$ Int -> [ScoreRecord] -> [ScoreRecord]
forall a. Int -> [a] -> [a]
drop (Int -> Int
forall a. Enum a => a -> a
pred Int
pos) [ScoreRecord]
table

getStatus :: ScoreRecord -> Status
getStatus :: ScoreRecord -> Status
getStatus = ScoreRecord -> Status
status

getDate :: ScoreRecord -> POSIXTime
getDate :: ScoreRecord -> POSIXTime
getDate = ScoreRecord -> POSIXTime
date

showAward :: Int        -- ^ number of (3-line) scores to be shown
          -> ScoreTable -- ^ current score table
          -> Int        -- ^ position of the current score in the table
          -> Text       -- ^ the name of the game mode
          -> Text
showAward :: Int -> ScoreTable -> Int -> Text -> Text
showAward Int
height ScoreTable
table Int
pos Text
gameModeName =
  let posStatus :: Status
posStatus = ScoreRecord -> Status
status (ScoreRecord -> Status) -> ScoreRecord -> Status
forall a b. (a -> b) -> a -> b
$ Int -> ScoreTable -> ScoreRecord
getRecord Int
pos ScoreTable
table
      (Part
efforts, Person
person, Part
msgUnless) =
        case Status -> Outcome
stOutcome Status
posStatus of
          Outcome
Killed | Status -> Int
stDepth Status
posStatus Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 ->
            (Part
"your short-lived struggle", Person
MU.Sg3rd, Part
"(no bonus)")
          Outcome
Killed ->
            (Part
"your heroic deeds", Person
MU.PlEtc, Part
"(no bonus)")
          Outcome
Defeated ->
            (Part
"your futile efforts", Person
MU.PlEtc, Part
"(no bonus)")
          Outcome
Camping ->
            -- This is only according to the limited player knowledge;
            -- the final score can be different, which is fine:
            (Part
"your valiant exploits", Person
MU.PlEtc, Part
"")
          Outcome
Conquer ->
            (Part
"your ruthless victory", Person
MU.Sg3rd,
             if Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
height
             then Part
"among the best"  -- "greatest heroes" doesn't fit
             else Part
"(bonus included)")
          Outcome
Escape ->
            (Part
"your dashing coup", Person
MU.Sg3rd,
             if Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
height
             then Part
"among the best"
             else Part
"(bonus included)")
          Outcome
Restart ->
            (Part
"your abortive attempt", Person
MU.Sg3rd, Part
"(no bonus)")
      subject :: Text
subject = [Part] -> Text
makePhrase [Part
efforts, Part
"in", Text -> Part
MU.Text Text
gameModeName]
  in [Part] -> Text
makeSentence
       [ Person -> Polarity -> Part -> Part -> Part
MU.SubjectVerb Person
person Polarity
MU.Yes (Text -> Part
MU.Text Text
subject) Part
"award you"
       , Int -> Part
MU.Ordinal Int
pos, Part
"place", Part
msgUnless ]