irc-core 1.1.1 → 1.1.1.1
raw patch · 5 files changed
+93/−51 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +5/−0
- driver/ClientState.hs +6/−4
- driver/Main.hs +70/−46
- irc-core.cabal +4/−1
- stack.yaml +8/−0
CHANGELOG.md view
@@ -1,3 +1,8 @@+1.1.1.1+-------+* Better error handling+* Added a stack.yaml+ 1.1.1 ----- * Add `/grep` filter command
driver/ClientState.hs view
@@ -12,6 +12,7 @@ import Control.Monad (foldM, guard) import Data.ByteString (ByteString) import Data.Char (isControl)+import Data.Foldable (for_) import Data.Functor.Compose import Data.Map (Map) import Data.Maybe (fromMaybe)@@ -45,10 +46,10 @@ data ClientConnection = ClientConnection { _ccServerSettings :: ServerSettings- , _ccSendChan :: TChan ByteString , _ccConnection :: IrcConnection- , _ccRecvThread :: ThreadId- , _ccSendThread :: ThreadId+ , _ccSendChan :: Maybe (TChan ByteString)+ , _ccRecvThread :: Maybe ThreadId+ , _ccSendThread :: Maybe ThreadId } data ClientState = ClientState@@ -200,7 +201,8 @@ clientSend :: ByteString -> ClientState -> IO () clientSend x st =- atomically (writeTChan (view (clientServer0.ccSendChan) st) x)+ for_ (view (clientServer0.ccSendChan) st) $ \chan ->+ atomically (writeTChan chan x) focusedName :: ClientState -> Identifier focusedName st =
driver/Main.hs view
@@ -121,30 +121,49 @@ Maybe Handle {- ^ error log -} -> IO ClientConnection startIrcConnection config recvChan settings hErr =- do h <- connect config settings- sendChan <- atomically newTChan- sendThreadId <- forkIO (sendLoop sendChan h)- recvThreadId <- forkIO (socketLoop recvChan h hErr)+ do connectRes <- try (connect config settings)+ case connectRes of+ Left e -> connectionFailed e+ Right h -> connectionSuceeded h - let utf8Bytes = Text.encodeUtf8 . Text.pack- nick = mkId (utf8Bytes (view ssNick settings))- user = utf8Bytes (view ssUser settings)- real = utf8Bytes (view ssReal settings)- sasl = over (mapped.both) utf8Bytes (view ssSaslCredential settings)- pass = over mapped utf8Bytes (view ssPassword settings)+ where+ utf8Bytes = Text.encodeUtf8 . Text.pack+ nick = mkId (utf8Bytes (view ssNick settings))+ user = utf8Bytes (view ssUser settings)+ real = utf8Bytes (view ssReal settings)+ sasl = over (mapped.both) utf8Bytes (view ssSaslCredential settings)+ pass = over mapped utf8Bytes (view ssPassword settings) - initializeConnection pass nick user real h+ connectionSuceeded h =+ do sendChan <- atomically newTChan+ sendThreadId <- forkIO (sendLoop sendChan h)+ recvThreadId <- forkIO (socketLoop recvChan h hErr)+ initializeConnection pass nick user real h+ return ClientConnection+ { _ccServerSettings = settings+ , _ccConnection = defaultIrcConnection+ { _connNick = nick+ , _connSasl = sasl+ }+ , _ccSendChan = Just sendChan+ , _ccRecvThread = Just recvThreadId+ , _ccSendThread = Just sendThreadId+ } - return ClientConnection- { _ccServerSettings = settings- , _ccSendChan = sendChan- , _ccConnection = defaultIrcConnection- { _connNick = nick- , _connSasl = sasl- }- , _ccRecvThread = recvThreadId- , _ccSendThread = sendThreadId- }+ connectionFailed (SomeException e) =+ do let eUtf8 = utf8Bytes (show e)+ now <- getCurrentTime+ atomically (writeTChan recvChan (now, Error eUtf8))+ return ClientConnection+ { _ccServerSettings = settings+ , _ccConnection = defaultIrcConnection+ { _connNick = nick+ , _connSasl = sasl+ }+ , _ccSendChan = Nothing+ , _ccRecvThread = Nothing+ , _ccSendThread = Nothing+ } initializeConnection :: Maybe ByteString {- ^ server password -} ->@@ -557,25 +576,18 @@ ] --- Exploratory! doReconnect :: ClientState -> IO ClientState doReconnect st = do let server0 = view clientServer0 st- views ccRecvThread killThread server0- views ccSendThread killThread server0+ traverse_ killThread (view ccRecvThread server0)+ traverse_ killThread (view ccSendThread server0) let settings = view ccServerSettings server0 recvChan = view clientRecvChan st hErr = view clientErrors st config = view clientConfig st- res <- try (startIrcConnection config recvChan settings hErr)- case res of- Right server0' -> return (set clientServer0 server0' st)- Left e -> do- now <- getCurrentTime- let eUtf8 = Text.encodeUtf8 (Text.pack (ioeGetErrorString e))- atomically (writeTChan recvChan (now, Error eUtf8))- return st+ server0' <- startIrcConnection config recvChan settings hErr+ return (set clientServer0 server0' st) doNick :: ClientState ->@@ -908,21 +920,33 @@ getOne :: Connection -> Maybe Handle -> IO (UTCTime, MsgFromServer) getOne h hErr = do xs <- getRawIrcLine h- let debug x = for_ hErr (`hPrint` x) case parseRawIrcMsg xs of- Nothing ->- do debug xs- t <- getCurrentTime- return (t,Error ("Parse: " <> xs))- Just msg ->- do t <- maybe getCurrentTime return (msgTime msg)- case ircMsgToServerMsg msg of- Nothing ->- do debug msg- return (t,Error ("Unknown: " <> xs))- Just x ->- do debug x- return (t,x)+ _ | B.null xs -> connectionClosed+ Nothing -> unparsableLine xs+ Just rawMsg ->+ do t <- maybe getCurrentTime return (msgTime rawMsg)+ case ircMsgToServerMsg rawMsg of+ Nothing -> unhandledMsg t rawMsg+ Just msg -> handledMsg t msg+ where+ debugPrint x = for_ hErr (`hPrint` x)++ connectionClosed =+ do t <- getCurrentTime+ return (t,Error "Connection closed")++ unparsableLine xs =+ do debugPrint xs+ t <- getCurrentTime+ return (t,Error ("Unparsable IRC line: " <> xs))++ unhandledMsg t rawMsg =+ do debugPrint rawMsg+ return (t,Error ("Unhandled IRC line: " <> Text.encodeUtf8 (Text.pack (show rawMsg))))++ handledMsg t msg =+ do debugPrint msg+ return (t,msg) readEitherTChan :: TChan a -> TChan b -> IO (Either a b) readEitherTChan a b =
irc-core.cabal view
@@ -1,5 +1,5 @@ name: irc-core-version: 1.1.1+version: 1.1.1.1 homepage: https://github.com/glguy/irc-core bug-reports: https://github.com/glguy/irc-core/issues license: BSD3@@ -11,6 +11,7 @@ build-type: Simple cabal-version: >=1.10 synopsis: An IRC client library and text client+tested-with: GHC == 7.8.4, GHC == 7.10.1 description: This package provides an IRC connection library as well as a console-based IRC client that uses the library.@@ -68,6 +69,7 @@ extra-source-files: README.md CHANGELOG.md+ stack.yaml -- Use time-1.5 and drop old-locale flag time15@@ -125,6 +127,7 @@ Views.BanList Views.Channel Views.ChannelInfo+ Paths_irc_core hs-source-dirs: driver ghc-options: -threaded build-depends: irc-core,
+ stack.yaml view
@@ -0,0 +1,8 @@+flags: {}+packages:+- '.'+extra-deps:+- config-value-0.4.0.1+- time-1.5.0.1+- vty-5.4.0+resolver: lts-3.2