{-# 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, tutorialHint, msgColor
  , RepMsgNK, nullRepMsgNK
  , emptyReport, renderWholeReport, 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 :: UAttrString -> AttrString
uToAttrString v :: UAttrString
v = (Word32 -> AttrCharW32) -> [Word32] -> AttrString
forall a b. (a -> b) -> [a] -> [b]
map Word32 -> AttrCharW32
Color.AttrCharW32 ([Word32] -> AttrString) -> [Word32] -> AttrString
forall a b. (a -> b) -> a -> b
$ UAttrString -> [Word32]
forall a. Unbox a => Vector a -> [a]
U.toList UAttrString
v

attrStringToU :: AttrString -> UAttrString
attrStringToU :: AttrString -> UAttrString
attrStringToU l :: AttrString
l = [Word32] -> UAttrString
forall a. Unbox a => [a] -> Vector a
U.fromList ([Word32] -> UAttrString) -> [Word32] -> UAttrString
forall a b. (a -> b) -> a -> b
$ (AttrCharW32 -> Word32) -> AttrString -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map AttrCharW32 -> Word32
Color.attrCharW32 AttrString
l

-- * Msg

-- | The type of a single game message.
data Msg = Msg
  { Msg -> AttrString
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
  , Msg -> AttrString
msgSave  :: AttrString  -- ^ the same to be saved in the message log only
  , Msg -> MsgClass
msgClass :: MsgClass
  }
  deriving (Int -> Msg -> ShowS
[Msg] -> ShowS
Msg -> String
(Int -> Msg -> ShowS)
-> (Msg -> String) -> ([Msg] -> ShowS) -> Show Msg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Msg] -> ShowS
$cshowList :: [Msg] -> ShowS
show :: Msg -> String
$cshow :: Msg -> String
showsPrec :: Int -> Msg -> ShowS
$cshowsPrec :: Int -> Msg -> ShowS
Show, Msg -> Msg -> Bool
(Msg -> Msg -> Bool) -> (Msg -> Msg -> Bool) -> Eq Msg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Msg -> Msg -> Bool
$c/= :: Msg -> Msg -> Bool
== :: Msg -> Msg -> Bool
$c== :: Msg -> Msg -> Bool
Eq, Eq Msg
Eq Msg =>
(Msg -> Msg -> Ordering)
-> (Msg -> Msg -> Bool)
-> (Msg -> Msg -> Bool)
-> (Msg -> Msg -> Bool)
-> (Msg -> Msg -> Bool)
-> (Msg -> Msg -> Msg)
-> (Msg -> Msg -> Msg)
-> Ord Msg
Msg -> Msg -> Bool
Msg -> Msg -> Ordering
Msg -> Msg -> Msg
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 :: Msg -> Msg -> Msg
$cmin :: Msg -> Msg -> Msg
max :: Msg -> Msg -> Msg
$cmax :: Msg -> Msg -> Msg
>= :: Msg -> Msg -> Bool
$c>= :: Msg -> Msg -> Bool
> :: Msg -> Msg -> Bool
$c> :: Msg -> Msg -> Bool
<= :: Msg -> Msg -> Bool
$c<= :: Msg -> Msg -> Bool
< :: Msg -> Msg -> Bool
$c< :: Msg -> Msg -> Bool
compare :: Msg -> Msg -> Ordering
$ccompare :: Msg -> Msg -> Ordering
$cp1Ord :: Eq Msg
Ord, (forall x. Msg -> Rep Msg x)
-> (forall x. Rep Msg x -> Msg) -> Generic Msg
forall x. Rep Msg x -> Msg
forall x. Msg -> Rep Msg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Msg x -> Msg
$cfrom :: forall x. Msg -> Rep Msg x
Generic)

instance Binary Msg

toMsg :: [(String, Color.Color)] -> MsgPrototype -> Msg
toMsg :: [(String, Color)] -> MsgPrototype -> Msg
toMsg prefixColors :: [(String, Color)]
prefixColors msgProto :: MsgPrototype
msgProto =
  let (tShow :: Text
tShow, tSave :: Text
tSave, msgClass :: MsgClass
msgClass) = MsgPrototype -> (Text, Text, MsgClass)
tripleFromProto MsgPrototype
msgProto
      msgClassName :: String
msgClassName = MsgClass -> String
showSimpleMsgClass MsgClass
msgClass
      mprefixColor :: Maybe (String, Color)
mprefixColor = ((String, Color) -> Bool)
-> [(String, Color)] -> Maybe (String, Color)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
msgClassName) (String -> Bool)
-> ((String, Color) -> String) -> (String, Color) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Color) -> String
forall a b. (a, b) -> a
fst) [(String, Color)]
prefixColors
      color :: Color
color = Color
-> ((String, Color) -> Color) -> Maybe (String, Color) -> Color
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MsgClass -> Color
msgColor MsgClass
msgClass) (String, Color) -> Color
forall a b. (a, b) -> b
snd Maybe (String, Color)
mprefixColor
      msgShow :: AttrString
msgShow = Color -> Text -> AttrString
textFgToAS Color
color Text
tShow
      msgSave :: AttrString
msgSave = Color -> Text -> AttrString
textFgToAS Color
color Text
tSave
  in $WMsg :: AttrString -> AttrString -> MsgClass -> Msg
Msg {..}

data MsgPrototype =
    MsgProtoShowAndSave MsgClassShowAndSave Text
  | MsgProtoShow MsgClassShow Text
  | MsgProtoSave MsgClassSave Text
  | MsgProtoIgnore MsgClassIgnore
  | MsgProtoDistinct MsgClassDistinct Text Text

tripleFromProto :: MsgPrototype -> (Text, Text, MsgClass)
tripleFromProto :: MsgPrototype -> (Text, Text, MsgClass)
tripleFromProto = \case
  MsgProtoShowAndSave x :: MsgClassShowAndSave
x t :: Text
t -> (Text
t, Text
t, MsgClassShowAndSave -> MsgClass
MsgClassShowAndSave MsgClassShowAndSave
x)
  MsgProtoShow x :: MsgClassShow
x t :: Text
t -> (Text
t, "", MsgClassShow -> MsgClass
MsgClassShow MsgClassShow
x)
  MsgProtoSave x :: MsgClassSave
x t :: Text
t -> ("", Text
t, MsgClassSave -> MsgClass
MsgClassSave MsgClassSave
x)
  MsgProtoIgnore x :: MsgClassIgnore
x -> ("", "", MsgClassIgnore -> MsgClass
MsgClassIgnore MsgClassIgnore
x)
  MsgProtoDistinct x :: MsgClassDistinct
x t1 :: Text
t1 t2 :: Text
t2 -> (Text
t1, Text
t2, MsgClassDistinct -> MsgClass
MsgClassDistinct MsgClassDistinct
x)

class MsgShared a where
  toMsgShared :: [(String, Color.Color)] -> a -> Text -> Msg

instance MsgShared MsgClassShowAndSave where
  toMsgShared :: [(String, Color)] -> MsgClassShowAndSave -> Text -> Msg
toMsgShared prefixColors :: [(String, Color)]
prefixColors msgClass :: MsgClassShowAndSave
msgClass t :: Text
t =
    [(String, Color)] -> MsgPrototype -> Msg
toMsg [(String, Color)]
prefixColors (MsgPrototype -> Msg) -> MsgPrototype -> Msg
forall a b. (a -> b) -> a -> b
$ MsgClassShowAndSave -> Text -> MsgPrototype
MsgProtoShowAndSave MsgClassShowAndSave
msgClass Text
t

instance MsgShared MsgClassShow where
  toMsgShared :: [(String, Color)] -> MsgClassShow -> Text -> Msg
toMsgShared prefixColors :: [(String, Color)]
prefixColors msgClass :: MsgClassShow
msgClass t :: Text
t =
    [(String, Color)] -> MsgPrototype -> Msg
toMsg [(String, Color)]
prefixColors (MsgPrototype -> Msg) -> MsgPrototype -> Msg
forall a b. (a -> b) -> a -> b
$ MsgClassShow -> Text -> MsgPrototype
MsgProtoShow MsgClassShow
msgClass Text
t

instance MsgShared MsgClassSave where
  toMsgShared :: [(String, Color)] -> MsgClassSave -> Text -> Msg
toMsgShared prefixColors :: [(String, Color)]
prefixColors msgClass :: MsgClassSave
msgClass t :: Text
t =
    [(String, Color)] -> MsgPrototype -> Msg
toMsg [(String, Color)]
prefixColors (MsgPrototype -> Msg) -> MsgPrototype -> Msg
forall a b. (a -> b) -> a -> b
$ MsgClassSave -> Text -> MsgPrototype
MsgProtoSave MsgClassSave
msgClass Text
t

instance MsgShared MsgClassIgnore where
  toMsgShared :: [(String, Color)] -> MsgClassIgnore -> Text -> Msg
toMsgShared prefixColors :: [(String, Color)]
prefixColors msgClass :: MsgClassIgnore
msgClass _ =
    [(String, Color)] -> MsgPrototype -> Msg
toMsg [(String, Color)]
prefixColors (MsgPrototype -> Msg) -> MsgPrototype -> Msg
forall a b. (a -> b) -> a -> b
$ MsgClassIgnore -> MsgPrototype
MsgProtoIgnore MsgClassIgnore
msgClass

toMsgDistinct :: [(String, Color.Color)] -> MsgClassDistinct -> Text -> Text
              -> Msg
toMsgDistinct :: [(String, Color)] -> MsgClassDistinct -> Text -> Text -> Msg
toMsgDistinct prefixColors :: [(String, Color)]
prefixColors msgClass :: MsgClassDistinct
msgClass t1 :: Text
t1 t2 :: Text
t2 =
  [(String, Color)] -> MsgPrototype -> Msg
toMsg [(String, Color)]
prefixColors (MsgPrototype -> Msg) -> MsgPrototype -> Msg
forall a b. (a -> b) -> a -> b
$ MsgClassDistinct -> Text -> Text -> MsgPrototype
MsgProtoDistinct MsgClassDistinct
msgClass Text
t1 Text
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 (Int -> MsgClass -> ShowS
[MsgClass] -> ShowS
MsgClass -> String
(Int -> MsgClass -> ShowS)
-> (MsgClass -> String) -> ([MsgClass] -> ShowS) -> Show MsgClass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgClass] -> ShowS
$cshowList :: [MsgClass] -> ShowS
show :: MsgClass -> String
$cshow :: MsgClass -> String
showsPrec :: Int -> MsgClass -> ShowS
$cshowsPrec :: Int -> MsgClass -> ShowS
Show, MsgClass -> MsgClass -> Bool
(MsgClass -> MsgClass -> Bool)
-> (MsgClass -> MsgClass -> Bool) -> Eq MsgClass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgClass -> MsgClass -> Bool
$c/= :: MsgClass -> MsgClass -> Bool
== :: MsgClass -> MsgClass -> Bool
$c== :: MsgClass -> MsgClass -> Bool
Eq, Eq MsgClass
Eq MsgClass =>
(MsgClass -> MsgClass -> Ordering)
-> (MsgClass -> MsgClass -> Bool)
-> (MsgClass -> MsgClass -> Bool)
-> (MsgClass -> MsgClass -> Bool)
-> (MsgClass -> MsgClass -> Bool)
-> (MsgClass -> MsgClass -> MsgClass)
-> (MsgClass -> MsgClass -> MsgClass)
-> Ord MsgClass
MsgClass -> MsgClass -> Bool
MsgClass -> MsgClass -> Ordering
MsgClass -> MsgClass -> MsgClass
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 :: MsgClass -> MsgClass -> MsgClass
$cmin :: MsgClass -> MsgClass -> MsgClass
max :: MsgClass -> MsgClass -> MsgClass
$cmax :: MsgClass -> MsgClass -> MsgClass
>= :: MsgClass -> MsgClass -> Bool
$c>= :: MsgClass -> MsgClass -> Bool
> :: MsgClass -> MsgClass -> Bool
$c> :: MsgClass -> MsgClass -> Bool
<= :: MsgClass -> MsgClass -> Bool
$c<= :: MsgClass -> MsgClass -> Bool
< :: MsgClass -> MsgClass -> Bool
$c< :: MsgClass -> MsgClass -> Bool
compare :: MsgClass -> MsgClass -> Ordering
$ccompare :: MsgClass -> MsgClass -> Ordering
$cp1Ord :: Eq MsgClass
Ord, (forall x. MsgClass -> Rep MsgClass x)
-> (forall x. Rep MsgClass x -> MsgClass) -> Generic MsgClass
forall x. Rep MsgClass x -> MsgClass
forall x. MsgClass -> Rep MsgClass x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MsgClass x -> MsgClass
$cfrom :: forall x. MsgClass -> Rep MsgClass x
Generic)

instance Binary MsgClass

showSimpleMsgClass :: MsgClass -> String
showSimpleMsgClass :: MsgClass -> String
showSimpleMsgClass = \case
  MsgClassShowAndSave x :: MsgClassShowAndSave
x -> MsgClassShowAndSave -> String
forall a. Show a => a -> String
show MsgClassShowAndSave
x
  MsgClassShow x :: MsgClassShow
x -> MsgClassShow -> String
forall a. Show a => a -> String
show MsgClassShow
x
  MsgClassSave x :: MsgClassSave
x -> MsgClassSave -> String
forall a. Show a => a -> String
show MsgClassSave
x
  MsgClassIgnore x :: MsgClassIgnore
x -> MsgClassIgnore -> String
forall a. Show a => a -> String
show MsgClassIgnore
x
  MsgClassDistinct x :: MsgClassDistinct
x -> MsgClassDistinct -> String
forall a. Show a => a -> String
show MsgClassDistinct
x

data MsgClassShowAndSave =
    MsgBookKeeping
  | MsgStatusWakeup
  | MsgStatusStopUs
  | MsgStatusStopThem
  | MsgItemCreation
  | MsgItemRuination
  | MsgDeathVictory
  | MsgDeathDeafeat
  | MsgDeathBoring
  | MsgRiskOfDeath
  | MsgPointmanSwap
  | MsgFactionIntel
  | MsgFinalOutcome
  | MsgPlotExposition
  | 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 (Int -> MsgClassShowAndSave -> ShowS
[MsgClassShowAndSave] -> ShowS
MsgClassShowAndSave -> String
(Int -> MsgClassShowAndSave -> ShowS)
-> (MsgClassShowAndSave -> String)
-> ([MsgClassShowAndSave] -> ShowS)
-> Show MsgClassShowAndSave
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgClassShowAndSave] -> ShowS
$cshowList :: [MsgClassShowAndSave] -> ShowS
show :: MsgClassShowAndSave -> String
$cshow :: MsgClassShowAndSave -> String
showsPrec :: Int -> MsgClassShowAndSave -> ShowS
$cshowsPrec :: Int -> MsgClassShowAndSave -> ShowS
Show, MsgClassShowAndSave -> MsgClassShowAndSave -> Bool
(MsgClassShowAndSave -> MsgClassShowAndSave -> Bool)
-> (MsgClassShowAndSave -> MsgClassShowAndSave -> Bool)
-> Eq MsgClassShowAndSave
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgClassShowAndSave -> MsgClassShowAndSave -> Bool
$c/= :: MsgClassShowAndSave -> MsgClassShowAndSave -> Bool
== :: MsgClassShowAndSave -> MsgClassShowAndSave -> Bool
$c== :: MsgClassShowAndSave -> MsgClassShowAndSave -> Bool
Eq, Eq MsgClassShowAndSave
Eq MsgClassShowAndSave =>
(MsgClassShowAndSave -> MsgClassShowAndSave -> Ordering)
-> (MsgClassShowAndSave -> MsgClassShowAndSave -> Bool)
-> (MsgClassShowAndSave -> MsgClassShowAndSave -> Bool)
-> (MsgClassShowAndSave -> MsgClassShowAndSave -> Bool)
-> (MsgClassShowAndSave -> MsgClassShowAndSave -> Bool)
-> (MsgClassShowAndSave
    -> MsgClassShowAndSave -> MsgClassShowAndSave)
-> (MsgClassShowAndSave
    -> MsgClassShowAndSave -> MsgClassShowAndSave)
-> Ord MsgClassShowAndSave
MsgClassShowAndSave -> MsgClassShowAndSave -> Bool
MsgClassShowAndSave -> MsgClassShowAndSave -> Ordering
MsgClassShowAndSave -> MsgClassShowAndSave -> MsgClassShowAndSave
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 :: MsgClassShowAndSave -> MsgClassShowAndSave -> MsgClassShowAndSave
$cmin :: MsgClassShowAndSave -> MsgClassShowAndSave -> MsgClassShowAndSave
max :: MsgClassShowAndSave -> MsgClassShowAndSave -> MsgClassShowAndSave
$cmax :: MsgClassShowAndSave -> MsgClassShowAndSave -> MsgClassShowAndSave
>= :: MsgClassShowAndSave -> MsgClassShowAndSave -> Bool
$c>= :: MsgClassShowAndSave -> MsgClassShowAndSave -> Bool
> :: MsgClassShowAndSave -> MsgClassShowAndSave -> Bool
$c> :: MsgClassShowAndSave -> MsgClassShowAndSave -> Bool
<= :: MsgClassShowAndSave -> MsgClassShowAndSave -> Bool
$c<= :: MsgClassShowAndSave -> MsgClassShowAndSave -> Bool
< :: MsgClassShowAndSave -> MsgClassShowAndSave -> Bool
$c< :: MsgClassShowAndSave -> MsgClassShowAndSave -> Bool
compare :: MsgClassShowAndSave -> MsgClassShowAndSave -> Ordering
$ccompare :: MsgClassShowAndSave -> MsgClassShowAndSave -> Ordering
$cp1Ord :: Eq MsgClassShowAndSave
Ord, Int -> MsgClassShowAndSave
MsgClassShowAndSave -> Int
MsgClassShowAndSave -> [MsgClassShowAndSave]
MsgClassShowAndSave -> MsgClassShowAndSave
MsgClassShowAndSave -> MsgClassShowAndSave -> [MsgClassShowAndSave]
MsgClassShowAndSave
-> MsgClassShowAndSave
-> MsgClassShowAndSave
-> [MsgClassShowAndSave]
(MsgClassShowAndSave -> MsgClassShowAndSave)
-> (MsgClassShowAndSave -> MsgClassShowAndSave)
-> (Int -> MsgClassShowAndSave)
-> (MsgClassShowAndSave -> Int)
-> (MsgClassShowAndSave -> [MsgClassShowAndSave])
-> (MsgClassShowAndSave
    -> MsgClassShowAndSave -> [MsgClassShowAndSave])
-> (MsgClassShowAndSave
    -> MsgClassShowAndSave -> [MsgClassShowAndSave])
-> (MsgClassShowAndSave
    -> MsgClassShowAndSave
    -> MsgClassShowAndSave
    -> [MsgClassShowAndSave])
-> Enum MsgClassShowAndSave
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MsgClassShowAndSave
-> MsgClassShowAndSave
-> MsgClassShowAndSave
-> [MsgClassShowAndSave]
$cenumFromThenTo :: MsgClassShowAndSave
-> MsgClassShowAndSave
-> MsgClassShowAndSave
-> [MsgClassShowAndSave]
enumFromTo :: MsgClassShowAndSave -> MsgClassShowAndSave -> [MsgClassShowAndSave]
$cenumFromTo :: MsgClassShowAndSave -> MsgClassShowAndSave -> [MsgClassShowAndSave]
enumFromThen :: MsgClassShowAndSave -> MsgClassShowAndSave -> [MsgClassShowAndSave]
$cenumFromThen :: MsgClassShowAndSave -> MsgClassShowAndSave -> [MsgClassShowAndSave]
enumFrom :: MsgClassShowAndSave -> [MsgClassShowAndSave]
$cenumFrom :: MsgClassShowAndSave -> [MsgClassShowAndSave]
fromEnum :: MsgClassShowAndSave -> Int
$cfromEnum :: MsgClassShowAndSave -> Int
toEnum :: Int -> MsgClassShowAndSave
$ctoEnum :: Int -> MsgClassShowAndSave
pred :: MsgClassShowAndSave -> MsgClassShowAndSave
$cpred :: MsgClassShowAndSave -> MsgClassShowAndSave
succ :: MsgClassShowAndSave -> MsgClassShowAndSave
$csucc :: MsgClassShowAndSave -> MsgClassShowAndSave
Enum, MsgClassShowAndSave
MsgClassShowAndSave
-> MsgClassShowAndSave -> Bounded MsgClassShowAndSave
forall a. a -> a -> Bounded a
maxBound :: MsgClassShowAndSave
$cmaxBound :: MsgClassShowAndSave
minBound :: MsgClassShowAndSave
$cminBound :: MsgClassShowAndSave
Bounded, (forall x. MsgClassShowAndSave -> Rep MsgClassShowAndSave x)
-> (forall x. Rep MsgClassShowAndSave x -> MsgClassShowAndSave)
-> Generic MsgClassShowAndSave
forall x. Rep MsgClassShowAndSave x -> MsgClassShowAndSave
forall x. MsgClassShowAndSave -> Rep MsgClassShowAndSave x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MsgClassShowAndSave x -> MsgClassShowAndSave
$cfrom :: forall x. MsgClassShowAndSave -> Rep MsgClassShowAndSave x
Generic)

instance Binary MsgClassShowAndSave

data MsgClassShow =
    MsgPromptGeneric
  | MsgPromptFocus
  | MsgPromptMention
  | MsgPromptModify
  | MsgPromptActors
  | MsgPromptItems
  | MsgPromptAction
  | MsgActionAlert
  | MsgSpottedThreat
  deriving (Int -> MsgClassShow -> ShowS
[MsgClassShow] -> ShowS
MsgClassShow -> String
(Int -> MsgClassShow -> ShowS)
-> (MsgClassShow -> String)
-> ([MsgClassShow] -> ShowS)
-> Show MsgClassShow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgClassShow] -> ShowS
$cshowList :: [MsgClassShow] -> ShowS
show :: MsgClassShow -> String
$cshow :: MsgClassShow -> String
showsPrec :: Int -> MsgClassShow -> ShowS
$cshowsPrec :: Int -> MsgClassShow -> ShowS
Show, MsgClassShow -> MsgClassShow -> Bool
(MsgClassShow -> MsgClassShow -> Bool)
-> (MsgClassShow -> MsgClassShow -> Bool) -> Eq MsgClassShow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgClassShow -> MsgClassShow -> Bool
$c/= :: MsgClassShow -> MsgClassShow -> Bool
== :: MsgClassShow -> MsgClassShow -> Bool
$c== :: MsgClassShow -> MsgClassShow -> Bool
Eq, Eq MsgClassShow
Eq MsgClassShow =>
(MsgClassShow -> MsgClassShow -> Ordering)
-> (MsgClassShow -> MsgClassShow -> Bool)
-> (MsgClassShow -> MsgClassShow -> Bool)
-> (MsgClassShow -> MsgClassShow -> Bool)
-> (MsgClassShow -> MsgClassShow -> Bool)
-> (MsgClassShow -> MsgClassShow -> MsgClassShow)
-> (MsgClassShow -> MsgClassShow -> MsgClassShow)
-> Ord MsgClassShow
MsgClassShow -> MsgClassShow -> Bool
MsgClassShow -> MsgClassShow -> Ordering
MsgClassShow -> MsgClassShow -> MsgClassShow
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 :: MsgClassShow -> MsgClassShow -> MsgClassShow
$cmin :: MsgClassShow -> MsgClassShow -> MsgClassShow
max :: MsgClassShow -> MsgClassShow -> MsgClassShow
$cmax :: MsgClassShow -> MsgClassShow -> MsgClassShow
>= :: MsgClassShow -> MsgClassShow -> Bool
$c>= :: MsgClassShow -> MsgClassShow -> Bool
> :: MsgClassShow -> MsgClassShow -> Bool
$c> :: MsgClassShow -> MsgClassShow -> Bool
<= :: MsgClassShow -> MsgClassShow -> Bool
$c<= :: MsgClassShow -> MsgClassShow -> Bool
< :: MsgClassShow -> MsgClassShow -> Bool
$c< :: MsgClassShow -> MsgClassShow -> Bool
compare :: MsgClassShow -> MsgClassShow -> Ordering
$ccompare :: MsgClassShow -> MsgClassShow -> Ordering
$cp1Ord :: Eq MsgClassShow
Ord, Int -> MsgClassShow
MsgClassShow -> Int
MsgClassShow -> [MsgClassShow]
MsgClassShow -> MsgClassShow
MsgClassShow -> MsgClassShow -> [MsgClassShow]
MsgClassShow -> MsgClassShow -> MsgClassShow -> [MsgClassShow]
(MsgClassShow -> MsgClassShow)
-> (MsgClassShow -> MsgClassShow)
-> (Int -> MsgClassShow)
-> (MsgClassShow -> Int)
-> (MsgClassShow -> [MsgClassShow])
-> (MsgClassShow -> MsgClassShow -> [MsgClassShow])
-> (MsgClassShow -> MsgClassShow -> [MsgClassShow])
-> (MsgClassShow -> MsgClassShow -> MsgClassShow -> [MsgClassShow])
-> Enum MsgClassShow
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MsgClassShow -> MsgClassShow -> MsgClassShow -> [MsgClassShow]
$cenumFromThenTo :: MsgClassShow -> MsgClassShow -> MsgClassShow -> [MsgClassShow]
enumFromTo :: MsgClassShow -> MsgClassShow -> [MsgClassShow]
$cenumFromTo :: MsgClassShow -> MsgClassShow -> [MsgClassShow]
enumFromThen :: MsgClassShow -> MsgClassShow -> [MsgClassShow]
$cenumFromThen :: MsgClassShow -> MsgClassShow -> [MsgClassShow]
enumFrom :: MsgClassShow -> [MsgClassShow]
$cenumFrom :: MsgClassShow -> [MsgClassShow]
fromEnum :: MsgClassShow -> Int
$cfromEnum :: MsgClassShow -> Int
toEnum :: Int -> MsgClassShow
$ctoEnum :: Int -> MsgClassShow
pred :: MsgClassShow -> MsgClassShow
$cpred :: MsgClassShow -> MsgClassShow
succ :: MsgClassShow -> MsgClassShow
$csucc :: MsgClassShow -> MsgClassShow
Enum, MsgClassShow
MsgClassShow -> MsgClassShow -> Bounded MsgClassShow
forall a. a -> a -> Bounded a
maxBound :: MsgClassShow
$cmaxBound :: MsgClassShow
minBound :: MsgClassShow
$cminBound :: MsgClassShow
Bounded, (forall x. MsgClassShow -> Rep MsgClassShow x)
-> (forall x. Rep MsgClassShow x -> MsgClassShow)
-> Generic MsgClassShow
forall x. Rep MsgClassShow x -> MsgClassShow
forall x. MsgClassShow -> Rep MsgClassShow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MsgClassShow x -> MsgClassShow
$cfrom :: forall x. MsgClassShow -> Rep MsgClassShow x
Generic)

instance Binary MsgClassShow

data MsgClassSave =
    MsgInnerWorkSpam
  | MsgNumericReport
  deriving (Int -> MsgClassSave -> ShowS
[MsgClassSave] -> ShowS
MsgClassSave -> String
(Int -> MsgClassSave -> ShowS)
-> (MsgClassSave -> String)
-> ([MsgClassSave] -> ShowS)
-> Show MsgClassSave
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgClassSave] -> ShowS
$cshowList :: [MsgClassSave] -> ShowS
show :: MsgClassSave -> String
$cshow :: MsgClassSave -> String
showsPrec :: Int -> MsgClassSave -> ShowS
$cshowsPrec :: Int -> MsgClassSave -> ShowS
Show, MsgClassSave -> MsgClassSave -> Bool
(MsgClassSave -> MsgClassSave -> Bool)
-> (MsgClassSave -> MsgClassSave -> Bool) -> Eq MsgClassSave
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgClassSave -> MsgClassSave -> Bool
$c/= :: MsgClassSave -> MsgClassSave -> Bool
== :: MsgClassSave -> MsgClassSave -> Bool
$c== :: MsgClassSave -> MsgClassSave -> Bool
Eq, Eq MsgClassSave
Eq MsgClassSave =>
(MsgClassSave -> MsgClassSave -> Ordering)
-> (MsgClassSave -> MsgClassSave -> Bool)
-> (MsgClassSave -> MsgClassSave -> Bool)
-> (MsgClassSave -> MsgClassSave -> Bool)
-> (MsgClassSave -> MsgClassSave -> Bool)
-> (MsgClassSave -> MsgClassSave -> MsgClassSave)
-> (MsgClassSave -> MsgClassSave -> MsgClassSave)
-> Ord MsgClassSave
MsgClassSave -> MsgClassSave -> Bool
MsgClassSave -> MsgClassSave -> Ordering
MsgClassSave -> MsgClassSave -> MsgClassSave
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 :: MsgClassSave -> MsgClassSave -> MsgClassSave
$cmin :: MsgClassSave -> MsgClassSave -> MsgClassSave
max :: MsgClassSave -> MsgClassSave -> MsgClassSave
$cmax :: MsgClassSave -> MsgClassSave -> MsgClassSave
>= :: MsgClassSave -> MsgClassSave -> Bool
$c>= :: MsgClassSave -> MsgClassSave -> Bool
> :: MsgClassSave -> MsgClassSave -> Bool
$c> :: MsgClassSave -> MsgClassSave -> Bool
<= :: MsgClassSave -> MsgClassSave -> Bool
$c<= :: MsgClassSave -> MsgClassSave -> Bool
< :: MsgClassSave -> MsgClassSave -> Bool
$c< :: MsgClassSave -> MsgClassSave -> Bool
compare :: MsgClassSave -> MsgClassSave -> Ordering
$ccompare :: MsgClassSave -> MsgClassSave -> Ordering
$cp1Ord :: Eq MsgClassSave
Ord, Int -> MsgClassSave
MsgClassSave -> Int
MsgClassSave -> [MsgClassSave]
MsgClassSave -> MsgClassSave
MsgClassSave -> MsgClassSave -> [MsgClassSave]
MsgClassSave -> MsgClassSave -> MsgClassSave -> [MsgClassSave]
(MsgClassSave -> MsgClassSave)
-> (MsgClassSave -> MsgClassSave)
-> (Int -> MsgClassSave)
-> (MsgClassSave -> Int)
-> (MsgClassSave -> [MsgClassSave])
-> (MsgClassSave -> MsgClassSave -> [MsgClassSave])
-> (MsgClassSave -> MsgClassSave -> [MsgClassSave])
-> (MsgClassSave -> MsgClassSave -> MsgClassSave -> [MsgClassSave])
-> Enum MsgClassSave
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MsgClassSave -> MsgClassSave -> MsgClassSave -> [MsgClassSave]
$cenumFromThenTo :: MsgClassSave -> MsgClassSave -> MsgClassSave -> [MsgClassSave]
enumFromTo :: MsgClassSave -> MsgClassSave -> [MsgClassSave]
$cenumFromTo :: MsgClassSave -> MsgClassSave -> [MsgClassSave]
enumFromThen :: MsgClassSave -> MsgClassSave -> [MsgClassSave]
$cenumFromThen :: MsgClassSave -> MsgClassSave -> [MsgClassSave]
enumFrom :: MsgClassSave -> [MsgClassSave]
$cenumFrom :: MsgClassSave -> [MsgClassSave]
fromEnum :: MsgClassSave -> Int
$cfromEnum :: MsgClassSave -> Int
toEnum :: Int -> MsgClassSave
$ctoEnum :: Int -> MsgClassSave
pred :: MsgClassSave -> MsgClassSave
$cpred :: MsgClassSave -> MsgClassSave
succ :: MsgClassSave -> MsgClassSave
$csucc :: MsgClassSave -> MsgClassSave
Enum, MsgClassSave
MsgClassSave -> MsgClassSave -> Bounded MsgClassSave
forall a. a -> a -> Bounded a
maxBound :: MsgClassSave
$cmaxBound :: MsgClassSave
minBound :: MsgClassSave
$cminBound :: MsgClassSave
Bounded, (forall x. MsgClassSave -> Rep MsgClassSave x)
-> (forall x. Rep MsgClassSave x -> MsgClassSave)
-> Generic MsgClassSave
forall x. Rep MsgClassSave x -> MsgClassSave
forall x. MsgClassSave -> Rep MsgClassSave x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MsgClassSave x -> MsgClassSave
$cfrom :: forall x. MsgClassSave -> Rep MsgClassSave x
Generic)

instance Binary MsgClassSave

data MsgClassIgnore =
    MsgMacroOperation
  | MsgRunStopReason
  | MsgStopPlayback
  deriving (Int -> MsgClassIgnore -> ShowS
[MsgClassIgnore] -> ShowS
MsgClassIgnore -> String
(Int -> MsgClassIgnore -> ShowS)
-> (MsgClassIgnore -> String)
-> ([MsgClassIgnore] -> ShowS)
-> Show MsgClassIgnore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgClassIgnore] -> ShowS
$cshowList :: [MsgClassIgnore] -> ShowS
show :: MsgClassIgnore -> String
$cshow :: MsgClassIgnore -> String
showsPrec :: Int -> MsgClassIgnore -> ShowS
$cshowsPrec :: Int -> MsgClassIgnore -> ShowS
Show, MsgClassIgnore -> MsgClassIgnore -> Bool
(MsgClassIgnore -> MsgClassIgnore -> Bool)
-> (MsgClassIgnore -> MsgClassIgnore -> Bool) -> Eq MsgClassIgnore
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgClassIgnore -> MsgClassIgnore -> Bool
$c/= :: MsgClassIgnore -> MsgClassIgnore -> Bool
== :: MsgClassIgnore -> MsgClassIgnore -> Bool
$c== :: MsgClassIgnore -> MsgClassIgnore -> Bool
Eq, Eq MsgClassIgnore
Eq MsgClassIgnore =>
(MsgClassIgnore -> MsgClassIgnore -> Ordering)
-> (MsgClassIgnore -> MsgClassIgnore -> Bool)
-> (MsgClassIgnore -> MsgClassIgnore -> Bool)
-> (MsgClassIgnore -> MsgClassIgnore -> Bool)
-> (MsgClassIgnore -> MsgClassIgnore -> Bool)
-> (MsgClassIgnore -> MsgClassIgnore -> MsgClassIgnore)
-> (MsgClassIgnore -> MsgClassIgnore -> MsgClassIgnore)
-> Ord MsgClassIgnore
MsgClassIgnore -> MsgClassIgnore -> Bool
MsgClassIgnore -> MsgClassIgnore -> Ordering
MsgClassIgnore -> MsgClassIgnore -> MsgClassIgnore
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 :: MsgClassIgnore -> MsgClassIgnore -> MsgClassIgnore
$cmin :: MsgClassIgnore -> MsgClassIgnore -> MsgClassIgnore
max :: MsgClassIgnore -> MsgClassIgnore -> MsgClassIgnore
$cmax :: MsgClassIgnore -> MsgClassIgnore -> MsgClassIgnore
>= :: MsgClassIgnore -> MsgClassIgnore -> Bool
$c>= :: MsgClassIgnore -> MsgClassIgnore -> Bool
> :: MsgClassIgnore -> MsgClassIgnore -> Bool
$c> :: MsgClassIgnore -> MsgClassIgnore -> Bool
<= :: MsgClassIgnore -> MsgClassIgnore -> Bool
$c<= :: MsgClassIgnore -> MsgClassIgnore -> Bool
< :: MsgClassIgnore -> MsgClassIgnore -> Bool
$c< :: MsgClassIgnore -> MsgClassIgnore -> Bool
compare :: MsgClassIgnore -> MsgClassIgnore -> Ordering
$ccompare :: MsgClassIgnore -> MsgClassIgnore -> Ordering
$cp1Ord :: Eq MsgClassIgnore
Ord, Int -> MsgClassIgnore
MsgClassIgnore -> Int
MsgClassIgnore -> [MsgClassIgnore]
MsgClassIgnore -> MsgClassIgnore
MsgClassIgnore -> MsgClassIgnore -> [MsgClassIgnore]
MsgClassIgnore
-> MsgClassIgnore -> MsgClassIgnore -> [MsgClassIgnore]
(MsgClassIgnore -> MsgClassIgnore)
-> (MsgClassIgnore -> MsgClassIgnore)
-> (Int -> MsgClassIgnore)
-> (MsgClassIgnore -> Int)
-> (MsgClassIgnore -> [MsgClassIgnore])
-> (MsgClassIgnore -> MsgClassIgnore -> [MsgClassIgnore])
-> (MsgClassIgnore -> MsgClassIgnore -> [MsgClassIgnore])
-> (MsgClassIgnore
    -> MsgClassIgnore -> MsgClassIgnore -> [MsgClassIgnore])
-> Enum MsgClassIgnore
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MsgClassIgnore
-> MsgClassIgnore -> MsgClassIgnore -> [MsgClassIgnore]
$cenumFromThenTo :: MsgClassIgnore
-> MsgClassIgnore -> MsgClassIgnore -> [MsgClassIgnore]
enumFromTo :: MsgClassIgnore -> MsgClassIgnore -> [MsgClassIgnore]
$cenumFromTo :: MsgClassIgnore -> MsgClassIgnore -> [MsgClassIgnore]
enumFromThen :: MsgClassIgnore -> MsgClassIgnore -> [MsgClassIgnore]
$cenumFromThen :: MsgClassIgnore -> MsgClassIgnore -> [MsgClassIgnore]
enumFrom :: MsgClassIgnore -> [MsgClassIgnore]
$cenumFrom :: MsgClassIgnore -> [MsgClassIgnore]
fromEnum :: MsgClassIgnore -> Int
$cfromEnum :: MsgClassIgnore -> Int
toEnum :: Int -> MsgClassIgnore
$ctoEnum :: Int -> MsgClassIgnore
pred :: MsgClassIgnore -> MsgClassIgnore
$cpred :: MsgClassIgnore -> MsgClassIgnore
succ :: MsgClassIgnore -> MsgClassIgnore
$csucc :: MsgClassIgnore -> MsgClassIgnore
Enum, MsgClassIgnore
MsgClassIgnore -> MsgClassIgnore -> Bounded MsgClassIgnore
forall a. a -> a -> Bounded a
maxBound :: MsgClassIgnore
$cmaxBound :: MsgClassIgnore
minBound :: MsgClassIgnore
$cminBound :: MsgClassIgnore
Bounded, (forall x. MsgClassIgnore -> Rep MsgClassIgnore x)
-> (forall x. Rep MsgClassIgnore x -> MsgClassIgnore)
-> Generic MsgClassIgnore
forall x. Rep MsgClassIgnore x -> MsgClassIgnore
forall x. MsgClassIgnore -> Rep MsgClassIgnore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MsgClassIgnore x -> MsgClassIgnore
$cfrom :: forall x. MsgClassIgnore -> Rep MsgClassIgnore x
Generic)

instance Binary MsgClassIgnore

data MsgClassDistinct =
    MsgSpottedItem
  | MsgStatusSleep
  | MsgStatusGoodUs
  | MsgStatusBadUs
  | MsgStatusOthers
  | MsgStatusBenign
  | MsgStatusWarning
  | MsgStatusLongerUs
  | MsgStatusLongThem
  deriving (Int -> MsgClassDistinct -> ShowS
[MsgClassDistinct] -> ShowS
MsgClassDistinct -> String
(Int -> MsgClassDistinct -> ShowS)
-> (MsgClassDistinct -> String)
-> ([MsgClassDistinct] -> ShowS)
-> Show MsgClassDistinct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgClassDistinct] -> ShowS
$cshowList :: [MsgClassDistinct] -> ShowS
show :: MsgClassDistinct -> String
$cshow :: MsgClassDistinct -> String
showsPrec :: Int -> MsgClassDistinct -> ShowS
$cshowsPrec :: Int -> MsgClassDistinct -> ShowS
Show, MsgClassDistinct -> MsgClassDistinct -> Bool
(MsgClassDistinct -> MsgClassDistinct -> Bool)
-> (MsgClassDistinct -> MsgClassDistinct -> Bool)
-> Eq MsgClassDistinct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgClassDistinct -> MsgClassDistinct -> Bool
$c/= :: MsgClassDistinct -> MsgClassDistinct -> Bool
== :: MsgClassDistinct -> MsgClassDistinct -> Bool
$c== :: MsgClassDistinct -> MsgClassDistinct -> Bool
Eq, Eq MsgClassDistinct
Eq MsgClassDistinct =>
(MsgClassDistinct -> MsgClassDistinct -> Ordering)
-> (MsgClassDistinct -> MsgClassDistinct -> Bool)
-> (MsgClassDistinct -> MsgClassDistinct -> Bool)
-> (MsgClassDistinct -> MsgClassDistinct -> Bool)
-> (MsgClassDistinct -> MsgClassDistinct -> Bool)
-> (MsgClassDistinct -> MsgClassDistinct -> MsgClassDistinct)
-> (MsgClassDistinct -> MsgClassDistinct -> MsgClassDistinct)
-> Ord MsgClassDistinct
MsgClassDistinct -> MsgClassDistinct -> Bool
MsgClassDistinct -> MsgClassDistinct -> Ordering
MsgClassDistinct -> MsgClassDistinct -> MsgClassDistinct
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 :: MsgClassDistinct -> MsgClassDistinct -> MsgClassDistinct
$cmin :: MsgClassDistinct -> MsgClassDistinct -> MsgClassDistinct
max :: MsgClassDistinct -> MsgClassDistinct -> MsgClassDistinct
$cmax :: MsgClassDistinct -> MsgClassDistinct -> MsgClassDistinct
>= :: MsgClassDistinct -> MsgClassDistinct -> Bool
$c>= :: MsgClassDistinct -> MsgClassDistinct -> Bool
> :: MsgClassDistinct -> MsgClassDistinct -> Bool
$c> :: MsgClassDistinct -> MsgClassDistinct -> Bool
<= :: MsgClassDistinct -> MsgClassDistinct -> Bool
$c<= :: MsgClassDistinct -> MsgClassDistinct -> Bool
< :: MsgClassDistinct -> MsgClassDistinct -> Bool
$c< :: MsgClassDistinct -> MsgClassDistinct -> Bool
compare :: MsgClassDistinct -> MsgClassDistinct -> Ordering
$ccompare :: MsgClassDistinct -> MsgClassDistinct -> Ordering
$cp1Ord :: Eq MsgClassDistinct
Ord, Int -> MsgClassDistinct
MsgClassDistinct -> Int
MsgClassDistinct -> [MsgClassDistinct]
MsgClassDistinct -> MsgClassDistinct
MsgClassDistinct -> MsgClassDistinct -> [MsgClassDistinct]
MsgClassDistinct
-> MsgClassDistinct -> MsgClassDistinct -> [MsgClassDistinct]
(MsgClassDistinct -> MsgClassDistinct)
-> (MsgClassDistinct -> MsgClassDistinct)
-> (Int -> MsgClassDistinct)
-> (MsgClassDistinct -> Int)
-> (MsgClassDistinct -> [MsgClassDistinct])
-> (MsgClassDistinct -> MsgClassDistinct -> [MsgClassDistinct])
-> (MsgClassDistinct -> MsgClassDistinct -> [MsgClassDistinct])
-> (MsgClassDistinct
    -> MsgClassDistinct -> MsgClassDistinct -> [MsgClassDistinct])
-> Enum MsgClassDistinct
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MsgClassDistinct
-> MsgClassDistinct -> MsgClassDistinct -> [MsgClassDistinct]
$cenumFromThenTo :: MsgClassDistinct
-> MsgClassDistinct -> MsgClassDistinct -> [MsgClassDistinct]
enumFromTo :: MsgClassDistinct -> MsgClassDistinct -> [MsgClassDistinct]
$cenumFromTo :: MsgClassDistinct -> MsgClassDistinct -> [MsgClassDistinct]
enumFromThen :: MsgClassDistinct -> MsgClassDistinct -> [MsgClassDistinct]
$cenumFromThen :: MsgClassDistinct -> MsgClassDistinct -> [MsgClassDistinct]
enumFrom :: MsgClassDistinct -> [MsgClassDistinct]
$cenumFrom :: MsgClassDistinct -> [MsgClassDistinct]
fromEnum :: MsgClassDistinct -> Int
$cfromEnum :: MsgClassDistinct -> Int
toEnum :: Int -> MsgClassDistinct
$ctoEnum :: Int -> MsgClassDistinct
pred :: MsgClassDistinct -> MsgClassDistinct
$cpred :: MsgClassDistinct -> MsgClassDistinct
succ :: MsgClassDistinct -> MsgClassDistinct
$csucc :: MsgClassDistinct -> MsgClassDistinct
Enum, MsgClassDistinct
MsgClassDistinct -> MsgClassDistinct -> Bounded MsgClassDistinct
forall a. a -> a -> Bounded a
maxBound :: MsgClassDistinct
$cmaxBound :: MsgClassDistinct
minBound :: MsgClassDistinct
$cminBound :: MsgClassDistinct
Bounded, (forall x. MsgClassDistinct -> Rep MsgClassDistinct x)
-> (forall x. Rep MsgClassDistinct x -> MsgClassDistinct)
-> Generic MsgClassDistinct
forall x. Rep MsgClassDistinct x -> MsgClassDistinct
forall x. MsgClassDistinct -> Rep MsgClassDistinct x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MsgClassDistinct x -> MsgClassDistinct
$cfrom :: forall x. MsgClassDistinct -> Rep MsgClassDistinct x
Generic)

instance Binary MsgClassDistinct

interruptsRunning :: MsgClass -> Bool
interruptsRunning :: MsgClass -> Bool
interruptsRunning = \case
  MsgClassShowAndSave x :: MsgClassShowAndSave
x -> case MsgClassShowAndSave
x of
    MsgBookKeeping -> Bool
False
    MsgStatusStopThem -> Bool
False
    MsgItemMovement -> Bool
False
    MsgActionMinor -> Bool
False
    MsgEffectMinor -> Bool
False
    MsgMiscellanous -> Bool
False  -- taunts are colourful, but spammy
    MsgHeardOutside -> Bool
False  -- cause must be 'profound', but even taunts are
    MsgHeardFaraway -> Bool
False
    -- MsgHeardNearby interrupts, even if running started while hearing close
    MsgRangedOthers -> Bool
False
    MsgAtFeetMinor -> Bool
False
    _ -> Bool
True
  MsgClassShow x :: MsgClassShow
x -> case MsgClassShow
x of
    MsgPromptGeneric -> Bool
False
    MsgPromptFocus -> Bool
False
    MsgPromptMention -> Bool
False
    MsgPromptModify -> Bool
False
    MsgPromptActors -> Bool
False
    MsgPromptItems -> Bool
False
    MsgPromptAction -> Bool
False
    MsgActionAlert -> Bool
True  -- action alerts or questions cause alarm
    MsgSpottedThreat -> Bool
True
  MsgClassSave x :: MsgClassSave
x -> case MsgClassSave
x of
    MsgInnerWorkSpam -> Bool
False
    MsgNumericReport -> Bool
False
  MsgClassIgnore x :: MsgClassIgnore
x -> case MsgClassIgnore
x of
    MsgMacroOperation -> Bool
False
    MsgRunStopReason -> Bool
True
    MsgStopPlayback -> Bool
True
  MsgClassDistinct x :: MsgClassDistinct
x -> case MsgClassDistinct
x of
    MsgSpottedItem -> Bool
False
    MsgStatusLongThem -> Bool
False
    MsgStatusOthers -> Bool
False
    MsgStatusBenign -> Bool
False
    MsgStatusWarning -> Bool
False
    _ -> Bool
True

disturbsResting :: MsgClass -> Bool
disturbsResting :: MsgClass -> Bool
disturbsResting = \case
  MsgClassShowAndSave x :: MsgClassShowAndSave
x -> case MsgClassShowAndSave
x of
    MsgPointmanSwap -> Bool
False  -- handled separately
    MsgItemDiscovery -> Bool
False  -- medium importance
    MsgHeardNearby -> Bool
False  -- handled separately; no disturbance if old
    _ -> MsgClass -> Bool
interruptsRunning (MsgClass -> Bool) -> MsgClass -> Bool
forall a b. (a -> b) -> a -> b
$ MsgClassShowAndSave -> MsgClass
MsgClassShowAndSave MsgClassShowAndSave
x
  msgClass :: MsgClass
msgClass -> MsgClass -> Bool
interruptsRunning MsgClass
msgClass

scrapsRepeats :: MsgClass -> Bool
scrapsRepeats :: MsgClass -> Bool
scrapsRepeats = \case
  MsgClassShowAndSave x :: MsgClassShowAndSave
x -> case MsgClassShowAndSave
x of
    MsgBookKeeping -> Bool
False  -- too important to scrap
    MsgDeathDeafeat -> Bool
False
    MsgRiskOfDeath -> Bool
False
    MsgFinalOutcome -> Bool
False
    _ -> Bool
True
  MsgClassShow x :: MsgClassShow
x -> case MsgClassShow
x of
    MsgPromptGeneric -> Bool
False
    MsgPromptFocus -> Bool
False
    MsgPromptMention -> Bool
False
    MsgPromptModify -> Bool
False
    MsgPromptActors -> Bool
False
    MsgPromptItems -> Bool
False
    MsgPromptAction -> Bool
False
    MsgActionAlert -> Bool
False
    MsgSpottedThreat -> Bool
True
  MsgClassSave x :: MsgClassSave
x -> case MsgClassSave
x of
    MsgInnerWorkSpam -> Bool
True
    MsgNumericReport -> Bool
True
  MsgClassIgnore _ -> Bool
False  -- ignored, so no need to scrap
  MsgClassDistinct x :: MsgClassDistinct
x -> case MsgClassDistinct
x of
    _ -> Bool
True

tutorialHint :: MsgClass -> Bool
tutorialHint :: MsgClass -> Bool
tutorialHint = \case
  MsgClassShowAndSave x :: MsgClassShowAndSave
x -> case MsgClassShowAndSave
x of  -- show and save: least surprise
    MsgTutorialHint -> Bool
True
    _ -> Bool
False
  MsgClassShow _ -> Bool
False
  MsgClassSave _ -> Bool
False
  MsgClassIgnore _ -> Bool
False
  MsgClassDistinct _ -> Bool
False

-- Only initially @White@ colour in text (e.g., not highlighted @BrWhite@)
-- gets replaced by the one indicated.
msgColor :: MsgClass -> Color.Color
msgColor :: MsgClass -> Color
msgColor = \case
  MsgClassShowAndSave x :: MsgClassShowAndSave
x -> case MsgClassShowAndSave
x of
    MsgBookKeeping -> Color
Color.cBoring
    MsgStatusWakeup -> Color
Color.cWakeUp
    MsgStatusStopUs -> Color
Color.cBoring
    MsgStatusStopThem -> Color
Color.cBoring
    MsgItemCreation -> Color
Color.cGreed
    MsgItemRuination -> Color
Color.cBoring  -- common, colourful components created
    MsgDeathVictory -> Color
Color.cVeryGoodEvent
    MsgDeathDeafeat -> Color
Color.cVeryBadEvent
    MsgDeathBoring -> Color
Color.cBoring
    MsgRiskOfDeath -> Color
Color.cGraveRisk
    MsgPointmanSwap -> Color
Color.cBoring
    MsgFactionIntel -> Color
Color.cMeta  -- good or bad
    MsgFinalOutcome -> Color
Color.cGameOver
    MsgPlotExposition -> Color
Color.cBoring
    MsgBackdropInfo -> Color
Color.cBoring
    MsgTerrainReveal -> Color
Color.cIdentification
    MsgItemDiscovery -> Color
Color.cIdentification
    MsgSpottedActor -> Color
Color.cBoring  -- common; warning in @MsgSpottedThreat@
    MsgItemMovement -> Color
Color.cBoring
    MsgActionMajor -> Color
Color.cBoring
    MsgActionMinor -> Color
Color.cBoring
    MsgEffectMajor -> Color
Color.cRareNeutralEvent
    MsgEffectMedium -> Color
Color.cNeutralEvent
    MsgEffectMinor -> Color
Color.cBoring
    MsgMiscellanous -> Color
Color.cBoring
    MsgHeardOutside -> Color
Color.cBoring
    MsgHeardNearby -> Color
Color.cGraveRisk
    MsgHeardFaraway -> Color
Color.cRisk
    MsgBackdropFocus -> Color
Color.cVista
    MsgActionWarning -> Color
Color.cMeta
    MsgRangedMightyWe -> Color
Color.cGoodEvent
    MsgRangedMightyUs -> Color
Color.cVeryBadEvent
    MsgRangedOthers -> Color
Color.cBoring
    MsgRangedNormalUs -> Color
Color.cBadEvent
    MsgGoodMiscEvent -> Color
Color.cGoodEvent
    MsgBadMiscEvent -> Color
Color.cBadEvent
    MsgNeutralEvent -> Color
Color.cNeutralEvent
    MsgSpecialEvent -> Color
Color.cRareNeutralEvent
    MsgMeleeMightyWe -> Color
Color.cGoodEvent
    MsgMeleeMightyUs -> Color
Color.cVeryBadEvent
    MsgMeleeComplexWe -> Color
Color.cGoodEvent
    MsgMeleeComplexUs -> Color
Color.cBadEvent
    MsgMeleeOthers -> Color
Color.cBoring
    MsgMeleeNormalUs -> Color
Color.cBadEvent
    MsgActionComplete -> Color
Color.cBoring
    MsgAtFeetMajor -> Color
Color.cBoring
    MsgAtFeetMinor -> Color
Color.cBoring
    MsgTutorialHint -> Color
Color.cTutorialHint
  MsgClassShow x :: MsgClassShow
x -> case MsgClassShow
x of
    MsgPromptGeneric -> Color
Color.cBoring
    MsgPromptFocus -> Color
Color.cVista
    MsgPromptMention -> Color
Color.cNeutralEvent
    MsgPromptModify -> Color
Color.cRareNeutralEvent
    MsgPromptActors -> Color
Color.cRisk
    MsgPromptItems -> Color
Color.cGreed
    MsgPromptAction -> Color
Color.cMeta
    MsgActionAlert -> Color
Color.cMeta
    MsgSpottedThreat -> Color
Color.cGraveRisk
  MsgClassSave x :: MsgClassSave
x -> case MsgClassSave
x of
    MsgInnerWorkSpam -> Color
Color.cBoring
    MsgNumericReport -> Color
Color.cBoring
  MsgClassIgnore x :: MsgClassIgnore
x -> case MsgClassIgnore
x of
    MsgMacroOperation -> Color
Color.cBoring
    MsgRunStopReason -> Color
Color.cBoring
    MsgStopPlayback -> Color
Color.cMeta
  MsgClassDistinct x :: MsgClassDistinct
x -> case MsgClassDistinct
x of
    MsgSpottedItem -> Color
Color.cBoring
    MsgStatusSleep -> Color
Color.cSleep
    MsgStatusGoodUs -> Color
Color.cGoodEvent
    MsgStatusBadUs -> Color
Color.cBadEvent
    MsgStatusOthers -> Color
Color.cBoring
    MsgStatusBenign -> Color
Color.cBoring
    MsgStatusWarning -> Color
Color.cMeta
    MsgStatusLongerUs -> Color
Color.cBoring  -- not important enough
    MsgStatusLongThem -> Color
Color.cBoring  -- not important enough, no disturb even

-- * Report

data RepMsgNK = RepMsgNK {RepMsgNK -> Msg
repMsg :: Msg, RepMsgNK -> Int
_repShow :: Int, RepMsgNK -> Int
_repSave :: Int}
  deriving (Int -> RepMsgNK -> ShowS
[RepMsgNK] -> ShowS
RepMsgNK -> String
(Int -> RepMsgNK -> ShowS)
-> (RepMsgNK -> String) -> ([RepMsgNK] -> ShowS) -> Show RepMsgNK
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepMsgNK] -> ShowS
$cshowList :: [RepMsgNK] -> ShowS
show :: RepMsgNK -> String
$cshow :: RepMsgNK -> String
showsPrec :: Int -> RepMsgNK -> ShowS
$cshowsPrec :: Int -> RepMsgNK -> ShowS
Show, (forall x. RepMsgNK -> Rep RepMsgNK x)
-> (forall x. Rep RepMsgNK x -> RepMsgNK) -> Generic RepMsgNK
forall x. Rep RepMsgNK x -> RepMsgNK
forall x. RepMsgNK -> Rep RepMsgNK x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RepMsgNK x -> RepMsgNK
$cfrom :: forall x. RepMsgNK -> Rep RepMsgNK x
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 -> Bool
nullRepMsgNK (RepMsgNK Msg{..} _ _) =
  (AttrCharW32 -> Bool) -> AttrString -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Bool
Char.isSpace (Char -> Bool) -> (AttrCharW32 -> Char) -> AttrCharW32 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrCharW32 -> Char
Color.charFromW32) AttrString
msgShow
  Bool -> Bool -> Bool
&& (AttrCharW32 -> Bool) -> AttrString -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Bool
Char.isSpace (Char -> Bool) -> (AttrCharW32 -> Char) -> AttrCharW32 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrCharW32 -> Char
Color.charFromW32) AttrString
msgSave

-- | The set of messages, with repetitions, to show at the screen at once.
newtype Report = Report [RepMsgNK]
  deriving (Int -> Report -> ShowS
[Report] -> ShowS
Report -> String
(Int -> Report -> ShowS)
-> (Report -> String) -> ([Report] -> ShowS) -> Show Report
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Report] -> ShowS
$cshowList :: [Report] -> ShowS
show :: Report -> String
$cshow :: Report -> String
showsPrec :: Int -> Report -> ShowS
$cshowsPrec :: Int -> Report -> ShowS
Show, Get Report
[Report] -> Put
Report -> Put
(Report -> Put) -> Get Report -> ([Report] -> Put) -> Binary Report
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Report] -> Put
$cputList :: [Report] -> Put
get :: Get Report
$cget :: Get Report
put :: Report -> Put
$cput :: Report -> Put
Binary)

-- | Empty set of messages.
emptyReport :: Report
emptyReport :: Report
emptyReport = Bool -> Report -> Report
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (let checkLen :: MsgClass -> Bool
checkLen msgClass :: MsgClass
msgClass =
                            let len :: Int
len = String -> Int
forall a. [a] -> Int
length (MsgClass -> String
showSimpleMsgClass MsgClass
msgClass)
                            in Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 14 Bool -> Bool -> Bool
&& Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 17
                          l :: [MsgClass]
l = (MsgClassShowAndSave -> MsgClass)
-> [MsgClassShowAndSave] -> [MsgClass]
forall a b. (a -> b) -> [a] -> [b]
map MsgClassShowAndSave -> MsgClass
MsgClassShowAndSave [MsgClassShowAndSave
forall a. Bounded a => a
minBound .. MsgClassShowAndSave
forall a. Bounded a => a
maxBound]
                              [MsgClass] -> [MsgClass] -> [MsgClass]
forall a. [a] -> [a] -> [a]
++ (MsgClassShow -> MsgClass) -> [MsgClassShow] -> [MsgClass]
forall a b. (a -> b) -> [a] -> [b]
map MsgClassShow -> MsgClass
MsgClassShow [MsgClassShow
forall a. Bounded a => a
minBound .. MsgClassShow
forall a. Bounded a => a
maxBound]
                              [MsgClass] -> [MsgClass] -> [MsgClass]
forall a. [a] -> [a] -> [a]
++ (MsgClassSave -> MsgClass) -> [MsgClassSave] -> [MsgClass]
forall a b. (a -> b) -> [a] -> [b]
map MsgClassSave -> MsgClass
MsgClassSave [MsgClassSave
forall a. Bounded a => a
minBound .. MsgClassSave
forall a. Bounded a => a
maxBound]
                              [MsgClass] -> [MsgClass] -> [MsgClass]
forall a. [a] -> [a] -> [a]
++ (MsgClassIgnore -> MsgClass) -> [MsgClassIgnore] -> [MsgClass]
forall a b. (a -> b) -> [a] -> [b]
map MsgClassIgnore -> MsgClass
MsgClassIgnore [MsgClassIgnore
forall a. Bounded a => a
minBound .. MsgClassIgnore
forall a. Bounded a => a
maxBound]
                              [MsgClass] -> [MsgClass] -> [MsgClass]
forall a. [a] -> [a] -> [a]
++ (MsgClassDistinct -> MsgClass) -> [MsgClassDistinct] -> [MsgClass]
forall a b. (a -> b) -> [a] -> [b]
map MsgClassDistinct -> MsgClass
MsgClassDistinct [MsgClassDistinct
forall a. Bounded a => a
minBound .. MsgClassDistinct
forall a. Bounded a => a
maxBound]
                      in (MsgClass -> Bool) -> [MsgClass] -> Bool
forall a. Show a => (a -> Bool) -> [a] -> Bool
allB MsgClass -> Bool
checkLen [MsgClass]
l)
              (Report -> Report) -> Report -> Report
forall a b. (a -> b) -> a -> b
$ [RepMsgNK] -> Report
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 -> Bool
nullVisibleReport (Report l :: [RepMsgNK]
l) =
  (RepMsgNK -> Bool) -> [RepMsgNK] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((AttrCharW32 -> Bool) -> AttrString -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Bool
Char.isSpace (Char -> Bool) -> (AttrCharW32 -> Char) -> AttrCharW32 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrCharW32 -> Char
Color.charFromW32) (AttrString -> Bool)
-> (RepMsgNK -> AttrString) -> RepMsgNK -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Msg -> AttrString
msgShow (Msg -> AttrString) -> (RepMsgNK -> Msg) -> RepMsgNK -> AttrString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepMsgNK -> Msg
repMsg) [RepMsgNK]
l

-- | Add a message to the start of report.
consReport :: Msg -> Report -> Report
consReport :: Msg -> Report -> Report
consReport msg :: Msg
msg (Report r :: [RepMsgNK]
r) = [RepMsgNK] -> Report
Report ([RepMsgNK] -> Report) -> [RepMsgNK] -> Report
forall a b. (a -> b) -> a -> b
$ [RepMsgNK]
r [RepMsgNK] -> [RepMsgNK] -> [RepMsgNK]
forall a. [a] -> [a] -> [a]
++ [Msg -> Int -> Int -> RepMsgNK
RepMsgNK Msg
msg 1 1]

-- | Render a report as a (possibly very long) 'AttrString'. Filter out
-- messages not meant for display, unless not showing, but saving to history.
renderReport :: Bool -> Report -> [AttrString]
renderReport :: Bool -> Report -> [AttrString]
renderReport displaying :: Bool
displaying (Report r :: [RepMsgNK]
r) =
  let rep :: [(AttrString, Int)]
rep = (RepMsgNK -> (AttrString, Int))
-> [RepMsgNK] -> [(AttrString, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(RepMsgNK msg :: Msg
msg n :: Int
n k :: Int
k) -> if Bool
displaying
                                        then (Msg -> AttrString
msgShow Msg
msg, Int
n)
                                        else (Msg -> AttrString
msgSave Msg
msg, Int
k)) [RepMsgNK]
r
  in [(AttrString, Int)] -> [AttrString] -> [AttrString]
renderWholeReport [(AttrString, Int)]
rep []

-- | Render a report as a (possibly very long) 'AttrString'.
renderWholeReport :: [(AttrString, Int)] -> [AttrString] -> [AttrString]
renderWholeReport :: [(AttrString, Int)] -> [AttrString] -> [AttrString]
renderWholeReport [] acc :: [AttrString]
acc = [AttrString]
acc
renderWholeReport (x :: (AttrString, Int)
x : xs :: [(AttrString, Int)]
xs) acc :: [AttrString]
acc = [(AttrString, Int)] -> [AttrString] -> [AttrString]
renderWholeReport [(AttrString, Int)]
xs ((AttrString, Int) -> AttrString
renderRepetition (AttrString, Int)
x AttrString -> [AttrString] -> [AttrString]
forall a. a -> [a] -> [a]
: [AttrString]
acc)

renderRepetition :: (AttrString, Int) -> AttrString
renderRepetition :: (AttrString, Int) -> AttrString
renderRepetition (asRaw :: AttrString
asRaw, n :: Int
n) =
  let as :: AttrString
as = (AttrCharW32 -> Bool) -> AttrString -> AttrString
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Bool
Char.isSpace (Char -> Bool) -> (AttrCharW32 -> Char) -> AttrCharW32 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrCharW32 -> Char
Color.charFromW32) AttrString
asRaw
  in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 1 Bool -> Bool -> Bool
|| AttrString -> Bool
forall a. [a] -> Bool
null AttrString
as
     then AttrString
as
     else AttrString
as AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ String -> AttrString
stringToAS ("<x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ ">")

anyInReport :: (MsgClass -> Bool) -> Report -> Bool
anyInReport :: (MsgClass -> Bool) -> Report -> Bool
anyInReport f :: MsgClass -> Bool
f (Report xns :: [RepMsgNK]
xns) = (RepMsgNK -> Bool) -> [RepMsgNK] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (MsgClass -> Bool
f (MsgClass -> Bool) -> (RepMsgNK -> MsgClass) -> RepMsgNK -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Msg -> MsgClass
msgClass(Msg -> MsgClass) -> (RepMsgNK -> Msg) -> RepMsgNK -> MsgClass
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepMsgNK -> Msg
repMsg) [RepMsgNK]
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
  { History -> Report
newReport       :: Report
  , History -> Time
newTime         :: Time
  , History -> Report
oldReport       :: Report
  , History -> Time
oldTime         :: Time
  , History -> RingBuffer UAttrString
archivedHistory :: RB.RingBuffer UAttrString }
  deriving (Int -> History -> ShowS
[History] -> ShowS
History -> String
(Int -> History -> ShowS)
-> (History -> String) -> ([History] -> ShowS) -> Show History
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [History] -> ShowS
$cshowList :: [History] -> ShowS
show :: History -> String
$cshow :: History -> String
showsPrec :: Int -> History -> ShowS
$cshowsPrec :: Int -> History -> ShowS
Show, (forall x. History -> Rep History x)
-> (forall x. Rep History x -> History) -> Generic History
forall x. Rep History x -> History
forall x. History -> Rep History x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep History x -> History
$cfrom :: forall x. History -> Rep History x
Generic)

instance Binary History

-- | Empty history of the given maximal length.
emptyHistory :: Int -> History
emptyHistory :: Int -> History
emptyHistory size :: Int
size =
  let ringBufferSize :: Int
ringBufferSize = Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1  -- a report resides outside the buffer
  in Report
-> Time -> Report -> Time -> RingBuffer UAttrString -> History
History Report
emptyReport Time
timeZero Report
emptyReport Time
timeZero
             (Int -> UAttrString -> RingBuffer UAttrString
forall a. Int -> a -> RingBuffer a
RB.empty Int
ringBufferSize UAttrString
forall a. Unbox a => Vector a
U.empty)

scrapRepetitionSingle :: (AttrString, Int)
                      -> [(AttrString, Int)]
                      -> [(AttrString, Int)]
                      -> (Bool, [(AttrString, Int)], [(AttrString, Int)])
scrapRepetitionSingle :: (AttrString, Int)
-> [(AttrString, Int)]
-> [(AttrString, Int)]
-> (Bool, [(AttrString, Int)], [(AttrString, Int)])
scrapRepetitionSingle (s1 :: AttrString
s1, n1 :: Int
n1) rest1 :: [(AttrString, Int)]
rest1 oldMsgs :: [(AttrString, Int)]
oldMsgs =
  let butLastEOLs :: AttrString -> AttrString
butLastEOLs = (AttrCharW32 -> Bool) -> AttrString -> AttrString
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd ((Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n') (Char -> Bool) -> (AttrCharW32 -> Char) -> AttrCharW32 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrCharW32 -> Char
Color.charFromW32)
      eqs1 :: (AttrString, Int) -> Bool
eqs1 (s2 :: AttrString
s2, _) = AttrString -> AttrString
butLastEOLs AttrString
s1 AttrString -> AttrString -> Bool
forall a. Eq a => a -> a -> Bool
== AttrString -> AttrString
butLastEOLs AttrString
s2
  in case ((AttrString, Int) -> Bool)
-> [(AttrString, Int)]
-> ([(AttrString, Int)], [(AttrString, Int)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (AttrString, Int) -> Bool
eqs1 [(AttrString, Int)]
rest1 of
    (_, []) -> case ((AttrString, Int) -> Bool)
-> [(AttrString, Int)]
-> ([(AttrString, Int)], [(AttrString, Int)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (AttrString, Int) -> Bool
eqs1 [(AttrString, Int)]
oldMsgs of
      (noDup :: [(AttrString, Int)]
noDup, (_, n2 :: Int
n2) : rest2 :: [(AttrString, Int)]
rest2) ->
        -- We keep the occurence of the message in the new report only.
        let newReport :: [(AttrString, Int)]
newReport = (AttrString
s1, Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2) (AttrString, Int) -> [(AttrString, Int)] -> [(AttrString, Int)]
forall a. a -> [a] -> [a]
: [(AttrString, Int)]
rest1
            oldReport :: [(AttrString, Int)]
oldReport = [(AttrString, Int)]
noDup [(AttrString, Int)] -> [(AttrString, Int)] -> [(AttrString, Int)]
forall a. [a] -> [a] -> [a]
++ ([], 0) (AttrString, Int) -> [(AttrString, Int)] -> [(AttrString, Int)]
forall a. a -> [a] -> [a]
: [(AttrString, Int)]
rest2
        in (Bool
True, [(AttrString, Int)]
newReport, [(AttrString, Int)]
oldReport)
      _ -> (Bool
False, (AttrString
s1, Int
n1) (AttrString, Int) -> [(AttrString, Int)] -> [(AttrString, Int)]
forall a. a -> [a] -> [a]
: [(AttrString, Int)]
rest1, [(AttrString, Int)]
oldMsgs)
    (noDup :: [(AttrString, Int)]
noDup, (s2 :: AttrString
s2, n2 :: Int
n2) : rest3 :: [(AttrString, Int)]
rest3) ->
      -- We keep the older (and so, oldest) occurence of the message,
      -- to avoid visual disruption by moving the message around.
      let newReport :: [(AttrString, Int)]
newReport = ([], 0) (AttrString, Int) -> [(AttrString, Int)] -> [(AttrString, Int)]
forall a. a -> [a] -> [a]
: [(AttrString, Int)]
noDup [(AttrString, Int)] -> [(AttrString, Int)] -> [(AttrString, Int)]
forall a. [a] -> [a] -> [a]
++ (AttrString
s2, Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2) (AttrString, Int) -> [(AttrString, Int)] -> [(AttrString, Int)]
forall a. a -> [a] -> [a]
: [(AttrString, Int)]
rest3
          oldReport :: [(AttrString, Int)]
oldReport = [(AttrString, Int)]
oldMsgs
      in (Bool
True, [(AttrString, Int)]
newReport, [(AttrString, Int)]
oldReport)

scrapRepetition :: History -> Maybe History
scrapRepetition :: History -> Maybe History
scrapRepetition History{ newReport :: History -> Report
newReport = Report newMsgs :: [RepMsgNK]
newMsgs
                       , oldReport :: History -> Report
oldReport = Report oldMsgs :: [RepMsgNK]
oldMsgs
                       , .. } =
  case [RepMsgNK]
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 :: Msg
msg1 n1 :: Int
n1 k1 :: Int
k1 : rest1 :: [RepMsgNK]
rest1 ->
      let -- We ignore message classes and scrap even if same strings
          -- come from different classes. Otherwise user would be confused.
          makeShow :: [RepMsgNK] -> [(AttrString, Int)]
makeShow = (RepMsgNK -> (AttrString, Int))
-> [RepMsgNK] -> [(AttrString, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(RepMsgNK msg :: Msg
msg n :: Int
n _) -> (Msg -> AttrString
msgShow Msg
msg, Int
n))
          makeSave :: [RepMsgNK] -> [(AttrString, Int)]
makeSave = (RepMsgNK -> (AttrString, Int))
-> [RepMsgNK] -> [(AttrString, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(RepMsgNK msg :: Msg
msg _ k :: Int
k) -> (Msg -> AttrString
msgSave Msg
msg, Int
k))
          (scrapShowNeeded :: Bool
scrapShowNeeded, scrapShowNew :: [(AttrString, Int)]
scrapShowNew, scrapShowOld :: [(AttrString, Int)]
scrapShowOld) =
            (AttrString, Int)
-> [(AttrString, Int)]
-> [(AttrString, Int)]
-> (Bool, [(AttrString, Int)], [(AttrString, Int)])
scrapRepetitionSingle (Msg -> AttrString
msgShow Msg
msg1, Int
n1)
                                  ([RepMsgNK] -> [(AttrString, Int)]
makeShow [RepMsgNK]
rest1)
                                  ([RepMsgNK] -> [(AttrString, Int)]
makeShow [RepMsgNK]
oldMsgs)
          (scrapSaveNeeded :: Bool
scrapSaveNeeded, scrapSaveNew :: [(AttrString, Int)]
scrapSaveNew, scrapSaveOld :: [(AttrString, Int)]
scrapSaveOld) =
            (AttrString, Int)
-> [(AttrString, Int)]
-> [(AttrString, Int)]
-> (Bool, [(AttrString, Int)], [(AttrString, Int)])
scrapRepetitionSingle (Msg -> AttrString
msgSave Msg
msg1, Int
k1)
                                  ([RepMsgNK] -> [(AttrString, Int)]
makeSave [RepMsgNK]
rest1)
                                  ([RepMsgNK] -> [(AttrString, Int)]
makeSave [RepMsgNK]
oldMsgs)
      in if Bool
scrapShowNeeded Bool -> Bool -> Bool
|| Bool
scrapSaveNeeded
         then let combineMsg :: Msg -> (AttrString, Int) -> (AttrString, Int) -> Maybe RepMsgNK
combineMsg _ ([], _) ([], _) = Maybe RepMsgNK
forall a. Maybe a
Nothing
                  combineMsg msg :: Msg
msg (s :: AttrString
s, n :: Int
n) (t :: AttrString
t, k :: Int
k) = RepMsgNK -> Maybe RepMsgNK
forall a. a -> Maybe a
Just (RepMsgNK -> Maybe RepMsgNK) -> RepMsgNK -> Maybe RepMsgNK
forall a b. (a -> b) -> a -> b
$
                    Msg -> Int -> Int -> RepMsgNK
RepMsgNK Msg
msg{msgShow :: AttrString
msgShow = AttrString
s, msgSave :: AttrString
msgSave = AttrString
t} Int
n Int
k
                  zipMsg :: [RepMsgNK] -> [(AttrString, Int)] -> [(AttrString, Int)] -> Report
zipMsg l1 :: [RepMsgNK]
l1 l2 :: [(AttrString, Int)]
l2 l3 :: [(AttrString, Int)]
l3 = [RepMsgNK] -> Report
Report ([RepMsgNK] -> Report) -> [RepMsgNK] -> Report
forall a b. (a -> b) -> a -> b
$ [Maybe RepMsgNK] -> [RepMsgNK]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe RepMsgNK] -> [RepMsgNK]) -> [Maybe RepMsgNK] -> [RepMsgNK]
forall a b. (a -> b) -> a -> b
$
                    (Msg -> (AttrString, Int) -> (AttrString, Int) -> Maybe RepMsgNK)
-> [Msg]
-> [(AttrString, Int)]
-> [(AttrString, Int)]
-> [Maybe RepMsgNK]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Msg -> (AttrString, Int) -> (AttrString, Int) -> Maybe RepMsgNK
combineMsg ((RepMsgNK -> Msg) -> [RepMsgNK] -> [Msg]
forall a b. (a -> b) -> [a] -> [b]
map RepMsgNK -> Msg
repMsg [RepMsgNK]
l1) [(AttrString, Int)]
l2 [(AttrString, Int)]
l3
                  newReport :: Report
newReport = [RepMsgNK] -> [(AttrString, Int)] -> [(AttrString, Int)] -> Report
zipMsg [RepMsgNK]
newMsgs [(AttrString, Int)]
scrapShowNew [(AttrString, Int)]
scrapSaveNew
                  oldReport :: Report
oldReport = [RepMsgNK] -> [(AttrString, Int)] -> [(AttrString, Int)] -> Report
zipMsg [RepMsgNK]
oldMsgs [(AttrString, Int)]
scrapShowOld [(AttrString, Int)]
scrapSaveOld
              in History -> Maybe History
forall a. a -> Maybe a
Just $WHistory :: Report
-> Time -> Report -> Time -> RingBuffer UAttrString -> History
History{..}
         else Maybe History
forall a. Maybe a
Nothing
    _ -> String -> Maybe History
forall a. (?callStack::CallStack) => String -> a
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 :: Set Msg
-> Bool
-> Bool
-> History
-> Msg
-> Time
-> (Set Msg, History, Bool)
addToReport usedHints :: Set Msg
usedHints displayHints :: Bool
displayHints inMelee :: Bool
inMelee
            oldHistory :: History
oldHistory@History{newReport :: History -> Report
newReport = Report r :: [RepMsgNK]
r, ..} msgRaw :: Msg
msgRaw time :: Time
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 :: MsgClass -> Bool
isMsgClassShow = \case
        MsgClassShow{} -> Bool
True
        _ -> Bool
False
      msg :: Msg
msg = if Bool
inMelee
               Bool -> Bool -> Bool
&& Bool -> Bool
not (MsgClass -> Bool
interruptsRunning (Msg -> MsgClass
msgClass Msg
msgRaw))
               Bool -> Bool -> Bool
&& Bool -> Bool
not (MsgClass -> Bool
isMsgClassShow (MsgClass -> Bool) -> MsgClass -> Bool
forall a b. (a -> b) -> a -> b
$ Msg -> MsgClass
msgClass Msg
msgRaw)
            then Msg
msgRaw {msgShow :: AttrString
msgShow = []}
            else Msg
msgRaw
      repMsgNK :: RepMsgNK
repMsgNK = Msg -> Int -> Int -> RepMsgNK
RepMsgNK Msg
msg 1 1
      newH :: History
newH = $WHistory :: Report
-> Time -> Report -> Time -> RingBuffer UAttrString -> History
History { newReport :: Report
newReport = [RepMsgNK] -> Report
Report ([RepMsgNK] -> Report) -> [RepMsgNK] -> Report
forall a b. (a -> b) -> a -> b
$ RepMsgNK
repMsgNK RepMsgNK -> [RepMsgNK] -> [RepMsgNK]
forall a. a -> [a] -> [a]
: [RepMsgNK]
r
                     , newTime :: Time
newTime = Time
time
                     , .. }
      msgIsHint :: Bool
msgIsHint = MsgClass -> Bool
tutorialHint (Msg -> MsgClass
msgClass Msg
msg)
      msgUsedAsHit :: Bool
msgUsedAsHit = Msg -> Set Msg -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Msg
msg Set Msg
usedHints
      newUsedHints :: Set Msg
newUsedHints = if Bool
msgIsHint Bool -> Bool -> Bool
&& Bool
displayHints Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
msgUsedAsHit
                     then Msg -> Set Msg -> Set Msg
forall a. Ord a => a -> Set a -> Set a
S.insert Msg
msg Set Msg
usedHints
                     else Set Msg
usedHints
  in -- Tutorial hint shown only when tutorial enabled and hint not yet shown.
     if | Bool
msgIsHint Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
displayHints Bool -> Bool -> Bool
|| Bool
msgUsedAsHit) ->
          (Set Msg
usedHints, History
oldHistory, Bool
False)
        | Bool -> Bool
not (MsgClass -> Bool
scrapsRepeats (MsgClass -> Bool) -> MsgClass -> Bool
forall a b. (a -> b) -> a -> b
$ Msg -> MsgClass
msgClass Msg
msg)
          Bool -> Bool -> Bool
|| RepMsgNK -> Bool
nullRepMsgNK RepMsgNK
repMsgNK ->
          -- Don't waste time on never shown messages.
          (Set Msg
newUsedHints, History
newH, Bool
False)
        | Bool
otherwise -> case History -> Maybe History
scrapRepetition History
newH of
            Just scrappedH :: History
scrappedH -> (Set Msg
newUsedHints, History
scrappedH, Bool
True)
            Nothing -> (Set Msg
newUsedHints, History
newH, Bool
False)

-- | Add a newline to end of the new report of history, unless empty.
addEolToNewReport :: History -> History
addEolToNewReport :: History -> History
addEolToNewReport hist :: History
hist =
  let addEolToReport :: Report -> Report
addEolToReport (Report []) = [RepMsgNK] -> Report
Report []
      addEolToReport (Report (hd :: RepMsgNK
hd : tl :: [RepMsgNK]
tl)) = [RepMsgNK] -> Report
Report ([RepMsgNK] -> Report) -> [RepMsgNK] -> Report
forall a b. (a -> b) -> a -> b
$ RepMsgNK -> RepMsgNK
addEolToRepMsgNK RepMsgNK
hd RepMsgNK -> [RepMsgNK] -> [RepMsgNK]
forall a. a -> [a] -> [a]
: [RepMsgNK]
tl
      addEolToRepMsgNK :: RepMsgNK -> RepMsgNK
addEolToRepMsgNK rm :: RepMsgNK
rm = RepMsgNK
rm {repMsg :: Msg
repMsg = Msg -> Msg
addEolToMsg (Msg -> Msg) -> Msg -> Msg
forall a b. (a -> b) -> a -> b
$ RepMsgNK -> Msg
repMsg RepMsgNK
rm}
      addEolToMsg :: Msg -> Msg
addEolToMsg msg :: Msg
msg = Msg
msg { msgShow :: AttrString
msgShow = AttrString -> AttrString
addEolToAS (AttrString -> AttrString) -> AttrString -> AttrString
forall a b. (a -> b) -> a -> b
$ Msg -> AttrString
msgShow Msg
msg
                            , msgSave :: AttrString
msgSave = AttrString -> AttrString
addEolToAS (AttrString -> AttrString) -> AttrString -> AttrString
forall a b. (a -> b) -> a -> b
$ Msg -> AttrString
msgSave Msg
msg }
      addEolToAS :: AttrString -> AttrString
addEolToAS as :: AttrString
as = AttrString
as AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ String -> AttrString
stringToAS "\n"
  in History
hist {newReport :: Report
newReport = Report -> Report
addEolToReport (Report -> Report) -> Report -> Report
forall a b. (a -> b) -> a -> b
$ History -> Report
newReport History
hist}

-- | Archive old report to history, filtering out messages with 0 duplicates
-- and prompts. Set up new report with a new timestamp.
archiveReport :: Bool -> History -> History
archiveReport :: Bool -> History -> History
archiveReport uHistory1PerLine :: Bool
uHistory1PerLine History{newReport :: History -> Report
newReport=Report newMsgs :: [RepMsgNK]
newMsgs, ..} =
  let newFiltered :: Report
newFiltered@(Report r :: [RepMsgNK]
r) = [RepMsgNK] -> Report
Report ([RepMsgNK] -> Report) -> [RepMsgNK] -> Report
forall a b. (a -> b) -> a -> b
$ (RepMsgNK -> Bool) -> [RepMsgNK] -> [RepMsgNK]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (RepMsgNK -> Bool) -> RepMsgNK -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepMsgNK -> Bool
nullRepMsgNK) [RepMsgNK]
newMsgs
  in if [RepMsgNK] -> Bool
forall a. [a] -> Bool
null [RepMsgNK]
r
     then -- Drop empty new report.
          Report
-> Time -> Report -> Time -> RingBuffer UAttrString -> History
History Report
emptyReport Time
timeZero Report
oldReport Time
oldTime RingBuffer UAttrString
archivedHistory
     else let lU :: [UAttrString]
lU = (AttrString -> UAttrString) -> [AttrString] -> [UAttrString]
forall a b. (a -> b) -> [a] -> [b]
map AttrString -> UAttrString
attrStringToU
                   ([AttrString] -> [UAttrString]) -> [AttrString] -> [UAttrString]
forall a b. (a -> b) -> a -> b
$ Bool -> Time -> Report -> [AttrString]
renderTimeReport Bool
uHistory1PerLine Time
oldTime Report
oldReport
          in Report
-> Time -> Report -> Time -> RingBuffer UAttrString -> History
History Report
emptyReport Time
timeZero Report
newFiltered Time
newTime
             (RingBuffer UAttrString -> History)
-> RingBuffer UAttrString -> History
forall a b. (a -> b) -> a -> b
$ (RingBuffer UAttrString -> UAttrString -> RingBuffer UAttrString)
-> RingBuffer UAttrString
-> [UAttrString]
-> RingBuffer UAttrString
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ !RingBuffer UAttrString
h !UAttrString
v -> UAttrString -> RingBuffer UAttrString -> RingBuffer UAttrString
forall a. a -> RingBuffer a -> RingBuffer a
RB.cons UAttrString
v RingBuffer UAttrString
h) RingBuffer UAttrString
archivedHistory [UAttrString]
lU

renderTimeReport :: Bool -> Time -> Report -> [AttrString]
renderTimeReport :: Bool -> Time -> Report -> [AttrString]
renderTimeReport uHistory1PerLine :: Bool
uHistory1PerLine t :: Time
t rep :: Report
rep@(Report r :: [RepMsgNK]
r) =
  let turns :: Int
turns = Time
t Time -> Time -> Int
`timeFitUp` Time
timeTurn
      repMsgs :: [AttrString]
repMsgs = Bool -> Report -> [AttrString]
renderReport Bool
False Report
rep
      mgsClasses :: [String]
mgsClasses = [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (RepMsgNK -> String) -> [RepMsgNK] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (MsgClass -> String
showSimpleMsgClass (MsgClass -> String)
-> (RepMsgNK -> MsgClass) -> RepMsgNK -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Msg -> MsgClass
msgClass (Msg -> MsgClass) -> (RepMsgNK -> Msg) -> RepMsgNK -> MsgClass
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepMsgNK -> Msg
repMsg) [RepMsgNK]
r
      turnsString :: String
turnsString = Int -> String
forall a. Show a => a -> String
show Int
turns
      isSpace32 :: AttrCharW32 -> Bool
isSpace32 = Char -> Bool
Char.isSpace (Char -> Bool) -> (AttrCharW32 -> Char) -> AttrCharW32 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrCharW32 -> Char
Color.charFromW32
      worthSaving :: AttrString -> Bool
worthSaving = Bool -> Bool
not (Bool -> Bool) -> (AttrString -> Bool) -> AttrString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttrCharW32 -> Bool) -> AttrString -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all AttrCharW32 -> Bool
isSpace32
      renderAS :: AttrString -> AttrString
renderAS as :: AttrString
as = String -> AttrString
stringToAS (String
turnsString String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": ") AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ (AttrCharW32 -> Bool) -> AttrString -> AttrString
forall a. (a -> Bool) -> [a] -> [a]
dropWhile AttrCharW32 -> Bool
isSpace32 AttrString
as
      renderClass :: (AttrString, String) -> AttrString
renderClass (as :: AttrString
as, msgClassString :: String
msgClassString) =
        let lenUnderscore :: Int
lenUnderscore = 17 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
length String
msgClassString
                            Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
length String
turnsString)
        in String -> AttrString
stringToAS (String
turnsString String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":")
           AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ (Char -> AttrCharW32) -> String -> AttrString
forall a b. (a -> b) -> [a] -> [b]
map (Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
Color.BrBlack)
                  ("[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
lenUnderscore '_' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msgClassString String -> ShowS
forall a. [a] -> [a] -> [a]
++ "]")
           AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
Color.spaceAttrW32]
           AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ (AttrCharW32 -> Bool) -> AttrString -> AttrString
forall a. (a -> Bool) -> [a] -> [a]
dropWhile AttrCharW32 -> Bool
isSpace32 AttrString
as
  in if Bool
uHistory1PerLine
     then ((AttrString, String) -> AttrString)
-> [(AttrString, String)] -> [AttrString]
forall a b. (a -> b) -> [a] -> [b]
map (AttrString, String) -> AttrString
renderClass ([(AttrString, String)] -> [AttrString])
-> [(AttrString, String)] -> [AttrString]
forall a b. (a -> b) -> a -> b
$ ((AttrString, String) -> Bool)
-> [(AttrString, String)] -> [(AttrString, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (AttrString -> Bool
worthSaving (AttrString -> Bool)
-> ((AttrString, String) -> AttrString)
-> (AttrString, String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttrString, String) -> AttrString
forall a b. (a, b) -> a
fst) ([(AttrString, String)] -> [(AttrString, String)])
-> [(AttrString, String)] -> [(AttrString, String)]
forall a b. (a -> b) -> a -> b
$ [AttrString] -> [String] -> [(AttrString, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [AttrString]
repMsgs [String]
mgsClasses
     else (AttrString -> AttrString) -> [AttrString] -> [AttrString]
forall a b. (a -> b) -> [a] -> [b]
map AttrString -> AttrString
renderAS ([AttrString] -> [AttrString]) -> [AttrString] -> [AttrString]
forall a b. (a -> b) -> a -> b
$ (AttrString -> Bool) -> [AttrString] -> [AttrString]
forall a. (a -> Bool) -> [a] -> [a]
filter AttrString -> Bool
worthSaving [(AttrString -> AttrString -> AttrString)
-> AttrString -> [AttrString] -> AttrString
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AttrString -> AttrString -> AttrString
(<+:>) [] [AttrString]
repMsgs]

lengthHistory :: Bool -> History -> Int
lengthHistory :: Bool -> History -> Int
lengthHistory uHistory1PerLine :: Bool
uHistory1PerLine History{Report
oldReport :: Report
oldReport :: History -> Report
oldReport, RingBuffer UAttrString
archivedHistory :: RingBuffer UAttrString
archivedHistory :: History -> RingBuffer UAttrString
archivedHistory} =
  RingBuffer UAttrString -> Int
forall a. RingBuffer a -> Int
RB.length RingBuffer UAttrString
archivedHistory
  Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [AttrString] -> Int
forall a. [a] -> Int
length (Bool -> Time -> Report -> [AttrString]
renderTimeReport Bool
uHistory1PerLine Time
timeZero Report
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 :: Bool -> History -> [AttrString]
renderHistory :: Bool -> History -> [AttrString]
renderHistory uHistory1PerLine :: Bool
uHistory1PerLine History{..} =
  (UAttrString -> AttrString) -> [UAttrString] -> [AttrString]
forall a b. (a -> b) -> [a] -> [b]
map UAttrString -> AttrString
uToAttrString (RingBuffer UAttrString -> [UAttrString]
forall a. RingBuffer a -> [a]
RB.toList RingBuffer UAttrString
archivedHistory)
  [AttrString] -> [AttrString] -> [AttrString]
forall a. [a] -> [a] -> [a]
++ Bool -> Time -> Report -> [AttrString]
renderTimeReport Bool
uHistory1PerLine Time
oldTime Report
oldReport