{-# LANGUAGE DeriveGeneric, TupleSections #-} -- | 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(..) , tshowDiplomacy, tshowChallenge, gleader, isHorrorFact, noRunWithMulti , bannedPointmanSwitchBetweenLevels, isFoe, isFriend , difficultyBound, difficultyDefault, difficultyCoeff , 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.Text as T import GHC.Generics (Generic) import Game.LambdaHack.Common.Point import Game.LambdaHack.Common.Types import Game.LambdaHack.Content.FactionKind import Game.LambdaHack.Content.ItemKind (ItemKind) import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.ModeKind (ModeKind) import Game.LambdaHack.Core.Frequency 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 -> FactionKind gkind :: FactionKind -- ^ the player spec for this faction, do not update! -- it is morally read-only, but not represented -- as @ContentId FactionKind@, because it's very small -- and it's looked up often enough in the code and during runtime; -- a side-effect is that if content changes mid-game, this stays; -- if we ever have thousands of factions in a single game, -- e.g., one for each separately spawned herd of animals, change this , Faction -> Text gname :: Text -- ^ individual name , Faction -> Color gcolor :: Color.Color -- ^ color of numbered actors , Faction -> Doctrine gdoctrine :: Ability.Doctrine -- ^ non-pointmen behave according to this , Faction -> Bool gunderAI :: Bool -- ^ whether the faction is under AI control , 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 } 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, Eq Diplomacy Eq Diplomacy -> (Diplomacy -> Diplomacy -> Ordering) -> (Diplomacy -> Diplomacy -> Bool) -> (Diplomacy -> Diplomacy -> Bool) -> (Diplomacy -> Diplomacy -> Bool) -> (Diplomacy -> Diplomacy -> Bool) -> (Diplomacy -> Diplomacy -> Diplomacy) -> (Diplomacy -> Diplomacy -> Diplomacy) -> Ord Diplomacy Diplomacy -> Diplomacy -> Bool Diplomacy -> Diplomacy -> Ordering Diplomacy -> Diplomacy -> Diplomacy 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 :: Diplomacy -> Diplomacy -> Diplomacy $cmin :: Diplomacy -> Diplomacy -> Diplomacy max :: Diplomacy -> Diplomacy -> Diplomacy $cmax :: Diplomacy -> Diplomacy -> Diplomacy >= :: Diplomacy -> Diplomacy -> Bool $c>= :: Diplomacy -> Diplomacy -> Bool > :: Diplomacy -> Diplomacy -> Bool $c> :: Diplomacy -> Diplomacy -> Bool <= :: Diplomacy -> Diplomacy -> Bool $c<= :: Diplomacy -> Diplomacy -> Bool < :: Diplomacy -> Diplomacy -> Bool $c< :: Diplomacy -> Diplomacy -> Bool compare :: Diplomacy -> Diplomacy -> Ordering $ccompare :: Diplomacy -> Diplomacy -> Ordering $cp1Ord :: Eq Diplomacy Ord, 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 tshowDiplomacy :: Diplomacy -> Text tshowDiplomacy :: Diplomacy -> Text tshowDiplomacy Diplomacy Unknown = Text "unknown to each other" tshowDiplomacy Diplomacy Neutral = Text "in neutral diplomatic relations" tshowDiplomacy Diplomacy Alliance = Text "allied" tshowDiplomacy Diplomacy War = Text "at war" 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 = Int -> Maybe Int -> Int forall a. a -> Maybe a -> a fromMaybe Int 0 (GroupName ItemKind -> [(GroupName ItemKind, Int)] -> Maybe Int forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup GroupName ItemKind IK.HORROR ([(GroupName ItemKind, Int)] -> Maybe Int) -> [(GroupName ItemKind, Int)] -> Maybe Int forall a b. (a -> b) -> a -> b $ FactionKind -> [(GroupName ItemKind, Int)] fgroups (FactionKind -> [(GroupName ItemKind, Int)]) -> FactionKind -> [(GroupName ItemKind, Int)] forall a b. (a -> b) -> a -> b $ Faction -> FactionKind gkind Faction fact) Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int 0 -- 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 = FactionKind -> Skills fskillsOther (FactionKind -> Skills) -> FactionKind -> Skills forall a b. (a -> b) -> a -> b $ Faction -> FactionKind gkind 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 || Faction -> Bool bannedPointmanSwitchBetweenLevels Faction fact Bool -> Bool -> Bool || Bool -> Bool not (FactionKind -> Bool fhasPointman (Faction -> FactionKind gkind Faction fact)) bannedPointmanSwitchBetweenLevels :: Faction -> Bool bannedPointmanSwitchBetweenLevels :: Faction -> Bool bannedPointmanSwitchBetweenLevels = FactionKind -> Bool fspawnsFast (FactionKind -> Bool) -> (Faction -> FactionKind) -> Faction -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Faction -> FactionKind gkind -- | 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 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 :: [GroupName ItemKind] -> ItemKind -> FactionDict -> Frequency (FactionId, Faction) possibleActorFactions :: [GroupName ItemKind] -> ItemKind -> FactionDict -> Frequency (FactionId, Faction) possibleActorFactions [GroupName ItemKind] itemGroups ItemKind itemKind FactionDict factionD = let candidatesFromGroups :: [GroupName ItemKind] -> [(Int, (FactionId, Faction))] candidatesFromGroups [GroupName ItemKind] grps = let h :: (FactionId, Faction) -> [(Int, (FactionId, Faction))] h (FactionId fid, Faction fact) = let f :: GroupName ItemKind -> (GroupName ItemKind, Int) -> [(Int, (FactionId, Faction))] f GroupName ItemKind grp (GroupName ItemKind grp2, Int n) = [(Int n, (FactionId fid, Faction fact)) | GroupName ItemKind grp GroupName ItemKind -> GroupName ItemKind -> Bool forall a. Eq a => a -> a -> Bool == GroupName ItemKind grp2] g :: GroupName ItemKind -> [(Int, (FactionId, Faction))] g GroupName ItemKind grp = ((GroupName ItemKind, Int) -> [(Int, (FactionId, Faction))]) -> [(GroupName ItemKind, Int)] -> [(Int, (FactionId, Faction))] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap (GroupName ItemKind -> (GroupName ItemKind, Int) -> [(Int, (FactionId, Faction))] f GroupName ItemKind grp) (FactionKind -> [(GroupName ItemKind, Int)] fgroups (Faction -> FactionKind gkind Faction fact)) in (GroupName ItemKind -> [(Int, (FactionId, Faction))]) -> [GroupName ItemKind] -> [(Int, (FactionId, Faction))] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap GroupName ItemKind -> [(Int, (FactionId, Faction))] g [GroupName ItemKind] grps in ((FactionId, Faction) -> [(Int, (FactionId, Faction))]) -> [(FactionId, Faction)] -> [(Int, (FactionId, Faction))] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap (FactionId, Faction) -> [(Int, (FactionId, Faction))] h ([(FactionId, Faction)] -> [(Int, (FactionId, Faction))]) -> [(FactionId, Faction)] -> [(Int, (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 allCandidates :: [[(Int, (FactionId, Faction))]] allCandidates = [ [GroupName ItemKind] -> [(Int, (FactionId, Faction))] candidatesFromGroups [GroupName ItemKind] itemGroups -- when origin known/matters , [GroupName ItemKind] -> [(Int, (FactionId, Faction))] candidatesFromGroups ([GroupName ItemKind] -> [(Int, (FactionId, Faction))]) -> [GroupName ItemKind] -> [(Int, (FactionId, Faction))] forall a b. (a -> b) -> a -> b $ ((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 -- otherwise , ((FactionId, Faction) -> (Int, (FactionId, Faction))) -> [(FactionId, Faction)] -> [(Int, (FactionId, Faction))] forall a b. (a -> b) -> [a] -> [b] map (Int 1,) ([(FactionId, Faction)] -> [(Int, (FactionId, Faction))]) -> [(FactionId, Faction)] -> [(Int, (FactionId, Faction))] forall a b. (a -> b) -> a -> b $ ((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 , ((FactionId, Faction) -> (Int, (FactionId, Faction))) -> [(FactionId, Faction)] -> [(Int, (FactionId, Faction))] forall a b. (a -> b) -> [a] -> [b] map (Int 1,) ([(FactionId, Faction)] -> [(Int, (FactionId, Faction))]) -> [(FactionId, Faction)] -> [(Int, (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 -- desperate fall back ] in case ([(Int, (FactionId, Faction))] -> Bool) -> [[(Int, (FactionId, Faction))]] -> [[(Int, (FactionId, Faction))]] forall a. (a -> Bool) -> [a] -> [a] filter (Bool -> Bool not (Bool -> Bool) -> ([(Int, (FactionId, Faction))] -> Bool) -> [(Int, (FactionId, Faction))] -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . [(Int, (FactionId, Faction))] -> Bool forall a. [a] -> Bool null) [[(Int, (FactionId, Faction))]] allCandidates of [] -> String -> Frequency (FactionId, Faction) forall a. HasCallStack => String -> a error String "possibleActorFactions: no faction found for an actor" [(Int, (FactionId, Faction))] candidates : [[(Int, (FactionId, Faction))]] _ -> Text -> [(Int, (FactionId, Faction))] -> Frequency (FactionId, Faction) forall a. Text -> [(Int, a)] -> Frequency a toFreq Text "possibleActorFactions" [(Int, (FactionId, Faction))] candidates 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