{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
-- | The type of kinds of factions present in a game, both human
-- and computer-controlled.
module Game.LambdaHack.Content.FactionKind
  ( FactionKind(..), makeData
  , HiCondPoly, HiSummand, HiPolynomial, HiIndeterminant(..)
  , TeamContinuity(..), Outcome(..)
  , teamExplorer, hiHeroLong, hiHeroMedium, hiHeroShort, hiDweller
  , victoryOutcomes, deafeatOutcomes
  , nameOutcomePast, nameOutcomeVerb, endMessageOutcome
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , validateSingle, validateAll
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Binary
import qualified Data.Text as T
import           GHC.Generics (Generic)

import           Game.LambdaHack.Content.ItemKind (ItemKind)
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.ContentData
import           Game.LambdaHack.Definition.Defs

-- | Properties of a particular faction.
data FactionKind = FactionKind
  { FactionKind -> Text
fname         :: Text        -- ^ name of the faction
  , FactionKind -> Freqs FactionKind
ffreq         :: Freqs FactionKind
                                 -- ^ frequency within groups
  , FactionKind -> TeamContinuity
fteam         :: TeamContinuity
                                 -- ^ the team the faction identifies with
                                 --   across games and modes
  , FactionKind -> Freqs ItemKind
fgroups       :: Freqs ItemKind
      -- ^ names of actor groups that may naturally fall under faction's
      --   control, e.g., upon spawning; make sure all groups that may
      --   ever continuousely generate actors, e.g., through spawning
      --   or summoning, are mentioned in at least one faction kind;
      --   groups of initial faction actors don't need to be included
  , FactionKind -> Skills
fskillsOther  :: Ability.Skills
                                 -- ^ fixed skill modifiers to the non-leader
                                 --   actors; also summed with skills implied
                                 --   by @fdoctrine@ (which is not fixed)
  , FactionKind -> Bool
fcanEscape    :: Bool        -- ^ the faction can escape the dungeon
  , FactionKind -> Bool
fneverEmpty   :: Bool        -- ^ the faction declared killed if no actors
  , FactionKind -> HiCondPoly
fhiCondPoly   :: HiCondPoly  -- ^ score formula (conditional polynomial)
  , FactionKind -> Bool
fhasGender    :: Bool        -- ^ whether actors have gender
  , FactionKind -> Doctrine
finitDoctrine :: Ability.Doctrine
                                 -- ^ initial faction's non-leaders doctrine
  , FactionKind -> Bool
fspawnsFast   :: Bool
      -- ^ spawns fast enough that switching pointman to another level
      --   to optimize spawning is a winning tactics, which would spoil
      --   the fun, so switching is disabled in UI and AI clients
  , FactionKind -> Bool
fhasPointman  :: Bool        -- ^ whether the faction can have a pointman
  , FactionKind -> Bool
fhasUI        :: Bool        -- ^ does the faction have a UI client
                                 --   (for control or passive observation)
  , FactionKind -> Bool
finitUnderAI  :: Bool        -- ^ is the faction initially under AI control
  , FactionKind -> [TeamContinuity]
fenemyTeams   :: [TeamContinuity]
                                 -- ^ teams starting at war with the faction
  , FactionKind -> [TeamContinuity]
falliedTeams  :: [TeamContinuity]
                                 -- ^ teams starting allied with the faction
  }
  deriving (Int -> FactionKind -> ShowS
[FactionKind] -> ShowS
FactionKind -> String
(Int -> FactionKind -> ShowS)
-> (FactionKind -> String)
-> ([FactionKind] -> ShowS)
-> Show FactionKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FactionKind] -> ShowS
$cshowList :: [FactionKind] -> ShowS
show :: FactionKind -> String
$cshow :: FactionKind -> String
showsPrec :: Int -> FactionKind -> ShowS
$cshowsPrec :: Int -> FactionKind -> ShowS
Show, FactionKind -> FactionKind -> Bool
(FactionKind -> FactionKind -> Bool)
-> (FactionKind -> FactionKind -> Bool) -> Eq FactionKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FactionKind -> FactionKind -> Bool
$c/= :: FactionKind -> FactionKind -> Bool
== :: FactionKind -> FactionKind -> Bool
$c== :: FactionKind -> FactionKind -> Bool
Eq, (forall x. FactionKind -> Rep FactionKind x)
-> (forall x. Rep FactionKind x -> FactionKind)
-> Generic FactionKind
forall x. Rep FactionKind x -> FactionKind
forall x. FactionKind -> Rep FactionKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FactionKind x -> FactionKind
$cfrom :: forall x. FactionKind -> Rep FactionKind x
Generic)

instance Binary FactionKind

-- | Team continuity index. Starting with 1. See the comment for `FactionId`.
newtype TeamContinuity = TeamContinuity Int
  deriving (Int -> TeamContinuity -> ShowS
[TeamContinuity] -> ShowS
TeamContinuity -> String
(Int -> TeamContinuity -> ShowS)
-> (TeamContinuity -> String)
-> ([TeamContinuity] -> ShowS)
-> Show TeamContinuity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TeamContinuity] -> ShowS
$cshowList :: [TeamContinuity] -> ShowS
show :: TeamContinuity -> String
$cshow :: TeamContinuity -> String
showsPrec :: Int -> TeamContinuity -> ShowS
$cshowsPrec :: Int -> TeamContinuity -> ShowS
Show, TeamContinuity -> TeamContinuity -> Bool
(TeamContinuity -> TeamContinuity -> Bool)
-> (TeamContinuity -> TeamContinuity -> Bool) -> Eq TeamContinuity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TeamContinuity -> TeamContinuity -> Bool
$c/= :: TeamContinuity -> TeamContinuity -> Bool
== :: TeamContinuity -> TeamContinuity -> Bool
$c== :: TeamContinuity -> TeamContinuity -> Bool
Eq, Eq TeamContinuity
Eq TeamContinuity
-> (TeamContinuity -> TeamContinuity -> Ordering)
-> (TeamContinuity -> TeamContinuity -> Bool)
-> (TeamContinuity -> TeamContinuity -> Bool)
-> (TeamContinuity -> TeamContinuity -> Bool)
-> (TeamContinuity -> TeamContinuity -> Bool)
-> (TeamContinuity -> TeamContinuity -> TeamContinuity)
-> (TeamContinuity -> TeamContinuity -> TeamContinuity)
-> Ord TeamContinuity
TeamContinuity -> TeamContinuity -> Bool
TeamContinuity -> TeamContinuity -> Ordering
TeamContinuity -> TeamContinuity -> TeamContinuity
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 :: TeamContinuity -> TeamContinuity -> TeamContinuity
$cmin :: TeamContinuity -> TeamContinuity -> TeamContinuity
max :: TeamContinuity -> TeamContinuity -> TeamContinuity
$cmax :: TeamContinuity -> TeamContinuity -> TeamContinuity
>= :: TeamContinuity -> TeamContinuity -> Bool
$c>= :: TeamContinuity -> TeamContinuity -> Bool
> :: TeamContinuity -> TeamContinuity -> Bool
$c> :: TeamContinuity -> TeamContinuity -> Bool
<= :: TeamContinuity -> TeamContinuity -> Bool
$c<= :: TeamContinuity -> TeamContinuity -> Bool
< :: TeamContinuity -> TeamContinuity -> Bool
$c< :: TeamContinuity -> TeamContinuity -> Bool
compare :: TeamContinuity -> TeamContinuity -> Ordering
$ccompare :: TeamContinuity -> TeamContinuity -> Ordering
$cp1Ord :: Eq TeamContinuity
Ord, Int -> TeamContinuity
TeamContinuity -> Int
TeamContinuity -> [TeamContinuity]
TeamContinuity -> TeamContinuity
TeamContinuity -> TeamContinuity -> [TeamContinuity]
TeamContinuity
-> TeamContinuity -> TeamContinuity -> [TeamContinuity]
(TeamContinuity -> TeamContinuity)
-> (TeamContinuity -> TeamContinuity)
-> (Int -> TeamContinuity)
-> (TeamContinuity -> Int)
-> (TeamContinuity -> [TeamContinuity])
-> (TeamContinuity -> TeamContinuity -> [TeamContinuity])
-> (TeamContinuity -> TeamContinuity -> [TeamContinuity])
-> (TeamContinuity
    -> TeamContinuity -> TeamContinuity -> [TeamContinuity])
-> Enum TeamContinuity
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 :: TeamContinuity
-> TeamContinuity -> TeamContinuity -> [TeamContinuity]
$cenumFromThenTo :: TeamContinuity
-> TeamContinuity -> TeamContinuity -> [TeamContinuity]
enumFromTo :: TeamContinuity -> TeamContinuity -> [TeamContinuity]
$cenumFromTo :: TeamContinuity -> TeamContinuity -> [TeamContinuity]
enumFromThen :: TeamContinuity -> TeamContinuity -> [TeamContinuity]
$cenumFromThen :: TeamContinuity -> TeamContinuity -> [TeamContinuity]
enumFrom :: TeamContinuity -> [TeamContinuity]
$cenumFrom :: TeamContinuity -> [TeamContinuity]
fromEnum :: TeamContinuity -> Int
$cfromEnum :: TeamContinuity -> Int
toEnum :: Int -> TeamContinuity
$ctoEnum :: Int -> TeamContinuity
pred :: TeamContinuity -> TeamContinuity
$cpred :: TeamContinuity -> TeamContinuity
succ :: TeamContinuity -> TeamContinuity
$csucc :: TeamContinuity -> TeamContinuity
Enum, (forall x. TeamContinuity -> Rep TeamContinuity x)
-> (forall x. Rep TeamContinuity x -> TeamContinuity)
-> Generic TeamContinuity
forall x. Rep TeamContinuity x -> TeamContinuity
forall x. TeamContinuity -> Rep TeamContinuity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TeamContinuity x -> TeamContinuity
$cfrom :: forall x. TeamContinuity -> Rep TeamContinuity x
Generic)

instance Binary TeamContinuity

-- | Conditional polynomial representing score calculation for this faction.
type HiCondPoly = [HiSummand]

type HiSummand = (HiPolynomial, [Outcome])

type HiPolynomial = [(HiIndeterminant, Double)]

data HiIndeterminant =
    HiConst
  | HiLoot
  | HiSprint
  | HiBlitz
  | HiSurvival
  | HiKill
  | HiLoss
  deriving (Int -> HiIndeterminant -> ShowS
[HiIndeterminant] -> ShowS
HiIndeterminant -> String
(Int -> HiIndeterminant -> ShowS)
-> (HiIndeterminant -> String)
-> ([HiIndeterminant] -> ShowS)
-> Show HiIndeterminant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HiIndeterminant] -> ShowS
$cshowList :: [HiIndeterminant] -> ShowS
show :: HiIndeterminant -> String
$cshow :: HiIndeterminant -> String
showsPrec :: Int -> HiIndeterminant -> ShowS
$cshowsPrec :: Int -> HiIndeterminant -> ShowS
Show, HiIndeterminant -> HiIndeterminant -> Bool
(HiIndeterminant -> HiIndeterminant -> Bool)
-> (HiIndeterminant -> HiIndeterminant -> Bool)
-> Eq HiIndeterminant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HiIndeterminant -> HiIndeterminant -> Bool
$c/= :: HiIndeterminant -> HiIndeterminant -> Bool
== :: HiIndeterminant -> HiIndeterminant -> Bool
$c== :: HiIndeterminant -> HiIndeterminant -> Bool
Eq, (forall x. HiIndeterminant -> Rep HiIndeterminant x)
-> (forall x. Rep HiIndeterminant x -> HiIndeterminant)
-> Generic HiIndeterminant
forall x. Rep HiIndeterminant x -> HiIndeterminant
forall x. HiIndeterminant -> Rep HiIndeterminant x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HiIndeterminant x -> HiIndeterminant
$cfrom :: forall x. HiIndeterminant -> Rep HiIndeterminant x
Generic)

instance Binary HiIndeterminant

-- | Outcome of a game.
data Outcome =
    Escape    -- ^ the faction escaped the dungeon alive
  | Conquer   -- ^ the faction won by eliminating all rivals
  | Defeated  -- ^ the faction lost the game in another way
  | Killed    -- ^ the faction was eliminated
  | Restart   -- ^ game is restarted; the quitter quit
  | Camping   -- ^ game is supended
  deriving (Int -> Outcome -> ShowS
[Outcome] -> ShowS
Outcome -> String
(Int -> Outcome -> ShowS)
-> (Outcome -> String) -> ([Outcome] -> ShowS) -> Show Outcome
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Outcome] -> ShowS
$cshowList :: [Outcome] -> ShowS
show :: Outcome -> String
$cshow :: Outcome -> String
showsPrec :: Int -> Outcome -> ShowS
$cshowsPrec :: Int -> Outcome -> ShowS
Show, Outcome -> Outcome -> Bool
(Outcome -> Outcome -> Bool)
-> (Outcome -> Outcome -> Bool) -> Eq Outcome
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Outcome -> Outcome -> Bool
$c/= :: Outcome -> Outcome -> Bool
== :: Outcome -> Outcome -> Bool
$c== :: Outcome -> Outcome -> Bool
Eq, Eq Outcome
Eq Outcome
-> (Outcome -> Outcome -> Ordering)
-> (Outcome -> Outcome -> Bool)
-> (Outcome -> Outcome -> Bool)
-> (Outcome -> Outcome -> Bool)
-> (Outcome -> Outcome -> Bool)
-> (Outcome -> Outcome -> Outcome)
-> (Outcome -> Outcome -> Outcome)
-> Ord Outcome
Outcome -> Outcome -> Bool
Outcome -> Outcome -> Ordering
Outcome -> Outcome -> Outcome
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 :: Outcome -> Outcome -> Outcome
$cmin :: Outcome -> Outcome -> Outcome
max :: Outcome -> Outcome -> Outcome
$cmax :: Outcome -> Outcome -> Outcome
>= :: Outcome -> Outcome -> Bool
$c>= :: Outcome -> Outcome -> Bool
> :: Outcome -> Outcome -> Bool
$c> :: Outcome -> Outcome -> Bool
<= :: Outcome -> Outcome -> Bool
$c<= :: Outcome -> Outcome -> Bool
< :: Outcome -> Outcome -> Bool
$c< :: Outcome -> Outcome -> Bool
compare :: Outcome -> Outcome -> Ordering
$ccompare :: Outcome -> Outcome -> Ordering
$cp1Ord :: Eq Outcome
Ord, Int -> Outcome
Outcome -> Int
Outcome -> [Outcome]
Outcome -> Outcome
Outcome -> Outcome -> [Outcome]
Outcome -> Outcome -> Outcome -> [Outcome]
(Outcome -> Outcome)
-> (Outcome -> Outcome)
-> (Int -> Outcome)
-> (Outcome -> Int)
-> (Outcome -> [Outcome])
-> (Outcome -> Outcome -> [Outcome])
-> (Outcome -> Outcome -> [Outcome])
-> (Outcome -> Outcome -> Outcome -> [Outcome])
-> Enum Outcome
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 :: Outcome -> Outcome -> Outcome -> [Outcome]
$cenumFromThenTo :: Outcome -> Outcome -> Outcome -> [Outcome]
enumFromTo :: Outcome -> Outcome -> [Outcome]
$cenumFromTo :: Outcome -> Outcome -> [Outcome]
enumFromThen :: Outcome -> Outcome -> [Outcome]
$cenumFromThen :: Outcome -> Outcome -> [Outcome]
enumFrom :: Outcome -> [Outcome]
$cenumFrom :: Outcome -> [Outcome]
fromEnum :: Outcome -> Int
$cfromEnum :: Outcome -> Int
toEnum :: Int -> Outcome
$ctoEnum :: Int -> Outcome
pred :: Outcome -> Outcome
$cpred :: Outcome -> Outcome
succ :: Outcome -> Outcome
$csucc :: Outcome -> Outcome
Enum, Outcome
Outcome -> Outcome -> Bounded Outcome
forall a. a -> a -> Bounded a
maxBound :: Outcome
$cmaxBound :: Outcome
minBound :: Outcome
$cminBound :: Outcome
Bounded, (forall x. Outcome -> Rep Outcome x)
-> (forall x. Rep Outcome x -> Outcome) -> Generic Outcome
forall x. Rep Outcome x -> Outcome
forall x. Outcome -> Rep Outcome x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Outcome x -> Outcome
$cfrom :: forall x. Outcome -> Rep Outcome x
Generic)

instance Binary Outcome

teamExplorer :: TeamContinuity
teamExplorer :: TeamContinuity
teamExplorer = Int -> TeamContinuity
TeamContinuity Int
1

hiHeroLong, hiHeroMedium, hiHeroShort, hiDweller :: HiCondPoly

hiHeroShort :: HiCondPoly
hiHeroShort =
  [ ( [(HiIndeterminant
HiLoot, Double
100)]
    , [Outcome
forall a. Bounded a => a
minBound..Outcome
forall a. Bounded a => a
maxBound] )
  , ( [(HiIndeterminant
HiConst, Double
100)]
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiSprint, -Double
500)]  -- speed matters, but only if fast enough
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiSurvival, Double
10)]  -- few points for surviving long
    , [Outcome]
deafeatOutcomes )
  ]

hiHeroMedium :: HiCondPoly
hiHeroMedium =
  [ ( [(HiIndeterminant
HiLoot, Double
200)]  -- usually no loot, but if so, no harm
    , [Outcome
forall a. Bounded a => a
minBound..Outcome
forall a. Bounded a => a
maxBound] )
  , ( [(HiIndeterminant
HiConst, Double
200), (HiIndeterminant
HiLoss, -Double
10)]  -- normally, always positive
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiSprint, -Double
500)]  -- speed matters, but only if fast enough
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiBlitz, -Double
100)]  -- speed matters always
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiSurvival, Double
10)]  -- few points for surviving long
    , [Outcome]
deafeatOutcomes )
  ]

-- Heroes in long crawls rejoice in loot.
hiHeroLong :: HiCondPoly
hiHeroLong =
  [ ( [(HiIndeterminant
HiLoot, Double
10000)]  -- multiplied by fraction of collected
    , [Outcome
forall a. Bounded a => a
minBound..Outcome
forall a. Bounded a => a
maxBound] )
  , ( [(HiIndeterminant
HiConst, Double
15)]  -- a token bonus in case all loot lost, but victory
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiSprint, -Double
20000)]  -- speedrun bonus, if below this number of turns
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiBlitz, -Double
100)]  -- speed matters always
    , [Outcome]
victoryOutcomes )
  , ( [(HiIndeterminant
HiSurvival, Double
10)]  -- few points for surviving long
    , [Outcome]
deafeatOutcomes )
  ]

-- Spawners get no points from loot, but try to kill
-- all opponents fast or at least hold up for long.
hiDweller :: HiCondPoly
hiDweller = [ ( [(HiIndeterminant
HiConst, Double
1000)]  -- no loot, so big win reward
              , [Outcome]
victoryOutcomes )
            , ( [(HiIndeterminant
HiConst, Double
1000), (HiIndeterminant
HiLoss, -Double
10)]
              , [Outcome]
victoryOutcomes )
            , ( [(HiIndeterminant
HiSprint, -Double
1000)]  -- speedrun bonus, if below
              , [Outcome]
victoryOutcomes )
            , ( [(HiIndeterminant
HiBlitz, -Double
100)]  -- speed matters
              , [Outcome]
victoryOutcomes )
            , ( [(HiIndeterminant
HiSurvival, Double
100)]
              , [Outcome]
deafeatOutcomes )
            ]

victoryOutcomes :: [Outcome]
victoryOutcomes :: [Outcome]
victoryOutcomes = [Outcome
Escape, Outcome
Conquer]

deafeatOutcomes :: [Outcome]
deafeatOutcomes :: [Outcome]
deafeatOutcomes = [Outcome
Defeated, Outcome
Killed, Outcome
Restart]

nameOutcomePast :: Outcome -> Text
nameOutcomePast :: Outcome -> Text
nameOutcomePast = \case
  Outcome
Escape   -> Text
"emerged victorious"
  Outcome
Conquer  -> Text
"vanquished all opposition"
  Outcome
Defeated -> Text
"got decisively defeated"
  Outcome
Killed   -> Text
"got eliminated"
  Outcome
Restart  -> Text
"resigned prematurely"
  Outcome
Camping  -> Text
"set camp"

nameOutcomeVerb :: Outcome -> Text
nameOutcomeVerb :: Outcome -> Text
nameOutcomeVerb = \case
  Outcome
Escape   -> Text
"emerge victorious"
  Outcome
Conquer  -> Text
"vanquish all opposition"
  Outcome
Defeated -> Text
"be decisively defeated"
  Outcome
Killed   -> Text
"be eliminated"
  Outcome
Restart  -> Text
"resign prematurely"
  Outcome
Camping  -> Text
"set camp"

endMessageOutcome :: Outcome -> Text
endMessageOutcome :: Outcome -> Text
endMessageOutcome = \case
  Outcome
Escape   -> Text
"Can it be done more efficiently, though?"
  Outcome
Conquer  -> Text
"Can it be done in a better style, though?"
  Outcome
Defeated -> Text
"Let's hope your new overlords let you live."
  Outcome
Killed   -> Text
"Let's hope a rescue party arrives in time!"
  Outcome
Restart  -> Text
"This time for real."
  Outcome
Camping  -> Text
"See you soon, stronger and braver!"

validateSingle :: FactionKind -> [Text]
validateSingle :: FactionKind -> [Text]
validateSingle FactionKind{Bool
HiCondPoly
Freqs ItemKind
Freqs FactionKind
[TeamContinuity]
Text
Doctrine
Skills
TeamContinuity
falliedTeams :: [TeamContinuity]
fenemyTeams :: [TeamContinuity]
finitUnderAI :: Bool
fhasUI :: Bool
fhasPointman :: Bool
fspawnsFast :: Bool
finitDoctrine :: Doctrine
fhasGender :: Bool
fhiCondPoly :: HiCondPoly
fneverEmpty :: Bool
fcanEscape :: Bool
fskillsOther :: Skills
fgroups :: Freqs ItemKind
fteam :: TeamContinuity
ffreq :: Freqs FactionKind
fname :: Text
falliedTeams :: FactionKind -> [TeamContinuity]
fenemyTeams :: FactionKind -> [TeamContinuity]
finitUnderAI :: FactionKind -> Bool
fhasUI :: FactionKind -> Bool
fhasPointman :: FactionKind -> Bool
fspawnsFast :: FactionKind -> Bool
finitDoctrine :: FactionKind -> Doctrine
fhasGender :: FactionKind -> Bool
fhiCondPoly :: FactionKind -> HiCondPoly
fneverEmpty :: FactionKind -> Bool
fcanEscape :: FactionKind -> Bool
fskillsOther :: FactionKind -> Skills
fgroups :: FactionKind -> Freqs ItemKind
fteam :: FactionKind -> TeamContinuity
ffreq :: FactionKind -> Freqs FactionKind
fname :: FactionKind -> Text
..} =
  [ Text
"fname longer than 50" | Text -> Int
T.length Text
fname Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
50 ]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"fskillsOther not negative:" Text -> Text -> Text
<+> Text
fname
     | ((Skill, Int) -> Bool) -> [(Skill, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (Int -> Bool) -> ((Skill, Int) -> Int) -> (Skill, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Skill, Int) -> Int
forall a b. (a, b) -> b
snd) ([(Skill, Int)] -> Bool) -> [(Skill, Int)] -> Bool
forall a b. (a -> b) -> a -> b
$ Skills -> [(Skill, Int)]
Ability.skillsToList Skills
fskillsOther ]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let checkLoveHate :: t a -> a -> [Text]
checkLoveHate t a
l a
team =
           [ Text
"love-hate relationship for" Text -> Text -> Text
<+> a -> Text
forall a. Show a => a -> Text
tshow a
team | a
team a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
l ]
     in (TeamContinuity -> [Text]) -> [TeamContinuity] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([TeamContinuity] -> TeamContinuity -> [Text]
forall (t :: * -> *) a.
(Foldable t, Eq a, Show a) =>
t a -> a -> [Text]
checkLoveHate [TeamContinuity]
fenemyTeams) [TeamContinuity]
falliedTeams
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let checkDipl :: Text -> [a] -> a -> [Text]
checkDipl Text
field [a]
l a
team =
           [ Text
"self-diplomacy in" Text -> Text -> Text
<+> Text
field | [Int] -> Int
forall a. [a] -> Int
length (a -> [a] -> [Int]
forall a. Eq a => a -> [a] -> [Int]
elemIndices a
team [a]
l) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 ]
     in (TeamContinuity -> [Text]) -> [TeamContinuity] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> [TeamContinuity] -> TeamContinuity -> [Text]
forall a. Eq a => Text -> [a] -> a -> [Text]
checkDipl Text
"fenemyTeams" [TeamContinuity]
fenemyTeams) [TeamContinuity]
fenemyTeams
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (TeamContinuity -> [Text]) -> [TeamContinuity] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> [TeamContinuity] -> TeamContinuity -> [Text]
forall a. Eq a => Text -> [a] -> a -> [Text]
checkDipl Text
"falliedTeams" [TeamContinuity]
falliedTeams) [TeamContinuity]
falliedTeams

-- | Validate game faction kinds together.
validateAll :: [FactionKind] -> ContentData FactionKind -> [Text]
validateAll :: [FactionKind] -> ContentData FactionKind -> [Text]
validateAll [FactionKind]
_ ContentData FactionKind
_ = []  -- so far, always valid

makeData :: [FactionKind] -> [GroupName FactionKind] -> [GroupName FactionKind]
         -> ContentData FactionKind
makeData :: [FactionKind]
-> [GroupName FactionKind]
-> [GroupName FactionKind]
-> ContentData FactionKind
makeData = String
-> (FactionKind -> Text)
-> (FactionKind -> Freqs FactionKind)
-> (FactionKind -> [Text])
-> ([FactionKind] -> ContentData FactionKind -> [Text])
-> [FactionKind]
-> [GroupName FactionKind]
-> [GroupName FactionKind]
-> ContentData FactionKind
forall c.
Show c =>
String
-> (c -> Text)
-> (c -> Freqs c)
-> (c -> [Text])
-> ([c] -> ContentData c -> [Text])
-> [c]
-> [GroupName c]
-> [GroupName c]
-> ContentData c
makeContentData String
"FactionKind" FactionKind -> Text
fname FactionKind -> Freqs FactionKind
ffreq FactionKind -> [Text]
validateSingle [FactionKind] -> ContentData FactionKind -> [Text]
validateAll