{-# LANGUAGE DeriveGeneric #-}
-- | Factions taking part in the game, e.g., a hero faction, a monster faction
-- and an animal faction.
module Game.LambdaHack.Common.Faction
  ( FactionDict, Faction(..), Diplomacy(..)
  , Status(..), Challenge(..)
  , tshowChallenge, gleader, isHorrorFact, noRunWithMulti, isAIFact
  , autoDungeonLevel, automatePlayer, isFoe, isFriend
  , difficultyBound, difficultyDefault, difficultyCoeff, difficultyInverse
  , defaultChallenge, possibleActorFactions, ppContainer
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , Dipl
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Binary
import qualified Data.EnumMap.Strict as EM
import qualified Data.IntMap.Strict as IM
import qualified Data.Text as T
import           GHC.Generics (Generic)

import           Game.LambdaHack.Common.Point
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Content.ItemKind (ItemKind)
import qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Content.ModeKind
import qualified Game.LambdaHack.Definition.Ability as Ability
import qualified Game.LambdaHack.Definition.Color as Color
import           Game.LambdaHack.Definition.Defs

-- | All factions in the game, indexed by faction identifier.
type FactionDict = EM.EnumMap FactionId Faction

-- | The faction datatype.
data Faction = Faction
  { Faction -> Text
gname     :: Text            -- ^ individual name
  , Faction -> Color
gcolor    :: Color.Color     -- ^ color of actors or their frames
  , Faction -> Player
gplayer   :: Player          -- ^ the player spec for this faction
  , Faction -> Maybe TeamContinuity
gteamCont :: Maybe TeamContinuity
                                 -- ^ identity of this faction across games
                                 --   and scenarios
  , Faction -> [(Int, Int, GroupName ItemKind)]
ginitial  :: [(Int, Int, GroupName ItemKind)]  -- ^ initial actors
  , Faction -> Dipl
gdipl     :: Dipl            -- ^ diplomatic standing
  , Faction -> Maybe Status
gquit     :: Maybe Status    -- ^ cause of game end/exit
  , Faction -> Maybe ActorId
_gleader  :: Maybe ActorId   -- ^ the leader of the faction; don't use
                                 --   in place of sleader on clients
  , Faction -> Maybe (LevelId, Point)
gstash    :: Maybe (LevelId, Point)
                                 -- ^ level and position of faction's
                                 --   shared inventory stash
  , Faction -> EnumMap (ContentId ItemKind) Int
gvictims  :: EM.EnumMap (ContentId ItemKind) Int  -- ^ members killed
  , Faction
-> EnumMap
     (ContentId ModeKind) (IntMap (EnumMap (ContentId ItemKind) Int))
gvictimsD :: EM.EnumMap (ContentId ModeKind)
                            (IM.IntMap (EM.EnumMap (ContentId ItemKind) Int))
      -- ^ members killed in the past, by game mode and difficulty level
  }
  deriving (Int -> Faction -> ShowS
[Faction] -> ShowS
Faction -> String
(Int -> Faction -> ShowS)
-> (Faction -> String) -> ([Faction] -> ShowS) -> Show Faction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Faction] -> ShowS
$cshowList :: [Faction] -> ShowS
show :: Faction -> String
$cshow :: Faction -> String
showsPrec :: Int -> Faction -> ShowS
$cshowsPrec :: Int -> Faction -> ShowS
Show, Faction -> Faction -> Bool
(Faction -> Faction -> Bool)
-> (Faction -> Faction -> Bool) -> Eq Faction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Faction -> Faction -> Bool
$c/= :: Faction -> Faction -> Bool
== :: Faction -> Faction -> Bool
$c== :: Faction -> Faction -> Bool
Eq, (forall x. Faction -> Rep Faction x)
-> (forall x. Rep Faction x -> Faction) -> Generic Faction
forall x. Rep Faction x -> Faction
forall x. Faction -> Rep Faction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Faction x -> Faction
$cfrom :: forall x. Faction -> Rep Faction x
Generic)

instance Binary Faction

-- | Diplomacy states. Higher overwrite lower in case of asymmetric content.
data Diplomacy =
    Unknown
  | Neutral
  | Alliance
  | War
  deriving (Int -> Diplomacy -> ShowS
[Diplomacy] -> ShowS
Diplomacy -> String
(Int -> Diplomacy -> ShowS)
-> (Diplomacy -> String)
-> ([Diplomacy] -> ShowS)
-> Show Diplomacy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Diplomacy] -> ShowS
$cshowList :: [Diplomacy] -> ShowS
show :: Diplomacy -> String
$cshow :: Diplomacy -> String
showsPrec :: Int -> Diplomacy -> ShowS
$cshowsPrec :: Int -> Diplomacy -> ShowS
Show, Diplomacy -> Diplomacy -> Bool
(Diplomacy -> Diplomacy -> Bool)
-> (Diplomacy -> Diplomacy -> Bool) -> Eq Diplomacy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Diplomacy -> Diplomacy -> Bool
$c/= :: Diplomacy -> Diplomacy -> Bool
== :: Diplomacy -> Diplomacy -> Bool
$c== :: Diplomacy -> Diplomacy -> Bool
Eq, Int -> Diplomacy
Diplomacy -> Int
Diplomacy -> [Diplomacy]
Diplomacy -> Diplomacy
Diplomacy -> Diplomacy -> [Diplomacy]
Diplomacy -> Diplomacy -> Diplomacy -> [Diplomacy]
(Diplomacy -> Diplomacy)
-> (Diplomacy -> Diplomacy)
-> (Int -> Diplomacy)
-> (Diplomacy -> Int)
-> (Diplomacy -> [Diplomacy])
-> (Diplomacy -> Diplomacy -> [Diplomacy])
-> (Diplomacy -> Diplomacy -> [Diplomacy])
-> (Diplomacy -> Diplomacy -> Diplomacy -> [Diplomacy])
-> Enum Diplomacy
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 :: Diplomacy -> Diplomacy -> Diplomacy -> [Diplomacy]
$cenumFromThenTo :: Diplomacy -> Diplomacy -> Diplomacy -> [Diplomacy]
enumFromTo :: Diplomacy -> Diplomacy -> [Diplomacy]
$cenumFromTo :: Diplomacy -> Diplomacy -> [Diplomacy]
enumFromThen :: Diplomacy -> Diplomacy -> [Diplomacy]
$cenumFromThen :: Diplomacy -> Diplomacy -> [Diplomacy]
enumFrom :: Diplomacy -> [Diplomacy]
$cenumFrom :: Diplomacy -> [Diplomacy]
fromEnum :: Diplomacy -> Int
$cfromEnum :: Diplomacy -> Int
toEnum :: Int -> Diplomacy
$ctoEnum :: Int -> Diplomacy
pred :: Diplomacy -> Diplomacy
$cpred :: Diplomacy -> Diplomacy
succ :: Diplomacy -> Diplomacy
$csucc :: Diplomacy -> Diplomacy
Enum, (forall x. Diplomacy -> Rep Diplomacy x)
-> (forall x. Rep Diplomacy x -> Diplomacy) -> Generic Diplomacy
forall x. Rep Diplomacy x -> Diplomacy
forall x. Diplomacy -> Rep Diplomacy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Diplomacy x -> Diplomacy
$cfrom :: forall x. Diplomacy -> Rep Diplomacy x
Generic)

instance Binary Diplomacy

type Dipl = EM.EnumMap FactionId Diplomacy

-- | Current game status.
data Status = Status
  { Status -> Outcome
stOutcome :: Outcome  -- ^ current game outcome
  , Status -> Int
stDepth   :: Int      -- ^ depth of the final encounter
  , Status -> Maybe (GroupName ModeKind)
stNewGame :: Maybe (GroupName ModeKind)
                          -- ^ new game group to start, if any
  }
  deriving (Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Status] -> ShowS
$cshowList :: [Status] -> ShowS
show :: Status -> String
$cshow :: Status -> String
showsPrec :: Int -> Status -> ShowS
$cshowsPrec :: Int -> Status -> ShowS
Show, Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c== :: Status -> Status -> Bool
Eq, Eq Status
Eq Status
-> (Status -> Status -> Ordering)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Status)
-> (Status -> Status -> Status)
-> Ord Status
Status -> Status -> Bool
Status -> Status -> Ordering
Status -> Status -> Status
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 :: Status -> Status -> Status
$cmin :: Status -> Status -> Status
max :: Status -> Status -> Status
$cmax :: Status -> Status -> Status
>= :: Status -> Status -> Bool
$c>= :: Status -> Status -> Bool
> :: Status -> Status -> Bool
$c> :: Status -> Status -> Bool
<= :: Status -> Status -> Bool
$c<= :: Status -> Status -> Bool
< :: Status -> Status -> Bool
$c< :: Status -> Status -> Bool
compare :: Status -> Status -> Ordering
$ccompare :: Status -> Status -> Ordering
$cp1Ord :: Eq Status
Ord, (forall x. Status -> Rep Status x)
-> (forall x. Rep Status x -> Status) -> Generic Status
forall x. Rep Status x -> Status
forall x. Status -> Rep Status x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Status x -> Status
$cfrom :: forall x. Status -> Rep Status x
Generic)

instance Binary Status

-- | The difficulty level influencess HP of either the human player or the AI.
-- The challenges restrict some abilities of the human player only.
data Challenge = Challenge
  { Challenge -> Int
cdiff   :: Int   -- ^ game difficulty level (HP bonus or malus)
  , Challenge -> Bool
cfish   :: Bool  -- ^ cold fish challenge (no healing from enemies)
  , Challenge -> Bool
cgoods  :: Bool  -- ^ ready goods challenge (crafting disabled)
  , Challenge -> Bool
cwolf   :: Bool  -- ^ lone wolf challenge (only one starting character)
  , Challenge -> Bool
ckeeper :: Bool  -- ^ finder keeper challenge (ranged attacks disabled)
  }
  deriving (Int -> Challenge -> ShowS
[Challenge] -> ShowS
Challenge -> String
(Int -> Challenge -> ShowS)
-> (Challenge -> String)
-> ([Challenge] -> ShowS)
-> Show Challenge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Challenge] -> ShowS
$cshowList :: [Challenge] -> ShowS
show :: Challenge -> String
$cshow :: Challenge -> String
showsPrec :: Int -> Challenge -> ShowS
$cshowsPrec :: Int -> Challenge -> ShowS
Show, Challenge -> Challenge -> Bool
(Challenge -> Challenge -> Bool)
-> (Challenge -> Challenge -> Bool) -> Eq Challenge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Challenge -> Challenge -> Bool
$c/= :: Challenge -> Challenge -> Bool
== :: Challenge -> Challenge -> Bool
$c== :: Challenge -> Challenge -> Bool
Eq, Eq Challenge
Eq Challenge
-> (Challenge -> Challenge -> Ordering)
-> (Challenge -> Challenge -> Bool)
-> (Challenge -> Challenge -> Bool)
-> (Challenge -> Challenge -> Bool)
-> (Challenge -> Challenge -> Bool)
-> (Challenge -> Challenge -> Challenge)
-> (Challenge -> Challenge -> Challenge)
-> Ord Challenge
Challenge -> Challenge -> Bool
Challenge -> Challenge -> Ordering
Challenge -> Challenge -> Challenge
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 :: Challenge -> Challenge -> Challenge
$cmin :: Challenge -> Challenge -> Challenge
max :: Challenge -> Challenge -> Challenge
$cmax :: Challenge -> Challenge -> Challenge
>= :: Challenge -> Challenge -> Bool
$c>= :: Challenge -> Challenge -> Bool
> :: Challenge -> Challenge -> Bool
$c> :: Challenge -> Challenge -> Bool
<= :: Challenge -> Challenge -> Bool
$c<= :: Challenge -> Challenge -> Bool
< :: Challenge -> Challenge -> Bool
$c< :: Challenge -> Challenge -> Bool
compare :: Challenge -> Challenge -> Ordering
$ccompare :: Challenge -> Challenge -> Ordering
$cp1Ord :: Eq Challenge
Ord, (forall x. Challenge -> Rep Challenge x)
-> (forall x. Rep Challenge x -> Challenge) -> Generic Challenge
forall x. Rep Challenge x -> Challenge
forall x. Challenge -> Rep Challenge x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Challenge x -> Challenge
$cfrom :: forall x. Challenge -> Rep Challenge x
Generic)

instance Binary Challenge

tshowChallenge :: Challenge -> Text
tshowChallenge :: Challenge -> Text
tshowChallenge Challenge{Bool
Int
ckeeper :: Bool
cwolf :: Bool
cgoods :: Bool
cfish :: Bool
cdiff :: Int
ckeeper :: Challenge -> Bool
cwolf :: Challenge -> Bool
cgoods :: Challenge -> Bool
cfish :: Challenge -> Bool
cdiff :: Challenge -> Int
..} =
  Text
"("
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", "
    ([Text
"difficulty" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
cdiff | Int
cdiff Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
difficultyDefault]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"cold fish" | Bool
cfish]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"ready goods" | Bool
cgoods]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"lone wolf" | Bool
cwolf]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"finder keeper" | Bool
ckeeper])
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

gleader :: Faction -> Maybe ActorId
gleader :: Faction -> Maybe ActorId
gleader = Faction -> Maybe ActorId
_gleader

-- | Tell whether the faction consists of summoned horrors only.
--
-- Horror player is special, for summoned actors that don't belong to any
-- of the main players of a given game. E.g., animals summoned during
-- a skirmish game between two hero factions land in the horror faction.
-- In every game, either all factions for which summoning items exist
-- should be present or a horror player should be added to host them.
isHorrorFact :: Faction -> Bool
isHorrorFact :: Faction -> Bool
isHorrorFact Faction
fact = GroupName ItemKind
IK.HORROR GroupName ItemKind -> [GroupName ItemKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Player -> [GroupName ItemKind]
fgroups (Faction -> Player
gplayer Faction
fact)

-- A faction where other actors move at once or where some of leader change
-- is automatic can't run with multiple actors at once. That would be
-- overpowered or too complex to keep correct.
--
-- Note that this doesn't take into account individual actor skills,
-- so this is overly restrictive and, OTOH, sometimes running will fail
-- or behave wierdly regardless. But it's simple and easy to understand
-- by the UI user.
noRunWithMulti :: Faction -> Bool
noRunWithMulti :: Faction -> Bool
noRunWithMulti Faction
fact =
  let skillsOther :: Skills
skillsOther = Player -> Skills
fskillsOther (Player -> Skills) -> Player -> Skills
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer Faction
fact
  in Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMove Skills
skillsOther Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
     Bool -> Bool -> Bool
|| case Player -> Maybe AutoLeader
fleaderMode (Faction -> Player
gplayer Faction
fact) of
          Maybe AutoLeader
Nothing -> Bool
True
          Just AutoLeader{Bool
autoLevel :: AutoLeader -> Bool
autoDungeon :: AutoLeader -> Bool
autoLevel :: Bool
autoDungeon :: Bool
..} -> Bool
autoDungeon Bool -> Bool -> Bool
|| Bool
autoLevel

isAIFact :: Faction -> Bool
isAIFact :: Faction -> Bool
isAIFact Faction
fact = Player -> Bool
funderAI (Faction -> Player
gplayer Faction
fact)

autoDungeonLevel :: Faction -> (Bool, Bool)
autoDungeonLevel :: Faction -> (Bool, Bool)
autoDungeonLevel Faction
fact = case Player -> Maybe AutoLeader
fleaderMode (Faction -> Player
gplayer Faction
fact) of
                          Maybe AutoLeader
Nothing -> (Bool
False, Bool
False)
                          Just AutoLeader{Bool
autoLevel :: Bool
autoDungeon :: Bool
autoLevel :: AutoLeader -> Bool
autoDungeon :: AutoLeader -> Bool
..} -> (Bool
autoDungeon, Bool
autoLevel)

automatePlayer :: Bool -> Player -> Player
automatePlayer :: Bool -> Player -> Player
automatePlayer Bool
funderAI Player
pl = Player
pl {Bool
funderAI :: Bool
funderAI :: Bool
funderAI}

-- | Check if factions are at war. Assumes symmetry.
isFoe :: FactionId -> Faction -> FactionId -> Bool
isFoe :: FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
fid1 Faction
fact1 FactionId
fid2 =
  FactionId
fid1 FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
fid2  -- shortcut
  Bool -> Bool -> Bool
&& Diplomacy
War Diplomacy -> Diplomacy -> Bool
forall a. Eq a => a -> a -> Bool
== Diplomacy -> FactionId -> Dipl -> Diplomacy
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault Diplomacy
Unknown FactionId
fid2 (Faction -> Dipl
gdipl Faction
fact1)

-- | Check if factions are allied. Assumes symmetry.
isAlly :: Faction -> FactionId -> Bool
{-# INLINE isAlly #-}
isAlly :: Faction -> FactionId -> Bool
isAlly Faction
fact1 FactionId
fid2 = Diplomacy
Alliance Diplomacy -> Diplomacy -> Bool
forall a. Eq a => a -> a -> Bool
== Diplomacy -> FactionId -> Dipl -> Diplomacy
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault Diplomacy
Unknown FactionId
fid2 (Faction -> Dipl
gdipl Faction
fact1)

-- | Check if factions are allied or are the same faction. Assumes symmetry.
isFriend :: FactionId -> Faction -> FactionId -> Bool
isFriend :: FactionId -> Faction -> FactionId -> Bool
isFriend FactionId
fid1 Faction
fact1 FactionId
fid2 = FactionId
fid1 FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
fid2 Bool -> Bool -> Bool
|| Faction -> FactionId -> Bool
isAlly Faction
fact1 FactionId
fid2

difficultyBound :: Int
difficultyBound :: Int
difficultyBound = Int
9

difficultyDefault :: Int
difficultyDefault :: Int
difficultyDefault = (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
difficultyBound) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2

-- The function is its own inverse.
difficultyCoeff :: Int -> Int
difficultyCoeff :: Int -> Int
difficultyCoeff Int
n = Int
difficultyDefault Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n

-- The function is its own inverse.
difficultyInverse :: Int -> Int
difficultyInverse :: Int -> Int
difficultyInverse Int
n = Int
difficultyBound Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n

defaultChallenge :: Challenge
defaultChallenge :: Challenge
defaultChallenge = Challenge :: Int -> Bool -> Bool -> Bool -> Bool -> Challenge
Challenge { cdiff :: Int
cdiff = Int
difficultyDefault
                             , cfish :: Bool
cfish = Bool
False
                             , cgoods :: Bool
cgoods = Bool
False
                             , cwolf :: Bool
cwolf = Bool
False
                             , ckeeper :: Bool
ckeeper = Bool
False }

possibleActorFactions :: ItemKind -> FactionDict -> [(FactionId, Faction)]
possibleActorFactions :: ItemKind -> FactionDict -> [(FactionId, Faction)]
possibleActorFactions ItemKind
itemKind FactionDict
factionD =
  let freqNames :: [GroupName ItemKind]
freqNames = ((GroupName ItemKind, Int) -> GroupName ItemKind)
-> [(GroupName ItemKind, Int)] -> [GroupName ItemKind]
forall a b. (a -> b) -> [a] -> [b]
map (GroupName ItemKind, Int) -> GroupName ItemKind
forall a b. (a, b) -> a
fst ([(GroupName ItemKind, Int)] -> [GroupName ItemKind])
-> [(GroupName ItemKind, Int)] -> [GroupName ItemKind]
forall a b. (a -> b) -> a -> b
$ ItemKind -> [(GroupName ItemKind, Int)]
IK.ifreq ItemKind
itemKind
      f :: (FactionId, Faction) -> Bool
f (FactionId
_, Faction
fact) = (GroupName ItemKind -> Bool) -> [GroupName ItemKind] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (GroupName ItemKind -> [GroupName ItemKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Player -> [GroupName ItemKind]
fgroups (Faction -> Player
gplayer Faction
fact)) [GroupName ItemKind]
freqNames
      fidFactsRaw :: [(FactionId, Faction)]
fidFactsRaw = ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (FactionId, Faction) -> Bool
f ([(FactionId, Faction)] -> [(FactionId, Faction)])
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a b. (a -> b) -> a -> b
$ FactionDict -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs FactionDict
factionD
  in if [(FactionId, Faction)] -> Bool
forall a. [a] -> Bool
null [(FactionId, Faction)]
fidFactsRaw
     then ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Faction -> Bool
isHorrorFact (Faction -> Bool)
-> ((FactionId, Faction) -> Faction)
-> (FactionId, Faction)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId, Faction) -> Faction
forall a b. (a, b) -> b
snd) ([(FactionId, Faction)] -> [(FactionId, Faction)])
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a b. (a -> b) -> a -> b
$ FactionDict -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs FactionDict
factionD  -- fall back
     else [(FactionId, Faction)]
fidFactsRaw

ppContainer :: FactionDict -> Container -> Text
ppContainer :: FactionDict -> Container -> Text
ppContainer FactionDict
factionD (CFloor LevelId
lid Point
p) =
  let f :: Faction -> Maybe Text
f Faction
fact = case Faction -> Maybe (LevelId, Point)
gstash Faction
fact of
        Just (LevelId
slid, Point
sp) | LevelId
slid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lid Bool -> Bool -> Bool
&& Point
sp Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
p -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Faction -> Text
gname Faction
fact
        Maybe (LevelId, Point)
_ -> Maybe Text
forall a. Maybe a
Nothing
  in case (Faction -> Maybe Text) -> [Faction] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Faction -> Maybe Text
f ([Faction] -> [Text]) -> [Faction] -> [Text]
forall a b. (a -> b) -> a -> b
$ FactionDict -> [Faction]
forall k a. EnumMap k a -> [a]
EM.elems FactionDict
factionD of
    [] -> Text
"nearby"
    [Text
t] -> Text
"in the shared inventory stash of" Text -> Text -> Text
<+> Text
t
    [Text]
_ -> Text
"in a shared zone of interests"
ppContainer FactionDict
_ CEmbed{} = Text
"embedded nearby"
ppContainer FactionDict
_ (CActor ActorId
_ CStore
cstore) = CStore -> Text
ppCStoreIn CStore
cstore
ppContainer FactionDict
_ c :: Container
c@CTrunk{} = String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"" String -> Container -> String
forall v. Show v => String -> v -> String
`showFailure` Container
c