-- | Possible causes of failure of request.
module Game.LambdaHack.Common.ReqFailure
  ( ReqFailure(..)
  , impossibleReqFailure, showReqFailure
  , permittedPrecious, permittedProject, permittedProjectAI, permittedApply
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Time
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs

-- | Possible causes of failure of request.
data ReqFailure =
    MoveUnskilled
  | MoveUnskilledAsleep
  | MoveNothing
  | MeleeUnskilled
  | MeleeSelf
  | MeleeDistant
  | MeleeNotWeapon
  | DisplaceUnskilled
  | DisplaceDistant
  | DisplaceAccess
  | DisplaceMultiple
  | DisplaceDying
  | DisplaceBraced
  | DisplaceImmobile
  | DisplaceSupported
  | AlterUnskilled
  | AlterUnwalked
  | AlterDistant
  | AlterBlockActor
  | AlterBlockItem
  | AlterNothing
  | CloseDistant
  | CloseClosed
  | CloseNothing
  | CloseNonClosable
  | WaitUnskilled
  | YellUnskilled
  | MoveItemUnskilled
  | EqpOverfull
  | EqpStackFull
  | ApplyUnskilled
  | ApplyFood
  | ApplyRead
  | ApplyPeriodic
  | ApplyOutOfReach
  | ApplyCharging
  | ApplyNoEffects
  | ItemNothing
  | ItemNotCalm
  | ItemOverStash
  | NotCalmPrecious
  | ProjectUnskilled
  | ProjectAimOnself
  | ProjectBlockTerrain
  | ProjectBlockActor
  | ProjectLobable
  | ProjectOutOfReach
  | ProjectFinderKeeper
  | NoChangeDunLeader
  deriving (Int -> ReqFailure -> ShowS
[ReqFailure] -> ShowS
ReqFailure -> String
(Int -> ReqFailure -> ShowS)
-> (ReqFailure -> String)
-> ([ReqFailure] -> ShowS)
-> Show ReqFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReqFailure] -> ShowS
$cshowList :: [ReqFailure] -> ShowS
show :: ReqFailure -> String
$cshow :: ReqFailure -> String
showsPrec :: Int -> ReqFailure -> ShowS
$cshowsPrec :: Int -> ReqFailure -> ShowS
Show, ReqFailure -> ReqFailure -> Bool
(ReqFailure -> ReqFailure -> Bool)
-> (ReqFailure -> ReqFailure -> Bool) -> Eq ReqFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReqFailure -> ReqFailure -> Bool
$c/= :: ReqFailure -> ReqFailure -> Bool
== :: ReqFailure -> ReqFailure -> Bool
$c== :: ReqFailure -> ReqFailure -> Bool
Eq)

impossibleReqFailure :: ReqFailure -> Bool
impossibleReqFailure :: ReqFailure -> Bool
impossibleReqFailure reqFailure :: ReqFailure
reqFailure = case ReqFailure
reqFailure of
  MoveUnskilled -> Bool
False  -- unidentified skill items
  MoveUnskilledAsleep -> Bool
False  -- unidentified skill items
  MoveNothing -> Bool
True
  MeleeUnskilled -> Bool
False  -- unidentified skill items
  MeleeSelf -> Bool
True
  MeleeDistant -> Bool
True
  MeleeNotWeapon -> Bool
False  -- unidentified items
  DisplaceUnskilled -> Bool
False  -- unidentified skill items
  DisplaceDistant -> Bool
True
  DisplaceAccess -> Bool
True
  DisplaceMultiple -> Bool
True
  DisplaceDying -> Bool
True
  DisplaceBraced -> Bool
True
  DisplaceImmobile -> Bool
False  -- unidentified skill items
  DisplaceSupported -> Bool
False
  AlterUnskilled -> Bool
False  -- unidentified skill items
  AlterUnwalked -> Bool
False
  AlterDistant -> Bool
True
  AlterBlockActor -> Bool
True  -- adjacent actor always visible
  AlterBlockItem -> Bool
True  -- adjacent item always visible
  AlterNothing -> Bool
True  -- if tile known, its properties known
  CloseDistant -> Bool
True
  CloseClosed -> Bool
True
  CloseNothing -> Bool
True
  CloseNonClosable -> Bool
True
  WaitUnskilled -> Bool
False  -- unidentified skill items
  YellUnskilled -> Bool
False  -- unidentified skill items
  MoveItemUnskilled -> Bool
False  -- unidentified skill items
  EqpOverfull -> Bool
True
  EqpStackFull -> Bool
True
  ApplyUnskilled -> Bool
False  -- unidentified skill items
  ApplyFood -> Bool
False  -- unidentified skill items
  ApplyRead -> Bool
False  -- unidentified skill items
  ApplyPeriodic -> Bool
False  -- unidentified skill items
  ApplyOutOfReach -> Bool
True
  ApplyCharging -> Bool
False  -- if aspect record unknown, charging unknown
  ApplyNoEffects -> Bool
False  -- if effects unknown, can't prevent it
  ItemNothing -> Bool
True
  ItemNotCalm -> Bool
False  -- unidentified skill items
  ItemOverStash -> Bool
True
  NotCalmPrecious -> Bool
False  -- unidentified skill items
  ProjectUnskilled -> Bool
False  -- unidentified skill items
  ProjectAimOnself -> Bool
True
  ProjectBlockTerrain -> Bool
True  -- adjacent terrain always visible
  ProjectBlockActor -> Bool
True  -- adjacent actor always visible
  ProjectLobable -> Bool
False  -- unidentified skill items
  ProjectOutOfReach -> Bool
True
  ProjectFinderKeeper -> Bool
False
  NoChangeDunLeader -> Bool
True

showReqFailure :: ReqFailure -> Text
showReqFailure :: ReqFailure -> Text
showReqFailure reqFailure :: ReqFailure
reqFailure = case ReqFailure
reqFailure of
  MoveUnskilled -> "too low movement stat; use equipment menu to take off stat draining gear or switch to another teammate or wait until a stat draining condition passes as seen in organ menu"
  MoveUnskilledAsleep -> "actor asleep; yawn to wake up"
  MoveNothing -> "wasting time on moving into obstacle"
  MeleeUnskilled -> "too low melee combat stat"
  MeleeSelf -> "trying to melee oneself"
  MeleeDistant -> "trying to melee a distant foe"
  MeleeNotWeapon -> "trying to melee with not a weapon"
  DisplaceUnskilled -> "too low actor displacing stat"
  DisplaceDistant -> "trying to displace a distant actor"
  DisplaceAccess -> "trying to switch places without access"
  DisplaceMultiple -> "trying to displace multiple actors"
  DisplaceDying -> "trying to displace a dying foe"
  DisplaceBraced -> "trying to displace a braced foe"
  DisplaceImmobile -> "trying to displace an immobile foe"
  DisplaceSupported -> "trying to displace a foe supported by teammates or supply stash"
  AlterUnskilled -> "modify stat is needed to search or activate or transform terrain"
  AlterUnwalked -> "too low modify stat to enter or activate or transform terrain; find and equip gear that improves the stat or try with a teammate whose skill menu shows a higher stat"
  AlterDistant -> "trying to modify distant terrain"
  AlterBlockActor -> "blocked by an actor"
  AlterBlockItem -> "jammed by an item"
  AlterNothing -> "wasting time on modifying nothing"
  CloseDistant -> "trying to close a distant terrain"
  CloseClosed -> "already closed"
  CloseNothing -> "no adjacent terrain can be closed"
  CloseNonClosable -> "cannot be closed"
  WaitUnskilled -> "too low wait stat"
  YellUnskilled -> "actors unskilled in waiting cannot yell/yawn"
  MoveItemUnskilled -> "too low item moving stat"
  EqpOverfull -> "cannot equip any more items"
  EqpStackFull -> "cannot equip the whole item stack"
  ApplyUnskilled -> "too low item triggering stat"
  ApplyFood -> "trigger stat 1 is enough only to eat food from the ground and trigger simple appendages"
  ApplyRead -> "activating cultural artifacts requires trigger stat 3"
  ApplyPeriodic -> "manually activating periodic items requires trigger stat 4"
  ApplyOutOfReach -> "cannot trigger an item out of reach"
  ApplyCharging -> "cannot trigger an item that is still charging"
  ApplyNoEffects -> "cannot trigger an item that produces no effect"
  ItemNothing -> "wasting time on void item manipulation"
  ItemNotCalm -> "you try to focus on your equipment but your calm fails you"
  ItemOverStash -> "you roll in your hoard a little"
  NotCalmPrecious -> "you are too distracted to handle such an exquisite item"
  ProjectUnskilled -> "too low item flinging stat"
  ProjectAimOnself -> "cannot aim at oneself"
  ProjectBlockTerrain -> "aiming obstructed by terrain"
  ProjectBlockActor -> "aiming blocked by an actor"
  ProjectLobable -> "flinging a lobable item that stops at target position requires fling stat 3"
  ProjectOutOfReach -> "cannot aim an item out of reach"
  ProjectFinderKeeper -> "flinging any projectile you've found is out of the question; you prefer to keep them pristine and safe"
  NoChangeDunLeader -> "no manual level change for your team"

-- The item should not be applied nor thrown because it's too delicate
-- to operate when not calm or because it's too precious to identify by use.
permittedPrecious :: Bool -> Bool -> ItemFull -> Either ReqFailure Bool
permittedPrecious :: Bool -> Bool -> ItemFull -> Either ReqFailure Bool
permittedPrecious forced :: Bool
forced calmE :: Bool
calmE itemFull :: ItemFull
itemFull@ItemFull{ItemDisco
itemDisco :: ItemFull -> ItemDisco
itemDisco :: ItemDisco
itemDisco} =
  let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      isPrecious :: Bool
isPrecious = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Precious AspectRecord
arItem
  in if Bool -> Bool
not Bool
forced Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
calmE Bool -> Bool -> Bool
&& Bool
isPrecious
     then ReqFailure -> Either ReqFailure Bool
forall a b. a -> Either a b
Left ReqFailure
NotCalmPrecious
     else Bool -> Either ReqFailure Bool
forall a b. b -> Either a b
Right (Bool -> Either ReqFailure Bool) -> Bool -> Either ReqFailure Bool
forall a b. (a -> b) -> a -> b
$ Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Durable AspectRecord
arItem
                  Bool -> Bool -> Bool
|| case ItemDisco
itemDisco of
                       ItemDiscoFull{} -> Bool
True
                       ItemDiscoMean itemAspectMean :: KindMean
itemAspectMean ->
                         KindMean -> Bool
IA.kmConst KindMean
itemAspectMean Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
isPrecious

-- Simplified, faster version, for inner AI loop.
permittedPreciousAI :: Bool -> ItemFull -> Bool
permittedPreciousAI :: Bool -> ItemFull -> Bool
permittedPreciousAI calmE :: Bool
calmE itemFull :: ItemFull
itemFull@ItemFull{ItemDisco
itemDisco :: ItemDisco
itemDisco :: ItemFull -> ItemDisco
itemDisco} =
  let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      isPrecious :: Bool
isPrecious = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Precious AspectRecord
arItem
  in (Bool
calmE Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
isPrecious)
     Bool -> Bool -> Bool
&& Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Durable AspectRecord
arItem
        Bool -> Bool -> Bool
|| case ItemDisco
itemDisco of
             ItemDiscoFull{} -> Bool
True
             ItemDiscoMean itemAspectMean :: KindMean
itemAspectMean ->
               KindMean -> Bool
IA.kmConst KindMean
itemAspectMean Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
isPrecious

permittedProject :: Bool -> Int -> Bool -> ItemFull -> Either ReqFailure Bool
permittedProject :: Bool -> Int -> Bool -> ItemFull -> Either ReqFailure Bool
permittedProject forced :: Bool
forced skill :: Int
skill calmE :: Bool
calmE itemFull :: ItemFull
itemFull =
 let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
 in if | Bool -> Bool
not Bool
forced Bool -> Bool -> Bool
&& Int
skill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 -> ReqFailure -> Either ReqFailure Bool
forall a b. a -> Either a b
Left ReqFailure
ProjectUnskilled
       | Bool -> Bool
not Bool
forced
         Bool -> Bool -> Bool
&& Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Lobable AspectRecord
arItem
         Bool -> Bool -> Bool
&& Int
skill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 3 -> ReqFailure -> Either ReqFailure Bool
forall a b. a -> Either a b
Left ReqFailure
ProjectLobable
       | Bool
otherwise -> Bool -> Bool -> ItemFull -> Either ReqFailure Bool
permittedPrecious Bool
forced Bool
calmE ItemFull
itemFull

-- Simplified, faster and more permissive version, for inner AI loop.
permittedProjectAI :: Int -> Bool -> ItemFull -> Bool
permittedProjectAI :: Int -> Bool -> ItemFull -> Bool
permittedProjectAI skill :: Int
skill calmE :: Bool
calmE itemFull :: ItemFull
itemFull =
 let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
 in if | Int
skill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 -> Bool
False
       | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Lobable AspectRecord
arItem
         Bool -> Bool -> Bool
&& Int
skill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 3 -> Bool
False
       | Bool
otherwise -> Bool -> ItemFull -> Bool
permittedPreciousAI Bool
calmE ItemFull
itemFull

permittedApply :: Time -> Int -> Bool -> Maybe CStore -> ItemFull -> ItemQuant
               -> Either ReqFailure Bool
permittedApply :: Time
-> Int
-> Bool
-> Maybe CStore
-> ItemFull
-> ItemQuant
-> Either ReqFailure Bool
permittedApply localTime :: Time
localTime skill :: Int
skill calmE :: Bool
calmE mstore :: Maybe CStore
mstore
               itemFull :: ItemFull
itemFull@ItemFull{ItemKind
itemKind :: ItemFull -> ItemKind
itemKind :: ItemKind
itemKind, Bool
itemSuspect :: ItemFull -> Bool
itemSuspect :: Bool
itemSuspect} kit :: ItemQuant
kit =
  if | Int
skill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 -> ReqFailure -> Either ReqFailure Bool
forall a b. a -> Either a b
Left ReqFailure
ApplyUnskilled
     | Int
skill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2
       Bool -> Bool -> Bool
&& ItemKind -> Char
IK.isymbol ItemKind
itemKind Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '"'
       Bool -> Bool -> Bool
&& (ItemKind -> Char
IK.isymbol ItemKind
itemKind Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ','
           Bool -> Bool -> Bool
|| Maybe CStore
mstore Maybe CStore -> Maybe CStore -> Bool
forall a. Eq a => a -> a -> Bool
/= CStore -> Maybe CStore
forall a. a -> Maybe a
Just CStore
CGround) -> ReqFailure -> Either ReqFailure Bool
forall a b. a -> Either a b
Left ReqFailure
ApplyFood
     | Int
skill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 3 Bool -> Bool -> Bool
&& ItemKind -> Char
IK.isymbol ItemKind
itemKind Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '?' -> ReqFailure -> Either ReqFailure Bool
forall a b. a -> Either a b
Left ReqFailure
ApplyRead
     | Int
skill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 4
       Bool -> Bool -> Bool
&& let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
          in Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Periodic AspectRecord
arItem -> ReqFailure -> Either ReqFailure Bool
forall a b. a -> Either a b
Left ReqFailure
ApplyPeriodic
     -- If the item is discharged, neither the kinetic hit nor
     -- any effects activate, so there's no point triggering.
     -- Note that if client doesn't know the timeout, here we may leak the fact
     -- that the item is still charging, but the client risks destruction
     -- if the item is, in fact, recharged and is not durable
     -- (likely in case of jewellery). So it's OK (the message may be
     -- somewhat alarming though).
     | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Time -> ItemQuant -> Bool
hasCharge Time
localTime ItemQuant
kit -> ReqFailure -> Either ReqFailure Bool
forall a b. a -> Either a b
Left ReqFailure
ApplyCharging
     | Bool
otherwise ->
       if [Effect] -> Bool
forall a. [a] -> Bool
null (ItemKind -> [Effect]
IK.ieffects ItemKind
itemKind)
          Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
itemSuspect Bool -> Bool -> Bool
|| ItemKind -> Bool
IA.isHumanTrinket ItemKind
itemKind)
       then ReqFailure -> Either ReqFailure Bool
forall a b. a -> Either a b
Left ReqFailure
ApplyNoEffects
       else Bool -> Bool -> ItemFull -> Either ReqFailure Bool
permittedPrecious Bool
False Bool
calmE ItemFull
itemFull