    -- | Game state reading monad and basic operations.
    module Game.LambdaHack.Common.MonadStateRead
      ( MonadStateRead(..)
      , getState, getLevel
      , getGameMode, isNoConfirmsGame, getEntryArena, pickWeaponM, displayTaunt
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import           Data.Either
    import qualified Data.EnumMap.Strict as EM

    import           Game.LambdaHack.Common.Actor
    import           Game.LambdaHack.Common.ActorState
    import           Game.LambdaHack.Common.Faction
    import           Game.LambdaHack.Common.Item
    import           Game.LambdaHack.Common.Kind
    import           Game.LambdaHack.Common.Level
    import           Game.LambdaHack.Common.ReqFailure
    import           Game.LambdaHack.Common.State
    import           Game.LambdaHack.Common.Types
    import           Game.LambdaHack.Content.ModeKind
    import           Game.LambdaHack.Core.Frequency
    import           Game.LambdaHack.Core.Random
    import qualified Game.LambdaHack.Definition.Ability as Ability

    -- | Monad for reading game state. A state monad with state modification
    -- disallowed (another constraint is needed to permit that).
    -- The basic server and client monads are like that, because server
    -- and clients freely modify their internal session data, but don't modify
    -- the main game state, except in very restricted and synchronized way.
    class (Monad m, Functor m, Applicative m) => MonadStateRead m where
      getsState :: (State -> a) -> m a

    getState :: MonadStateRead m => m State
    getState :: forall (m :: * -> *). MonadStateRead m => m State
    getState = (State -> State) -> m State
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> State
    forall a. a -> a
    id

    getLevel :: MonadStateRead m => LevelId -> m Level
    getLevel :: forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
    getLevel LevelId
    lid = (State -> Level) -> m Level
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Level) -> m Level) -> (State -> Level) -> m Level
    forall a b. (a -> b) -> a -> b
    $ (EnumMap LevelId Level -> LevelId -> Level
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! LevelId
    lid) (EnumMap LevelId Level -> Level)
    -> (State -> EnumMap LevelId Level) -> State -> Level
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . State -> EnumMap LevelId Level
    sdungeon

    getGameMode :: MonadStateRead m => m ModeKind
    getGameMode :: forall (m :: * -> *). MonadStateRead m => m ModeKind
    getGameMode = do
      COps{comode} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      gameModeId <- getsState sgameModeId
      return $! okind comode gameModeId

    isNoConfirmsGame :: MonadStateRead m => m Bool
    isNoConfirmsGame :: forall (m :: * -> *). MonadStateRead m => m Bool
    isNoConfirmsGame = do
      gameMode <- m ModeKind
    forall (m :: * -> *). MonadStateRead m => m ModeKind
    getGameMode
      return $! mattract gameMode

    getEntryArena :: MonadStateRead m => Faction -> m LevelId
    getEntryArena :: forall (m :: * -> *). MonadStateRead m => Faction -> m LevelId
    getEntryArena Faction
    fact = do
      dungeon <- (State -> EnumMap LevelId Level) -> m (EnumMap LevelId Level)
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> EnumMap LevelId Level
    sdungeon
      let (minD, maxD) = dungeonBounds dungeon
          f [] = a
    0
          f ((a
    ln, b
    _, c
    _) : [(a, b, c)]
    _) = a
    ln
      return $! max minD $ min maxD $ toEnum $ f $ ginitial fact

    pickWeaponM :: MonadStateRead m
                => Bool -> Maybe DiscoveryBenefit
                -> [(ItemId, ItemFullKit)] -> Ability.Skills -> ActorId
                -> m [(Double, Bool, Int, Int, ItemId, ItemFullKit)]
    pickWeaponM :: forall (m :: * -> *).
    MonadStateRead m =>
    Bool
    -> Maybe DiscoveryBenefit
    -> [(ItemId, ItemFullKit)]
    -> Skills
    -> ActorId
    -> m [(Double, Bool, Int, Int, ItemId, ItemFullKit)]
    pickWeaponM Bool
    ignoreCharges Maybe DiscoveryBenefit
    mdiscoBenefit [(ItemId, ItemFullKit)]
    kitAss Skills
    actorSk ActorId
    source = do
      sb <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    source
      localTime <- getsState $ getLocalTime (blid sb)
      actorMaxSk <- getsState $ getActorMaxSkills source
      let calmE = Actor -> Skills -> Bool
    calmEnough Actor
    sb Skills
    actorMaxSk
          forced = Actor -> Bool
    bproj Actor
    sb
          permitted = Bool -> Bool -> ItemFull -> Either ReqFailure Bool
    permittedPrecious Bool
    forced Bool
    calmE
          preferredPrecious = Bool -> Either ReqFailure Bool -> Bool
    forall b a. b -> Either a b -> b
    fromRight Bool
    False (Either ReqFailure Bool -> Bool)
    -> (ItemFull -> Either ReqFailure Bool) -> ItemFull -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ItemFull -> Either ReqFailure Bool
    permitted
          permAssocs = ((ItemId, ItemFullKit) -> Bool)
    -> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (ItemFull -> Bool
    preferredPrecious (ItemFull -> Bool)
    -> ((ItemId, ItemFullKit) -> ItemFull)
    -> (ItemId, ItemFullKit)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ItemFullKit -> ItemFull
    forall a b. (a, b) -> a
    fst (ItemFullKit -> ItemFull)
    -> ((ItemId, ItemFullKit) -> ItemFullKit)
    -> (ItemId, ItemFullKit)
    -> ItemFull
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ItemId, ItemFullKit) -> ItemFullKit
    forall a b. (a, b) -> b
    snd) [(ItemId, ItemFullKit)]
    kitAss
          strongest = Bool
    -> Maybe DiscoveryBenefit
    -> Time
    -> [(ItemId, ItemFullKit)]
    -> [(Double, Bool, Int, Int, ItemId, ItemFullKit)]
    strongestMelee Bool
    ignoreCharges Maybe DiscoveryBenefit
    mdiscoBenefit
                                     Time
    localTime [(ItemId, ItemFullKit)]
    permAssocs
      return $! if | forced -> map (\(ItemId
    iid, ItemFullKit
    itemFullKit) ->
                                      (-Double
    1, Bool
    False, Int
    0, Int
    1, ItemId
    iid, ItemFullKit
    itemFullKit)) kitAss
                   | Ability.getSk Ability.SkMelee actorSk <= 0 -> []
                   | otherwise -> strongest

    displayTaunt :: MonadStateRead m
                 => Bool -> (Rnd (Text, Text) -> m (Text, Text))
                 -> ActorId -> m (Text, Text)
    displayTaunt :: forall (m :: * -> *).
    MonadStateRead m =>
    Bool
    -> (Rnd (Text, Text) -> m (Text, Text))
    -> ActorId
    -> m (Text, Text)
    displayTaunt Bool
    _voluntary Rnd (Text, Text) -> m (Text, Text)
    rndToAction ActorId
    aid = do
      b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    aid
      actorMaxSk <- getsState $ getActorMaxSkills aid
      let canApply = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkApply Skills
    actorMaxSk Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    2
                     Bool -> Bool -> Bool
    && Bool
    canHear
            -- if applies complex items, probably intelligent and can speak
          canHear = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkHearing Skills
    actorMaxSk Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
                    Bool -> Bool -> Bool
    && Bool
    canBrace
            -- if hears, probably also emits sound vocally;
            -- disabled even by ushanka and rightly so
          canBrace = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkWait Skills
    actorMaxSk Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    2
            -- not an insect, plant, geyser, faucet, fence, etc.
            -- so can emit sound by hitting something with body parts
                     Bool -> Bool -> Bool
    || Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkApply Skills
    actorMaxSk Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    2
                          -- and neither an impatient intelligent actor
          braceUneasy = [ (Int
    2, (Text
    "something", Text
    "flail around"))
                        , (Int
    1, (Text
    "something", Text
    "toss blindly"))
                        , (Int
    1, (Text
    "something", Text
    "squirm dizzily")) ]
          braceEasy = [ (Int
    2, (Text
    "something", Text
    "stretch"))
                      , (Int
    1, (Text
    "something", Text
    "fidget"))
                      , (Int
    1, (Text
    "something", Text
    "fret")) ]
          uneasy = ResDelta -> Bool
    deltasSerious (Actor -> ResDelta
    bcalmDelta Actor
    b) Bool -> Bool -> Bool
    || Bool -> Bool
    not (Actor -> Skills -> Bool
    calmEnough Actor
    b Skills
    actorMaxSk)
      if bwatch b `elem` [WSleep, WWake]
      then rndToAction $ frequency $ toFreq "SfxTaunt" $
        if uneasy
        then if | canApply -> (5, ("somebody", "yell"))
                              : (3, ("somebody", "bellow"))
                              : braceUneasy
                | canHear -> (5, ("somebody", "bellow"))
                             : (3, ("something", "hiss"))
                             : braceUneasy
                | canBrace -> braceUneasy
                | otherwise -> [(1, ("something", "drone enquiringly"))]
        else if | canApply -> (5, ("somebody", "yawn"))
                              : (3, ("somebody", "grunt"))
                              : braceEasy
                | canHear -> (5, ("somebody", "grunt"))
                             : (3, ("something", "wheeze"))
                             : braceEasy
                | canBrace -> braceEasy
                | otherwise -> [(1, ("something", "hum silently"))]
      else return $!
        if | bproj b -> ("something", "ping")
           | canApply -> ("somebody", "holler a taunt")
           | canHear -> ("somebody", "growl menacingly")
           | canBrace -> ("something", "stomp repeatedly")
           | otherwise -> ("something", "buzz angrily")