    -- | Operations for starting and restarting the game.
    module Game.LambdaHack.Server.StartM
      ( initPer, reinitGame, gameReset, applyDebug
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , sampleTrunks, sampleItems
      , mapFromFuns, resetFactions, populateDungeon, findEntryPoss
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import qualified Control.Monad.Trans.State.Strict as St
    import qualified Data.EnumMap.Strict as EM
    import qualified Data.EnumSet as ES
    import           Data.Key (mapWithKeyM_)
    import qualified Data.Map.Strict as M
    import qualified Data.Set as S
    import qualified Data.Text as T
    import qualified NLP.Miniutter.English as MU
    import qualified System.Random.SplitMix32 as SM

    import           Game.LambdaHack.Atomic
    import           Game.LambdaHack.Common.ActorState
    import           Game.LambdaHack.Common.Analytics
    import           Game.LambdaHack.Common.Area
    import           Game.LambdaHack.Common.Faction
    import           Game.LambdaHack.Common.Item
    import           Game.LambdaHack.Common.Kind
    import           Game.LambdaHack.Common.Level
    import           Game.LambdaHack.Common.Misc
    import           Game.LambdaHack.Common.MonadStateRead
    import           Game.LambdaHack.Common.Point
    import           Game.LambdaHack.Common.State
    import qualified Game.LambdaHack.Common.Tile as Tile
    import           Game.LambdaHack.Common.Time
    import           Game.LambdaHack.Common.Types
    import qualified Game.LambdaHack.Content.CaveKind as CK
    import           Game.LambdaHack.Content.FactionKind
    import           Game.LambdaHack.Content.ItemKind (ItemKind)
    import qualified Game.LambdaHack.Content.ItemKind as IK
    import           Game.LambdaHack.Content.ModeKind
    import qualified Game.LambdaHack.Core.Dice as Dice
    import           Game.LambdaHack.Core.Frequency
    import           Game.LambdaHack.Core.Random
    import qualified Game.LambdaHack.Definition.Ability as Ability
    import qualified Game.LambdaHack.Definition.Color as Color
    import           Game.LambdaHack.Definition.Defs
    import           Game.LambdaHack.Definition.Flavour
    import           Game.LambdaHack.Server.CommonM
    import qualified Game.LambdaHack.Server.DungeonGen as DungeonGen
    import           Game.LambdaHack.Server.Fov
    import           Game.LambdaHack.Server.ItemM
    import           Game.LambdaHack.Server.ItemRev
    import           Game.LambdaHack.Server.MonadServer
    import           Game.LambdaHack.Server.ServerOptions
    import           Game.LambdaHack.Server.State

    initPer :: MonadServer m => m ()
    initPer :: forall (m :: * -> *). MonadServer m => m ()
    initPer = do
      ( sfovLitLid, sfovClearLid, sfovLucidLid
       ,sperValidFid, sperCacheFid, sperFid ) <- (State
     -> (FovLitLid, FovClearLid, FovLucidLid, PerValidFid, PerCacheFid,
         PerFid))
    -> m (FovLitLid, FovClearLid, FovLucidLid, PerValidFid,
          PerCacheFid, PerFid)
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State
    -> (FovLitLid, FovClearLid, FovLucidLid, PerValidFid, PerCacheFid,
        PerFid)
    perFidInDungeon
      modifyServer $ \StateServer
    ser ->
        StateServer
    ser { sfovLitLid, sfovClearLid, sfovLucidLid
            , sperValidFid, sperCacheFid, sperFid }

    reinitGame :: MonadServerAtomic m => FactionDict -> m ()
    reinitGame :: forall (m :: * -> *). MonadServerAtomic m => FactionDict -> m ()
    reinitGame FactionDict
    factionDold = do
      COps{coitem} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      pers <- getsServer sperFid
      ServerOptions{scurChalSer, sknowMap, sshowItemSamples, sclientOptions}
        <- getsServer soptions
      -- This state is quite small, fit for transmition to the client.
      -- The biggest part is content, which needs to be updated in clients
      -- at this point to keep them in sync with changes on the server.
      s <- getState
      discoS <- getsState sdiscoKind
      -- Thanks to the following, for any item with not hidden identity,
      -- the client has its kind from the start. The client needs to know this
      -- to have a fast way (faster that looking for @PresentAs@ flag on a list)
      -- of determining whether an item kind is already identified
      -- or needs identification.
      let discoKindFiltered =
            let f :: ContentId ItemKind -> Bool
    f ContentId ItemKind
    kindId = Maybe (GroupName ItemKind) -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe (GroupName ItemKind) -> Bool)
    -> Maybe (GroupName ItemKind) -> Bool
    forall a b. (a -> b) -> a -> b
    $ ItemKind -> Maybe (GroupName ItemKind)
    IK.getMandatoryPresentAsFromKind
                                     (ItemKind -> Maybe (GroupName ItemKind))
    -> ItemKind -> Maybe (GroupName ItemKind)
    forall a b. (a -> b) -> a -> b
    $ ContentData ItemKind -> ContentId ItemKind -> ItemKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData ItemKind
    coitem ContentId ItemKind
    kindId
            in (ContentId ItemKind -> Bool) -> DiscoveryKind -> DiscoveryKind
    forall a k. (a -> Bool) -> EnumMap k a -> EnumMap k a
    EM.filter ContentId ItemKind -> Bool
    f DiscoveryKind
    discoS
          defL | Bool
    sknowMap = State
    s
               | Bool
    otherwise = State -> State
    localFromGlobal State
    s
          defLocal = (DiscoveryKind -> DiscoveryKind) -> State -> State
    updateDiscoKind (DiscoveryKind -> DiscoveryKind -> DiscoveryKind
    forall a b. a -> b -> a
    const DiscoveryKind
    discoKindFiltered) State
    defL
      factionD <- getsState sfactionD
      clientStatesOld <- getsServer sclientStates
      metaBackupOld <- getsServer smetaBackup
      -- Some item kinds preserve their identity and flavour throughout
      -- the whole meta-game, until the savefiles are removed.
      -- These are usually not common man-made items, because these can be made
      -- in many flavours so it may be hard to recognize them.
      -- Character backstories and rare artifacts are uncommon enough
      -- to requiring learning their identify only once.
      -- However, the exact properties of even natural items may vary,
      -- so the random aspects of items, stored in @sdiscoAspect@
      -- are not preserved (a lot of other state components would need
      -- to be partially preserved, too, both on server and clients).
      let inMetaGame ContentId ItemKind
    kindId = Flag -> Aspect
    IK.SetFlag Flag
    Ability.MetaGame
                              Aspect -> [Aspect] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ItemKind -> [Aspect]
    IK.iaspects (ContentData ItemKind -> ContentId ItemKind -> ItemKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData ItemKind
    coitem ContentId ItemKind
    kindId)
          metaDiscoOldFid =
            (State -> DiscoveryKind)
    -> EnumMap FactionId State -> EnumMap FactionId DiscoveryKind
    forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
    EM.map ((ContentId ItemKind -> Bool) -> DiscoveryKind -> DiscoveryKind
    forall a k. (a -> Bool) -> EnumMap k a -> EnumMap k a
    EM.filter ContentId ItemKind -> Bool
    inMetaGame (DiscoveryKind -> DiscoveryKind)
    -> (State -> DiscoveryKind) -> State -> DiscoveryKind
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . State -> DiscoveryKind
    sdiscoKind) EnumMap FactionId State
    clientStatesOld
          fidToTeam :: FactionId -> TeamContinuity
          fidToTeam FactionId
    fid = FactionKind -> TeamContinuity
    fteam (FactionKind -> TeamContinuity) -> FactionKind -> TeamContinuity
    forall a b. (a -> b) -> a -> b
    $ Faction -> FactionKind
    gkind (Faction -> FactionKind) -> Faction -> FactionKind
    forall a b. (a -> b) -> a -> b
    $ FactionDict
    factionDold FactionDict -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid
          metaDiscoOldTeam =
            [(TeamContinuity, DiscoveryKind)]
    -> EnumMap TeamContinuity DiscoveryKind
    forall k a. Enum k => [(k, a)] -> EnumMap k a
    EM.fromList ([(TeamContinuity, DiscoveryKind)]
     -> EnumMap TeamContinuity DiscoveryKind)
    -> [(TeamContinuity, DiscoveryKind)]
    -> EnumMap TeamContinuity DiscoveryKind
    forall a b. (a -> b) -> a -> b
    $ ((FactionId, DiscoveryKind) -> (TeamContinuity, DiscoveryKind))
    -> [(FactionId, DiscoveryKind)]
    -> [(TeamContinuity, DiscoveryKind)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((FactionId -> TeamContinuity)
    -> (FactionId, DiscoveryKind) -> (TeamContinuity, DiscoveryKind)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first FactionId -> TeamContinuity
    fidToTeam) ([(FactionId, DiscoveryKind)] -> [(TeamContinuity, DiscoveryKind)])
    -> [(FactionId, DiscoveryKind)]
    -> [(TeamContinuity, DiscoveryKind)]
    forall a b. (a -> b) -> a -> b
    $ EnumMap FactionId DiscoveryKind -> [(FactionId, DiscoveryKind)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs EnumMap FactionId DiscoveryKind
    metaDiscoOldFid
          exclusiveUnion = (a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
    forall a k.
    (a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
    EM.unionWith ((a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a)
    -> (a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
    forall a b. (a -> b) -> a -> b
    $ \a
    _ a
    _ -> [Char] -> a
    forall a. (?callStack::CallStack) => [Char] -> a
    error [Char]
    "forbidden duplicate"
          metaDiscoAll = EnumMap TeamContinuity DiscoveryKind
    metaDiscoOldTeam EnumMap TeamContinuity DiscoveryKind
    -> EnumMap TeamContinuity DiscoveryKind
    -> EnumMap TeamContinuity DiscoveryKind
    forall {k} {a}. EnumMap k a -> EnumMap k a -> EnumMap k a
    `exclusiveUnion` EnumMap TeamContinuity DiscoveryKind
    metaBackupOld
          currentTeams = [TeamContinuity] -> EnumSet TeamContinuity
    forall k. Enum k => [k] -> EnumSet k
    ES.fromList ([TeamContinuity] -> EnumSet TeamContinuity)
    -> [TeamContinuity] -> EnumSet TeamContinuity
    forall a b. (a -> b) -> a -> b
    $ (Faction -> TeamContinuity) -> [Faction] -> [TeamContinuity]
    forall a b. (a -> b) -> [a] -> [b]
    map (FactionKind -> TeamContinuity
    fteam (FactionKind -> TeamContinuity)
    -> (Faction -> FactionKind) -> Faction -> TeamContinuity
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Faction -> FactionKind
    gkind) ([Faction] -> [TeamContinuity]) -> [Faction] -> [TeamContinuity]
    forall a b. (a -> b) -> a -> b
    $ FactionDict -> [Faction]
    forall k a. EnumMap k a -> [a]
    EM.elems FactionDict
    factionD
          metaBackupNew = EnumMap TeamContinuity DiscoveryKind
    -> EnumSet TeamContinuity -> EnumMap TeamContinuity DiscoveryKind
    forall k a. Enum k => EnumMap k a -> EnumSet k -> EnumMap k a
    EM.withoutKeys EnumMap TeamContinuity DiscoveryKind
    metaDiscoAll EnumSet TeamContinuity
    currentTeams
          stateNew Faction
    fact = case TeamContinuity
    -> EnumMap TeamContinuity DiscoveryKind -> Maybe DiscoveryKind
    forall k a. Enum k => k -> EnumMap k a -> Maybe a
    EM.lookup (FactionKind -> TeamContinuity
    fteam (FactionKind -> TeamContinuity) -> FactionKind -> TeamContinuity
    forall a b. (a -> b) -> a -> b
    $ Faction -> FactionKind
    gkind Faction
    fact) EnumMap TeamContinuity DiscoveryKind
    metaDiscoAll of
            Maybe DiscoveryKind
    Nothing -> State
    defLocal
            Just DiscoveryKind
    disco -> (DiscoveryKind -> DiscoveryKind) -> State -> State
    updateDiscoKind (DiscoveryKind
    disco DiscoveryKind -> DiscoveryKind -> DiscoveryKind
    forall {k} {a}. EnumMap k a -> EnumMap k a -> EnumMap k a
    `EM.union`) State
    defLocal
          clientStatesNew = (Faction -> State) -> FactionDict -> EnumMap FactionId State
    forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
    EM.map Faction -> State
    stateNew FactionDict
    factionD
      modifyServer $ \StateServer
    ser -> StateServer
    ser { sclientStates = clientStatesNew
                                 , smetaBackup = metaBackupNew }
      let updRestart FactionId
    fid = FactionId
    -> PerLid
    -> State
    -> Challenge
    -> ClientOptions
    -> SMGen
    -> UpdAtomic
    UpdRestart FactionId
    fid (PerFid
    pers PerFid -> FactionId -> PerLid
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid) (EnumMap FactionId State
    clientStatesNew EnumMap FactionId State -> FactionId -> State
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid)
                                      Challenge
    scurChalSer ClientOptions
    sclientOptions
      mapWithKeyM_ (\Key (EnumMap FactionId)
    fid Faction
    _ -> do
        -- Different seed for each client, to make sure behaviour is varied.
        gen1 <- (StateServer -> SMGen) -> m SMGen
    forall a. (StateServer -> a) -> m a
    forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
    getsServer StateServer -> SMGen
    srandom
        let (clientRandomSeed, gen2) = SM.splitSMGen gen1
        modifyServer $ \StateServer
    ser -> StateServer
    ser {srandom = gen2}
        execUpdAtomic $ updRestart fid clientRandomSeed) factionD
      dungeon <- getsState sdungeon
      let sactorTime = (Faction -> EnumMap LevelId (EnumMap ActorId Time))
    -> FactionDict
    -> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
    forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
    EM.map (EnumMap LevelId (EnumMap ActorId Time)
    -> Faction -> EnumMap LevelId (EnumMap ActorId Time)
    forall a b. a -> b -> a
    const ((Level -> EnumMap ActorId Time)
    -> Dungeon -> EnumMap LevelId (EnumMap ActorId Time)
    forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
    EM.map (EnumMap ActorId Time -> Level -> EnumMap ActorId Time
    forall a b. a -> b -> a
    const EnumMap ActorId Time
    forall k a. EnumMap k a
    EM.empty) Dungeon
    dungeon)) FactionDict
    factionD
          strajTime = (Faction -> EnumMap LevelId (EnumMap ActorId Time))
    -> FactionDict
    -> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
    forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
    EM.map (EnumMap LevelId (EnumMap ActorId Time)
    -> Faction -> EnumMap LevelId (EnumMap ActorId Time)
    forall a b. a -> b -> a
    const ((Level -> EnumMap ActorId Time)
    -> Dungeon -> EnumMap LevelId (EnumMap ActorId Time)
    forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
    EM.map (EnumMap ActorId Time -> Level -> EnumMap ActorId Time
    forall a b. a -> b -> a
    const EnumMap ActorId Time
    forall k a. EnumMap k a
    EM.empty) Dungeon
    dungeon)) FactionDict
    factionD
      modifyServer $ \StateServer
    ser -> StateServer
    ser {sactorTime, strajTime}
      when sshowItemSamples $ do
        genOrig <- getsServer srandom
        uniqueSetOrig <- getsServer suniqueSet
        genOld <- getsServer sgenerationAn
        genSampleTrunks <- sampleTrunks dungeon
        genSampleItems <- sampleItems dungeon
        let sgenerationAn = [GenerationAnalytics] -> GenerationAnalytics
    forall k a. [EnumMap k a] -> EnumMap k a
    EM.unions [GenerationAnalytics
    genSampleTrunks, GenerationAnalytics
    genSampleItems, GenerationAnalytics
    genOld]
        modifyServer $ \StateServer
    ser -> StateServer
    ser {sgenerationAn}
        -- Make sure the debug generations don't affect future RNG behaviour.
        -- However, in the long run, AI behaviour is affected anyway,
        -- because the items randomly chosen for AI actions are ordered by their
        -- @ItemId@, which is affected by the sample item generation.
        modifyServer $ \StateServer
    ser -> StateServer
    ser {srandom = genOrig, suniqueSet = uniqueSetOrig}
      populateDungeon
      mapM_ (\FactionId
    fid -> (LevelId -> m ()) -> [LevelId] -> m ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    (a -> m ()) -> t a -> m ()
    mapM_ (FactionId -> LevelId -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    FactionId -> LevelId -> m ()
    updatePer FactionId
    fid) (Dungeon -> [LevelId]
    forall k a. Enum k => EnumMap k a -> [k]
    EM.keys Dungeon
    dungeon))
            (EM.keys factionD)

    -- For simplicity only spawnable actors are taken into account, not starting
    -- actors of any faction nor summonable actors.
    sampleTrunks :: MonadServerAtomic m => Dungeon -> m GenerationAnalytics
    sampleTrunks :: forall (m :: * -> *).
    MonadServerAtomic m =>
    Dungeon -> m GenerationAnalytics
    sampleTrunks Dungeon
    dungeon = do
      COps{cocave, coitem} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      factionD <- getsState sfactionD
      let getGroups Level{ContentId CaveKind
    lkind :: ContentId CaveKind
    lkind :: Level -> ContentId CaveKind
    lkind} = ((GroupName ItemKind, Y) -> GroupName ItemKind)
    -> [(GroupName ItemKind, Y)] -> [GroupName ItemKind]
    forall a b. (a -> b) -> [a] -> [b]
    map (GroupName ItemKind, Y) -> GroupName ItemKind
    forall a b. (a, b) -> a
    fst ([(GroupName ItemKind, Y)] -> [GroupName ItemKind])
    -> [(GroupName ItemKind, Y)] -> [GroupName ItemKind]
    forall a b. (a -> b) -> a -> b
    $ CaveKind -> [(GroupName ItemKind, Y)]
    CK.cactorFreq (CaveKind -> [(GroupName ItemKind, Y)])
    -> CaveKind -> [(GroupName ItemKind, Y)]
    forall a b. (a -> b) -> a -> b
    $ ContentData CaveKind -> ContentId CaveKind -> CaveKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData CaveKind
    cocave ContentId CaveKind
    lkind
          groups = Set (GroupName ItemKind) -> [GroupName ItemKind]
    forall a. Set a -> [a]
    S.elems (Set (GroupName ItemKind) -> [GroupName ItemKind])
    -> Set (GroupName ItemKind) -> [GroupName ItemKind]
    forall a b. (a -> b) -> a -> b
    $ [GroupName ItemKind] -> Set (GroupName ItemKind)
    forall a. Ord a => [a] -> Set a
    S.fromList ([GroupName ItemKind] -> Set (GroupName ItemKind))
    -> [GroupName ItemKind] -> Set (GroupName ItemKind)
    forall a b. (a -> b) -> a -> b
    $ (Level -> [GroupName ItemKind]) -> [Level] -> [GroupName ItemKind]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Level -> [GroupName ItemKind]
    getGroups ([Level] -> [GroupName ItemKind])
    -> [Level] -> [GroupName ItemKind]
    forall a b. (a -> b) -> a -> b
    $ Dungeon -> [Level]
    forall k a. EnumMap k a -> [a]
    EM.elems Dungeon
    dungeon
          addGroupToSet !UniqueSet
    s0 !GroupName ItemKind
    grp =
            ContentData ItemKind
    -> GroupName ItemKind
    -> (UniqueSet -> Y -> ContentId ItemKind -> ItemKind -> UniqueSet)
    -> UniqueSet
    -> UniqueSet
    forall a b.
    ContentData a
    -> GroupName a -> (b -> Y -> ContentId a -> a -> b) -> b -> b
    ofoldlGroup' ContentData ItemKind
    coitem GroupName ItemKind
    grp (\UniqueSet
    s Y
    _ ContentId ItemKind
    ik ItemKind
    _ -> ContentId ItemKind -> UniqueSet -> UniqueSet
    forall k. Enum k => k -> EnumSet k -> EnumSet k
    ES.insert ContentId ItemKind
    ik UniqueSet
    s) UniqueSet
    s0
          trunkKindIds = UniqueSet -> [ContentId ItemKind]
    forall k. Enum k => EnumSet k -> [k]
    ES.elems (UniqueSet -> [ContentId ItemKind])
    -> UniqueSet -> [ContentId ItemKind]
    forall a b. (a -> b) -> a -> b
    $ (UniqueSet -> GroupName ItemKind -> UniqueSet)
    -> UniqueSet -> [GroupName ItemKind] -> UniqueSet
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' UniqueSet -> GroupName ItemKind -> UniqueSet
    addGroupToSet UniqueSet
    forall k. EnumSet k
    ES.empty [GroupName ItemKind]
    groups
          minLid = (LevelId, Level) -> LevelId
    forall a b. (a, b) -> a
    fst ((LevelId, Level) -> LevelId) -> (LevelId, Level) -> LevelId
    forall a b. (a -> b) -> a -> b
    $ ((LevelId, Level) -> (LevelId, Level) -> Ordering)
    -> [(LevelId, Level)] -> (LevelId, Level)
    forall (t :: * -> *) a.
    Foldable t =>
    (a -> a -> Ordering) -> t a -> a
    minimumBy (((LevelId, Level) -> AbsDepth)
    -> (LevelId, Level) -> (LevelId, Level) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (Level -> AbsDepth
    ldepth (Level -> AbsDepth)
    -> ((LevelId, Level) -> Level) -> (LevelId, Level) -> AbsDepth
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (LevelId, Level) -> Level
    forall a b. (a, b) -> b
    snd))
                       ([(LevelId, Level)] -> (LevelId, Level))
    -> [(LevelId, Level)] -> (LevelId, Level)
    forall a b. (a -> b) -> a -> b
    $ Dungeon -> [(LevelId, Level)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs Dungeon
    dungeon
      Level{ldepth} <- getLevel minLid
      let regItem ContentId ItemKind
    itemKindId = do
            let itemKind :: ItemKind
    itemKind = ContentData ItemKind -> ContentId ItemKind -> ItemKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData ItemKind
    coitem ContentId ItemKind
    itemKindId
                freq :: Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
    freq = (GroupName ItemKind, ContentId ItemKind, ItemKind)
    -> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
    forall a. a -> Frequency a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (GroupName ItemKind
    IK.HORROR, ContentId ItemKind
    itemKindId, ItemKind
    itemKind)
            case Frequency (FactionId, Faction) -> [(Y, (FactionId, Faction))]
    forall a. Frequency a -> [(Y, a)]
    runFrequency (Frequency (FactionId, Faction) -> [(Y, (FactionId, Faction))])
    -> Frequency (FactionId, Faction) -> [(Y, (FactionId, Faction))]
    forall a b. (a -> b) -> a -> b
    $ [GroupName ItemKind]
    -> ItemKind -> FactionDict -> Frequency (FactionId, Faction)
    possibleActorFactions [] ItemKind
    itemKind FactionDict
    factionD of
              [] -> [Char] -> m (Maybe ItemId)
    forall a. (?callStack::CallStack) => [Char] -> a
    error [Char]
    "sampleTrunks: null faction frequency"
              (Y
    _, (FactionId
    fid, Faction
    _)) : [(Y, (FactionId, Faction))]
    _ -> do
                let c :: Container
    c = FactionId -> LevelId -> Point -> Container
    CTrunk FactionId
    fid LevelId
    minLid Point
    originPoint
                    jfid :: Maybe FactionId
    jfid = FactionId -> Maybe FactionId
    forall a. a -> Maybe a
    Just FactionId
    fid
                m2 <- Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
    -> AbsDepth -> m NewItem
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
    -> AbsDepth -> m NewItem
    rollItemAspect Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
    freq AbsDepth
    ldepth
                case m2 of
                  NewItem
    NoNewItem -> [Char] -> m (Maybe ItemId)
    forall a. (?callStack::CallStack) => [Char] -> a
    error [Char]
    "sampleTrunks: can't create actor trunk"
                  NewItem GroupName ItemKind
    _ (ItemKnown ItemIdentity
    kindIx AspectRecord
    ar Maybe FactionId
    _) ItemFull
    itemFullRaw ItemQuant
    itemQuant -> do
                    let itemKnown :: ItemKnown
    itemKnown = ItemIdentity -> AspectRecord -> Maybe FactionId -> ItemKnown
    ItemKnown ItemIdentity
    kindIx AspectRecord
    ar Maybe FactionId
    jfid
                        itemFull :: ItemFull
    itemFull =
                          ItemFull
    itemFullRaw {itemBase = (itemBase itemFullRaw) {jfid}}
                    ItemId -> Maybe ItemId
    forall a. a -> Maybe a
    Just (ItemId -> Maybe ItemId) -> m ItemId -> m (Maybe ItemId)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Bool -> ItemFullKit -> ItemKnown -> Container -> m ItemId
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool -> ItemFullKit -> ItemKnown -> Container -> m ItemId
    registerItem Bool
    False (ItemFull
    itemFull, ItemQuant
    itemQuant) ItemKnown
    itemKnown Container
    c
      miids <- mapM regItem trunkKindIds
      return $! EM.singleton STrunk
                $ EM.fromDistinctAscList $ zip (catMaybes miids) $ repeat 0

    -- For simplicity, only actors generated on the ground are taken into account.
    -- not starting items of any actors nor items that can be create by effects
    -- occuring in the game.
    sampleItems :: MonadServerAtomic m => Dungeon -> m GenerationAnalytics
    sampleItems :: forall (m :: * -> *).
    MonadServerAtomic m =>
    Dungeon -> m GenerationAnalytics
    sampleItems Dungeon
    dungeon = do
      COps{cocave, coitem} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      let getGroups Level{ContentId CaveKind
    lkind :: Level -> ContentId CaveKind
    lkind :: ContentId CaveKind
    lkind} = ((GroupName ItemKind, Y) -> GroupName ItemKind)
    -> [(GroupName ItemKind, Y)] -> [GroupName ItemKind]
    forall a b. (a -> b) -> [a] -> [b]
    map (GroupName ItemKind, Y) -> GroupName ItemKind
    forall a b. (a, b) -> a
    fst ([(GroupName ItemKind, Y)] -> [GroupName ItemKind])
    -> [(GroupName ItemKind, Y)] -> [GroupName ItemKind]
    forall a b. (a -> b) -> a -> b
    $ CaveKind -> [(GroupName ItemKind, Y)]
    CK.citemFreq (CaveKind -> [(GroupName ItemKind, Y)])
    -> CaveKind -> [(GroupName ItemKind, Y)]
    forall a b. (a -> b) -> a -> b
    $ ContentData CaveKind -> ContentId CaveKind -> CaveKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData CaveKind
    cocave ContentId CaveKind
    lkind
          groups = Set (GroupName ItemKind) -> [GroupName ItemKind]
    forall a. Set a -> [a]
    S.elems (Set (GroupName ItemKind) -> [GroupName ItemKind])
    -> Set (GroupName ItemKind) -> [GroupName ItemKind]
    forall a b. (a -> b) -> a -> b
    $ [GroupName ItemKind] -> Set (GroupName ItemKind)
    forall a. Ord a => [a] -> Set a
    S.fromList ([GroupName ItemKind] -> Set (GroupName ItemKind))
    -> [GroupName ItemKind] -> Set (GroupName ItemKind)
    forall a b. (a -> b) -> a -> b
    $ (Level -> [GroupName ItemKind]) -> [Level] -> [GroupName ItemKind]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Level -> [GroupName ItemKind]
    getGroups ([Level] -> [GroupName ItemKind])
    -> [Level] -> [GroupName ItemKind]
    forall a b. (a -> b) -> a -> b
    $ Dungeon -> [Level]
    forall k a. EnumMap k a -> [a]
    EM.elems Dungeon
    dungeon
          addGroupToSet !UniqueSet
    s0 !GroupName ItemKind
    grp =
            ContentData ItemKind
    -> GroupName ItemKind
    -> (UniqueSet -> Y -> ContentId ItemKind -> ItemKind -> UniqueSet)
    -> UniqueSet
    -> UniqueSet
    forall a b.
    ContentData a
    -> GroupName a -> (b -> Y -> ContentId a -> a -> b) -> b -> b
    ofoldlGroup' ContentData ItemKind
    coitem GroupName ItemKind
    grp (\UniqueSet
    s Y
    _ ContentId ItemKind
    ik ItemKind
    _ -> ContentId ItemKind -> UniqueSet -> UniqueSet
    forall k. Enum k => k -> EnumSet k -> EnumSet k
    ES.insert ContentId ItemKind
    ik UniqueSet
    s) UniqueSet
    s0
          itemKindIds = UniqueSet -> [ContentId ItemKind]
    forall k. Enum k => EnumSet k -> [k]
    ES.elems (UniqueSet -> [ContentId ItemKind])
    -> UniqueSet -> [ContentId ItemKind]
    forall a b. (a -> b) -> a -> b
    $ (UniqueSet -> GroupName ItemKind -> UniqueSet)
    -> UniqueSet -> [GroupName ItemKind] -> UniqueSet
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' UniqueSet -> GroupName ItemKind -> UniqueSet
    addGroupToSet UniqueSet
    forall k. EnumSet k
    ES.empty [GroupName ItemKind]
    groups
          minLid = (LevelId, Level) -> LevelId
    forall a b. (a, b) -> a
    fst ((LevelId, Level) -> LevelId) -> (LevelId, Level) -> LevelId
    forall a b. (a -> b) -> a -> b
    $ ((LevelId, Level) -> (LevelId, Level) -> Ordering)
    -> [(LevelId, Level)] -> (LevelId, Level)
    forall (t :: * -> *) a.
    Foldable t =>
    (a -> a -> Ordering) -> t a -> a
    minimumBy (((LevelId, Level) -> AbsDepth)
    -> (LevelId, Level) -> (LevelId, Level) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (Level -> AbsDepth
    ldepth (Level -> AbsDepth)
    -> ((LevelId, Level) -> Level) -> (LevelId, Level) -> AbsDepth
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (LevelId, Level) -> Level
    forall a b. (a, b) -> b
    snd))
                       ([(LevelId, Level)] -> (LevelId, Level))
    -> [(LevelId, Level)] -> (LevelId, Level)
    forall a b. (a -> b) -> a -> b
    $ Dungeon -> [(LevelId, Level)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs Dungeon
    dungeon
      Level{ldepth} <- getLevel minLid
      let regItem ContentId ItemKind
    itemKindId = do
            let itemKind :: ItemKind
    itemKind = ContentData ItemKind -> ContentId ItemKind -> ItemKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData ItemKind
    coitem ContentId ItemKind
    itemKindId
                freq :: Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
    freq = (GroupName ItemKind, ContentId ItemKind, ItemKind)
    -> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
    forall a. a -> Frequency a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (GroupName ItemKind
    IK.HORROR, ContentId ItemKind
    itemKindId, ItemKind
    itemKind)
                c :: Container
    c = LevelId -> Point -> Container
    CFloor LevelId
    minLid Point
    originPoint
            m2 <- Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
    -> AbsDepth -> m NewItem
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
    -> AbsDepth -> m NewItem
    rollItemAspect Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
    freq AbsDepth
    ldepth
            case m2 of
              NewItem
    NoNewItem -> [Char] -> m (Maybe ItemId)
    forall a. (?callStack::CallStack) => [Char] -> a
    error [Char]
    "sampleItems: can't create sample item"
              NewItem GroupName ItemKind
    _ ItemKnown
    itemKnown ItemFull
    itemFull ItemQuant
    _ ->
                ItemId -> Maybe ItemId
    forall a. a -> Maybe a
    Just (ItemId -> Maybe ItemId) -> m ItemId -> m (Maybe ItemId)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Bool -> ItemFullKit -> ItemKnown -> Container -> m ItemId
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool -> ItemFullKit -> ItemKnown -> Container -> m ItemId
    registerItem Bool
    False (ItemFull
    itemFull, (Y
    0, [])) ItemKnown
    itemKnown Container
    c
      miids <- mapM regItem itemKindIds
      return $! EM.singleton SItem
                $ EM.fromDistinctAscList $ zip (catMaybes miids) $ repeat 0

    mapFromFuns :: Ord b => [a] -> [a -> b] -> M.Map b a
    mapFromFuns :: forall b a. Ord b => [a] -> [a -> b] -> Map b a
    mapFromFuns [a]
    domain =
      let fromFun :: (a -> b) -> Map b a -> Map b a
    fromFun a -> b
    f Map b a
    m1 =
            let invAssocs :: [(b, a)]
    invAssocs = (a -> (b, a)) -> [a] -> [(b, a)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\a
    c -> (a -> b
    f a
    c, a
    c)) [a]
    domain
                m2 :: Map b a
    m2 = [(b, a)] -> Map b a
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(b, a)]
    invAssocs
            in Map b a
    m2 Map b a -> Map b a -> Map b a
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    `M.union` Map b a
    m1
      in ((a -> b) -> Map b a -> Map b a) -> Map b a -> [a -> b] -> Map b a
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (a -> b) -> Map b a -> Map b a
    fromFun Map b a
    forall k a. Map k a
    M.empty

    resetFactions :: ContentData FactionKind -> Dice.AbsDepth -> ModeKind -> Bool
                  -> Rnd FactionDict
    resetFactions :: ContentData FactionKind
    -> AbsDepth -> ModeKind -> Bool -> Rnd FactionDict
    resetFactions ContentData FactionKind
    cofact AbsDepth
    totalDepth ModeKind
    mode
                  Bool
    automateAll = do
      let rawCreate :: (FactionId,
     (GroupName FactionKind, [(Y, Dice, GroupName ItemKind)]))
    -> StateT SMGen Identity (FactionId, Faction)
    rawCreate (FactionId
    fid, (GroupName FactionKind
    fkGroup, [(Y, Dice, GroupName ItemKind)]
    initialActors)) = do
            -- Validation of content guarantess the existence of such faction kind.
            gkindId <- Maybe (ContentId FactionKind) -> ContentId FactionKind
    forall a. (?callStack::CallStack) => Maybe a -> a
    fromJust (Maybe (ContentId FactionKind) -> ContentId FactionKind)
    -> StateT SMGen Identity (Maybe (ContentId FactionKind))
    -> StateT SMGen Identity (ContentId FactionKind)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ContentData FactionKind
    -> GroupName FactionKind
    -> (FactionKind -> Bool)
    -> StateT SMGen Identity (Maybe (ContentId FactionKind))
    forall a.
    Show a =>
    ContentData a
    -> GroupName a -> (a -> Bool) -> Rnd (Maybe (ContentId a))
    opick ContentData FactionKind
    cofact GroupName FactionKind
    fkGroup (Bool -> FactionKind -> Bool
    forall a b. a -> b -> a
    const Bool
    True)
            let gkind@FactionKind{..} = okind cofact gkindId
                castInitialActors (Y
    ln, Dice
    d, GroupName ItemKind
    actorGroup) = do
                  n <- AbsDepth -> AbsDepth -> Dice -> Rnd Y
    castDice (Y -> AbsDepth
    Dice.AbsDepth (Y -> AbsDepth) -> Y -> AbsDepth
    forall a b. (a -> b) -> a -> b
    $ Y -> Y
    forall a. Num a => a -> a
    abs Y
    ln) AbsDepth
    totalDepth Dice
    d
                  return (ln, n, actorGroup)
            ginitial <- mapM castInitialActors initialActors
            let cmap =
                  [Color] -> [Color -> Text] -> Map Text Color
    forall b a. Ord b => [a] -> [a -> b] -> Map b a
    mapFromFuns [Color]
    Color.legalFgCol
                              [Color -> Text
    colorToTeamName, Color -> Text
    colorToPlainName, Color -> Text
    colorToFancyName]
                colorName = Text -> Text
    T.toLower (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Text
    forall a. (?callStack::CallStack) => [a] -> a
    head ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ Text -> [Text]
    T.words Text
    fname
                prefix = case (Bool
    fhasPointman, Bool
    finitUnderAI) of
                  (Bool
    False, Bool
    False) -> Text
    "Uncoordinated"
                  (Bool
    False, Bool
    True) -> Text
    "Loose"
                  (Bool
    True, Bool
    False) -> Text
    "Autonomous"
                  (Bool
    True, Bool
    True) -> Text
    "Controlled"
                gnameNew = Text
    prefix Text -> Text -> Text
    <+> if Bool
    fhasGender
                                      then [Part] -> Text
    makePhrase [Part -> Part
    MU.Ws (Part -> Part) -> Part -> Part
    forall a b. (a -> b) -> a -> b
    $ Text -> Part
    MU.Text Text
    fname]
                                      else Text
    fname
                gcolor = Color -> Text -> Map Text Color -> Color
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault Color
    Color.BrWhite Text
    colorName Map Text Color
    cmap
            let gname = Text
    gnameNew
                gdoctrine = Doctrine
    finitDoctrine
                gunderAI = Bool
    finitUnderAI Bool -> Bool -> Bool
    || ModeKind -> Bool
    mattract ModeKind
    mode Bool -> Bool -> Bool
    || Bool
    automateAll
                gdipl = EnumMap k a
    forall k a. EnumMap k a
    EM.empty  -- fixed below
                gquit = Maybe a
    forall a. Maybe a
    Nothing
                _gleader = Maybe a
    forall a. Maybe a
    Nothing
                gvictims = EnumMap k a
    forall k a. EnumMap k a
    EM.empty
                gstash = Maybe a
    forall a. Maybe a
    Nothing
            return (fid, Faction{..})
      lFs <- ((FactionId,
      (GroupName FactionKind, [(Y, Dice, GroupName ItemKind)]))
     -> StateT SMGen Identity (FactionId, Faction))
    -> [(FactionId,
         (GroupName FactionKind, [(Y, Dice, GroupName ItemKind)]))]
    -> StateT SMGen Identity [(FactionId, Faction)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (FactionId,
     (GroupName FactionKind, [(Y, Dice, GroupName ItemKind)]))
    -> StateT SMGen Identity (FactionId, Faction)
    rawCreate ([(FactionId,
       (GroupName FactionKind, [(Y, Dice, GroupName ItemKind)]))]
     -> StateT SMGen Identity [(FactionId, Faction)])
    -> [(FactionId,
         (GroupName FactionKind, [(Y, Dice, GroupName ItemKind)]))]
    -> StateT SMGen Identity [(FactionId, Faction)]
    forall a b. (a -> b) -> a -> b
    $ [FactionId]
    -> [(GroupName FactionKind, [(Y, Dice, GroupName ItemKind)])]
    -> [(FactionId,
         (GroupName FactionKind, [(Y, Dice, GroupName ItemKind)]))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Y -> FactionId
    forall a. Enum a => Y -> a
    toEnum Y
    1 ..] ([(GroupName FactionKind, [(Y, Dice, GroupName ItemKind)])]
     -> [(FactionId,
          (GroupName FactionKind, [(Y, Dice, GroupName ItemKind)]))])
    -> [(GroupName FactionKind, [(Y, Dice, GroupName ItemKind)])]
    -> [(FactionId,
         (GroupName FactionKind, [(Y, Dice, GroupName ItemKind)]))]
    forall a b. (a -> b) -> a -> b
    $ ModeKind
    -> [(GroupName FactionKind, [(Y, Dice, GroupName ItemKind)])]
    mroster ModeKind
    mode
      let mkDipl Diplomacy
    diplMode =
            let f :: (k, FactionId) -> EnumMap k Faction -> EnumMap k Faction
    f (k
    ix1, FactionId
    ix2) =
                  let adj1 :: Faction -> Faction
    adj1 Faction
    fact = Faction
    fact {gdipl = EM.insert ix2 diplMode (gdipl fact)}
                  in (Faction -> Faction) -> k -> EnumMap k Faction -> EnumMap k Faction
    forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
    EM.adjust Faction -> Faction
    adj1 k
    ix1
            in ((k, FactionId) -> EnumMap k Faction -> EnumMap k Faction)
    -> EnumMap k Faction -> t (k, FactionId) -> EnumMap k Faction
    forall a b. (a -> b -> b) -> b -> t a -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (k, FactionId) -> EnumMap k Faction -> EnumMap k Faction
    f
          -- Only symmetry is ensured, everything else is permitted,
          -- e.g., a faction in alliance with two others that are at war.
          pairsFromFaction :: (FactionKind -> [TeamContinuity])
                           -> (FactionId, Faction)
                           -> [(FactionId, FactionId)]
          pairsFromFaction FactionKind -> [TeamContinuity]
    selector (FactionId
    fid, Faction
    fact) =
            let teams :: [TeamContinuity]
    teams = FactionKind -> [TeamContinuity]
    selector (FactionKind -> [TeamContinuity])
    -> FactionKind -> [TeamContinuity]
    forall a b. (a -> b) -> a -> b
    $ Faction -> FactionKind
    gkind Faction
    fact
                hasTeam :: TeamContinuity -> (a, Faction) -> Bool
    hasTeam TeamContinuity
    team (a
    _, Faction
    fact2) = TeamContinuity
    team TeamContinuity -> TeamContinuity -> Bool
    forall a. Eq a => a -> a -> Bool
    == FactionKind -> TeamContinuity
    fteam (Faction -> FactionKind
    gkind Faction
    fact2)
                pairsFromTeam :: TeamContinuity -> [(FactionId, FactionId)]
    pairsFromTeam TeamContinuity
    team = case ((FactionId, Faction) -> Bool)
    -> [(FactionId, Faction)] -> Maybe (FactionId, Faction)
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (TeamContinuity -> (FactionId, Faction) -> Bool
    forall {a}. TeamContinuity -> (a, Faction) -> Bool
    hasTeam TeamContinuity
    team) [(FactionId, Faction)]
    lFs of
                  Just (FactionId
    fid2, Faction
    _) -> [(FactionId
    fid, FactionId
    fid2), (FactionId
    fid2, FactionId
    fid)]
                  Maybe (FactionId, Faction)
    Nothing -> []
            in (TeamContinuity -> [(FactionId, FactionId)])
    -> [TeamContinuity] -> [(FactionId, FactionId)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap TeamContinuity -> [(FactionId, FactionId)]
    pairsFromTeam [TeamContinuity]
    teams
          rawFs = [(FactionId, Faction)] -> FactionDict
    forall k a. Enum k => [(k, a)] -> EnumMap k a
    EM.fromList [(FactionId, Faction)]
    lFs
          -- War overrides alliance, so 'warFs' second. Consequently, if a faction
          -- is allied with a faction that is at war with them, they will be
          -- symmetrically at war.
          allianceFs = Diplomacy -> FactionDict -> [(FactionId, FactionId)] -> FactionDict
    forall {k} {t :: * -> *}.
    (Enum k, Foldable t) =>
    Diplomacy
    -> EnumMap k Faction -> t (k, FactionId) -> EnumMap k Faction
    mkDipl Diplomacy
    Alliance FactionDict
    rawFs
                       ([(FactionId, FactionId)] -> FactionDict)
    -> [(FactionId, FactionId)] -> FactionDict
    forall a b. (a -> b) -> a -> b
    $ ((FactionId, Faction) -> [(FactionId, FactionId)])
    -> [(FactionId, Faction)] -> [(FactionId, FactionId)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((FactionKind -> [TeamContinuity])
    -> (FactionId, Faction) -> [(FactionId, FactionId)]
    pairsFromFaction FactionKind -> [TeamContinuity]
    falliedTeams) ([(FactionId, Faction)] -> [(FactionId, FactionId)])
    -> [(FactionId, Faction)] -> [(FactionId, FactionId)]
    forall a b. (a -> b) -> a -> b
    $ FactionDict -> [(FactionId, Faction)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs FactionDict
    rawFs
          warFs = Diplomacy -> FactionDict -> [(FactionId, FactionId)] -> FactionDict
    forall {k} {t :: * -> *}.
    (Enum k, Foldable t) =>
    Diplomacy
    -> EnumMap k Faction -> t (k, FactionId) -> EnumMap k Faction
    mkDipl Diplomacy
    War FactionDict
    allianceFs
                  ([(FactionId, FactionId)] -> FactionDict)
    -> [(FactionId, FactionId)] -> FactionDict
    forall a b. (a -> b) -> a -> b
    $ ((FactionId, Faction) -> [(FactionId, FactionId)])
    -> [(FactionId, Faction)] -> [(FactionId, FactionId)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((FactionKind -> [TeamContinuity])
    -> (FactionId, Faction) -> [(FactionId, FactionId)]
    pairsFromFaction FactionKind -> [TeamContinuity]
    fenemyTeams) ([(FactionId, Faction)] -> [(FactionId, FactionId)])
    -> [(FactionId, Faction)] -> [(FactionId, FactionId)]
    forall a b. (a -> b) -> a -> b
    $ FactionDict -> [(FactionId, Faction)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs FactionDict
    allianceFs
      return $! warFs

    gameReset :: MonadServer m
              => ServerOptions -> Maybe (GroupName ModeKind)
              -> Maybe SM.SMGen -> m State
    gameReset :: forall (m :: * -> *).
    MonadServer m =>
    ServerOptions
    -> Maybe (GroupName ModeKind) -> Maybe SMGen -> m State
    gameReset ServerOptions
    serverOptions Maybe (GroupName ModeKind)
    mGameMode Maybe SMGen
    mrandom = do
      -- Dungeon seed generation has to come first, to ensure item boosting
      -- is determined by the dungeon RNG.
      cops@COps{cofact, comode} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      dungeonSeed <- getSetGen $ sdungeonRng serverOptions `mplus` mrandom
      srandom <- getSetGen $ smainRng serverOptions `mplus` mrandom
      let srngs = Maybe SMGen -> Maybe SMGen -> RNGs
    RNGs (SMGen -> Maybe SMGen
    forall a. a -> Maybe a
    Just SMGen
    dungeonSeed) (SMGen -> Maybe SMGen
    forall a. a -> Maybe a
    Just SMGen
    srandom)
      when (sdumpInitRngs serverOptions) $ dumpRngs srngs
      scoreTable <- restoreScore cops
      teamGearOld <- getsServer steamGear
      flavourOld <- getsServer sflavour
      discoKindRevOld <- getsServer sdiscoKindRev
      clientStatesOld <- getsServer sclientStates
      let gameMode = GroupName ModeKind
    -> Maybe (GroupName ModeKind) -> GroupName ModeKind
    forall a. a -> Maybe a -> a
    fromMaybe GroupName ModeKind
    INSERT_COIN
                     (Maybe (GroupName ModeKind) -> GroupName ModeKind)
    -> Maybe (GroupName ModeKind) -> GroupName ModeKind
    forall a b. (a -> b) -> a -> b
    $ Maybe (GroupName ModeKind)
    mGameMode Maybe (GroupName ModeKind)
    -> Maybe (GroupName ModeKind) -> Maybe (GroupName ModeKind)
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` ServerOptions -> Maybe (GroupName ModeKind)
    sgameMode ServerOptions
    serverOptions
          rnd :: Rnd (FactionDict, FlavourMap, DiscoveryKind, DiscoveryKindRev,
                      DungeonGen.FreshDungeon, ContentId ModeKind)
          rnd = do
            modeKindId <-
              ContentId ModeKind
    -> Maybe (ContentId ModeKind) -> ContentId ModeKind
    forall a. a -> Maybe a -> a
    fromMaybe ([Char] -> ContentId ModeKind
    forall a. (?callStack::CallStack) => [Char] -> a
    error ([Char] -> ContentId ModeKind) -> [Char] -> ContentId ModeKind
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Unknown game mode:" [Char] -> GroupName ModeKind -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` GroupName ModeKind
    gameMode)
              (Maybe (ContentId ModeKind) -> ContentId ModeKind)
    -> StateT SMGen Identity (Maybe (ContentId ModeKind))
    -> StateT SMGen Identity (ContentId ModeKind)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ContentData ModeKind
    -> GroupName ModeKind
    -> (ModeKind -> Bool)
    -> StateT SMGen Identity (Maybe (ContentId ModeKind))
    forall a.
    Show a =>
    ContentData a
    -> GroupName a -> (a -> Bool) -> Rnd (Maybe (ContentId a))
    opick ContentData ModeKind
    comode GroupName ModeKind
    gameMode (Bool -> ModeKind -> Bool
    forall a b. a -> b -> a
    const Bool
    True)
            let mode = ContentData ModeKind -> ContentId ModeKind -> ModeKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData ModeKind
    comode ContentId ModeKind
    modeKindId
            flavour <- dungeonFlavourMap cops flavourOld
            (discoKind, sdiscoKindRev) <- serverDiscos cops discoKindRevOld
            freshDng <- DungeonGen.dungeonGen cops serverOptions $ mcaves mode
            factionD <- resetFactions cofact (DungeonGen.freshTotalDepth freshDng)
                                      mode (sautomateAll serverOptions)
            return ( factionD, flavour, discoKind
                   , sdiscoKindRev, freshDng, modeKindId )
      let ( factionD, sflavour, discoKind
           ,sdiscoKindRev, DungeonGen.FreshDungeon{..}, modeKindId ) =
            St.evalState rnd dungeonSeed
          defState = Dungeon
    -> AbsDepth
    -> FactionDict
    -> COps
    -> ScoreDict
    -> ContentId ModeKind
    -> DiscoveryKind
    -> State
    defStateGlobal Dungeon
    freshDungeon AbsDepth
    freshTotalDepth
                                    FactionDict
    factionD COps
    cops ScoreDict
    scoreTable ContentId ModeKind
    modeKindId DiscoveryKind
    discoKind
          defSer = StateServer
    emptyStateServer { srandom
                                    , srngs }
      putServer defSer
      modifyServer $ \StateServer
    ser -> StateServer
    ser { steamGear = teamGearOld
                                 , steamGearCur = teamGearOld
                                 , sclientStates = clientStatesOld  -- reset later
                                 , sdiscoKindRev
                                 , sflavour }
      return $! defState

    -- Spawn initial actors. Clients should notice this, to set their leaders.
    populateDungeon :: forall m. MonadServerAtomic m => m ()
    populateDungeon :: forall (m :: * -> *). MonadServerAtomic m => m ()
    populateDungeon = do
      cops@COps{coTileSpeedup} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      factionD <- getsState sfactionD
      curChalSer <- getsServer $ scurChalSer . soptions
      let nGt0 (a
    _, a
    n, c
    _) = a
    n a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > a
    0
          ginitialWolf Faction
    fact1 = if Challenge -> Bool
    cwolf Challenge
    curChalSer Bool -> Bool -> Bool
    && FactionKind -> Bool
    fhasUI (Faction -> FactionKind
    gkind Faction
    fact1)
                               then case ((Y, Y, GroupName ItemKind) -> Bool)
    -> [(Y, Y, GroupName ItemKind)] -> [(Y, Y, GroupName ItemKind)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Y, Y, GroupName ItemKind) -> Bool
    forall {a} {a} {c}. (Ord a, Num a) => (a, a, c) -> Bool
    nGt0 ([(Y, Y, GroupName ItemKind)] -> [(Y, Y, GroupName ItemKind)])
    -> [(Y, Y, GroupName ItemKind)] -> [(Y, Y, GroupName ItemKind)]
    forall a b. (a -> b) -> a -> b
    $ Faction -> [(Y, Y, GroupName ItemKind)]
    ginitial Faction
    fact1 of
                                 [] -> []
                                 (Y
    ln, Y
    _, GroupName ItemKind
    grp) : [(Y, Y, GroupName ItemKind)]
    _ -> [(Y
    ln, Y
    1, GroupName ItemKind
    grp)]
                               else Faction -> [(Y, Y, GroupName ItemKind)]
    ginitial Faction
    fact1
          -- Keep the same order of factions as in roster.
          needInitialCrew = ((FactionId, Faction) -> (FactionId, Faction) -> Ordering)
    -> [(FactionId, Faction)] -> [(FactionId, Faction)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (((FactionId, Faction) -> FactionId)
    -> (FactionId, Faction) -> (FactionId, Faction) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (FactionId, Faction) -> FactionId
    forall a b. (a, b) -> a
    fst)
                            ([(FactionId, Faction)] -> [(FactionId, Faction)])
    -> [(FactionId, Faction)] -> [(FactionId, Faction)]
    forall a b. (a -> b) -> a -> b
    $ ((FactionId, Faction) -> Bool)
    -> [(FactionId, Faction)] -> [(FactionId, Faction)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> ((FactionId, Faction) -> Bool) -> (FactionId, Faction) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(Y, Y, GroupName ItemKind)] -> Bool
    forall a. [a] -> Bool
    null ([(Y, Y, GroupName ItemKind)] -> Bool)
    -> ((FactionId, Faction) -> [(Y, Y, GroupName ItemKind)])
    -> (FactionId, Faction)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Faction -> [(Y, Y, GroupName ItemKind)]
    ginitialWolf (Faction -> [(Y, Y, GroupName ItemKind)])
    -> ((FactionId, Faction) -> Faction)
    -> (FactionId, Faction)
    -> [(Y, Y, GroupName ItemKind)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FactionId, Faction) -> Faction
    forall a b. (a, b) -> b
    snd)
                            ([(FactionId, Faction)] -> [(FactionId, Faction)])
    -> [(FactionId, Faction)] -> [(FactionId, Faction)]
    forall a b. (a -> b) -> a -> b
    $ FactionDict -> [(FactionId, Faction)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs FactionDict
    factionD
          getEntryLevels (FactionId
    _, Faction
    fact) =
            ((Y, Y, GroupName ItemKind) -> LevelId)
    -> [(Y, Y, GroupName ItemKind)] -> [LevelId]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Y
    ln, Y
    _, GroupName ItemKind
    _) -> Y -> LevelId
    forall a. Enum a => Y -> a
    toEnum Y
    ln) ([(Y, Y, GroupName ItemKind)] -> [LevelId])
    -> [(Y, Y, GroupName ItemKind)] -> [LevelId]
    forall a b. (a -> b) -> a -> b
    $ Faction -> [(Y, Y, GroupName ItemKind)]
    ginitialWolf Faction
    fact
          arenas = EnumSet LevelId -> [LevelId]
    forall k. Enum k => EnumSet k -> [k]
    ES.elems (EnumSet LevelId -> [LevelId]) -> EnumSet LevelId -> [LevelId]
    forall a b. (a -> b) -> a -> b
    $ [LevelId] -> EnumSet LevelId
    forall k. Enum k => [k] -> EnumSet k
    ES.fromList ([LevelId] -> EnumSet LevelId) -> [LevelId] -> EnumSet LevelId
    forall a b. (a -> b) -> a -> b
    $ ((FactionId, Faction) -> [LevelId])
    -> [(FactionId, Faction)] -> [LevelId]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (FactionId, Faction) -> [LevelId]
    getEntryLevels [(FactionId, Faction)]
    needInitialCrew
          hasActorsOnArena LevelId
    lid (FactionId
    _, Faction
    fact) =
            ((Y, Y, GroupName ItemKind) -> Bool)
    -> [(Y, Y, GroupName ItemKind)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (\(Y
    ln, Y
    _, GroupName ItemKind
    _) -> Y -> LevelId
    forall a. Enum a => Y -> a
    toEnum Y
    ln LevelId -> LevelId -> Bool
    forall a. Eq a => a -> a -> Bool
    == LevelId
    lid) ([(Y, Y, GroupName ItemKind)] -> Bool)
    -> [(Y, Y, GroupName ItemKind)] -> Bool
    forall a b. (a -> b) -> a -> b
    $ Faction -> [(Y, Y, GroupName ItemKind)]
    ginitialWolf Faction
    fact
          initialActorPositions :: LevelId
                                -> m (LevelId, EM.EnumMap FactionId Point)
          initialActorPositions LevelId
    lid = do
            lvl <- LevelId -> m Level
    forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
    getLevel LevelId
    lid
            let arenaFactions =
                  ((FactionId, Faction) -> FactionId)
    -> [(FactionId, Faction)] -> [FactionId]
    forall a b. (a -> b) -> [a] -> [b]
    map (FactionId, Faction) -> FactionId
    forall a b. (a, b) -> a
    fst ([(FactionId, Faction)] -> [FactionId])
    -> [(FactionId, Faction)] -> [FactionId]
    forall a b. (a -> b) -> a -> b
    $ ((FactionId, Faction) -> Bool)
    -> [(FactionId, Faction)] -> [(FactionId, Faction)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (LevelId -> (FactionId, Faction) -> Bool
    hasActorsOnArena LevelId
    lid) [(FactionId, Faction)]
    needInitialCrew
            entryPoss <- rndToAction $ findEntryPoss cops lvl (length arenaFactions)
            when (length entryPoss < length arenaFactions) $ debugPossiblyPrint
              "Server: populateDungeon: failed to find enough distinct faction starting positions; some factions share positions"
            let usedPoss = [(FactionId, Point)] -> EnumMap FactionId Point
    forall k a. Enum k => [(k, a)] -> EnumMap k a
    EM.fromList ([(FactionId, Point)] -> EnumMap FactionId Point)
    -> [(FactionId, Point)] -> EnumMap FactionId Point
    forall a b. (a -> b) -> a -> b
    $ [FactionId] -> [Point] -> [(FactionId, Point)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [FactionId]
    arenaFactions ([Point] -> [(FactionId, Point)])
    -> [Point] -> [(FactionId, Point)]
    forall a b. (a -> b) -> a -> b
    $ [Point] -> [Point]
    forall a. (?callStack::CallStack) => [a] -> [a]
    cycle [Point]
    entryPoss
            return (lid, usedPoss)
      factionPositions <- EM.fromDistinctAscList
                          <$> mapM initialActorPositions arenas
      let initialActors :: (FactionId, Faction) -> m ()
          initialActors (FactionId
    fid3, Faction
    fact3) =
            ((Y, Y, GroupName ItemKind) -> m ())
    -> [(Y, Y, GroupName ItemKind)] -> m ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    (a -> m ()) -> t a -> m ()
    mapM_ (FactionId -> (Y, Y, GroupName ItemKind) -> m ()
    placeActors FactionId
    fid3) ([(Y, Y, GroupName ItemKind)] -> m ())
    -> [(Y, Y, GroupName ItemKind)] -> m ()
    forall a b. (a -> b) -> a -> b
    $ Faction -> [(Y, Y, GroupName ItemKind)]
    ginitialWolf Faction
    fact3
          placeActors :: FactionId -> (Int, Int, GroupName ItemKind) -> m ()
          placeActors FactionId
    fid3 (Y
    ln, Y
    n, GroupName ItemKind
    actorGroup) = do
            let lid :: LevelId
    lid = Y -> LevelId
    forall a. Enum a => Y -> a
    toEnum Y
    ln
            lvl <- LevelId -> m Level
    forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
    getLevel LevelId
    lid
            let ppos = EnumMap LevelId (EnumMap FactionId Point)
    factionPositions EnumMap LevelId (EnumMap FactionId Point)
    -> LevelId -> EnumMap FactionId Point
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! LevelId
    lid EnumMap FactionId Point -> FactionId -> Point
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid3
                validTile ContentId TileKind
    t = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ TileSpeedup -> ContentId TileKind -> Bool
    Tile.isNoActor TileSpeedup
    coTileSpeedup ContentId TileKind
    t
                -- This takes into account already spawned actors of this
                -- and other factions. If not enough space, some are skipped.
                psFree = COps -> Level -> (ContentId TileKind -> Bool) -> Point -> [Point]
    nearbyFreePoints COps
    cops Level
    lvl ContentId TileKind -> Bool
    validTile Point
    ppos
                ps = Y -> [Point] -> [Point]
    forall a. Y -> [a] -> [a]
    take Y
    n [Point]
    psFree
            when (length ps < n) $ debugPossiblyPrint
              "Server: populateDungeon: failed to find enough initial actor positions; some actors are not generated"
            localTime <- getsState $ getLocalTime lid
            forM_ ps $ \Point
    p -> do
              rndDelay <- Rnd Y -> m Y
    forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
    rndToAction (Rnd Y -> m Y) -> Rnd Y -> m Y
    forall a b. (a -> b) -> a -> b
    $ (Y, Y) -> Rnd Y
    forall a. Integral a => (a, a) -> Rnd a
    randomR (Y
    1, Y
    clipsInTurn Y -> Y -> Y
    forall a. Num a => a -> a -> a
    - Y
    1)
              let delta = Delta Time -> Y -> Delta Time
    timeDeltaScale (Time -> Delta Time
    forall a. a -> Delta a
    Delta Time
    timeClip) Y
    rndDelay
                  rndTime = Time -> Delta Time -> Time
    timeShift Time
    localTime Delta Time
    delta
              maid <- addActorFromGroup actorGroup fid3 p lid rndTime
              case maid of
                Maybe ActorId
    Nothing -> [Char] -> m ()
    forall a. (?callStack::CallStack) => [Char] -> a
    error ([Char] -> m ()) -> [Char] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "can't spawn initial actors"
                                   [Char] -> (LevelId, FactionId) -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` (LevelId
    lid, FactionId
    fid3)
                Just ActorId
    aid -> do
                  mleader <- (State -> Maybe ActorId) -> m (Maybe ActorId)
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Maybe ActorId) -> m (Maybe ActorId))
    -> (State -> Maybe ActorId) -> m (Maybe ActorId)
    forall a b. (a -> b) -> a -> b
    $ Faction -> Maybe ActorId
    gleader (Faction -> Maybe ActorId)
    -> (State -> Faction) -> State -> Maybe ActorId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FactionDict -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid3) (FactionDict -> Faction)
    -> (State -> FactionDict) -> State -> Faction
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . State -> FactionDict
    sfactionD
                  -- Sleeping actor may become a leader, but it's quickly corrected.
                  when (isNothing mleader) $ setFreshLeader fid3 aid
      placeItemsInDungeon factionPositions
      embedItemsInDungeon
      mapM_ initialActors needInitialCrew

    -- | Find starting postions for all factions. Try to make them distant
    -- from each other. Place as many of the factions, as possible,
    -- over stairs. Place the first faction(s) over escape(s)
    -- (we assume they are guardians of the escapes).
    -- This implies the inital factions (if any) start far from escapes.
    findEntryPoss :: COps -> Level -> Int -> Rnd [Point]
    findEntryPoss :: COps -> Level -> Y -> Rnd [Point]
    findEntryPoss COps{ContentData CaveKind
    cocave :: COps -> ContentData CaveKind
    cocave :: ContentData CaveKind
    cocave, TileSpeedup
    coTileSpeedup :: COps -> TileSpeedup
    coTileSpeedup :: TileSpeedup
    coTileSpeedup}
                  lvl :: Level
    lvl@Level{ContentId CaveKind
    lkind :: Level -> ContentId CaveKind
    lkind :: ContentId CaveKind
    lkind, Area
    larea :: Area
    larea :: Level -> Area
    larea, ([Point], [Point])
    lstair :: ([Point], [Point])
    lstair :: Level -> ([Point], [Point])
    lstair, [Point]
    lescape :: [Point]
    lescape :: Level -> [Point]
    lescape}
                  Y
    kRaw = do
      let lskip :: [Y]
    lskip = CaveKind -> [Y]
    CK.cskip (CaveKind -> [Y]) -> CaveKind -> [Y]
    forall a b. (a -> b) -> a -> b
    $ ContentData CaveKind -> ContentId CaveKind -> CaveKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData CaveKind
    cocave ContentId CaveKind
    lkind
          k :: Y
    k = Y
    kRaw Y -> Y -> Y
    forall a. Num a => a -> a -> a
    + [Y] -> Y
    forall a. [a] -> Y
    length [Y]
    lskip  -- if @lskip@ is bogus, will be too large; OK
          (Point
    _, Y
    xspan, Y
    yspan) = Area -> (Point, Y, Y)
    spanArea Area
    larea
          factionDist :: Y
    factionDist = Y -> Y -> Y
    forall a. Ord a => a -> a -> a
    max Y
    xspan Y
    yspan Y -> Y -> Y
    forall a. Num a => a -> a -> a
    - Y
    10
          dist :: t Point -> Y -> Point -> p -> Bool
    dist !t Point
    poss !Y
    cmin !Point
    l p
    _ = (Point -> Bool) -> t Point -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (\ !Point
    pos -> Point -> Point -> Y
    chessDist Point
    l Point
    pos Y -> Y -> Bool
    forall a. Ord a => a -> a -> Bool
    > Y
    cmin) t Point
    poss
          tryFind :: [Point] -> Y -> Rnd [Point]
    tryFind [Point]
    _ Y
    0 = [Point] -> Rnd [Point]
    forall a. a -> StateT SMGen Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
          tryFind ![Point]
    ps !Y
    n = do
            let ds :: [Point -> ContentId TileKind -> Bool]
    ds = [ [Point] -> Y -> Point -> ContentId TileKind -> Bool
    forall {t :: * -> *} {p}.
    Foldable t =>
    t Point -> Y -> Point -> p -> Bool
    dist [Point]
    ps Y
    factionDist
                     , [Point] -> Y -> Point -> ContentId TileKind -> Bool
    forall {t :: * -> *} {p}.
    Foldable t =>
    t Point -> Y -> Point -> p -> Bool
    dist [Point]
    ps (Y -> Point -> ContentId TileKind -> Bool)
    -> Y -> Point -> ContentId TileKind -> Bool
    forall a b. (a -> b) -> a -> b
    $ Y
    factionDist Y -> Y -> Y
    forall a. Integral a => a -> a -> a
    `div` Y
    2
                     , [Point] -> Y -> Point -> ContentId TileKind -> Bool
    forall {t :: * -> *} {p}.
    Foldable t =>
    t Point -> Y -> Point -> p -> Bool
    dist [Point]
    ps (Y -> Point -> ContentId TileKind -> Bool)
    -> Y -> Point -> ContentId TileKind -> Bool
    forall a b. (a -> b) -> a -> b
    $ Y
    factionDist Y -> Y -> Y
    forall a. Integral a => a -> a -> a
    `div` Y
    3
                     , [Point] -> Y -> Point -> ContentId TileKind -> Bool
    forall {t :: * -> *} {p}.
    Foldable t =>
    t Point -> Y -> Point -> p -> Bool
    dist [Point]
    ps (Y -> Point -> ContentId TileKind -> Bool)
    -> Y -> Point -> ContentId TileKind -> Bool
    forall a b. (a -> b) -> a -> b
    $ Y -> Y -> Y
    forall a. Ord a => a -> a -> a
    max Y
    5 (Y -> Y) -> Y -> Y
    forall a b. (a -> b) -> a -> b
    $ Y
    factionDist Y -> Y -> Y
    forall a. Integral a => a -> a -> a
    `div` Y
    5
                     , [Point] -> Y -> Point -> ContentId TileKind -> Bool
    forall {t :: * -> *} {p}.
    Foldable t =>
    t Point -> Y -> Point -> p -> Bool
    dist [Point]
    ps (Y -> Point -> ContentId TileKind -> Bool)
    -> Y -> Point -> ContentId TileKind -> Bool
    forall a b. (a -> b) -> a -> b
    $ Y -> Y -> Y
    forall a. Ord a => a -> a -> a
    max Y
    2 (Y -> Y) -> Y -> Y
    forall a b. (a -> b) -> a -> b
    $ Y
    factionDist Y -> Y -> Y
    forall a. Integral a => a -> a -> a
    `div` Y
    10
                     ]
            mp <- Y
    -> Level
    -> (Point -> ContentId TileKind -> Bool)
    -> [Point -> ContentId TileKind -> Bool]
    -> (Point -> ContentId TileKind -> Bool)
    -> [Point -> ContentId TileKind -> Bool]
    -> Rnd (Maybe Point)
    findPosTry2 Y
    500 Level
    lvl  -- try really hard, for skirmish fairness
                    (\Point
    _ !ContentId TileKind
    t -> TileSpeedup -> ContentId TileKind -> Bool
    Tile.isWalkable TileSpeedup
    coTileSpeedup ContentId TileKind
    t
                              Bool -> Bool -> Bool
    && Bool -> Bool
    not (TileSpeedup -> ContentId TileKind -> Bool
    Tile.isNoActor TileSpeedup
    coTileSpeedup ContentId TileKind
    t))
                    (Y
    -> [Point -> ContentId TileKind -> Bool]
    -> [Point -> ContentId TileKind -> Bool]
    forall a. Y -> [a] -> [a]
    take Y
    2 [Point -> ContentId TileKind -> Bool]
    ds)  -- don't pick too close @isOftenActor@ locations
                    (\Point
    _ !ContentId TileKind
    t -> TileSpeedup -> ContentId TileKind -> Bool
    Tile.isOftenActor TileSpeedup
    coTileSpeedup ContentId TileKind
    t)
                    [Point -> ContentId TileKind -> Bool]
    ds
            case mp of
              Just Point
    np -> do
                nps <- [Point] -> Y -> Rnd [Point]
    tryFind (Point
    np Point -> [Point] -> [Point]
    forall a. a -> [a] -> [a]
    : [Point]
    ps) (Y
    n Y -> Y -> Y
    forall a. Num a => a -> a -> a
    - Y
    1)
                return $! np : nps
              Maybe Point
    Nothing -> [Point] -> Rnd [Point]
    forall a. a -> StateT SMGen Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
          sameStaircase :: [Point] -> Point -> Bool
          sameStaircase :: [Point] -> Point -> Bool
    sameStaircase [Point]
    upStairs Point{Y
    px :: Y
    py :: Y
    py :: Point -> Y
    px :: Point -> Y
    ..} =
            (Point -> Bool) -> [Point] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (\(Point Y
    ux Y
    uy) -> Y
    uy Y -> Y -> Bool
    forall a. Eq a => a -> a -> Bool
    == Y
    py Bool -> Bool -> Bool
    && Y
    ux Y -> Y -> Y
    forall a. Num a => a -> a -> a
    + Y
    2 Y -> Y -> Bool
    forall a. Eq a => a -> a -> Bool
    == Y
    px) [Point]
    upStairs
          upAndSomeDownStairs :: [Point]
    upAndSomeDownStairs =
            ([Point], [Point]) -> [Point]
    forall a b. (a, b) -> a
    fst ([Point], [Point])
    lstair
            [Point] -> [Point] -> [Point]
    forall a. [a] -> [a] -> [a]
    ++ (Point -> Bool) -> [Point] -> [Point]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Point -> Bool) -> Point -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Point] -> Point -> Bool
    sameStaircase (([Point], [Point]) -> [Point]
    forall a b. (a, b) -> a
    fst ([Point], [Point])
    lstair)) (([Point], [Point]) -> [Point]
    forall a b. (a, b) -> b
    snd ([Point], [Point])
    lstair)
          skipIndexes :: t a -> [b] -> [b]
    skipIndexes t a
    ixs [b]
    l = ((a, b) -> b) -> [(a, b)] -> [b]
    forall a b. (a -> b) -> [a] -> [b]
    map (a, b) -> b
    forall a b. (a, b) -> b
    snd ([(a, b)] -> [b]) -> [(a, b)] -> [b]
    forall a b. (a -> b) -> a -> b
    $ ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(a
    ix, b
    _) -> a
    ix a -> t a -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` t a
    ixs)
                                      ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [(a, b)]
    forall a b. (a -> b) -> a -> b
    $ [a] -> [b] -> [(a, b)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [a
    0..] [b]
    l
      let !_A :: ()
    _A = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Y
    k Y -> Y -> Bool
    forall a. Ord a => a -> a -> Bool
    > Y
    0 Bool -> Bool -> Bool
    && Y
    factionDist Y -> Y -> Bool
    forall a. Ord a => a -> a -> Bool
    > Y
    0) ()
          onEscapes :: [Point]
    onEscapes = Y -> [Point] -> [Point]
    forall a. Y -> [a] -> [a]
    take Y
    k [Point]
    lescape
          onStairs :: [Point]
    onStairs = Y -> [Point] -> [Point]
    forall a. Y -> [a] -> [a]
    take (Y
    k Y -> Y -> Y
    forall a. Num a => a -> a -> a
    - [Point] -> Y
    forall a. [a] -> Y
    length [Point]
    onEscapes) [Point]
    upAndSomeDownStairs
          nk :: Y
    nk = Y
    k Y -> Y -> Y
    forall a. Num a => a -> a -> a
    - [Point] -> Y
    forall a. [a] -> Y
    length [Point]
    onEscapes Y -> Y -> Y
    forall a. Num a => a -> a -> a
    - [Point] -> Y
    forall a. [a] -> Y
    length [Point]
    onStairs
      -- Starting in the middle is too easy.
      found <- [Point] -> Y -> Rnd [Point]
    tryFind (Area -> Point
    middlePoint Area
    larea Point -> [Point] -> [Point]
    forall a. a -> [a] -> [a]
    : [Point]
    onEscapes [Point] -> [Point] -> [Point]
    forall a. [a] -> [a] -> [a]
    ++ [Point]
    onStairs) Y
    nk
      return $! skipIndexes lskip $ onEscapes ++ onStairs ++ found

    -- | Apply options that don't need a new game.
    applyDebug :: MonadServer m => m ()
    applyDebug :: forall (m :: * -> *). MonadServer m => m ()
    applyDebug = do
      ServerOptions{..} <- (StateServer -> ServerOptions) -> m ServerOptions
    forall a. (StateServer -> a) -> m a
    forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
    getsServer StateServer -> ServerOptions
    soptionsNxt
      modifyServer $ \StateServer
    ser ->
        StateServer
    ser {soptions = (soptions ser) { sniff
                                       , sallClear
                                       , sdbgMsgSer
                                       , snewGameSer
                                       , sassertExplored
                                       , sdumpInitRngs
                                       , sclientOptions }}