    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    -- | The implementation of our custom game server monads. Just as any other
    -- component of the library, this implementation can be substituted.
    module Implementation.MonadServerImplementation
      ( executorSer
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , SerState(..), SerImplementation(..)
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import           Control.Concurrent
    import           Control.Concurrent.Async
    import qualified Control.Exception as Ex
    import qualified Control.Monad.IO.Class as IO
    import           Control.Monad.Trans.State.Strict hiding (State)
    import qualified Data.EnumMap.Strict as EM
    import qualified Data.Text.IO as T
    import           Options.Applicative
      (defaultPrefs, execParserPure, handleParseResult)
    import           System.Exit (ExitCode)
    import           System.IO (hFlush, stdout)

    import           Game.LambdaHack.Atomic
    import           Game.LambdaHack.Client
    import           Game.LambdaHack.Common.Kind
    import           Game.LambdaHack.Common.MonadStateRead
    import qualified Game.LambdaHack.Common.Save as Save
    import           Game.LambdaHack.Common.State
    import           Game.LambdaHack.Common.Thread
    import           Game.LambdaHack.Server
    import           Game.LambdaHack.Server.BroadcastAtomic
    import           Game.LambdaHack.Server.HandleAtomicM
    import           Game.LambdaHack.Server.MonadServer
    import           Game.LambdaHack.Server.ProtocolM
    import           Game.LambdaHack.Server.State

    import Implementation.MonadClientImplementation (executorCli)

    data SerState = SerState
      { SerState -> State
    serState  :: State             -- ^ current global state
      , SerState -> StateServer
    serServer :: StateServer       -- ^ current server state
      , SerState -> ConnServerDict
    serDict   :: ConnServerDict    -- ^ client-server connection information
      , SerState -> ChanSave (State, StateServer)
    serToSave :: Save.ChanSave (State, StateServer)
                                           -- ^ connection to the save thread
      }

    -- | Server state transformation monad.
    newtype SerImplementation a =
        SerImplementation {forall a. SerImplementation a -> StateT SerState IO a
    runSerImplementation :: StateT SerState IO a}
      deriving (Applicative SerImplementation
    Applicative SerImplementation =>
    (forall a b.
     SerImplementation a
     -> (a -> SerImplementation b) -> SerImplementation b)
    -> (forall a b.
        SerImplementation a -> SerImplementation b -> SerImplementation b)
    -> (forall a. a -> SerImplementation a)
    -> Monad SerImplementation
    forall a. a -> SerImplementation a
    forall a b.
    SerImplementation a -> SerImplementation b -> SerImplementation b
    forall a b.
    SerImplementation a
    -> (a -> SerImplementation b) -> SerImplementation b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall a b.
    SerImplementation a
    -> (a -> SerImplementation b) -> SerImplementation b
    >>= :: forall a b.
    SerImplementation a
    -> (a -> SerImplementation b) -> SerImplementation b
    $c>> :: forall a b.
    SerImplementation a -> SerImplementation b -> SerImplementation b
    >> :: forall a b.
    SerImplementation a -> SerImplementation b -> SerImplementation b
    $creturn :: forall a. a -> SerImplementation a
    return :: forall a. a -> SerImplementation a
    Monad, (forall a b.
     (a -> b) -> SerImplementation a -> SerImplementation b)
    -> (forall a b. a -> SerImplementation b -> SerImplementation a)
    -> Functor SerImplementation
    forall a b. a -> SerImplementation b -> SerImplementation a
    forall a b. (a -> b) -> SerImplementation a -> SerImplementation b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> SerImplementation a -> SerImplementation b
    fmap :: forall a b. (a -> b) -> SerImplementation a -> SerImplementation b
    $c<$ :: forall a b. a -> SerImplementation b -> SerImplementation a
    <$ :: forall a b. a -> SerImplementation b -> SerImplementation a
    Functor, Functor SerImplementation
    Functor SerImplementation =>
    (forall a. a -> SerImplementation a)
    -> (forall a b.
        SerImplementation (a -> b)
        -> SerImplementation a -> SerImplementation b)
    -> (forall a b c.
        (a -> b -> c)
        -> SerImplementation a
        -> SerImplementation b
        -> SerImplementation c)
    -> (forall a b.
        SerImplementation a -> SerImplementation b -> SerImplementation b)
    -> (forall a b.
        SerImplementation a -> SerImplementation b -> SerImplementation a)
    -> Applicative SerImplementation
    forall a. a -> SerImplementation a
    forall a b.
    SerImplementation a -> SerImplementation b -> SerImplementation a
    forall a b.
    SerImplementation a -> SerImplementation b -> SerImplementation b
    forall a b.
    SerImplementation (a -> b)
    -> SerImplementation a -> SerImplementation b
    forall a b c.
    (a -> b -> c)
    -> SerImplementation a
    -> SerImplementation b
    -> SerImplementation c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall a. a -> SerImplementation a
    pure :: forall a. a -> SerImplementation a
    $c<*> :: forall a b.
    SerImplementation (a -> b)
    -> SerImplementation a -> SerImplementation b
    <*> :: forall a b.
    SerImplementation (a -> b)
    -> SerImplementation a -> SerImplementation b
    $cliftA2 :: forall a b c.
    (a -> b -> c)
    -> SerImplementation a
    -> SerImplementation b
    -> SerImplementation c
    liftA2 :: forall a b c.
    (a -> b -> c)
    -> SerImplementation a
    -> SerImplementation b
    -> SerImplementation c
    $c*> :: forall a b.
    SerImplementation a -> SerImplementation b -> SerImplementation b
    *> :: forall a b.
    SerImplementation a -> SerImplementation b -> SerImplementation b
    $c<* :: forall a b.
    SerImplementation a -> SerImplementation b -> SerImplementation a
    <* :: forall a b.
    SerImplementation a -> SerImplementation b -> SerImplementation a
    Applicative)

    instance MonadStateRead SerImplementation where
      {-# INLINE getsState #-}
      getsState :: forall a. (State -> a) -> SerImplementation a
    getsState State -> a
    f = StateT SerState IO a -> SerImplementation a
    forall a. StateT SerState IO a -> SerImplementation a
    SerImplementation (StateT SerState IO a -> SerImplementation a)
    -> StateT SerState IO a -> SerImplementation a
    forall a b. (a -> b) -> a -> b
    $ (SerState -> a) -> StateT SerState IO a
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    gets ((SerState -> a) -> StateT SerState IO a)
    -> (SerState -> a) -> StateT SerState IO a
    forall a b. (a -> b) -> a -> b
    $ State -> a
    f (State -> a) -> (SerState -> State) -> SerState -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SerState -> State
    serState

    instance MonadStateWrite SerImplementation where
      {-# INLINE modifyState #-}
      modifyState :: (State -> State) -> SerImplementation ()
    modifyState State -> State
    f = StateT SerState IO () -> SerImplementation ()
    forall a. StateT SerState IO a -> SerImplementation a
    SerImplementation (StateT SerState IO () -> SerImplementation ())
    -> StateT SerState IO () -> SerImplementation ()
    forall a b. (a -> b) -> a -> b
    $ (SerState -> ((), SerState)) -> StateT SerState IO ()
    forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
    state ((SerState -> ((), SerState)) -> StateT SerState IO ())
    -> (SerState -> ((), SerState)) -> StateT SerState IO ()
    forall a b. (a -> b) -> a -> b
    $ \SerState
    serS ->
        let !newSerS :: SerState
    newSerS = SerState
    serS {serState = f $ serState serS}
        in ((), SerState
    newSerS)
      {-# INLINE putState #-}
      putState :: State -> SerImplementation ()
    putState State
    newSerState = StateT SerState IO () -> SerImplementation ()
    forall a. StateT SerState IO a -> SerImplementation a
    SerImplementation (StateT SerState IO () -> SerImplementation ())
    -> StateT SerState IO () -> SerImplementation ()
    forall a b. (a -> b) -> a -> b
    $ (SerState -> ((), SerState)) -> StateT SerState IO ()
    forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
    state ((SerState -> ((), SerState)) -> StateT SerState IO ())
    -> (SerState -> ((), SerState)) -> StateT SerState IO ()
    forall a b. (a -> b) -> a -> b
    $ \SerState
    serS ->
        let !newSerS :: SerState
    newSerS = SerState
    serS {serState = newSerState}
        in ((), SerState
    newSerS)

    instance MonadServer SerImplementation where
      {-# INLINE getsServer #-}
      getsServer :: forall a. (StateServer -> a) -> SerImplementation a
    getsServer   StateServer -> a
    f = StateT SerState IO a -> SerImplementation a
    forall a. StateT SerState IO a -> SerImplementation a
    SerImplementation (StateT SerState IO a -> SerImplementation a)
    -> StateT SerState IO a -> SerImplementation a
    forall a b. (a -> b) -> a -> b
    $ (SerState -> a) -> StateT SerState IO a
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    gets ((SerState -> a) -> StateT SerState IO a)
    -> (SerState -> a) -> StateT SerState IO a
    forall a b. (a -> b) -> a -> b
    $ StateServer -> a
    f (StateServer -> a) -> (SerState -> StateServer) -> SerState -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SerState -> StateServer
    serServer
      {-# INLINE modifyServer #-}
      modifyServer :: (StateServer -> StateServer) -> SerImplementation ()
    modifyServer StateServer -> StateServer
    f = StateT SerState IO () -> SerImplementation ()
    forall a. StateT SerState IO a -> SerImplementation a
    SerImplementation (StateT SerState IO () -> SerImplementation ())
    -> StateT SerState IO () -> SerImplementation ()
    forall a b. (a -> b) -> a -> b
    $ (SerState -> ((), SerState)) -> StateT SerState IO ()
    forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
    state ((SerState -> ((), SerState)) -> StateT SerState IO ())
    -> (SerState -> ((), SerState)) -> StateT SerState IO ()
    forall a b. (a -> b) -> a -> b
    $ \SerState
    serS ->
        let !newSerS :: SerState
    newSerS = SerState
    serS {serServer = f $ serServer serS}
        in ((), SerState
    newSerS)
      chanSaveServer :: SerImplementation (ChanSave (State, StateServer))
    chanSaveServer = StateT SerState IO (ChanSave (State, StateServer))
    -> SerImplementation (ChanSave (State, StateServer))
    forall a. StateT SerState IO a -> SerImplementation a
    SerImplementation (StateT SerState IO (ChanSave (State, StateServer))
     -> SerImplementation (ChanSave (State, StateServer)))
    -> StateT SerState IO (ChanSave (State, StateServer))
    -> SerImplementation (ChanSave (State, StateServer))
    forall a b. (a -> b) -> a -> b
    $ (SerState -> ChanSave (State, StateServer))
    -> StateT SerState IO (ChanSave (State, StateServer))
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    gets SerState -> ChanSave (State, StateServer)
    serToSave
      liftIO :: forall a. IO a -> SerImplementation a
    liftIO         = StateT SerState IO a -> SerImplementation a
    forall a. StateT SerState IO a -> SerImplementation a
    SerImplementation (StateT SerState IO a -> SerImplementation a)
    -> (IO a -> StateT SerState IO a) -> IO a -> SerImplementation a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO a -> StateT SerState IO a
    forall a. IO a -> StateT SerState IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    IO.liftIO

    instance MonadServerComm SerImplementation where
      {-# INLINE getsDict #-}
      getsDict :: forall a. (ConnServerDict -> a) -> SerImplementation a
    getsDict ConnServerDict -> a
    f = StateT SerState IO a -> SerImplementation a
    forall a. StateT SerState IO a -> SerImplementation a
    SerImplementation (StateT SerState IO a -> SerImplementation a)
    -> StateT SerState IO a -> SerImplementation a
    forall a b. (a -> b) -> a -> b
    $ (SerState -> a) -> StateT SerState IO a
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    gets ((SerState -> a) -> StateT SerState IO a)
    -> (SerState -> a) -> StateT SerState IO a
    forall a b. (a -> b) -> a -> b
    $ ConnServerDict -> a
    f (ConnServerDict -> a)
    -> (SerState -> ConnServerDict) -> SerState -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SerState -> ConnServerDict
    serDict
      {-# INLINE putDict #-}
      putDict :: ConnServerDict -> SerImplementation ()
    putDict ConnServerDict
    newSerDict = StateT SerState IO () -> SerImplementation ()
    forall a. StateT SerState IO a -> SerImplementation a
    SerImplementation (StateT SerState IO () -> SerImplementation ())
    -> StateT SerState IO () -> SerImplementation ()
    forall a b. (a -> b) -> a -> b
    $ (SerState -> ((), SerState)) -> StateT SerState IO ()
    forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
    state ((SerState -> ((), SerState)) -> StateT SerState IO ())
    -> (SerState -> ((), SerState)) -> StateT SerState IO ()
    forall a b. (a -> b) -> a -> b
    $ \SerState
    serS ->
        let !newSerS :: SerState
    newSerS = SerState
    serS {serDict = newSerDict}
        in ((), SerState
    newSerS)
      liftIO :: forall a. IO a -> SerImplementation a
    liftIO = StateT SerState IO a -> SerImplementation a
    forall a. StateT SerState IO a -> SerImplementation a
    SerImplementation (StateT SerState IO a -> SerImplementation a)
    -> (IO a -> StateT SerState IO a) -> IO a -> SerImplementation a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO a -> StateT SerState IO a
    forall a. IO a -> StateT SerState IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    IO.liftIO

    instance MonadServerAtomic SerImplementation where
      execUpdAtomic :: UpdAtomic -> SerImplementation ()
    execUpdAtomic UpdAtomic
    cmd = do
        oldState <- SerImplementation State
    forall (m :: * -> *). MonadStateRead m => m State
    getState
        (ps, atomicBroken, executedOnServer) <- handleCmdAtomicServer cmd
        when executedOnServer $ cmdAtomicSemSer oldState cmd
        handleAndBroadcast ps atomicBroken (UpdAtomic cmd)
      execUpdAtomicSer :: UpdAtomic -> SerImplementation Bool
    execUpdAtomicSer UpdAtomic
    cmd = StateT SerState IO Bool -> SerImplementation Bool
    forall a. StateT SerState IO a -> SerImplementation a
    SerImplementation (StateT SerState IO Bool -> SerImplementation Bool)
    -> StateT SerState IO Bool -> SerImplementation Bool
    forall a b. (a -> b) -> a -> b
    $ (SerState -> IO (Bool, SerState)) -> StateT SerState IO Bool
    forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
    StateT ((SerState -> IO (Bool, SerState)) -> StateT SerState IO Bool)
    -> (SerState -> IO (Bool, SerState)) -> StateT SerState IO Bool
    forall a b. (a -> b) -> a -> b
    $ \SerState
    cliS -> do
        cliSNewOrE <- IO SerState -> IO (Either AtomicFail SerState)
    forall e a. Exception e => IO a -> IO (Either e a)
    Ex.try
                      (IO SerState -> IO (Either AtomicFail SerState))
    -> IO SerState -> IO (Either AtomicFail SerState)
    forall a b. (a -> b) -> a -> b
    $ StateT SerState IO () -> SerState -> IO SerState
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
    execStateT (SerImplementation () -> StateT SerState IO ()
    forall a. SerImplementation a -> StateT SerState IO a
    runSerImplementation (SerImplementation () -> StateT SerState IO ())
    -> SerImplementation () -> StateT SerState IO ()
    forall a b. (a -> b) -> a -> b
    $ UpdAtomic -> SerImplementation ()
    forall (m :: * -> *). MonadStateWrite m => UpdAtomic -> m ()
    handleUpdAtomic UpdAtomic
    cmd)
                                   SerState
    cliS
        case cliSNewOrE of
          Left AtomicFail{} -> (Bool, SerState) -> IO (Bool, SerState)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, SerState
    cliS)
          Right !SerState
    cliSNew ->
            -- We know @cliSNew@ differs only in @serState@.
            (Bool, SerState) -> IO (Bool, SerState)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, SerState
    cliSNew)
      execUpdAtomicFid :: FactionId -> UpdAtomic -> SerImplementation ()
    execUpdAtomicFid FactionId
    fid UpdAtomic
    cmd = StateT SerState IO () -> SerImplementation ()
    forall a. StateT SerState IO a -> SerImplementation a
    SerImplementation (StateT SerState IO () -> SerImplementation ())
    -> StateT SerState IO () -> SerImplementation ()
    forall a b. (a -> b) -> a -> b
    $ (SerState -> IO ((), SerState)) -> StateT SerState IO ()
    forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
    StateT ((SerState -> IO ((), SerState)) -> StateT SerState IO ())
    -> (SerState -> IO ((), SerState)) -> StateT SerState IO ()
    forall a b. (a -> b) -> a -> b
    $ \SerState
    cliS -> do
        -- Don't catch anything; assume exceptions impossible.
        let sFid :: State
    sFid = StateServer -> EnumMap FactionId State
    sclientStates (SerState -> StateServer
    serServer SerState
    cliS) EnumMap FactionId State -> FactionId -> State
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid
        cliSNew <- StateT SerState IO () -> SerState -> IO SerState
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
    execStateT (SerImplementation () -> StateT SerState IO ()
    forall a. SerImplementation a -> StateT SerState IO a
    runSerImplementation (SerImplementation () -> StateT SerState IO ())
    -> SerImplementation () -> StateT SerState IO ()
    forall a b. (a -> b) -> a -> b
    $ UpdAtomic -> SerImplementation ()
    forall (m :: * -> *). MonadStateWrite m => UpdAtomic -> m ()
    handleUpdAtomic UpdAtomic
    cmd)
                              SerState
    cliS {serState = sFid}
        -- We know @cliSNew@ differs only in @serState@.
        let serServerNew = (SerState -> StateServer
    serServer SerState
    cliS)
              {sclientStates = EM.insert fid (serState cliSNew)
                               $ sclientStates $ serServer cliS}
            !newCliS = SerState
    cliS {serServer = serServerNew}
        return ((), newCliS)
      execUpdAtomicFidCatch :: FactionId -> UpdAtomic -> SerImplementation Bool
    execUpdAtomicFidCatch FactionId
    fid UpdAtomic
    cmd = StateT SerState IO Bool -> SerImplementation Bool
    forall a. StateT SerState IO a -> SerImplementation a
    SerImplementation (StateT SerState IO Bool -> SerImplementation Bool)
    -> StateT SerState IO Bool -> SerImplementation Bool
    forall a b. (a -> b) -> a -> b
    $ (SerState -> IO (Bool, SerState)) -> StateT SerState IO Bool
    forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
    StateT ((SerState -> IO (Bool, SerState)) -> StateT SerState IO Bool)
    -> (SerState -> IO (Bool, SerState)) -> StateT SerState IO Bool
    forall a b. (a -> b) -> a -> b
    $ \SerState
    cliS -> do
        let sFid :: State
    sFid = StateServer -> EnumMap FactionId State
    sclientStates (SerState -> StateServer
    serServer SerState
    cliS) EnumMap FactionId State -> FactionId -> State
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid
        cliSNewOrE <- IO SerState -> IO (Either AtomicFail SerState)
    forall e a. Exception e => IO a -> IO (Either e a)
    Ex.try
                      (IO SerState -> IO (Either AtomicFail SerState))
    -> IO SerState -> IO (Either AtomicFail SerState)
    forall a b. (a -> b) -> a -> b
    $ StateT SerState IO () -> SerState -> IO SerState
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
    execStateT (SerImplementation () -> StateT SerState IO ()
    forall a. SerImplementation a -> StateT SerState IO a
    runSerImplementation (SerImplementation () -> StateT SerState IO ())
    -> SerImplementation () -> StateT SerState IO ()
    forall a b. (a -> b) -> a -> b
    $ UpdAtomic -> SerImplementation ()
    forall (m :: * -> *). MonadStateWrite m => UpdAtomic -> m ()
    handleUpdAtomic UpdAtomic
    cmd)
                                   SerState
    cliS {serState = sFid}
        case cliSNewOrE of
          Left AtomicFail{} -> (Bool, SerState) -> IO (Bool, SerState)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, SerState
    cliS)
          Right SerState
    cliSNew -> do
            -- We know @cliSNew@ differs only in @serState@.
            let serServerNew :: StateServer
    serServerNew = (SerState -> StateServer
    serServer SerState
    cliS)
                  {sclientStates = EM.insert fid (serState cliSNew)
                                   $ sclientStates $ serServer cliS}
                !newCliS :: SerState
    newCliS = SerState
    cliS {serServer = serServerNew}
            (Bool, SerState) -> IO (Bool, SerState)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, SerState
    newCliS)
      execSfxAtomic :: SfxAtomic -> SerImplementation ()
    execSfxAtomic SfxAtomic
    sfx = do
        ps <- SfxAtomic -> SerImplementation PosAtomic
    forall (m :: * -> *). MonadStateRead m => SfxAtomic -> m PosAtomic
    posSfxAtomic SfxAtomic
    sfx
        handleAndBroadcast ps [] (SfxAtomic sfx)
      execSendPer :: FactionId
    -> LevelId
    -> Perception
    -> Perception
    -> Perception
    -> SerImplementation ()
    execSendPer = FactionId
    -> LevelId
    -> Perception
    -> Perception
    -> Perception
    -> SerImplementation ()
    forall (m :: * -> *).
    (MonadServerAtomic m, MonadServerComm m) =>
    FactionId
    -> LevelId -> Perception -> Perception -> Perception -> m ()
    sendPer

    -- Don't inline this, to keep GHC hard work inside the library
    -- for easy access of code analysis tools.
    -- | Run the main server loop, with the given arguments and empty
    -- initial states, in the @IO@ monad.
    executorSer :: COps -> CCUI -> ServerOptions -> UIOptions -> IO ()
    executorSer :: COps -> CCUI -> ServerOptions -> UIOptions -> IO ()
    executorSer cops :: COps
    cops@COps{RuleContent
    corule :: RuleContent
    corule :: COps -> RuleContent
    corule} CCUI
    ccui ServerOptions
    soptionsNxtCmdline UIOptions
    sUIOptions = do
      soptionsNxtRaw <- case UIOptions -> [String]
    uOverrideCmdline UIOptions
    sUIOptions of
        []   -> ServerOptions -> IO ServerOptions
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ServerOptions
    soptionsNxtCmdline
        [String]
    args -> ParserResult ServerOptions -> IO ServerOptions
    forall a. ParserResult a -> IO a
    handleParseResult (ParserResult ServerOptions -> IO ServerOptions)
    -> ParserResult ServerOptions -> IO ServerOptions
    forall a b. (a -> b) -> a -> b
    $ ParserPrefs
    -> ParserInfo ServerOptions
    -> [String]
    -> ParserResult ServerOptions
    forall a. ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
    execParserPure ParserPrefs
    defaultPrefs ParserInfo ServerOptions
    serverOptionsPI [String]
    args
      -- Options for the clients modified with the configuration file.
      let clientOptions = COps -> UIOptions -> ClientOptions -> ClientOptions
    applyUIOptions COps
    cops UIOptions
    sUIOptions
                          (ClientOptions -> ClientOptions) -> ClientOptions -> ClientOptions
    forall a b. (a -> b) -> a -> b
    $ ServerOptions -> ClientOptions
    sclientOptions ServerOptions
    soptionsNxtRaw
          soptionsNxt = ServerOptions
    soptionsNxtRaw {sclientOptions = clientOptions}
          -- Partially applied main loop of the clients.
          executorClient Bool
    startsNewGame =
            CCUI
    -> UIOptions
    -> ClientOptions
    -> Bool
    -> COps
    -> FactionId
    -> ChanServer
    -> IO ()
    executorCli CCUI
    ccui UIOptions
    sUIOptions ClientOptions
    clientOptions Bool
    startsNewGame COps
    cops
      -- Wire together game content, the main loop of game clients
      -- and the game server loop.
      let stateToFileName (State
    _, StateServer
    ser) =
            ServerOptions -> String
    ssavePrefixSer (StateServer -> ServerOptions
    soptions StateServer
    ser) String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> RuleContent -> String
    Save.saveNameSer RuleContent
    corule
          totalState ChanSave (State, StateServer)
    serToSave = SerState
            { serState :: State
    serState = (COps -> COps) -> State -> State
    updateCOpsAndCachedData (COps -> COps -> COps
    forall a b. a -> b -> a
    const COps
    cops) State
    emptyState
                -- state is empty, so the cached data is left empty and untouched
            , serServer :: StateServer
    serServer = StateServer
    emptyStateServer
            , serDict :: ConnServerDict
    serDict = ConnServerDict
    forall k a. EnumMap k a
    EM.empty
            , ChanSave (State, StateServer)
    serToSave :: ChanSave (State, StateServer)
    serToSave :: ChanSave (State, StateServer)
    serToSave
            }
          m = ServerOptions
    -> (Bool -> FactionId -> ChanServer -> IO ())
    -> SerImplementation ()
    forall (m :: * -> *).
    (MonadServerAtomic m, MonadServerComm m) =>
    ServerOptions -> (Bool -> FactionId -> ChanServer -> IO ()) -> m ()
    loopSer ServerOptions
    soptionsNxt Bool -> FactionId -> ChanServer -> IO ()
    executorClient
          exe = StateT SerState IO () -> SerState -> IO ()
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT (SerImplementation () -> StateT SerState IO ()
    forall a. SerImplementation a -> StateT SerState IO a
    runSerImplementation SerImplementation ()
    m) (SerState -> IO ())
    -> (ChanSave (State, StateServer) -> SerState)
    -> ChanSave (State, StateServer)
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ChanSave (State, StateServer) -> SerState
    totalState
          exeWithSaves = COps
    -> ((State, StateServer) -> String)
    -> (ChanSave (State, StateServer) -> IO ())
    -> IO ()
    forall a.
    Binary a =>
    COps -> (a -> String) -> (ChanSave a -> IO ()) -> IO ()
    Save.wrapInSaves COps
    cops (State, StateServer) -> String
    stateToFileName ChanSave (State, StateServer) -> IO ()
    exe
          unwrapEx SomeException
    e = case SomeException -> Maybe ExceptionInLinkedThread
    forall e. Exception e => SomeException -> Maybe e
    Ex.fromException SomeException
    e of
            Just (ExceptionInLinkedThread Async a
    _ SomeException
    ex) -> SomeException -> SomeException
    unwrapEx SomeException
    ex
            Maybe ExceptionInLinkedThread
    _ -> SomeException
    e
      -- Wait for clients to exit even in case of server crash
      -- (or server and client crash), which gives them time to save
      -- and report their own inconsistencies, if any.
      Ex.handle (\SomeException
    ex -> case SomeException -> Maybe ExitCode
    forall e. Exception e => SomeException -> Maybe e
    Ex.fromException (SomeException -> SomeException
    unwrapEx SomeException
    ex) :: Maybe ExitCode of
                   Just{} ->
                     -- User-forced shutdown, not crash, so the intention is
                     -- to keep old saves and also clients may be not ready to save.
                     SomeException -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    Ex.throwIO SomeException
    ex
                   Maybe ExitCode
    _ -> do
                     IO () -> IO ()
    forall a. IO a -> IO a
    Ex.uninterruptibleMask_ (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> IO ()
    threadDelay Int
    1000000
                       -- let clients report their errors and save
                     moveAside <- RuleContent -> ClientOptions -> IO Bool
    Save.bkpAllSaves RuleContent
    corule ClientOptions
    clientOptions
                     when moveAside $
                       T.hPutStrLn stdout
                                   "The game crashed, so savefiles are moved aside."
                     hFlush stdout
                     Ex.throwIO ex  -- crash eventually, which kills clients
                )
                exeWithSaves
    --  T.hPutStrLn stdout "Server exiting, waiting for clients."
    --  hFlush stdout
      waitForChildren childrenServer  -- no crash, wait for clients indefinitely
    --  T.hPutStrLn stdout "Server exiting now."
    --  hFlush stdout