gameServer/OfficialServer/DBInteraction.hs
changeset 2385 56b2e12b9eeb
parent 2307 b20830087ed1
child 2386 f462ceff8abe
equal deleted inserted replaced
2384:9098f0430b6b 2385:56b2e12b9eeb
     6 
     6 
     7 import Prelude hiding (catch);
     7 import Prelude hiding (catch);
     8 import System.Process
     8 import System.Process
     9 import System.IO
     9 import System.IO
    10 import Control.Concurrent
    10 import Control.Concurrent
    11 #if defined(NEW_EXCEPTIONS)
       
    12 import qualified Control.OldException as Exception
       
    13 #else
       
    14 import qualified Control.Exception as Exception
    11 import qualified Control.Exception as Exception
    15 #endif
       
    16 import Control.Monad
    12 import Control.Monad
    17 import qualified Data.Map as Map
    13 import qualified Data.Map as Map
    18 import Monad
    14 import Monad
    19 import Maybe
    15 import Maybe
    20 import System.Log.Logger
    16 import System.Log.Logger
    36 
    32 
    37 	fakeDbConnection serverInfo
    33 	fakeDbConnection serverInfo
    38 
    34 
    39 
    35 
    40 #if defined(OFFICIAL_SERVER)
    36 #if defined(OFFICIAL_SERVER)
    41 -------------------------------------------------------------------
       
    42 -- borrowed from base 4.0.0 ---------------------------------------
       
    43 onException :: IO a -> IO b -> IO a
       
    44 onException io what = io `Exception.catch` \e -> do
       
    45 		what
       
    46 		Exception.throw (e :: Exception.Exception)
       
    47 -- to be deleted --------------------------------------------------
       
    48 -------------------------------------------------------------------
       
    49 
       
    50 
       
    51 pipeDbConnectionLoop queries coreChan hIn hOut accountsCache =
    37 pipeDbConnectionLoop queries coreChan hIn hOut accountsCache =
    52 	Exception.handle (\e -> warningM "Database" (show e) >> return accountsCache) $
    38 	Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $
    53 	do
    39 	do
    54 	q <- readChan queries
    40 	q <- readChan queries
    55 	updatedCache <- case q of
    41 	updatedCache <- case q of
    56 		CheckAccount clUid clNick _ -> do
    42 		CheckAccount clUid clNick _ -> do
    57 			let cacheEntry = clNick `Map.lookup` accountsCache
    43 			let cacheEntry = clNick `Map.lookup` accountsCache