diff --git a/Network/Tremulous/Polling.hs b/Network/Tremulous/Polling.hs
--- a/Network/Tremulous/Polling.hs
+++ b/Network/Tremulous/Polling.hs
@@ -5,8 +5,7 @@
 
 import Control.DeepSeq
 import Control.Monad hiding (mapM_, sequence_)
-import Control.Concurrent (forkIO, threadDelay, killThread)
-import Control.Concurrent.MVar
+import Control.Concurrent
 import Control.Applicative
 import Control.Exception
 
@@ -25,7 +24,7 @@
 import Network.Tremulous.MicroTime
 import Network.Tremulous.Scheduler
 
-data QType = QMaster !Int !Int | QGame !Int | QJustWait
+data QType = QMaster !Int !Int | QGame !Int | QJustWait deriving Show
 
 mtu :: Int
 mtu = 2048
@@ -40,6 +39,8 @@
 	sock		<- socket AF_INET Datagram defaultProtocol
 	bindSocket sock (SockAddrInet 0 0)
 	
+	finished	<- newEmptyMVar
+	
 	-- server addresses recieved by master
 	mstate		<- newMVar S.empty
 	-- Servers that has responded
@@ -49,42 +50,38 @@
 	pingstate	<- newMVar (M.empty :: Map SockAddr MicroTime)
 
 	let sf sched host qtype = case qtype of
-		QGame n		-> do
+		QGame n -> do
 			now <- getMicroTime
-			pureModifyMVar pingstate $ M.insertWith' (\_ b -> b) host now
+			when (n == packetDuplication) $
+				pureModifyMVar pingstate $ M.insert host now
 			sendTo sock getStatus host
-			if (n > 0) then
-				addScheduled sched (now + fromIntegral packetTimeout, host, QGame (n-1))
-			else
-				addScheduled sched (now + fromIntegral packetTimeout, host, QJustWait)
+			if (n > 0) then do
+				addScheduled sched $ E (now + fromIntegral packetTimeout) host (QGame (n-1))
+			else do
+				addScheduled sched $ E (now + fromIntegral packetTimeout) host QJustWait
 			
 		QMaster n proto	-> do
 			now <- getMicroTime
 			sendTo sock (getServers proto) host
-			if (n > 0) then
-				addScheduled sched (now + (fromIntegral packetTimeout) `div` 2 , host, QMaster (n-1) proto)
-			else
-				addScheduled sched (now + fromIntegral packetTimeout, host, QJustWait)
+			if (n > 0) then do
+				addScheduled sched $ E (now + fromIntegral packetTimeout `div` 2) host (QMaster (n-1) proto)
+			else do
+				addScheduled sched $ E (now + fromIntegral packetTimeout) host QJustWait
 				
-
 		QJustWait -> return ()
 		
-
-	sched		<- newScheduler throughputDelay sf (Just (sClose sock))
+	sched		<- newScheduler throughputDelay sf (Just (putMVar finished () >> sClose sock))
 	addScheduledInstant sched $
 		map (\MasterServer{..} -> (masterAddress, QMaster (packetDuplication*4) masterProtocol)) masterservers
 
-	startScheduler sched
-	
 	let buildResponse = do
-		packet <- ioMaybe $ recvFrom sock mtu
-		case parsePacket (masterAddress <$> masterservers) <$> packet of
+		packet <- forceIO finished $ recvFrom sock mtu
+		case parsePacket (map masterAddress masterservers) <$> packet of
 			-- The master responded, great! Now lets send requests to the new servers
 			Just (Master host x) -> do
 				deleteScheduled sched host
 				m <- takeMVar mstate
-				let m' = S.union m x
-				putMVar' mstate m'
+				putMVar' mstate (S.union m x)
 				let delta = S.difference x m
 				when (S.size delta > 0) $
 					addScheduledInstant sched $ map (,QGame packetDuplication) (S.toList delta)
@@ -113,10 +110,15 @@
 			Just Invalid -> buildResponse
 			
 			Nothing -> return []
+
 	xs	<- buildResponse
 	m	<- takeMVar mstate
 	t	<- takeMVar tstate
 	return $! PollResult xs (S.size t) (S.size m) t
+		
+	where forceIO m f = catch (Just <$> f) $ \(_ :: IOError) -> do
+		b <- isEmptyMVar m 
+		if b then forceIO m f else return Nothing
 
 data Packet = Master !SockAddr !(Set SockAddr) | Tremulous !SockAddr !GameServer | Invalid
 
@@ -131,42 +133,35 @@
 
 
 pollOne :: Delay -> SockAddr -> IO (Maybe GameServer)
-pollOne Delay{..} sockaddr = do
-	s <- socket AF_INET Datagram defaultProtocol
-	catch (f s) (err s)
+pollOne Delay{..} sockaddr = handle err $ bracket (socket AF_INET Datagram defaultProtocol) sClose $ \sock -> do
+	connect sock sockaddr
+	pid <- forkIO $ whileJust packetDuplication $ \n -> do
+		send sock getStatus
+		threadDelay packetTimeout
+		if n > 0 then
+			return $ Just (n-1)
+		else do
+			sClose sock
+			return Nothing
+		
+	start	<- getMicroTime
+	poll	<- ioMaybe $ recv sock mtu <* killThread pid
+	stop	<- getMicroTime
+	let gameping = fromIntegral (stop - start) `div` 1000
+	return $ (\x -> x {gameping}) <$> 
+		(parseGameServer sockaddr =<< isProper =<< poll)
 	where
-	f sock = do
-		connect sock sockaddr
-		pid <- forkIO $ whileJust packetDuplication $ \n -> do
-			send sock getStatus
-			threadDelay packetTimeout
-			if n > 0 then
-				return $ Just (n-1)
-			else do
-				sClose sock
-				return Nothing
-			
-		start	<- getMicroTime
-		poll	<- ioMaybe $ recv sock mtu
-		sClose sock
-		killThread pid
-		stop	<- getMicroTime
-		let gameping = fromIntegral (stop - start) `div` 1000
-		return $ (\x -> x {gameping}) <$> 
-			(parseGameServer sockaddr =<< isProper =<< poll)
-	err sock (_::IOError) = sClose sock >> return Nothing
+	err (_ :: IOError) = return Nothing
 	isProper = stripPrefix "\xFF\xFF\xFF\xFFstatusResponse"
 
 ioMaybe :: IO a -> IO (Maybe a)
 ioMaybe f = catch (Just <$> f) (\(_ :: IOError) -> return Nothing)
 
-putMVar' :: NFData a => MVar a -> a -> IO ()
-putMVar' m a = rnf a `seq` putMVar m a
+putMVar' :: MVar a -> a -> IO ()
+putMVar' m a = a `seq` putMVar m a
 
-pureModifyMVar :: NFData a => MVar a -> (a -> a) -> IO ()
-pureModifyMVar m f = do
-	x <- takeMVar m
-	putMVar' m (f x)
+pureModifyMVar :: MVar a -> (a -> a) -> IO ()
+pureModifyMVar m f = putMVar' m . f =<< takeMVar m
 	
 strict :: NFData a => a -> a
 strict x = x `deepseq` x
diff --git a/Network/Tremulous/Scheduler.hs b/Network/Tremulous/Scheduler.hs
--- a/Network/Tremulous/Scheduler.hs
+++ b/Network/Tremulous/Scheduler.hs
@@ -1,14 +1,12 @@
 module Network.Tremulous.Scheduler(
-	  Event, Scheduler
-	, newScheduler, startScheduler, addScheduled, addScheduledBatch
+	  Event(..), Scheduler
+	, newScheduler, addScheduled, addScheduledBatch
 	, addScheduledInstant, deleteScheduled
 ) where
-import Prelude hiding (drop)
 import Control.Monad
 import Control.Concurrent
 import Control.Exception
 import Data.Typeable
-import Data.Sequence
 import Data.Foldable
 import Network.Tremulous.MicroTime
 
@@ -19,55 +17,46 @@
 
 data (Eq id, Ord id) => Scheduler id a = Scheduler
 	{ sync		:: !(MVar ())
-	, started	:: !(MVar ())
-	, queue		:: !(MVar (Seq (Event id a)))
+	, queue		:: !(MVar [Event id a])
 	}
 
-type Event id a = (MicroTime, id, a)
-
--- ugly ugly ugly!
-threadBlock :: IO ()
-threadBlock = forever $ threadDelay maxBound
-
-pureModifyMVar ::MVar a -> (a -> a) -> IO ()
-pureModifyMVar m f = do
-	x <- takeMVar m
-	putMVar m (f x)
+data Event id a = E
+	{ time		:: !MicroTime
+	, idn		:: !id
+	, storage	:: !a
+	}
 
 newScheduler :: (Eq a, Ord a) => Int -> (Scheduler a b -> a -> b -> IO ()) -> Maybe (IO ()) -> IO (Scheduler a b)
 newScheduler throughput func finalizer = do 
-	queue		<- newMVar empty
+	queue		<- newMVar []
 	sync		<- newEmptyMVar
-	started		<- newEmptyMVar
 	let sched	=  Scheduler{..}
 	uninterruptibleMask $ \a -> forkIO $ runner sched a
 	return sched
 	
 	where
 	runner sched@Scheduler{..} restore = do
-		takeMVar started
+		takeMVar sync
 		tid <- myThreadId
 		let loop = do
 			q <- takeMVar queue
-			case viewl q of
-				EmptyL -> case finalizer of
+			case q of
+				[] -> putMVar queue q >> case finalizer of
 					Nothing -> do
-						putMVar queue q
-						ignoreException $ restore threadBlock
+						takeMVar sync
 						loop
 					Just a -> a
 					
-				(0, idn, storage) :< qs -> do
+				E{time=0, ..} : qs -> do
 					putMVar queue qs
 					func sched idn storage
 					when (throughput > 0)
 						(threadDelay throughput)
 					loop
 				
-				(time, idn, storage) :< qs -> do
+				E {..} : qs -> do
 					now <- getMicroTime
-					let wait = fromIntegral (time - now)
-					if wait <= 0 then do
+					if now >= time then do
 						putMVar queue qs
 						func sched idn storage
 						when (throughput > 0)
@@ -76,7 +65,8 @@
 						putMVar queue q
 						tryTakeMVar sync
 						syncid <- forkIOUnmasked $ takeMVar sync >> throwTo tid Interrupt
-						waited <- falseOnException $ restore $ threadDelay wait
+						let wait = fromIntegral (time - now)
+						waited <- falseOnInterrupt $ restore $ threadDelay wait
 						when waited $ do
 							killThread syncid
 							pureModifyMVar queue $ deleteID idn
@@ -89,10 +79,7 @@
 signal :: MVar () -> IO ()
 signal a = tryPutMVar a () >> return ()
 
-startScheduler :: (Ord id, Eq id, Show id) => Scheduler id a -> IO ()
-startScheduler Scheduler{..} = putMVar started ()
-
-addScheduled :: (Ord id, Eq id, Show id) => Scheduler id a -> Event id a -> IO ()
+addScheduled :: (Ord id, Eq id) => Scheduler id a -> Event id a -> IO ()
 addScheduled Scheduler{..} event = do
 	pureModifyMVar queue $ insertTimed event
 	signal sync
@@ -102,9 +89,9 @@
 	pureModifyMVar queue $ \q -> foldl' (flip insertTimed) q events
 	signal sync
 
-addScheduledInstant :: (Ord id, Eq id, Foldable f) => Scheduler id a -> f (id, a) -> IO ()
+addScheduledInstant :: (Ord id, Eq id) => Scheduler id a -> [(id, a)] -> IO ()
 addScheduledInstant Scheduler{..} events = do
-	pureModifyMVar queue $ \q -> foldl' (\acc (a, b) -> (0, a, b) <| acc) q events
+	pureModifyMVar queue $ \q -> (map (uncurry (E 0)) events) ++ q
 	signal sync
 
 deleteScheduled :: (Ord id, Eq id) => Scheduler id a -> id -> IO ()
@@ -112,19 +99,21 @@
 	pureModifyMVar queue $ deleteID ident
 	signal sync
 
-ignoreException :: IO () -> IO ()
-ignoreException = handle (\Interrupt -> return ())
 
-falseOnException :: IO a -> IO Bool
-falseOnException f = handle (\Interrupt -> return False) (f >> return True)
-
+falseOnInterrupt :: IO a -> IO Bool
+falseOnInterrupt f = handle (\Interrupt -> return False) (f >> return True)
 
-insertTimed :: (Ord id, Eq id) => Event id a -> Seq (Event id a) -> Seq (Event id a)
-insertTimed x@(a,_,_) q = (s1 |> x) >< s2 where
-	(s1, s2) = spanl (\(b,_,_) -> a >= b) q
+insertTimed :: (Ord id, Eq id) => Event id a -> [Event id a] -> [Event id a]
+insertTimed e (x:xs)
+	| time e >= time x	= x : insertTimed e xs
+	| otherwise		= e : x : xs
+insertTimed e []		= [e]
 
+deleteID :: (Ord id, Eq id) => id -> [Event id a] -> [Event id a]
+deleteID match xss = case xss of
+	x:xs	| idn x == match	-> xs
+		| otherwise		-> x : deleteID match xs
+	[]				-> []
 
-deleteID :: (Ord id, Eq id) => id -> Seq (Event id a) -> Seq (Event id a)
-deleteID ident q = s1 >< s2' where
-	(s1, s2) = spanl (\(_,a,_) -> a /= ident) q
-	s2' = drop 1 s2 
+pureModifyMVar ::MVar a -> (a -> a) -> IO ()
+pureModifyMVar m f = putMVar m . f =<< takeMVar m
diff --git a/Network/Tremulous/TupleReader.hs b/Network/Tremulous/TupleReader.hs
--- a/Network/Tremulous/TupleReader.hs
+++ b/Network/Tremulous/TupleReader.hs
@@ -13,19 +13,22 @@
 	roll []			= (Nothing, [])
 	roll (x@(a, b):xs)
 		| key == a	= (Just b, xs)
-		| otherwise	= let (may, xs') = roll xs in (may, x:xs')
+		| otherwise	= let ~(may, xs') = roll xs in (may, x:xs')
 
 require :: Eq k => k -> TupleReader k v v
-require key = get >>= \s -> case lookupDelete key s of
-	(Nothing, _)	-> lift Nothing
-	(Just a, s')	-> put s' >> return a
+require key = with key >>= lift
 
 requireWith :: Eq k => (v -> Maybe a) -> k -> TupleReader k v a
-requireWith f key = get >>= \s -> case lookupDelete key s of
-	(Nothing, _)	-> lift Nothing
-	(Just a, s')	-> put s' >> lift (f a)
+requireWith f key = do
+	e <- with key
+	lift $ f =<< e
 
 option :: Eq k => a -> (v -> a) -> k -> TupleReader k v a
-option def f key = get >>= \s -> case lookupDelete key s of
-	(Nothing, _)	-> return def
-	(Just a, s')	-> put s' >> return (f a)
+option def f key = maybe def f `fmap` with key
+
+with :: Eq k => k -> TupleReader k v (Maybe v)
+with key = do
+	s <- get
+	let (e, s') = lookupDelete key s
+	put s'
+	return e
diff --git a/Network/Tremulous/Util.hs b/Network/Tremulous/Util.hs
--- a/Network/Tremulous/Util.hs
+++ b/Network/Tremulous/Util.hs
@@ -25,7 +25,7 @@
 
 search :: String -> [GameServer] -> [(TI, GameServer)]
 search ""	= makePlayerNameList 
-search rawstr	= filter (\(a,_) -> str `B.isInfixOf` cleanedCase a ) . makePlayerNameList 
+search rawstr	= filter (\(a, _) -> str `B.isInfixOf` cleanedCase a ) . makePlayerNameList 
 	where
 	str	= B.pack $ map toLower rawstr
 	
diff --git a/tremulous-query.cabal b/tremulous-query.cabal
--- a/tremulous-query.cabal
+++ b/tremulous-query.cabal
@@ -1,5 +1,5 @@
 Name:			tremulous-query
-Version:		1.0.2
+Version:		1.0.3
 Author:			Christoffer Öjeling
 Maintainer:		Christoffer Öjeling <christoffer@ojeling.net>
 License:		GPL-3