content: {-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
  -- | Game messages displayed on top of the screen for the player to read
  -- and then saved to player history.
  module Game.LambdaHack.Client.UI.Msg
    ( -- * Msg
      Msg, MsgShared, toMsgShared, toMsgDistinct
    , MsgClassShowAndSave(..), MsgClassShow(..), MsgClassSave(..)
    , MsgClassIgnore(..), MsgClassDistinct(..)
    , MsgClass, interruptsRunning, disturbsResting
      -- * Report
    , Report, nullVisibleReport, consReport, renderReport, anyInReport
      -- * History
    , History, newReport, emptyHistory, addToReport, addEolToNewReport
    , archiveReport, lengthHistory, renderHistory
  #ifdef EXPOSE_INTERNAL
      -- * Internal operations
    , UAttrString, uToAttrString, attrStringToU
    , toMsg, MsgPrototype, tripleFromProto
    , scrapsRepeats, isTutorialHint, msgColor
    , RepMsgNK, nullRepMsgNK
    , emptyReport, renderRepetition
    , scrapRepetitionSingle, scrapRepetition, renderTimeReport
  #endif
    ) where
  
  import Prelude ()
  
  import Game.LambdaHack.Core.Prelude
  
  import           Data.Binary
  import qualified Data.Char as Char
  import qualified Data.Set as S
  import           Data.Vector.Binary ()
  import qualified Data.Vector.Unboxed as U
  import           GHC.Generics (Generic)
  
  import           Game.LambdaHack.Client.UI.Overlay
  import qualified Game.LambdaHack.Common.RingBuffer as RB
  import           Game.LambdaHack.Common.Time
  import qualified Game.LambdaHack.Definition.Color as Color
  
  -- * UAttrString
  
  type UAttrString = U.Vector Word32
  
  uToAttrString :: UAttrString -> AttrString
  uToAttrString v = map Color.AttrCharW32 $ U.toList v
  
  attrStringToU :: AttrString -> UAttrString
  attrStringToU l = U.fromList $ map Color.attrCharW32 l
  
  -- * Msg
  
  -- | The type of a single game message.
  data Msg = Msg
    { msgShow  :: AttrString  -- ^ the colours and characters of the message
                              --   to be shown on the screen; not just text,
                              --   in case there was some colour not coming
                              --   from the message class
    , msgSave  :: AttrString  -- ^ the same to be saved in the message log only
    , msgClass :: MsgClass
    }
    deriving (Show, Eq, Ord, Generic)
  
  instance Binary Msg
  
  toMsg :: [(String, Color.Color)] -> MsgPrototype -> Msg
  toMsg prefixColors msgProto =
    let (tShow, tSave, msgClass) = tripleFromProto msgProto
        msgClassName = showSimpleMsgClass msgClass
        mprefixColor = find ((`isPrefixOf` msgClassName) . fst) prefixColors
        color = maybe (msgColor msgClass) snd mprefixColor
        msgShow = textFgToAS color tShow
        msgSave = textFgToAS color tSave
    in Msg {..}
  
  data MsgPrototype =
      MsgProtoShowAndSave MsgClassShowAndSave Text
    | MsgProtoShow MsgClassShow Text
    | MsgProtoSave MsgClassSave Text
    | MsgProtoIgnore MsgClassIgnore
    | MsgProtoDistinct MsgClassDistinct Text Text
  
  tripleFromProto :: MsgPrototype -> (Text, Text, MsgClass)
  tripleFromProto = \case
    MsgProtoShowAndSave x t -> (t, t, MsgClassShowAndSave x)
    MsgProtoShow x t -> (t, "", MsgClassShow x)
    MsgProtoSave x t -> ("", t, MsgClassSave x)
    MsgProtoIgnore x -> ("", "", MsgClassIgnore x)
    MsgProtoDistinct x t1 t2 -> (t1, t2, MsgClassDistinct x)
  
  class MsgShared a where
    toMsgShared :: [(String, Color.Color)] -> a -> Text -> Msg
  
  instance MsgShared MsgClassShowAndSave where
    toMsgShared prefixColors msgClass t =
      toMsg prefixColors $ MsgProtoShowAndSave msgClass t
  
  instance MsgShared MsgClassShow where
    toMsgShared prefixColors msgClass t =
      toMsg prefixColors $ MsgProtoShow msgClass t
  
  instance MsgShared MsgClassSave where
    toMsgShared prefixColors msgClass t =
      toMsg prefixColors $ MsgProtoSave msgClass t
  
  instance MsgShared MsgClassIgnore where
    toMsgShared prefixColors msgClass _ =
      toMsg prefixColors $ MsgProtoIgnore msgClass
  
  toMsgDistinct :: [(String, Color.Color)] -> MsgClassDistinct -> Text -> Text
                -> Msg
  toMsgDistinct prefixColors msgClass t1 t2 =
    toMsg prefixColors $ MsgProtoDistinct msgClass t1 t2
  
  -- Each constructor name should have length as asserted in @emptyReport@,
  -- so that the message log with message classes (if set in config) looks tidy.
  data MsgClass =
      MsgClassShowAndSave MsgClassShowAndSave
    | MsgClassShow MsgClassShow
    | MsgClassSave MsgClassSave
    | MsgClassIgnore MsgClassIgnore
    | MsgClassDistinct MsgClassDistinct
    deriving (Show, Eq, Ord, Generic)
  
  instance Binary MsgClass
  
  showSimpleMsgClass :: MsgClass -> String
  showSimpleMsgClass = \case
    MsgClassShowAndSave x -> show x
    MsgClassShow x -> show x
    MsgClassSave x -> show x
    MsgClassIgnore x -> show x
    MsgClassDistinct x -> show x
  
  data MsgClassShowAndSave =
      MsgBookKeeping
    | MsgStatusWakeup
    | MsgStatusStopUs
    | MsgStatusStopThem
    | MsgItemCreation
    | MsgItemRuination
    | MsgDeathVictory
    | MsgDeathDeafeat
    | MsgDeathBoring
    | MsgRiskOfDeath
    | MsgPointmanSwap
    | MsgFactionIntel
    | MsgFinalOutcome
    | MsgBackdropInfo
    | MsgTerrainReveal
    | MsgItemDiscovery
    | MsgSpottedActor
    | MsgItemMovement
    | MsgActionMajor
    | MsgActionMinor
    | MsgEffectMajor
    | MsgEffectMedium
    | MsgEffectMinor
    | MsgMiscellanous
    | MsgHeardOutside
    | MsgHeardNearby
    | MsgHeardFaraway
    | MsgBackdropFocus
    | MsgActionWarning
    | MsgRangedMightyWe
    | MsgRangedMightyUs
    | MsgRangedOthers  -- not ours or projectiles are hit
    | MsgRangedNormalUs
    | MsgGoodMiscEvent
    | MsgBadMiscEvent
    | MsgNeutralEvent
    | MsgSpecialEvent
    | MsgMeleeMightyWe
    | MsgMeleeMightyUs
    | MsgMeleeComplexWe
    | MsgMeleeComplexUs
    | MsgMeleeOthers  -- not ours or projectiles are hit
    | MsgMeleeNormalUs
    | MsgActionComplete
    | MsgAtFeetMajor
    | MsgAtFeetMinor
    | MsgTutorialHint
    deriving (Show, Eq, Ord, Enum, Bounded, Generic)
  
  instance Binary MsgClassShowAndSave
  
  data MsgClassShow =
      MsgPromptGeneric
    | MsgPromptFocus
    | MsgPromptMention
    | MsgPromptModify
    | MsgPromptActors
    | MsgPromptItems
    | MsgPromptAction
    | MsgActionAlert
    | MsgSpottedThreat
    deriving (Show, Eq, Ord, Enum, Bounded, Generic)
  
  instance Binary MsgClassShow
  
  data MsgClassSave =
      MsgInnerWorkSpam
    | MsgNumericReport
    deriving (Show, Eq, Ord, Enum, Bounded, Generic)
  
  instance Binary MsgClassSave
  
  data MsgClassIgnore =
      MsgMacroOperation
    | MsgRunStopReason
    | MsgStopPlayback
    deriving (Show, Eq, Ord, Enum, Bounded, Generic)
  
  instance Binary MsgClassIgnore
  
  data MsgClassDistinct =
      MsgSpottedItem
    | MsgStatusSleep
    | MsgStatusGoodUs
    | MsgStatusBadUs
    | MsgStatusOthers
    | MsgStatusBenign
    | MsgStatusWarning
    | MsgStatusLongerUs
    | MsgStatusLongThem
    deriving (Show, Eq, Ord, Enum, Bounded, Generic)
  
  instance Binary MsgClassDistinct
  
  interruptsRunning :: MsgClass -> Bool
  interruptsRunning = \case
    MsgClassShowAndSave x -> case x of
      MsgBookKeeping -> False
      MsgStatusStopThem -> False
      MsgItemMovement -> False
      MsgActionMinor -> False
      MsgEffectMinor -> False
      MsgMiscellanous -> False  -- taunts are colourful, but spammy
      MsgHeardOutside -> False  -- cause must be 'profound', but even taunts are
      MsgHeardFaraway -> False
      -- MsgHeardNearby interrupts, even if running started while hearing close
      MsgRangedOthers -> False
      MsgNeutralEvent -> False
      MsgAtFeetMinor -> False
      _ -> True
    MsgClassShow x -> case x of
      MsgPromptGeneric -> False
      MsgPromptFocus -> False
      MsgPromptMention -> False
      MsgPromptModify -> False
      MsgPromptActors -> False
      MsgPromptItems -> False
      MsgPromptAction -> False
      MsgActionAlert -> True  -- action alerts or questions cause alarm
      MsgSpottedThreat -> True
    MsgClassSave x -> case x of
      MsgInnerWorkSpam -> False
      MsgNumericReport -> False
    MsgClassIgnore x -> case x of
      MsgMacroOperation -> False
      MsgRunStopReason -> True
      MsgStopPlayback -> True
    MsgClassDistinct x -> case x of
      MsgSpottedItem -> False
      MsgStatusLongThem -> False
      MsgStatusOthers -> False
      MsgStatusBenign -> False
      MsgStatusWarning -> False
      _ -> True
  
  disturbsResting :: MsgClass -> Bool
  disturbsResting = \case
    MsgClassShowAndSave x -> case x of
      MsgPointmanSwap -> False  -- handled separately
      MsgItemDiscovery -> False  -- medium importance
      MsgHeardNearby -> False  -- handled separately; no disturbance if old
      _ -> interruptsRunning $ MsgClassShowAndSave x
    msgClass -> interruptsRunning msgClass
  
  scrapsRepeats :: MsgClass -> Bool
  scrapsRepeats = \case
    MsgClassShowAndSave x -> case x of
      MsgBookKeeping -> False  -- too important to scrap
      MsgDeathDeafeat -> False
      MsgRiskOfDeath -> False
      MsgFinalOutcome -> False
      _ -> True
    MsgClassShow x -> case x of
      MsgPromptGeneric -> False
      MsgPromptFocus -> False
      MsgPromptMention -> False
      MsgPromptModify -> False
      MsgPromptActors -> False
      MsgPromptItems -> False
      MsgPromptAction -> False
      MsgActionAlert -> False
      MsgSpottedThreat -> True
    MsgClassSave x -> case x of
      MsgInnerWorkSpam -> True
      MsgNumericReport -> True
    MsgClassIgnore _ -> False  -- ignored, so no need to scrap
    MsgClassDistinct _x -> True
  
  isTutorialHint :: MsgClass -> Bool
  isTutorialHint = \case
    MsgClassShowAndSave x -> case x of  -- show and save: least surprise
      MsgTutorialHint -> True
      _ -> False
    MsgClassShow _ -> False
    MsgClassSave _ -> False
    MsgClassIgnore _ -> False
    MsgClassDistinct _ -> False
  
  -- Only initially @White@ colour in text (e.g., not highlighted @BrWhite@)
  -- gets replaced by the one indicated.
  msgColor :: MsgClass -> Color.Color
  msgColor = \case
    MsgClassShowAndSave x -> case x of
      MsgBookKeeping -> Color.cBoring
      MsgStatusWakeup -> Color.cWakeUp
      MsgStatusStopUs -> Color.cBoring
      MsgStatusStopThem -> Color.cBoring
      MsgItemCreation -> Color.cGreed
      MsgItemRuination -> Color.cBoring  -- common, colourful components created
      MsgDeathVictory -> Color.cVeryGoodEvent
      MsgDeathDeafeat -> Color.cVeryBadEvent
      MsgDeathBoring -> Color.cBoring
      MsgRiskOfDeath -> Color.cGraveRisk
      MsgPointmanSwap -> Color.cBoring
      MsgFactionIntel -> Color.cMeta  -- good or bad
      MsgFinalOutcome -> Color.cGameOver
      MsgBackdropInfo -> Color.cBoring
      MsgTerrainReveal -> Color.cIdentification
      MsgItemDiscovery -> Color.cIdentification
      MsgSpottedActor -> Color.cBoring  -- common; warning in @MsgSpottedThreat@
      MsgItemMovement -> Color.cBoring
      MsgActionMajor -> Color.cBoring
      MsgActionMinor -> Color.cBoring
      MsgEffectMajor -> Color.cRareNeutralEvent
      MsgEffectMedium -> Color.cNeutralEvent
      MsgEffectMinor -> Color.cBoring
      MsgMiscellanous -> Color.cBoring
      MsgHeardOutside -> Color.cBoring
      MsgHeardNearby -> Color.cGraveRisk
      MsgHeardFaraway -> Color.cRisk
      MsgBackdropFocus -> Color.cVista
      MsgActionWarning -> Color.cMeta
      MsgRangedMightyWe -> Color.cGoodEvent
      MsgRangedMightyUs -> Color.cVeryBadEvent
      MsgRangedOthers -> Color.cBoring
      MsgRangedNormalUs -> Color.cBadEvent
      MsgGoodMiscEvent -> Color.cGoodEvent
      MsgBadMiscEvent -> Color.cBadEvent
      MsgNeutralEvent -> Color.cNeutralEvent
      MsgSpecialEvent -> Color.cRareNeutralEvent
      MsgMeleeMightyWe -> Color.cGoodEvent
      MsgMeleeMightyUs -> Color.cVeryBadEvent
      MsgMeleeComplexWe -> Color.cGoodEvent
      MsgMeleeComplexUs -> Color.cBadEvent
      MsgMeleeOthers -> Color.cBoring
      MsgMeleeNormalUs -> Color.cBadEvent
      MsgActionComplete -> Color.cBoring
      MsgAtFeetMajor -> Color.cBoring
      MsgAtFeetMinor -> Color.cBoring
      MsgTutorialHint -> Color.cTutorialHint
    MsgClassShow x -> case x of
      MsgPromptGeneric -> Color.cBoring
      MsgPromptFocus -> Color.cVista
      MsgPromptMention -> Color.cNeutralEvent
      MsgPromptModify -> Color.cRareNeutralEvent
      MsgPromptActors -> Color.cRisk
      MsgPromptItems -> Color.cGreed
      MsgPromptAction -> Color.cMeta
      MsgActionAlert -> Color.cMeta
      MsgSpottedThreat -> Color.cGraveRisk
    MsgClassSave x -> case x of
      MsgInnerWorkSpam -> Color.cBoring
      MsgNumericReport -> Color.cBoring
    MsgClassIgnore x -> case x of
      MsgMacroOperation -> Color.cBoring
      MsgRunStopReason -> Color.cBoring
      MsgStopPlayback -> Color.cMeta
    MsgClassDistinct x -> case x of
      MsgSpottedItem -> Color.cBoring
      MsgStatusSleep -> Color.cSleep
      MsgStatusGoodUs -> Color.cGoodEvent
      MsgStatusBadUs -> Color.cBadEvent
      MsgStatusOthers -> Color.cBoring
      MsgStatusBenign -> Color.cBoring
      MsgStatusWarning -> Color.cMeta
      MsgStatusLongerUs -> Color.cBoring  -- not important enough
      MsgStatusLongThem -> Color.cBoring  -- not important enough, no disturb even
  
  -- * Report
  
  data RepMsgNK = RepMsgNK {repMsg :: Msg, _repShow :: Int, _repSave :: Int}
    deriving (Show, Generic)
  
  instance Binary RepMsgNK
  
  -- | If only one of the message components is non-empty and non-whitespace,
  -- but its count is zero, the message is considered empty.
  nullRepMsgNK :: RepMsgNK -> Bool
  nullRepMsgNK (RepMsgNK Msg{..} _ _) =
    all (Char.isSpace . Color.charFromW32) msgShow
    && all (Char.isSpace . Color.charFromW32) msgSave
  
  -- | The set of messages, with repetitions, to show at the screen at once.
  newtype Report = Report [RepMsgNK]
    deriving (Show, Binary)
  
  -- | Empty set of messages.
  emptyReport :: Report
  emptyReport = assert (let checkLen msgClass =
                              let len = length (showSimpleMsgClass msgClass)
                              in len >= 14 && len <= 17
                            l = map MsgClassShowAndSave [minBound .. maxBound]
                                ++ map MsgClassShow [minBound .. maxBound]
                                ++ map MsgClassSave [minBound .. maxBound]
                                ++ map MsgClassIgnore [minBound .. maxBound]
                                ++ map MsgClassDistinct [minBound .. maxBound]
                        in allB checkLen l)
                $ Report []  -- as good place as any to verify display lengths
  
  -- | Test if the list of non-whitespace messages is empty.
  nullVisibleReport :: Report -> Bool
  nullVisibleReport (Report l) =
    all (all (Char.isSpace . Color.charFromW32) . msgShow . repMsg) l
  
  -- | Add a message to the start of report.
  consReport :: Msg -> Report -> Report
  consReport msg (Report r) = Report $ r ++ [RepMsgNK msg 1 1]
  
  -- | Render a report as a (possibly very long) list of 'AttrString'.
  renderReport :: Bool -> Report -> [AttrString]
  renderReport displaying (Report r) =
    let rep = map (\(RepMsgNK msg n k) -> if displaying
                                          then (msgShow msg, n)
                                          else (msgSave msg, k)) r
    in reverse $ map renderRepetition rep
  
  renderRepetition :: (AttrString, Int) -> AttrString
  renderRepetition (asRaw, n) =
    let as = dropWhileEnd (Char.isSpace . Color.charFromW32) asRaw
    in if n <= 1 || null as
       then as
       else as ++ stringToAS ("<x" ++ show n ++ ">")
  
  anyInReport :: (MsgClass -> Bool) -> Report -> Bool
  anyInReport f (Report xns) = any (f . msgClass . repMsg) xns
  
  -- * History
  
  -- | The history of reports. This is a ring buffer of the given length
  -- containing old archived history and two most recent reports stored
  -- separately.
  data History = History
    { newReport       :: Report
    , newTime         :: Time
    , oldReport       :: Report
    , oldTime         :: Time
    , archivedHistory :: RB.RingBuffer UAttrString }
    deriving (Show, Generic)
  
  instance Binary History
  
  -- | Empty history of the given maximal length.
  emptyHistory :: Int -> History
  emptyHistory size =
    let ringBufferSize = size - 1  -- a report resides outside the buffer
    in History emptyReport timeZero emptyReport timeZero
               (RB.empty ringBufferSize U.empty)
  
  scrapRepetitionSingle :: (AttrString, Int)
                        -> [(AttrString, Int)]
                        -> [(AttrString, Int)]
                        -> (Bool, [(AttrString, Int)], [(AttrString, Int)])
  scrapRepetitionSingle (s1, n1) rest1 oldMsgs =
    let butLastEOLs = dropWhileEnd ((== '\n') . Color.charFromW32)
        eqs1 (s2, _) = butLastEOLs s1 == butLastEOLs s2
    in case break eqs1 rest1 of
      (_, []) -> case break eqs1 oldMsgs of
        (noDup, (_, n2) : rest2) ->
          -- We keep the occurrence of the message in the new report only.
          let newReport = (s1, n1 + n2) : rest1
              oldReport = noDup ++ ([], 0) : rest2
          in (True, newReport, oldReport)
        _ -> (False, (s1, n1) : rest1, oldMsgs)
      (noDup, (s2, n2) : rest3) ->
        -- We keep the older (and so, oldest) occurrence of the message,
        -- to avoid visual disruption by moving the message around.
        let newReport = ([], 0) : noDup ++ (s2, n1 + n2) : rest3
            oldReport = oldMsgs
        in (True, newReport, oldReport)
  
  scrapRepetition :: History -> Maybe History
  scrapRepetition History{ newReport = Report newMsgs
                         , oldReport = Report oldMsgs
                         , .. } =
    case newMsgs of
      -- We take into account only first message of the new report,
      -- because others were deduplicated as they were added.
      -- We keep the message in the new report, because it should not
      -- vanish from the screen. In this way the message may be passed
      -- along many reports.
      RepMsgNK msg1 n1 k1 : rest1 ->
        let -- We ignore message classes and scrap even if same strings
            -- come from different classes. Otherwise user would be confused.
            makeShow = map (\(RepMsgNK msg n _) -> (msgShow msg, n))
            makeSave = map (\(RepMsgNK msg _ k) -> (msgSave msg, k))
            (scrapShowNeeded, scrapShowNew, scrapShowOld) =
              scrapRepetitionSingle (msgShow msg1, n1)
                                    (makeShow rest1)
                                    (makeShow oldMsgs)
            (scrapSaveNeeded, scrapSaveNew, scrapSaveOld) =
              scrapRepetitionSingle (msgSave msg1, k1)
                                    (makeSave rest1)
                                    (makeSave oldMsgs)
        in if scrapShowNeeded || scrapSaveNeeded
           then let combineMsg _ ([], _) ([], _) = Nothing
                    combineMsg msg (s, n) (t, k) = Just $
                      RepMsgNK msg{msgShow = s, msgSave = t} n k
                    zipMsg l1 l2 l3 = Report $ catMaybes $
                      zipWith3 combineMsg (map repMsg l1) l2 l3
                    newReport = zipMsg newMsgs scrapShowNew scrapSaveNew
                    oldReport = zipMsg oldMsgs scrapShowOld scrapSaveOld
                in Just History{..}
           else Nothing
      _ -> error "scrapRepetition: empty new report for scrapping"
  
  -- | Add a message to the new report of history, eliminating a possible
  -- duplicate and noting its existence in the result.
  addToReport :: S.Set Msg -> Bool -> Bool -> History -> Msg -> Time
              -> (S.Set Msg, History, Bool)
  addToReport usedHints displayHints inMelee
              oldHistory@History{newReport = Report r, ..} msgRaw time =
    -- When each turn we lose HP, stuff that wouldn't interrupt
    -- running should go at most to message log, not onto the screen,
    -- unless it goes only onto screen, so the message would be lost.
    let isMsgClassShow = \case
          MsgClassShow{} -> True
          _ -> False
        msg = if inMelee
                 && not (interruptsRunning (msgClass msgRaw))
                 && not (isMsgClassShow $ msgClass msgRaw)
              then msgRaw {msgShow = []}
              else msgRaw
        repMsgNK = RepMsgNK msg 1 1
        newH = History { newReport = Report $ repMsgNK : r
                       , newTime = time
                       , .. }
        msgIsHint = isTutorialHint (msgClass msg)
        msgUsedAsHint = S.member msg usedHints
        newUsedHints = if msgIsHint && displayHints && not msgUsedAsHint
                       then S.insert msg usedHints
                       else usedHints
    in -- Tutorial hint shown only when tutorial enabled and hint not yet shown.
       if | msgIsHint && (not displayHints || msgUsedAsHint) ->
            (usedHints, oldHistory, False)
          | not (scrapsRepeats $ msgClass msg)
            || nullRepMsgNK repMsgNK ->
            -- Don't waste time on never shown messages.
            (newUsedHints, newH, False)
          | otherwise -> case scrapRepetition newH of
              Just scrappedH -> (newUsedHints, scrappedH, True)
              Nothing -> (newUsedHints, newH, False)
  
  -- | Add a newline to end of the new report of history, unless empty.
  addEolToNewReport :: History -> History
  addEolToNewReport hist =
    let addEolToReport (Report []) = Report []
        addEolToReport (Report (hd : tl)) = Report $ addEolToRepMsgNK hd : tl
        addEolToRepMsgNK rm = rm {repMsg = addEolToMsg $ repMsg rm}
        addEolToMsg msg = msg { msgShow = addEolToAS $ msgShow msg
                              , msgSave = addEolToAS $ msgSave msg }
        addEolToAS as = as ++ stringToAS "\n"
    in hist {newReport = addEolToReport $ newReport hist}
  
  -- | Archive old report to history, filtering out messages with 0 duplicates
  -- and prompts. Set up new report with a new timestamp.
  archiveReport :: History -> History
  archiveReport History{newReport=Report newMsgs, ..} =
    let newFiltered@(Report r) = Report $ filter (not . nullRepMsgNK) newMsgs
    in if null r
       then -- Drop empty new report.
            History emptyReport timeZero oldReport oldTime archivedHistory
       else let lU = map attrStringToU
                     $ renderTimeReport oldTime oldReport
            in History emptyReport timeZero newFiltered newTime
               $ foldl' (\ !h !v -> RB.cons v h) archivedHistory lU
  
  renderTimeReport :: Time -> Report -> [AttrString]
  renderTimeReport t rep@(Report r) =
    let turns = t `timeFitUp` timeTurn
        repMsgs = renderReport False rep
        mgsClasses = reverse $ map (showSimpleMsgClass . msgClass . repMsg) r
        turnsString = show turns
        isSpace32 = Char.isSpace . Color.charFromW32
        worthSaving = not . all isSpace32
        renderClass (as, msgClassString) =
          let lenUnderscore = 17 - length msgClassString
                              + max 0 (3 - length turnsString)
          in stringToAS (turnsString ++ ":")
             ++ map (Color.attrChar2ToW32 Color.BrBlack)
                    ("[" ++ replicate lenUnderscore '_' ++ msgClassString ++ "]")
             ++ [Color.spaceAttrW32]
             ++ dropWhile isSpace32 as
    in map renderClass $ filter (worthSaving . fst) $ zip repMsgs mgsClasses
  
  lengthHistory :: History -> Int
  lengthHistory History{oldReport, archivedHistory} =
    RB.length archivedHistory
    + length (renderTimeReport timeZero oldReport)
        -- matches @renderHistory@
  
  -- | Render history as many lines of text. New report is not rendered.
  -- It's expected to be empty when history is shown.
  renderHistory :: History -> [AttrString]
  renderHistory History{..} =
    map uToAttrString (RB.toList archivedHistory)
    ++ renderTimeReport oldTime oldReport
  