{-# LANGUAGE DeriveGeneric #-}
-- | The type of kinds of weapons, treasure, organs, blasts, etc.
module Game.LambdaHack.Content.ItemKind
  ( pattern CONDITION, pattern COMMON_ITEM, pattern S_BONUS_HP, pattern S_BRACED, pattern S_ASLEEP, pattern S_IMPRESSED, pattern S_CURRENCY, pattern MOBILE
  , pattern CRAWL_ITEM, pattern TREASURE, pattern ANY_SCROLL, pattern ANY_GLASS, pattern ANY_POTION, pattern ANY_FLASK, pattern EXPLOSIVE, pattern ANY_JEWELRY, pattern S_SINGLE_SPARK, pattern S_SPARK, pattern S_FRAGRANCE
  , pattern HORROR, pattern VALUABLE, pattern UNREPORTED_INVENTORY, pattern AQUATIC
  , ItemKind(..), makeData
  , Aspect(..), Effect(..), Condition(..), DetectKind(..)
  , TimerDice, ThrowMod(..)
  , boostItemKindList, forApplyEffect, forDamageEffect, isDamagingKind
  , strengthOnCombine, strengthOnSmash, getDropOrgans
  , getMandatoryPresentAsFromKind, isEffEscape, isEffEscapeOrAscend
  , timeoutAspect, orEffect, onSmashEffect, onCombineEffect, alwaysDudEffect
  , damageUsefulness, verbMsgNoLonger, verbMsgLess, toVelocity, toLinger
  , timerNone, isTimerNone, foldTimer, toOrganBad, toOrganGood, toOrganNoTimer
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , boostItemKind, onSmashOrCombineEffect
  , validateSingle, validateAll, validateDups, validateDamage
  , mandatoryGroups, mandatoryGroupsSingleton
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Binary
import           Data.Hashable (Hashable)
import qualified Data.Text as T
import           GHC.Generics (Generic)
import qualified System.Random.SplitMix32 as SM

import qualified Game.LambdaHack.Core.Dice as Dice
import           Game.LambdaHack.Core.Random (nextRandom)
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.ContentData
import           Game.LambdaHack.Definition.Defs
import           Game.LambdaHack.Definition.Flavour

-- * Mandatory item groups

mandatoryGroupsSingleton :: [GroupName ItemKind]
mandatoryGroupsSingleton :: [GroupName ItemKind]
mandatoryGroupsSingleton =
       [GroupName ItemKind
S_BONUS_HP, GroupName ItemKind
S_BRACED, GroupName ItemKind
S_ASLEEP, GroupName ItemKind
S_IMPRESSED, GroupName ItemKind
S_CURRENCY]

pattern S_BONUS_HP, S_BRACED, S_ASLEEP, S_IMPRESSED, S_CURRENCY :: GroupName ItemKind

mandatoryGroups :: [GroupName ItemKind]
mandatoryGroups :: [GroupName ItemKind]
mandatoryGroups =
       [GroupName ItemKind
CONDITION, GroupName ItemKind
COMMON_ITEM, GroupName ItemKind
MOBILE]

pattern CONDITION, COMMON_ITEM, MOBILE :: GroupName ItemKind

-- From Preferences.hs

pattern $bCONDITION :: GroupName ItemKind
$mCONDITION :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
CONDITION = GroupName "condition"
pattern $bCOMMON_ITEM :: GroupName ItemKind
$mCOMMON_ITEM :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
COMMON_ITEM = GroupName "common item"

-- Assorted

pattern $bS_BONUS_HP :: GroupName ItemKind
$mS_BONUS_HP :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_BONUS_HP = GroupName "bonus HP"
pattern $bS_BRACED :: GroupName ItemKind
$mS_BRACED :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_BRACED = GroupName "braced"
pattern $bS_ASLEEP :: GroupName ItemKind
$mS_ASLEEP :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_ASLEEP = GroupName "asleep"
pattern $bS_IMPRESSED :: GroupName ItemKind
$mS_IMPRESSED :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_IMPRESSED = GroupName "impressed"
pattern $bS_CURRENCY :: GroupName ItemKind
$mS_CURRENCY :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_CURRENCY = GroupName "currency"
pattern $bMOBILE :: GroupName ItemKind
$mMOBILE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
MOBILE = GroupName "mobile"

-- * Optional item groups

pattern S_SINGLE_SPARK, S_SPARK, S_FRAGRANCE, CRAWL_ITEM, TREASURE, ANY_SCROLL, ANY_GLASS, ANY_POTION, ANY_FLASK, EXPLOSIVE, ANY_JEWELRY, VALUABLE, UNREPORTED_INVENTORY, AQUATIC, HORROR :: GroupName ItemKind

-- Used in Preferences.hs

pattern $bS_SINGLE_SPARK :: GroupName ItemKind
$mS_SINGLE_SPARK :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SINGLE_SPARK = GroupName "single spark"
pattern $bS_SPARK :: GroupName ItemKind
$mS_SPARK :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SPARK = GroupName "spark"
pattern $bS_FRAGRANCE :: GroupName ItemKind
$mS_FRAGRANCE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_FRAGRANCE = GroupName "fragrance"

pattern $bCRAWL_ITEM :: GroupName ItemKind
$mCRAWL_ITEM :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
CRAWL_ITEM = GroupName "curious item"
  -- to be used only in long scenarios, such as multi-level dungeon crawl;
  -- may be a powerful or a mundate item, unlike @TREASURE@ item
pattern $bTREASURE :: GroupName ItemKind
$mTREASURE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
TREASURE = GroupName "treasure"
  -- particularly powerful items, but may appear in any scenario
pattern $bANY_SCROLL :: GroupName ItemKind
$mANY_SCROLL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
ANY_SCROLL = GroupName "scroll"
pattern $bANY_GLASS :: GroupName ItemKind
$mANY_GLASS :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
ANY_GLASS = GroupName "glass"
pattern $bANY_POTION :: GroupName ItemKind
$mANY_POTION :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
ANY_POTION = GroupName "potion"
pattern $bANY_FLASK :: GroupName ItemKind
$mANY_FLASK :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
ANY_FLASK = GroupName "flask"
pattern $bEXPLOSIVE :: GroupName ItemKind
$mEXPLOSIVE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
EXPLOSIVE = GroupName "explosive"
pattern $bANY_JEWELRY :: GroupName ItemKind
$mANY_JEWELRY :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
ANY_JEWELRY = GroupName "jewelry"

-- * Used elsewhere

pattern $bVALUABLE :: GroupName ItemKind
$mVALUABLE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
VALUABLE = GroupName "valuable"
pattern $bUNREPORTED_INVENTORY :: GroupName ItemKind
$mUNREPORTED_INVENTORY :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
UNREPORTED_INVENTORY = GroupName "unreported inventory"
pattern $bAQUATIC :: GroupName ItemKind
$mAQUATIC :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
AQUATIC = GroupName "aquatic"

pattern $bHORROR :: GroupName ItemKind
$mHORROR :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
HORROR = GroupName "horror"

-- | Item properties that are fixed for a given kind of items.
-- Of these, aspects and effects are jointly called item powers.
-- Note that this type is mutually recursive with 'Effect' and `Aspect`.
data ItemKind = ItemKind
  { ItemKind -> Char
isymbol  :: Char            -- ^ map symbol
  , ItemKind -> Text
iname    :: Text            -- ^ generic name; is pluralized if needed
  , ItemKind -> Freqs ItemKind
ifreq    :: Freqs ItemKind  -- ^ frequency within groups
  , ItemKind -> [Flavour]
iflavour :: [Flavour]       -- ^ possible flavours
  , ItemKind -> Dice
icount   :: Dice.Dice       -- ^ created in that quantity
  , ItemKind -> Rarity
irarity  :: Rarity          -- ^ rarity on given depths
  , ItemKind -> Text
iverbHit :: Text            -- ^ the verb for hitting
  , ItemKind -> Int
iweight  :: Int             -- ^ weight in grams
  , ItemKind -> Dice
idamage  :: Dice.Dice       -- ^ basic kinetic damage
  , ItemKind -> [Aspect]
iaspects :: [Aspect]        -- ^ affect the actor continuously
  , ItemKind -> [Effect]
ieffects :: [Effect]        -- ^ cause the effects when triggered
  , ItemKind -> [(GroupName ItemKind, CStore)]
ikit     :: [(GroupName ItemKind, CStore)]
                                -- ^ accompanying organs and equipment
  , ItemKind -> Text
idesc    :: Text            -- ^ description
  }
  deriving Int -> ItemKind -> ShowS
[ItemKind] -> ShowS
ItemKind -> String
(Int -> ItemKind -> ShowS)
-> (ItemKind -> String) -> ([ItemKind] -> ShowS) -> Show ItemKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemKind] -> ShowS
$cshowList :: [ItemKind] -> ShowS
show :: ItemKind -> String
$cshow :: ItemKind -> String
showsPrec :: Int -> ItemKind -> ShowS
$cshowsPrec :: Int -> ItemKind -> ShowS
Show  -- No Eq and Ord to make extending logically sound

-- | Aspects of items. Aspect @AddSkill@ is additive (starting at 0)
-- for all items wielded by an actor and it affects the actor.
-- The others affect only the item in question, not the actor carrying it,
-- and so are not additive in any sense.
data Aspect =
    Timeout Dice.Dice  -- ^ specifies the cooldown before an item may be
                       --   applied again; if a copy of an item is applied
                       --   manually (not via periodic activation),
                       --   all effects on a single copy of the item are
                       --   disabled until the copy recharges for the given
                       --   time expressed in game turns; all copies
                       --   recharge concurrently
  | AddSkill Ability.Skill Dice.Dice
                       -- ^ bonus to a skill; in content, avoid boosting
                       --   skills such as SkApply via permanent equipment,
                       --   to avoid micromanagement through swapping items
                       --   among party members before each skill use
  | SetFlag Ability.Flag
                       -- ^ item feature
  | ELabel Text        -- ^ extra label of the item; it's not pluralized
  | ToThrow ThrowMod   -- ^ parameters modifying a throw
  | PresentAs (GroupName ItemKind)
                       -- ^ until identified, presents as this unique kind
  | EqpSlot Ability.EqpSlot
                       -- ^ AI and UI flag that leaks item intended use
  | Odds Dice.Dice [Aspect] [Aspect]
                       -- ^ if level-scaled dice roll > 50,
                       --   pick the former aspects, otherwise the latter
  deriving (Int -> Aspect -> ShowS
[Aspect] -> ShowS
Aspect -> String
(Int -> Aspect -> ShowS)
-> (Aspect -> String) -> ([Aspect] -> ShowS) -> Show Aspect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Aspect] -> ShowS
$cshowList :: [Aspect] -> ShowS
show :: Aspect -> String
$cshow :: Aspect -> String
showsPrec :: Int -> Aspect -> ShowS
$cshowsPrec :: Int -> Aspect -> ShowS
Show, Aspect -> Aspect -> Bool
(Aspect -> Aspect -> Bool)
-> (Aspect -> Aspect -> Bool) -> Eq Aspect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Aspect -> Aspect -> Bool
$c/= :: Aspect -> Aspect -> Bool
== :: Aspect -> Aspect -> Bool
$c== :: Aspect -> Aspect -> Bool
Eq)

-- | Effects of items. Can be invoked by the item wielder to affect
-- another actor or the wielder himself.
--
-- Various effects of an item kind are all groupped in one list,
-- at the cost of conditionals, sequences, etc., to ensure brevity
-- and simplicity of content definitions. Most effects fire regardless
-- of activation kind (the only exceptions are @OnSmash@ and @OnCombine@
-- effects) so the deviations, handled via the conditionals, are rare
-- and the definitions remain simple. Whether an item can be activated
-- in any particular way, OTOH, is specified via simple flags elsewhere,
-- again, by default, assuming that most activations are possible for all.
data Effect =
    Burn Dice.Dice     -- ^ burn with this damage
  | Explode (GroupName ItemKind)
                       -- ^ explode producing this group of blasts
  | RefillHP Int       -- ^ modify HP of the actor by this amount
  | RefillCalm Int     -- ^ modify Calm of the actor by this amount
  | Dominate           -- ^ change actor's allegiance
  | Impress            -- ^ make actor susceptible to domination
  | PutToSleep         -- ^ put actor to sleep, also calming him
  | Yell               -- ^ make the actor yell/yawn, waking him and others up
  | Summon (GroupName ItemKind) Dice.Dice
      -- ^ summon the given number of actors of this group
  | Ascend Bool           -- ^ ascend to another level of the dungeon
  | Escape                -- ^ escape from the dungeon
  | Paralyze Dice.Dice    -- ^ paralyze for this many game clips
  | ParalyzeInWater Dice.Dice
                          -- ^ paralyze for this many game clips due to water
  | InsertMove Dice.Dice  -- ^ give actor this many extra tenths of actor move
  | Teleport Dice.Dice    -- ^ teleport actor across rougly this distance
  | CreateItem (Maybe Int) CStore (GroupName ItemKind) TimerDice
      -- ^ create an item of the group and insert into the store with the given
      --   random timer; it cardinality not specified, roll it
  | DestroyItem Int Int CStore (GroupName ItemKind)
      -- ^ destroy some items of the group from the store; see below about Ints
  | ConsumeItems [(Int, GroupName ItemKind)] [(Int, GroupName ItemKind)]
      -- ^ @ConsumeItems toUse toDestroy@ uses items matching @toUse@
      --   (destroys non-durable, without invoking OnSmash effects;
      --   applies normal effects of durable, without destroying them;
      --   the same behaviour as when transforming terrain using items)
      --   and destroys items matching @toDestroy@, invoking no effects,
      --   regardless of durability;
      --   the items are taken from @CGround@ (but not from @CEqp@),
      --   preferring non-durable (since durable can harm when used
      --   and may be more vauable when destroyed); if not all required items
      --   are present, no item are destroyed; if an item belongs to many groups
      --   in the sum of @toUse@ and @toDestroy@, it counts for all
      --   (otherwise, some orders of destroying would succeed,
      --   while others would not); even if item durable, as many copies
      --   are needed as specified, not just one applied many times;
      --   items are first destroyed and then, if any copies left, applied
  | DropItem Int Int CStore (GroupName ItemKind)
      -- ^ make the actor drop items of the given group from the given store;
      --   the first integer says how many item kinds to drop, the second,
      --   how many copies of each kind to drop;
      --   for non-organs, beware of not dropping all kinds, or cluttering
      --   store with rubbish becomes beneficial
  | Recharge Int Dice.Dice
      -- ^ reduce the cooldown period of this number of discharged items
      --   in the victim's equipment and organs by this dice of game clips;
      --   if the result is negative, set to 0, instantly recharging the item;
      --   starts with weapons with highest raw damage in equipment,
      --   then among organs, then non-weapons in equipment and among organs;
      --   beware of exploiting for healing periodic items
  | Discharge Int Dice.Dice
      -- ^ increase the cooldown period of this number of fully recharged items
      --   in the victim's equipment and organs by this dice of game clips;
      --   starts with weapons with highest raw damage in equipment,
      --   then among organs, then non-weapons in equipment and among organs;
      --   beware of exploiting for hunger inducing and similar organs
  | PolyItem
      -- ^ get a suitable (i.e., numerous enough) non-unique common item stack
      --   on the floor and polymorph it to a stack of random common items,
      --   with current depth coefficient
  | RerollItem
      -- ^ get a suitable (i.e., with any random aspects) single item
      --   (even unique) on the floor and change the random bonuses
      --   of the items randomly, with maximal depth coefficient
  | DupItem
      -- ^ exactly duplicate a single non-unique, non-valuable item on the floor
  | Identify
      -- ^ find a suitable (i.e., not identified) item, starting from
      --   the floor, and identify it
  | Detect DetectKind Int -- ^ detect something on the map in the given radius
  | SendFlying ThrowMod   -- ^ send an actor flying (push or pull, depending)
  | PushActor ThrowMod    -- ^ push an actor
  | PullActor ThrowMod    -- ^ pull an actor
  | ApplyPerfume          -- ^ remove all smell on the level
  | AtMostOneOf [Effect]  -- ^ try to trigger a single random effect of the list
  | OneOf [Effect]        -- ^ trigger, with equal probability,
                          --   one of the effects that don't end with @UseDud@
  | OnSmash Effect
      -- ^ trigger the effect when item smashed (not when applied nor meleed)
  | OnCombine Effect
      -- ^ trigger the effect only when the actor explicitly desires
      --   to combine items or otherwise subtly tinker with an
      --   item or a tile, e.g., craft items from other items in a workshop;
      --   in particular, don't trigger the effects when entering a tile;
      --   trigger exclusively the effects when activating walkable terrain
  | OnUser Effect  -- ^ apply the effect to the user, not the victim
  | NopEffect                -- ^ nothing happens, @UseDud@, no description
  | AndEffect Effect Effect  -- ^ only fire second effect if first activated
  | OrEffect Effect Effect   -- ^ only fire second effect if first not activated
  | SeqEffect [Effect]       -- ^ fire all effects in order; always suceed
  | When Condition Effect    -- ^ if condition not met, fail without a message;
                             --   better avoided, since AI can't value it well
  | Unless Condition Effect  -- ^ if condition met, fail without a message;
                             --   better avoided, since AI can't value it well
  | IfThenElse Condition Effect Effect
                             -- ^ conditional effect;
                             --   better avoided, since AI can't value it well
  | VerbNoLonger Text Text
      -- ^ a sentence with the actor causing the effect as subject, the given
      --   texts as the verb and the ending of the sentence (that may be
      --   ignored when the message is cited, e.g., as heard by someone)
      --   that is emitted when an activation causes an item to expire;
      --   no spam is emitted if a projectile; the ending is appended
      --   without a space in-between
  | VerbMsg Text Text
      -- ^ as @VerbNoLonger@ but that is emitted whenever the item is activated;
  | VerbMsgFail Text Text
      -- ^ as @VerbMsg@, but a failed effect (returns @UseId@)
  deriving (Int -> Effect -> ShowS
[Effect] -> ShowS
Effect -> String
(Int -> Effect -> ShowS)
-> (Effect -> String) -> ([Effect] -> ShowS) -> Show Effect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Effect] -> ShowS
$cshowList :: [Effect] -> ShowS
show :: Effect -> String
$cshow :: Effect -> String
showsPrec :: Int -> Effect -> ShowS
$cshowsPrec :: Int -> Effect -> ShowS
Show, Effect -> Effect -> Bool
(Effect -> Effect -> Bool)
-> (Effect -> Effect -> Bool) -> Eq Effect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Effect -> Effect -> Bool
$c/= :: Effect -> Effect -> Bool
== :: Effect -> Effect -> Bool
$c== :: Effect -> Effect -> Bool
Eq)

data Condition =
    HpLeq Int
  | HpGeq Int
  | CalmLeq Int
  | CalmGeq Int
  | TriggeredBy Ability.ActivationFlag
  deriving (Int -> Condition -> ShowS
[Condition] -> ShowS
Condition -> String
(Int -> Condition -> ShowS)
-> (Condition -> String)
-> ([Condition] -> ShowS)
-> Show Condition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Condition] -> ShowS
$cshowList :: [Condition] -> ShowS
show :: Condition -> String
$cshow :: Condition -> String
showsPrec :: Int -> Condition -> ShowS
$cshowsPrec :: Int -> Condition -> ShowS
Show, Condition -> Condition -> Bool
(Condition -> Condition -> Bool)
-> (Condition -> Condition -> Bool) -> Eq Condition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Condition -> Condition -> Bool
$c/= :: Condition -> Condition -> Bool
== :: Condition -> Condition -> Bool
$c== :: Condition -> Condition -> Bool
Eq)

data DetectKind =
    DetectAll
  | DetectActor
  | DetectLoot
  | DetectExit
  | DetectHidden
  | DetectEmbed
  | DetectStash
  deriving (Int -> DetectKind -> ShowS
[DetectKind] -> ShowS
DetectKind -> String
(Int -> DetectKind -> ShowS)
-> (DetectKind -> String)
-> ([DetectKind] -> ShowS)
-> Show DetectKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectKind] -> ShowS
$cshowList :: [DetectKind] -> ShowS
show :: DetectKind -> String
$cshow :: DetectKind -> String
showsPrec :: Int -> DetectKind -> ShowS
$cshowsPrec :: Int -> DetectKind -> ShowS
Show, DetectKind -> DetectKind -> Bool
(DetectKind -> DetectKind -> Bool)
-> (DetectKind -> DetectKind -> Bool) -> Eq DetectKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectKind -> DetectKind -> Bool
$c/= :: DetectKind -> DetectKind -> Bool
== :: DetectKind -> DetectKind -> Bool
$c== :: DetectKind -> DetectKind -> Bool
Eq)

-- | Specification of how to randomly roll a timer at item creation
-- to obtain a fixed timer for the item's lifetime.
data TimerDice =
    TimerNone
  | TimerGameTurn Dice.Dice
  | TimerActorTurn Dice.Dice
  deriving TimerDice -> TimerDice -> Bool
(TimerDice -> TimerDice -> Bool)
-> (TimerDice -> TimerDice -> Bool) -> Eq TimerDice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimerDice -> TimerDice -> Bool
$c/= :: TimerDice -> TimerDice -> Bool
== :: TimerDice -> TimerDice -> Bool
$c== :: TimerDice -> TimerDice -> Bool
Eq

instance Show TimerDice where
  show :: TimerDice -> String
show TimerNone = "0"
  show (TimerGameTurn nDm :: Dice
nDm) =
    Dice -> String
forall a. Show a => a -> String
show Dice
nDm String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ if Dice
nDm Dice -> Dice -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then "turn" else "turns"
  show (TimerActorTurn nDm :: Dice
nDm) =
    Dice -> String
forall a. Show a => a -> String
show Dice
nDm String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ if Dice
nDm Dice -> Dice -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then "move" else "moves"

-- | Parameters modifying a throw of a projectile or flight of pushed actor.
-- Not additive and don't start at 0.
data ThrowMod = ThrowMod
  { ThrowMod -> Int
throwVelocity :: Int  -- ^ fly with this percentage of base throw speed
  , ThrowMod -> Int
throwLinger   :: Int  -- ^ fly for this percentage of 2 turns
  , ThrowMod -> Int
throwHP       :: Int  -- ^ start flight with this many HP
  }
  deriving (Int -> ThrowMod -> ShowS
[ThrowMod] -> ShowS
ThrowMod -> String
(Int -> ThrowMod -> ShowS)
-> (ThrowMod -> String) -> ([ThrowMod] -> ShowS) -> Show ThrowMod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThrowMod] -> ShowS
$cshowList :: [ThrowMod] -> ShowS
show :: ThrowMod -> String
$cshow :: ThrowMod -> String
showsPrec :: Int -> ThrowMod -> ShowS
$cshowsPrec :: Int -> ThrowMod -> ShowS
Show, ThrowMod -> ThrowMod -> Bool
(ThrowMod -> ThrowMod -> Bool)
-> (ThrowMod -> ThrowMod -> Bool) -> Eq ThrowMod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThrowMod -> ThrowMod -> Bool
$c/= :: ThrowMod -> ThrowMod -> Bool
== :: ThrowMod -> ThrowMod -> Bool
$c== :: ThrowMod -> ThrowMod -> Bool
Eq, Eq ThrowMod
Eq ThrowMod =>
(ThrowMod -> ThrowMod -> Ordering)
-> (ThrowMod -> ThrowMod -> Bool)
-> (ThrowMod -> ThrowMod -> Bool)
-> (ThrowMod -> ThrowMod -> Bool)
-> (ThrowMod -> ThrowMod -> Bool)
-> (ThrowMod -> ThrowMod -> ThrowMod)
-> (ThrowMod -> ThrowMod -> ThrowMod)
-> Ord ThrowMod
ThrowMod -> ThrowMod -> Bool
ThrowMod -> ThrowMod -> Ordering
ThrowMod -> ThrowMod -> ThrowMod
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 :: ThrowMod -> ThrowMod -> ThrowMod
$cmin :: ThrowMod -> ThrowMod -> ThrowMod
max :: ThrowMod -> ThrowMod -> ThrowMod
$cmax :: ThrowMod -> ThrowMod -> ThrowMod
>= :: ThrowMod -> ThrowMod -> Bool
$c>= :: ThrowMod -> ThrowMod -> Bool
> :: ThrowMod -> ThrowMod -> Bool
$c> :: ThrowMod -> ThrowMod -> Bool
<= :: ThrowMod -> ThrowMod -> Bool
$c<= :: ThrowMod -> ThrowMod -> Bool
< :: ThrowMod -> ThrowMod -> Bool
$c< :: ThrowMod -> ThrowMod -> Bool
compare :: ThrowMod -> ThrowMod -> Ordering
$ccompare :: ThrowMod -> ThrowMod -> Ordering
$cp1Ord :: Eq ThrowMod
Ord, (forall x. ThrowMod -> Rep ThrowMod x)
-> (forall x. Rep ThrowMod x -> ThrowMod) -> Generic ThrowMod
forall x. Rep ThrowMod x -> ThrowMod
forall x. ThrowMod -> Rep ThrowMod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ThrowMod x -> ThrowMod
$cfrom :: forall x. ThrowMod -> Rep ThrowMod x
Generic)

instance Binary ThrowMod

instance Hashable ThrowMod

boostItemKindList :: SM.SMGen -> [ItemKind] -> [ItemKind]
boostItemKindList :: SMGen -> [ItemKind] -> [ItemKind]
boostItemKindList _ [] = []
boostItemKindList initialGen :: SMGen
initialGen l :: [ItemKind]
l =
  let (r :: Int
r, _) = Int -> SMGen -> (Int, SMGen)
forall a. Integral a => a -> SMGen -> (a, SMGen)
nextRandom ([ItemKind] -> Int
forall a. [a] -> Int
length [ItemKind]
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) SMGen
initialGen
  in case Int -> [ItemKind] -> ([ItemKind], [ItemKind])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
r [ItemKind]
l of
    (pre :: [ItemKind]
pre, i :: ItemKind
i : post :: [ItemKind]
post) -> [ItemKind]
pre [ItemKind] -> [ItemKind] -> [ItemKind]
forall a. [a] -> [a] -> [a]
++ ItemKind -> ItemKind
boostItemKind ItemKind
i ItemKind -> [ItemKind] -> [ItemKind]
forall a. a -> [a] -> [a]
: [ItemKind]
post
    _               -> String -> [ItemKind]
forall a. HasCallStack => String -> a
error (String -> [ItemKind]) -> String -> [ItemKind]
forall a b. (a -> b) -> a -> b
$ "" String -> [ItemKind] -> String
forall v. Show v => String -> v -> String
`showFailure` [ItemKind]
l

boostItemKind :: ItemKind -> ItemKind
boostItemKind :: ItemKind -> ItemKind
boostItemKind i :: ItemKind
i =
  let mainlineLabel :: (GroupName ItemKind, b) -> Bool
mainlineLabel (label :: GroupName ItemKind
label, _) =
        GroupName ItemKind
label GroupName ItemKind -> [GroupName ItemKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GroupName ItemKind
COMMON_ITEM, GroupName ItemKind
CRAWL_ITEM, GroupName ItemKind
TREASURE]
  in if ((GroupName ItemKind, Int) -> Bool) -> Freqs ItemKind -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (GroupName ItemKind, Int) -> Bool
forall b. (GroupName ItemKind, b) -> Bool
mainlineLabel (ItemKind -> Freqs ItemKind
ifreq ItemKind
i)
     then ItemKind
i { ifreq :: Freqs ItemKind
ifreq = (GroupName ItemKind
COMMON_ITEM, 10000) (GroupName ItemKind, Int) -> Freqs ItemKind -> Freqs ItemKind
forall a. a -> [a] -> [a]
: ((GroupName ItemKind, Int) -> Bool)
-> Freqs ItemKind -> Freqs ItemKind
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((GroupName ItemKind, Int) -> Bool)
-> (GroupName ItemKind, Int)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupName ItemKind, Int) -> Bool
forall b. (GroupName ItemKind, b) -> Bool
mainlineLabel)
                                                    (ItemKind -> Freqs ItemKind
ifreq ItemKind
i)
            , iaspects :: [Aspect]
iaspects = Aspect -> [Aspect] -> [Aspect]
forall a. Eq a => a -> [a] -> [a]
delete (Flag -> Aspect
SetFlag Flag
Ability.Unique) ([Aspect] -> [Aspect]) -> [Aspect] -> [Aspect]
forall a b. (a -> b) -> a -> b
$ ItemKind -> [Aspect]
iaspects ItemKind
i
            }
     else ItemKind
i

-- | Whether the effect has a chance of exhibiting any potentially
-- noticeable behaviour, except when the item is destroyed or combined.
-- We assume at least one of @OneOf@ effects must be noticeable.
forApplyEffect :: Effect -> Bool
forApplyEffect :: Effect -> Bool
forApplyEffect eff :: Effect
eff = case Effect
eff of
  OnSmash{} -> Bool
False
  OnCombine{} -> Bool
False
  OnUser eff1 :: Effect
eff1 -> Effect -> Bool
forApplyEffect Effect
eff1
  NopEffect -> Bool
False
  AndEffect eff1 :: Effect
eff1 eff2 :: Effect
eff2 -> Effect -> Bool
forApplyEffect Effect
eff1 Bool -> Bool -> Bool
|| Effect -> Bool
forApplyEffect Effect
eff2
  OrEffect eff1 :: Effect
eff1 eff2 :: Effect
eff2 -> Effect -> Bool
forApplyEffect Effect
eff1 Bool -> Bool -> Bool
|| Effect -> Bool
forApplyEffect Effect
eff2
  SeqEffect effs :: [Effect]
effs -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Effect -> Bool) -> [Effect] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Effect -> Bool
forApplyEffect [Effect]
effs
  When _ eff1 :: Effect
eff1 -> Effect -> Bool
forApplyEffect Effect
eff1
  Unless _ eff1 :: Effect
eff1 -> Effect -> Bool
forApplyEffect Effect
eff1
  IfThenElse _ eff1 :: Effect
eff1 eff2 :: Effect
eff2 -> Effect -> Bool
forApplyEffect Effect
eff1 Bool -> Bool -> Bool
|| Effect -> Bool
forApplyEffect Effect
eff2
  VerbNoLonger{} -> Bool
False
  VerbMsg{} -> Bool
False
  VerbMsgFail{} -> Bool
False
  ParalyzeInWater{} -> Bool
False  -- barely noticeable, spams when resisted
  _ -> Bool
True

-- | Whether a non-nested effect always applies raw damage.
forDamageEffect :: Effect -> Bool
forDamageEffect :: Effect -> Bool
forDamageEffect eff :: Effect
eff = case Effect
eff of
  Burn{} -> Bool
True
  RefillHP n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 -> Bool
True
  _ -> Bool
False

-- | Whether an item is damaging. Such items may trigger embedded items
-- and may collide with bursting items mid-air.
isDamagingKind :: ItemKind -> Bool
isDamagingKind :: ItemKind -> Bool
isDamagingKind itemKind :: ItemKind
itemKind = Dice -> Int
Dice.infDice (ItemKind -> Dice
idamage ItemKind
itemKind) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
                          Bool -> Bool -> Bool
|| (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
forDamageEffect (ItemKind -> [Effect]
ieffects ItemKind
itemKind)

isEffEscape :: Effect -> Bool
isEffEscape :: Effect -> Bool
isEffEscape Escape{} = Bool
True
isEffEscape (AtMostOneOf l :: [Effect]
l) = (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
isEffEscape [Effect]
l
isEffEscape (OneOf l :: [Effect]
l) = (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
isEffEscape [Effect]
l
isEffEscape (OnCombine eff :: Effect
eff) = Effect -> Bool
isEffEscape Effect
eff
isEffEscape (OnUser eff :: Effect
eff) = Effect -> Bool
isEffEscape Effect
eff
isEffEscape (AndEffect eff1 :: Effect
eff1 eff2 :: Effect
eff2) = Effect -> Bool
isEffEscape Effect
eff1 Bool -> Bool -> Bool
|| Effect -> Bool
isEffEscape Effect
eff2
isEffEscape (OrEffect eff1 :: Effect
eff1 eff2 :: Effect
eff2) = Effect -> Bool
isEffEscape Effect
eff1 Bool -> Bool -> Bool
|| Effect -> Bool
isEffEscape Effect
eff2
isEffEscape (SeqEffect effs :: [Effect]
effs) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Effect -> Bool) -> [Effect] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Effect -> Bool
isEffEscape [Effect]
effs
isEffEscape (When _ eff :: Effect
eff) = Effect -> Bool
isEffEscape Effect
eff
isEffEscape (Unless _ eff :: Effect
eff) = Effect -> Bool
isEffEscape Effect
eff
isEffEscape (IfThenElse _ eff1 :: Effect
eff1 eff2 :: Effect
eff2) = Effect -> Bool
isEffEscape Effect
eff1 Bool -> Bool -> Bool
|| Effect -> Bool
isEffEscape Effect
eff2
isEffEscape _ = Bool
False

isEffEscapeOrAscend :: Effect -> Bool
isEffEscapeOrAscend :: Effect -> Bool
isEffEscapeOrAscend Ascend{} = Bool
True
isEffEscapeOrAscend Escape{} = Bool
True
isEffEscapeOrAscend (AtMostOneOf l :: [Effect]
l) = (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
isEffEscapeOrAscend [Effect]
l
isEffEscapeOrAscend (OneOf l :: [Effect]
l) = (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
isEffEscapeOrAscend [Effect]
l
isEffEscapeOrAscend (OnCombine eff :: Effect
eff) = Effect -> Bool
isEffEscapeOrAscend Effect
eff
isEffEscapeOrAscend (OnUser eff :: Effect
eff) = Effect -> Bool
isEffEscapeOrAscend Effect
eff
isEffEscapeOrAscend (AndEffect eff1 :: Effect
eff1 eff2 :: Effect
eff2) =
  Effect -> Bool
isEffEscapeOrAscend Effect
eff1 Bool -> Bool -> Bool
|| Effect -> Bool
isEffEscapeOrAscend Effect
eff2
isEffEscapeOrAscend (OrEffect eff1 :: Effect
eff1 eff2 :: Effect
eff2) =
  Effect -> Bool
isEffEscapeOrAscend Effect
eff1 Bool -> Bool -> Bool
|| Effect -> Bool
isEffEscapeOrAscend Effect
eff2
isEffEscapeOrAscend (SeqEffect effs :: [Effect]
effs) =
  [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Effect -> Bool) -> [Effect] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Effect -> Bool
isEffEscapeOrAscend [Effect]
effs
isEffEscapeOrAscend (When _ eff :: Effect
eff) = Effect -> Bool
isEffEscapeOrAscend Effect
eff
isEffEscapeOrAscend (Unless _ eff :: Effect
eff) = Effect -> Bool
isEffEscapeOrAscend Effect
eff
isEffEscapeOrAscend (IfThenElse _ eff1 :: Effect
eff1 eff2 :: Effect
eff2) =
  Effect -> Bool
isEffEscapeOrAscend Effect
eff1 Bool -> Bool -> Bool
|| Effect -> Bool
isEffEscapeOrAscend Effect
eff2
isEffEscapeOrAscend _ = Bool
False

timeoutAspect :: Aspect -> Bool
timeoutAspect :: Aspect -> Bool
timeoutAspect Timeout{} = Bool
True
timeoutAspect _ = Bool
False

orEffect :: Effect -> Bool
orEffect :: Effect -> Bool
orEffect OrEffect{} = Bool
True
orEffect _ = Bool
False

onSmashEffect :: Effect -> Bool
onSmashEffect :: Effect -> Bool
onSmashEffect OnSmash{} = Bool
True
onSmashEffect _ = Bool
False

onCombineEffect :: Effect -> Bool
onCombineEffect :: Effect -> Bool
onCombineEffect OnCombine{} = Bool
True
onCombineEffect _ = Bool
False

onSmashOrCombineEffect :: Effect -> Bool
onSmashOrCombineEffect :: Effect -> Bool
onSmashOrCombineEffect OnSmash{} = Bool
True
onSmashOrCombineEffect OnCombine{} = Bool
True
onSmashOrCombineEffect _ = Bool
False

alwaysDudEffect :: Effect -> Bool
alwaysDudEffect :: Effect -> Bool
alwaysDudEffect OnSmash{} = Bool
True
alwaysDudEffect OnCombine{} = Bool
True
alwaysDudEffect NopEffect = Bool
True
alwaysDudEffect _ = Bool
False

strengthOnSmash :: ItemKind -> [Effect]
strengthOnSmash :: ItemKind -> [Effect]
strengthOnSmash =
  let f :: Effect -> [Effect]
f (OnSmash eff :: Effect
eff) = [Effect
eff]
      f _ = []
  in (Effect -> [Effect]) -> [Effect] -> [Effect]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Effect -> [Effect]
f ([Effect] -> [Effect])
-> (ItemKind -> [Effect]) -> ItemKind -> [Effect]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemKind -> [Effect]
ieffects

strengthOnCombine :: ItemKind -> [Effect]
strengthOnCombine :: ItemKind -> [Effect]
strengthOnCombine =
  let f :: Effect -> [Effect]
f (OnCombine eff :: Effect
eff) = [Effect
eff]
      f _ = []
  in (Effect -> [Effect]) -> [Effect] -> [Effect]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Effect -> [Effect]
f ([Effect] -> [Effect])
-> (ItemKind -> [Effect]) -> ItemKind -> [Effect]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemKind -> [Effect]
ieffects

getDropOrgans :: ItemKind -> [GroupName ItemKind]
getDropOrgans :: ItemKind -> [GroupName ItemKind]
getDropOrgans =
  let f :: Effect -> [GroupName ItemKind]
f (DestroyItem _ _ COrgan grp :: GroupName ItemKind
grp) = [GroupName ItemKind
grp]
      f (DropItem _ _ COrgan grp :: GroupName ItemKind
grp) = [GroupName ItemKind
grp]
      f Impress = [GroupName ItemKind
S_IMPRESSED]
      f (AtMostOneOf l :: [Effect]
l) = (Effect -> [GroupName ItemKind])
-> [Effect] -> [GroupName ItemKind]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Effect -> [GroupName ItemKind]
f [Effect]
l  -- even remote possibility accepted
      f (OneOf l :: [Effect]
l) = (Effect -> [GroupName ItemKind])
-> [Effect] -> [GroupName ItemKind]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Effect -> [GroupName ItemKind]
f [Effect]
l  -- even remote possibility accepted
      f (OnUser eff :: Effect
eff) = Effect -> [GroupName ItemKind]
f Effect
eff  -- no OnCombine, because checked for potions, etc.
      f (AndEffect eff1 :: Effect
eff1 eff2 :: Effect
eff2) = Effect -> [GroupName ItemKind]
f Effect
eff1 [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ Effect -> [GroupName ItemKind]
f Effect
eff2  -- not certain, but accepted
      f (OrEffect eff1 :: Effect
eff1 eff2 :: Effect
eff2) = Effect -> [GroupName ItemKind]
f Effect
eff1 [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ Effect -> [GroupName ItemKind]
f Effect
eff2  -- not certain, but accepted
      f (SeqEffect effs :: [Effect]
effs) = (Effect -> [GroupName ItemKind])
-> [Effect] -> [GroupName ItemKind]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Effect -> [GroupName ItemKind]
f [Effect]
effs
      f (When _ eff :: Effect
eff) = Effect -> [GroupName ItemKind]
f Effect
eff
      f (Unless _ eff :: Effect
eff) = Effect -> [GroupName ItemKind]
f Effect
eff
      f (IfThenElse _ eff1 :: Effect
eff1 eff2 :: Effect
eff2) = Effect -> [GroupName ItemKind]
f Effect
eff1 [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ Effect -> [GroupName ItemKind]
f Effect
eff2
      f _ = []
  in (Effect -> [GroupName ItemKind])
-> [Effect] -> [GroupName ItemKind]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Effect -> [GroupName ItemKind]
f ([Effect] -> [GroupName ItemKind])
-> (ItemKind -> [Effect]) -> ItemKind -> [GroupName ItemKind]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemKind -> [Effect]
ieffects

-- Anything under @Odds@ is ignored, because it's not mandatory.
getMandatoryPresentAsFromKind :: ItemKind -> Maybe (GroupName ItemKind)
getMandatoryPresentAsFromKind :: ItemKind -> Maybe (GroupName ItemKind)
getMandatoryPresentAsFromKind itemKind :: ItemKind
itemKind =
  let f :: Aspect -> [GroupName ItemKind]
f (PresentAs grp :: GroupName ItemKind
grp) = [GroupName ItemKind
grp]
      f _ = []
  in [GroupName ItemKind] -> Maybe (GroupName ItemKind)
forall a. [a] -> Maybe a
listToMaybe ([GroupName ItemKind] -> Maybe (GroupName ItemKind))
-> [GroupName ItemKind] -> Maybe (GroupName ItemKind)
forall a b. (a -> b) -> a -> b
$ (Aspect -> [GroupName ItemKind])
-> [Aspect] -> [GroupName ItemKind]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Aspect -> [GroupName ItemKind]
f (ItemKind -> [Aspect]
iaspects ItemKind
itemKind)

damageUsefulness :: ItemKind -> Double
damageUsefulness :: ItemKind -> Double
damageUsefulness itemKind :: ItemKind
itemKind =
  let v :: Double
v = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min 1000 (10 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Dice -> Double
Dice.meanDice (ItemKind -> Dice
idamage ItemKind
itemKind))
  in Bool -> Double -> Double
forall a. HasCallStack => Bool -> a -> a
assert (Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= 0) Double
v

verbMsgNoLonger :: Text -> Effect
verbMsgNoLonger :: Text -> Effect
verbMsgNoLonger name :: Text
name = Text -> Text -> Effect
VerbNoLonger ("be no longer" Text -> Text -> Text
<+> Text
name) "."

verbMsgLess :: Text -> Effect
verbMsgLess :: Text -> Effect
verbMsgLess name :: Text
name = Text -> Text -> Effect
VerbMsg ("appear less" Text -> Text -> Text
<+> Text
name) "."

toVelocity :: Int -> Aspect
toVelocity :: Int -> Aspect
toVelocity n :: Int
n = ThrowMod -> Aspect
ToThrow (ThrowMod -> Aspect) -> ThrowMod -> Aspect
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> ThrowMod
ThrowMod Int
n 100 1

toLinger :: Int -> Aspect
toLinger :: Int -> Aspect
toLinger n :: Int
n = ThrowMod -> Aspect
ToThrow (ThrowMod -> Aspect) -> ThrowMod -> Aspect
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> ThrowMod
ThrowMod 100 Int
n 1

timerNone :: TimerDice
timerNone :: TimerDice
timerNone = TimerDice
TimerNone

isTimerNone :: TimerDice -> Bool
isTimerNone :: TimerDice -> Bool
isTimerNone tim :: TimerDice
tim = TimerDice
tim TimerDice -> TimerDice -> Bool
forall a. Eq a => a -> a -> Bool
== TimerDice
TimerNone

foldTimer :: a -> (Dice.Dice -> a) -> (Dice.Dice -> a) -> TimerDice -> a
foldTimer :: a -> (Dice -> a) -> (Dice -> a) -> TimerDice -> a
foldTimer a :: a
a fgame :: Dice -> a
fgame factor :: Dice -> a
factor tim :: TimerDice
tim = case TimerDice
tim of
  TimerNone -> a
a
  TimerGameTurn nDm :: Dice
nDm -> Dice -> a
fgame Dice
nDm
  TimerActorTurn nDm :: Dice
nDm -> Dice -> a
factor Dice
nDm

toOrganBad :: GroupName ItemKind -> Dice.Dice -> Effect
toOrganBad :: GroupName ItemKind -> Dice -> Effect
toOrganBad grp :: GroupName ItemKind
grp nDm :: Dice
nDm = Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
COrgan GroupName ItemKind
grp (Dice -> TimerDice
TimerGameTurn Dice
nDm)

toOrganGood :: GroupName ItemKind -> Dice.Dice -> Effect
toOrganGood :: GroupName ItemKind -> Dice -> Effect
toOrganGood grp :: GroupName ItemKind
grp nDm :: Dice
nDm = Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
COrgan GroupName ItemKind
grp (Dice -> TimerDice
TimerActorTurn Dice
nDm)

toOrganNoTimer :: GroupName ItemKind -> Effect
toOrganNoTimer :: GroupName ItemKind -> Effect
toOrganNoTimer grp :: GroupName ItemKind
grp = Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
COrgan GroupName ItemKind
grp TimerDice
TimerNone

-- | Catch invalid item kind definitions.
validateSingle :: ItemKind -> [Text]
validateSingle :: ItemKind -> [Text]
validateSingle ik :: ItemKind
ik@ItemKind{..} =
  ["iname longer than 23" | Text -> Int
T.length Text
iname Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 23]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ ["icount < 0" | Dice -> Int
Dice.infDice Dice
icount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Rarity -> [Text]
validateRarity Rarity
irarity
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Dice -> [Text]
validateDamage Dice
idamage
  -- Reject duplicate Timeout, because it's not additive.
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (let ts :: [Aspect]
ts = (Aspect -> Bool) -> [Aspect] -> [Aspect]
forall a. (a -> Bool) -> [a] -> [a]
filter Aspect -> Bool
timeoutAspect [Aspect]
iaspects
      in ["more than one Timeout specification" | [Aspect] -> Int
forall a. [a] -> Int
length [Aspect]
ts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1])
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ "Conflicting Fragile and Durable"
     | Flag -> Aspect
SetFlag Flag
Ability.Fragile Aspect -> [Aspect] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Aspect]
iaspects
       Bool -> Bool -> Bool
&& Flag -> Aspect
SetFlag Flag
Ability.Durable Aspect -> [Aspect] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Aspect]
iaspects ]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (let f :: Aspect -> Bool
          f :: Aspect -> Bool
f EqpSlot{} = Bool
True
          f _ = Bool
False
          ts :: [Aspect]
ts = (Aspect -> Bool) -> [Aspect] -> [Aspect]
forall a. (a -> Bool) -> [a] -> [a]
filter Aspect -> Bool
f [Aspect]
iaspects
          equipable :: Bool
equipable = Flag -> Aspect
SetFlag Flag
Ability.Equipable Aspect -> [Aspect] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Aspect]
iaspects
          meleeable :: Bool
meleeable = Flag -> Aspect
SetFlag Flag
Ability.Meleeable Aspect -> [Aspect] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Aspect]
iaspects
          likelyTemplate :: Bool
likelyTemplate = case Freqs ItemKind
ifreq of
            [(grp :: GroupName ItemKind
grp, 1)] -> "unknown" Text -> Text -> Bool
`T.isSuffixOf` GroupName ItemKind -> Text
forall a. GroupName a -> Text
fromGroupName GroupName ItemKind
grp
            _ -> Bool
False
          likelyException :: Bool
likelyException = Char
isymbol Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [',', '"', '-'] Bool -> Bool -> Bool
|| Bool
likelyTemplate
      in [ "EqpSlot specified but not Equipable nor Meleeable"
         | [Aspect] -> Int
forall a. [a] -> Int
length [Aspect]
ts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
equipable Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
meleeable ]
         [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ "EqpSlot not specified but Equipable or Meleeable and not a likely organ or necklace or template"
            | Bool -> Bool
not Bool
likelyException
              Bool -> Bool -> Bool
&& [Aspect] -> Int
forall a. [a] -> Int
length [Aspect]
ts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
&& (Bool
equipable Bool -> Bool -> Bool
|| Bool
meleeable) ]
         [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ "More than one EqpSlot specified"
            | [Aspect] -> Int
forall a. [a] -> Int
length [Aspect]
ts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 ] )
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ "Redundant Equipable or Meleeable"
     | Flag -> Aspect
SetFlag Flag
Ability.Equipable Aspect -> [Aspect] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Aspect]
iaspects
       Bool -> Bool -> Bool
&& Flag -> Aspect
SetFlag Flag
Ability.Meleeable Aspect -> [Aspect] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Aspect]
iaspects ]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ "Conflicting Durable and Blast"
     | Flag -> Aspect
SetFlag Flag
Ability.Durable Aspect -> [Aspect] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Aspect]
iaspects
       Bool -> Bool -> Bool
&& Flag -> Aspect
SetFlag Flag
Ability.Blast Aspect -> [Aspect] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Aspect]
iaspects ]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ "Conflicting Durable and Condition"
     | Flag -> Aspect
SetFlag Flag
Ability.Durable Aspect -> [Aspect] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Aspect]
iaspects
       Bool -> Bool -> Bool
&& Flag -> Aspect
SetFlag Flag
Ability.Condition Aspect -> [Aspect] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Aspect]
iaspects ]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ "Conflicting Blast and Condition"
     | Flag -> Aspect
SetFlag Flag
Ability.Blast Aspect -> [Aspect] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Aspect]
iaspects
       Bool -> Bool -> Bool
&& Flag -> Aspect
SetFlag Flag
Ability.Condition Aspect -> [Aspect] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Aspect]
iaspects ]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (let f :: Aspect -> Bool
          f :: Aspect -> Bool
f ELabel{} = Bool
True
          f _ = Bool
False
          ts :: [Aspect]
ts = (Aspect -> Bool) -> [Aspect] -> [Aspect]
forall a. (a -> Bool) -> [a] -> [a]
filter Aspect -> Bool
f [Aspect]
iaspects
      in ["more than one ELabel specification" | [Aspect] -> Int
forall a. [a] -> Int
length [Aspect]
ts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1])
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (let f :: Aspect -> Bool
          f :: Aspect -> Bool
f ToThrow{} = Bool
True
          f _ = Bool
False
          ts :: [Aspect]
ts = (Aspect -> Bool) -> [Aspect] -> [Aspect]
forall a. (a -> Bool) -> [a] -> [a]
filter Aspect -> Bool
f [Aspect]
iaspects
      in ["more than one ToThrow specification" | [Aspect] -> Int
forall a. [a] -> Int
length [Aspect]
ts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1])
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (let f :: Aspect -> Bool
          f :: Aspect -> Bool
f PresentAs{} = Bool
True
          f _ = Bool
False
          ts :: [Aspect]
ts = (Aspect -> Bool) -> [Aspect] -> [Aspect]
forall a. (a -> Bool) -> [a] -> [a]
filter Aspect -> Bool
f [Aspect]
iaspects
      in ["more than one PresentAs specification" | [Aspect] -> Int
forall a. [a] -> Int
length [Aspect]
ts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1])
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Aspect -> [Text]) -> [Aspect] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ItemKind -> Aspect -> [Text]
validateDups ItemKind
ik) ((Flag -> Aspect) -> [Flag] -> [Aspect]
forall a b. (a -> b) -> [a] -> [b]
map Flag -> Aspect
SetFlag [Flag
forall a. Bounded a => a
minBound .. Flag
forall a. Bounded a => a
maxBound])
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (let f :: Effect -> Bool
          f :: Effect -> Bool
f VerbNoLonger{} = Bool
True
          f _ = Bool
False
      in [Effect] -> Text -> (Effect -> Bool) -> [Text]
validateOnlyOne [Effect]
ieffects "VerbNoLonger" Effect -> Bool
f)  -- may be duped if nested
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (let f :: Effect -> Bool
          f :: Effect -> Bool
f VerbMsg{} = Bool
True
          f _ = Bool
False
      in [Effect] -> Text -> (Effect -> Bool) -> [Text]
validateOnlyOne [Effect]
ieffects "VerbMsg" Effect -> Bool
f)  -- may be duplicated if nested
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (let f :: Effect -> Bool
          f :: Effect -> Bool
f VerbMsgFail{} = Bool
True
          f _ = Bool
False
      in [Effect] -> Text -> (Effect -> Bool) -> [Text]
validateOnlyOne [Effect]
ieffects "VerbMsgFail" Effect -> Bool
f)  -- may be duped if nested
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Effect] -> Text -> (Effect -> Bool) -> [Text]
validateNotNested [Effect]
ieffects "OnSmash or OnCombine" Effect -> Bool
onSmashOrCombineEffect
       -- but duplicates permitted
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let nonPositiveBurn :: Effect -> Bool
         nonPositiveBurn :: Effect -> Bool
nonPositiveBurn (Burn d :: Dice
d) = Dice -> Int
Dice.infDice Dice
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
         nonPositiveBurn _ = Bool
False
         containingNonPositiveBurn :: [Effect]
containingNonPositiveBurn =
           (Effect -> Bool) -> [Effect] -> [Effect]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Effect -> Bool) -> Effect -> Bool
checkSubEffectProp Effect -> Bool
nonPositiveBurn) [Effect]
ieffects
     in [ "effects with non-positive Burn:" Text -> Text -> Text
<+> [Effect] -> Text
forall a. Show a => a -> Text
tshow [Effect]
containingNonPositiveBurn
        | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Effect] -> Bool
forall a. [a] -> Bool
null [Effect]
containingNonPositiveBurn ]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let emptyOneOf :: Effect -> Bool
         emptyOneOf :: Effect -> Bool
emptyOneOf (AtMostOneOf []) = Bool
True
         emptyOneOf (OneOf []) = Bool
True
         emptyOneOf _ = Bool
False
         containingEmptyOneOf :: [Effect]
containingEmptyOneOf = (Effect -> Bool) -> [Effect] -> [Effect]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Effect -> Bool) -> Effect -> Bool
checkSubEffectProp Effect -> Bool
emptyOneOf) [Effect]
ieffects
     in [ "effects with empty AtMostOneOf or OneOf:"
          Text -> Text -> Text
<+> [Effect] -> Text
forall a. Show a => a -> Text
tshow [Effect]
containingEmptyOneOf
        | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Effect] -> Bool
forall a. [a] -> Bool
null [Effect]
containingEmptyOneOf ]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (let nonPositiveEffect :: Effect -> Bool
          nonPositiveEffect :: Effect -> Bool
nonPositiveEffect (CreateItem (Just n :: Int
n) _ _ _) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Bool
True
          nonPositiveEffect (DestroyItem n :: Int
n k :: Int
k _ _) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 Bool -> Bool -> Bool
|| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Bool
True
          nonPositiveEffect (ConsumeItems tools :: [(Int, GroupName ItemKind)]
tools raw :: [(Int, GroupName ItemKind)]
raw)
            | ((Int, GroupName ItemKind) -> Bool)
-> [(Int, GroupName ItemKind)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0) (Int -> Bool)
-> ((Int, GroupName ItemKind) -> Int)
-> (Int, GroupName ItemKind)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, GroupName ItemKind) -> Int
forall a b. (a, b) -> a
fst) ([(Int, GroupName ItemKind)]
tools [(Int, GroupName ItemKind)]
-> [(Int, GroupName ItemKind)] -> [(Int, GroupName ItemKind)]
forall a. [a] -> [a] -> [a]
++ [(Int, GroupName ItemKind)]
raw) = Bool
True
          nonPositiveEffect (DropItem n :: Int
n k :: Int
k _ _) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 Bool -> Bool -> Bool
|| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Bool
True
          nonPositiveEffect (Detect _ n :: Int
n) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Bool
True
          nonPositiveEffect _ = Bool
False
          containingNonPositiveEffect :: [Effect]
containingNonPositiveEffect =
            (Effect -> Bool) -> [Effect] -> [Effect]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Effect -> Bool) -> Effect -> Bool
checkSubEffectProp Effect -> Bool
nonPositiveEffect) [Effect]
ieffects
      in [ "effects with forbidden non-positive parameters:"
           Text -> Text -> Text
<+> [Effect] -> Text
forall a. Show a => a -> Text
tshow [Effect]
containingNonPositiveEffect
         | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Effect] -> Bool
forall a. [a] -> Bool
null [Effect]
containingNonPositiveEffect ])
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (let nonPositiveEffect :: Effect -> Bool
          nonPositiveEffect :: Effect -> Bool
nonPositiveEffect (Summon _ d :: Dice
d) | Dice -> Int
Dice.infDice Dice
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Bool
True
          nonPositiveEffect (Paralyze d :: Dice
d) | Dice -> Int
Dice.infDice Dice
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Bool
True
          nonPositiveEffect (ParalyzeInWater d :: Dice
d) | Dice -> Int
Dice.infDice Dice
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Bool
True
          nonPositiveEffect (InsertMove d :: Dice
d) | Dice -> Int
Dice.infDice Dice
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Bool
True
          nonPositiveEffect (Teleport d :: Dice
d) | Dice -> Int
Dice.infDice Dice
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Bool
True
          nonPositiveEffect (CreateItem _ _ _ (TimerGameTurn d :: Dice
d))
            | Dice -> Int
Dice.infDice Dice
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Bool
True
          nonPositiveEffect (CreateItem _ _ _ (TimerActorTurn d :: Dice
d))
            | Dice -> Int
Dice.infDice Dice
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Bool
True
          nonPositiveEffect (Recharge n :: Int
n d :: Dice
d)
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 Bool -> Bool -> Bool
|| Dice -> Int
Dice.infDice Dice
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Bool
True
          nonPositiveEffect (Discharge n :: Int
n d :: Dice
d)
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 Bool -> Bool -> Bool
|| Dice -> Int
Dice.infDice Dice
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Bool
True
          nonPositiveEffect _ = Bool
False
          containingNonPositiveEffect :: [Effect]
containingNonPositiveEffect =
            (Effect -> Bool) -> [Effect] -> [Effect]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Effect -> Bool) -> Effect -> Bool
checkSubEffectProp Effect -> Bool
nonPositiveEffect) [Effect]
ieffects
      in [ "effects with forbidden potentially non-positive or negative number or dice:"
           Text -> Text -> Text
<+> [Effect] -> Text
forall a. Show a => a -> Text
tshow [Effect]
containingNonPositiveEffect
         | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Effect] -> Bool
forall a. [a] -> Bool
null [Effect]
containingNonPositiveEffect ])

-- We only check there are no duplicates at top level. If it may be nested,
-- it may presumably be duplicated inside the nesting as well.
validateOnlyOne :: [Effect] -> Text -> (Effect -> Bool) -> [Text]
validateOnlyOne :: [Effect] -> Text -> (Effect -> Bool) -> [Text]
validateOnlyOne effs :: [Effect]
effs t :: Text
t f :: Effect -> Bool
f =
  let ts :: [Effect]
ts = (Effect -> Bool) -> [Effect] -> [Effect]
forall a. (a -> Bool) -> [a] -> [a]
filter Effect -> Bool
f [Effect]
effs
  in ["more than one" Text -> Text -> Text
<+> Text
t Text -> Text -> Text
<+> "specification" | [Effect] -> Int
forall a. [a] -> Int
length [Effect]
ts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1]

-- We check it's not nested one nor more levels.
validateNotNested :: [Effect] -> Text -> (Effect -> Bool) -> [Text]
validateNotNested :: [Effect] -> Text -> (Effect -> Bool) -> [Text]
validateNotNested effs :: [Effect]
effs t :: Text
t f :: Effect -> Bool
f =
  let g :: Effect -> Bool
g (AtMostOneOf l :: [Effect]
l) = (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
h [Effect]
l
      g (OneOf l :: [Effect]
l) = (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
h [Effect]
l
      g (OnSmash effect :: Effect
effect) = Effect -> Bool
h Effect
effect
      g (OnCombine effect :: Effect
effect) = Effect -> Bool
h Effect
effect
      g (OnUser effect :: Effect
effect) = Effect -> Bool
h Effect
effect
      g (AndEffect eff1 :: Effect
eff1 eff2 :: Effect
eff2) = Effect -> Bool
h Effect
eff1 Bool -> Bool -> Bool
|| Effect -> Bool
h Effect
eff2
      g (OrEffect eff1 :: Effect
eff1 eff2 :: Effect
eff2) = Effect -> Bool
h Effect
eff1 Bool -> Bool -> Bool
|| Effect -> Bool
h Effect
eff2
      g (SeqEffect effs2 :: [Effect]
effs2) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Effect -> Bool) -> [Effect] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Effect -> Bool
h [Effect]
effs2
      g (When _ effect :: Effect
effect) = Effect -> Bool
h Effect
effect
      g (Unless _ effect :: Effect
effect) = Effect -> Bool
h Effect
effect
      g (IfThenElse _ eff1 :: Effect
eff1 eff2 :: Effect
eff2) = Effect -> Bool
h Effect
eff1 Bool -> Bool -> Bool
|| Effect -> Bool
h Effect
eff2
      g _ = Bool
False
      h :: Effect -> Bool
h effect :: Effect
effect = Effect -> Bool
f Effect
effect Bool -> Bool -> Bool
|| Effect -> Bool
g Effect
effect
      ts :: [Effect]
ts = (Effect -> Bool) -> [Effect] -> [Effect]
forall a. (a -> Bool) -> [a] -> [a]
filter Effect -> Bool
g [Effect]
effs
  in [ "effect" Text -> Text -> Text
<+> Text
t Text -> Text -> Text
<+> "should be specified at top level, not nested"
     | [Effect] -> Int
forall a. [a] -> Int
length [Effect]
ts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 ]

checkSubEffectProp :: (Effect -> Bool) -> Effect -> Bool
checkSubEffectProp :: (Effect -> Bool) -> Effect -> Bool
checkSubEffectProp f :: Effect -> Bool
f eff :: Effect
eff =
  let g :: Effect -> Bool
g (AtMostOneOf l :: [Effect]
l) = (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
h [Effect]
l
      g (OneOf l :: [Effect]
l) = (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
h [Effect]
l
      g (OnSmash effect :: Effect
effect) = Effect -> Bool
h Effect
effect
      g (OnCombine effect :: Effect
effect) = Effect -> Bool
h Effect
effect
      g (OnUser effect :: Effect
effect) = Effect -> Bool
h Effect
effect
      g (AndEffect eff1 :: Effect
eff1 eff2 :: Effect
eff2) = Effect -> Bool
h Effect
eff1 Bool -> Bool -> Bool
|| Effect -> Bool
h Effect
eff2
      g (OrEffect eff1 :: Effect
eff1 eff2 :: Effect
eff2) = Effect -> Bool
h Effect
eff1 Bool -> Bool -> Bool
|| Effect -> Bool
h Effect
eff2
      g (SeqEffect effs :: [Effect]
effs) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Effect -> Bool) -> [Effect] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Effect -> Bool
h [Effect]
effs
      g (When _ effect :: Effect
effect) = Effect -> Bool
h Effect
effect
      g (Unless _ effect :: Effect
effect) = Effect -> Bool
h Effect
effect
      g (IfThenElse _ eff1 :: Effect
eff1 eff2 :: Effect
eff2) = Effect -> Bool
h Effect
eff1 Bool -> Bool -> Bool
|| Effect -> Bool
h Effect
eff2
      g _ = Bool
False
      h :: Effect -> Bool
h effect :: Effect
effect = Effect -> Bool
f Effect
effect Bool -> Bool -> Bool
|| Effect -> Bool
g Effect
effect
  in Effect -> Bool
h Effect
eff

validateDups :: ItemKind -> Aspect -> [Text]
validateDups :: ItemKind -> Aspect -> [Text]
validateDups ItemKind{..} feat :: Aspect
feat =
  let ts :: [Aspect]
ts = (Aspect -> Bool) -> [Aspect] -> [Aspect]
forall a. (a -> Bool) -> [a] -> [a]
filter (Aspect -> Aspect -> Bool
forall a. Eq a => a -> a -> Bool
== Aspect
feat) [Aspect]
iaspects
  in ["more than one" Text -> Text -> Text
<+> Aspect -> Text
forall a. Show a => a -> Text
tshow Aspect
feat Text -> Text -> Text
<+> "specification" | [Aspect] -> Int
forall a. [a] -> Int
length [Aspect]
ts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1]

validateDamage :: Dice.Dice -> [Text]
validateDamage :: Dice -> [Text]
validateDamage dice :: Dice
dice = [ "potentially negative dice:" Text -> Text -> Text
<+> Dice -> Text
forall a. Show a => a -> Text
tshow Dice
dice
                      | Dice -> Int
Dice.infDice Dice
dice Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0]

-- | Validate all item kinds.
validateAll :: [ItemKind] -> ContentData ItemKind -> [Text]
validateAll :: [ItemKind] -> ContentData ItemKind -> [Text]
validateAll content :: [ItemKind]
content coitem :: ContentData ItemKind
coitem =
  let f :: Aspect -> Bool
      f :: Aspect -> Bool
f PresentAs{} = Bool
True
      f _ = Bool
False
      wrongPresentAsGroups :: [GroupName ItemKind]
wrongPresentAsGroups =
        [ GroupName ItemKind
cgroup
        | ItemKind
k <- [ItemKind]
content
        , let (cgroup :: GroupName ItemKind
cgroup, notSingleton :: Bool
notSingleton) = case (Aspect -> Bool) -> [Aspect] -> Maybe Aspect
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Aspect -> Bool
f (ItemKind -> [Aspect]
iaspects ItemKind
k) of
                Just (PresentAs grp :: GroupName ItemKind
grp) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ContentData ItemKind -> GroupName ItemKind -> Bool
forall a. ContentData a -> GroupName a -> Bool
oisSingletonGroup ContentData ItemKind
coitem GroupName ItemKind
grp ->
                  (GroupName ItemKind
grp, Bool
True)
                _ -> (GroupName ItemKind
forall a. HasCallStack => a
undefined, Bool
False)
        , Bool
notSingleton
        ]
  in [ "PresentAs groups not singletons:" Text -> Text -> Text
<+> [GroupName ItemKind] -> Text
forall a. Show a => a -> Text
tshow [GroupName ItemKind]
wrongPresentAsGroups
     | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [GroupName ItemKind] -> Bool
forall a. [a] -> Bool
null [GroupName ItemKind]
wrongPresentAsGroups ]

makeData :: [ItemKind] -> [GroupName ItemKind] -> [GroupName ItemKind]
         -> ContentData ItemKind
makeData :: [ItemKind]
-> [GroupName ItemKind]
-> [GroupName ItemKind]
-> ContentData ItemKind
makeData content :: [ItemKind]
content groupNamesSingleton :: [GroupName ItemKind]
groupNamesSingleton groupNames :: [GroupName ItemKind]
groupNames =
  let allGroupNamesTooLong :: [GroupName ItemKind]
allGroupNamesTooLong = (GroupName ItemKind -> Bool)
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 23) (Int -> Bool)
-> (GroupName ItemKind -> Int) -> GroupName ItemKind -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length (Text -> Int)
-> (GroupName ItemKind -> Text) -> GroupName ItemKind -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupName ItemKind -> Text
forall a. GroupName a -> Text
fromGroupName)
                             ([GroupName ItemKind] -> [GroupName ItemKind])
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a b. (a -> b) -> a -> b
$ [GroupName ItemKind]
groupNamesSingleton [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind]
groupNames
  in Bool -> ContentData ItemKind -> ContentData ItemKind
forall a. HasCallStack => Bool -> a -> a
assert ([GroupName ItemKind] -> Bool
forall a. [a] -> Bool
null [GroupName ItemKind]
allGroupNamesTooLong
             Bool -> (String, [GroupName ItemKind]) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "ItemKind: some item group names too long"
             String -> [GroupName ItemKind] -> (String, [GroupName ItemKind])
forall v. String -> v -> (String, v)
`swith` [GroupName ItemKind]
allGroupNamesTooLong) (ContentData ItemKind -> ContentData ItemKind)
-> ContentData ItemKind -> ContentData ItemKind
forall a b. (a -> b) -> a -> b
$
     String
-> (ItemKind -> Text)
-> (ItemKind -> Freqs ItemKind)
-> (ItemKind -> [Text])
-> ([ItemKind] -> ContentData ItemKind -> [Text])
-> [ItemKind]
-> [GroupName ItemKind]
-> [GroupName ItemKind]
-> ContentData ItemKind
forall c.
Show c =>
String
-> (c -> Text)
-> (c -> Freqs c)
-> (c -> [Text])
-> ([c] -> ContentData c -> [Text])
-> [c]
-> [GroupName c]
-> [GroupName c]
-> ContentData c
makeContentData "ItemKind" ItemKind -> Text
iname ItemKind -> Freqs ItemKind
ifreq ItemKind -> [Text]
validateSingle [ItemKind] -> ContentData ItemKind -> [Text]
validateAll [ItemKind]
content
                     ([GroupName ItemKind]
mandatoryGroupsSingleton [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind]
groupNamesSingleton)
                     ([GroupName ItemKind]
mandatoryGroups [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind]
groupNames)