Fixed EOF while reading from socket
This commit is contained in:
parent
34bac20fa5
commit
9e322dc3e1
|
@ -6,3 +6,4 @@ dist
|
|||
config.cfg
|
||||
*sublime*
|
||||
logs
|
||||
stats
|
||||
|
|
4
Main.hs
4
Main.hs
|
@ -1,4 +1,6 @@
|
|||
{-# LANGUAGE OverloadedStrings, OverlappingInstances, NoImplicitPrelude #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverlappingInstances #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Main (main) where
|
||||
|
||||
|
|
|
@ -1,4 +1,7 @@
|
|||
{-# LANGUAGE RecordWildCards, ScopedTypeVariables, NoImplicitPrelude, OverloadedStrings #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Network.IRC.Client (run) where
|
||||
|
||||
|
@ -10,7 +13,7 @@ import Control.Concurrent.Lifted
|
|||
import Control.Monad.Reader hiding (forM_, foldM)
|
||||
import Control.Monad.State hiding (forM_, foldM)
|
||||
import Network
|
||||
import System.IO (hSetBuffering, BufferMode(..))
|
||||
import System.IO (hIsEOF, hSetBuffering, BufferMode(..))
|
||||
import System.Timeout
|
||||
|
||||
import Network.IRC.Handlers
|
||||
|
@ -32,6 +35,21 @@ sendCommand Bot { .. } reply = do
|
|||
TF.hprint socket "{}\r\n" $ TF.Only line
|
||||
TF.print "[{}] > {}\n" $ TF.buildParams (formatTime defaultTimeLocale "%F %T" time, line)
|
||||
|
||||
data Line = Timeout | EOF | Line !Text deriving (Show, Eq)
|
||||
|
||||
readLine :: Handle -> Int -> IO Line
|
||||
readLine socket timeoutDelay = do
|
||||
mLine <- timeout timeoutDelay readLine'
|
||||
case mLine of
|
||||
Nothing -> return Timeout
|
||||
Just line -> return line
|
||||
where
|
||||
readLine' = do
|
||||
eof <- hIsEOF socket
|
||||
if eof
|
||||
then return EOF
|
||||
else map Line $ hGetLine socket
|
||||
|
||||
listenerLoop :: Int -> IRC ()
|
||||
listenerLoop idleFor = do
|
||||
status <- get
|
||||
|
@ -45,10 +63,12 @@ listenerLoop idleFor = do
|
|||
when (status == Kicked) $
|
||||
threadDelay (5 * oneSec) >> sendCommand bot JoinCmd
|
||||
|
||||
mLine <- map (map initEx) . timeout oneSec . hGetLine $ socket
|
||||
mLine <- readLine socket oneSec
|
||||
case mLine of
|
||||
Nothing -> dispatchHandlers bot IdleMsg >> return Idle
|
||||
Just line -> do
|
||||
Timeout -> dispatchHandlers bot IdleMsg >> return Idle
|
||||
EOF -> return Disconnected
|
||||
Line line' -> do
|
||||
let line = initEx line'
|
||||
now <- getCurrentTime
|
||||
debug $ "< " ++ line
|
||||
|
||||
|
|
|
@ -1,4 +1,7 @@
|
|||
{-# LANGUAGE RecordWildCards, OverloadedStrings, NoImplicitPrelude, FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Network.IRC.Handlers (coreMsgHandlerNames, mkMsgHandler) where
|
||||
|
||||
|
|
|
@ -1,4 +1,8 @@
|
|||
{-# LANGUAGE RecordWildCards, NoImplicitPrelude, OverloadedStrings, FlexibleContexts, ScopedTypeVariables #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Network.IRC.Handlers.MessageLogger (mkMsgHandler) where
|
||||
|
||||
|
|
|
@ -1,4 +1,8 @@
|
|||
{-# LANGUAGE RecordWildCards, OverloadedStrings, ScopedTypeVariables, NoImplicitPrelude, FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Network.IRC.Handlers.SongSearch (mkMsgHandler) where
|
||||
|
||||
|
|
|
@ -1,4 +1,6 @@
|
|||
{-# LANGUAGE RecordWildCards, OverloadedStrings, NoImplicitPrelude #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Network.IRC.Protocol (msgFromLine, lineFromCommand) where
|
||||
|
||||
|
|
|
@ -1,5 +1,11 @@
|
|||
{-# LANGUAGE RecordWildCards, RankNTypes, GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, FlexibleContexts #-}
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Network.IRC.Types
|
||||
(Channel, Nick, MsgHandlerName,
|
||||
|
|
Loading…
Reference in New Issue