diff --git a/Main.hs b/Main.hs index 09292ab..abf803a 100644 --- a/Main.hs +++ b/Main.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverlappingInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} module Main (main) where diff --git a/Network/IRC/Bot.hs b/Network/IRC/Bot.hs index 7b499f6..8d26dc2 100644 --- a/Network/IRC/Bot.hs +++ b/Network/IRC/Bot.hs @@ -1,8 +1,3 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} module Network.IRC.Bot @@ -126,7 +121,7 @@ messageProcessLoop lineChan commandChan !idleFor = do where dispatchHandlers Bot { .. } message = - forM_ (mapValues msgHandlers) $ \msgHandler -> fork $ + forM_ (mapValues msgHandlers) $ \msgHandler -> void . fork $ handle (\(e :: SomeException) -> errorM $ "Exception while processing message: " ++ show e) $ do mCmd <- handleMessage msgHandler botConfig message @@ -139,7 +134,7 @@ eventProcessLoop (eventChan, latch) lineChan commandChan bot@Bot {.. } = do Just (QuitEvent, _) -> latchIt latch _ -> do debugM $ "Event: " ++ show event - forM_ (mapValues msgHandlers) $ \msgHandler -> fork $ + forM_ (mapValues msgHandlers) $ \msgHandler -> void . fork $ handle (\(ex :: SomeException) -> errorM $ "Exception while processing event: " ++ show ex) $ do resp <- handleEvent msgHandler botConfig event diff --git a/Network/IRC/Client.hs b/Network/IRC/Client.hs index c6d2a9c..e5d446a 100644 --- a/Network/IRC/Client.hs +++ b/Network/IRC/Client.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} module Network.IRC.Client (runBot) where diff --git a/Network/IRC/Handlers.hs b/Network/IRC/Handlers.hs index b54a2ec..1b61c6f 100644 --- a/Network/IRC/Handlers.hs +++ b/Network/IRC/Handlers.hs @@ -1,7 +1,4 @@ {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} module Network.IRC.Handlers (coreMsgHandlerNames, mkMsgHandler) where diff --git a/Network/IRC/Handlers/Auth.hs b/Network/IRC/Handlers/Auth.hs index 7d5af2e..23fd11c 100644 --- a/Network/IRC/Handlers/Auth.hs +++ b/Network/IRC/Handlers/Auth.hs @@ -1,8 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} diff --git a/Network/IRC/Handlers/MessageLogger.hs b/Network/IRC/Handlers/MessageLogger.hs index 75ce945..33e4b8f 100644 --- a/Network/IRC/Handlers/MessageLogger.hs +++ b/Network/IRC/Handlers/MessageLogger.hs @@ -1,8 +1,4 @@ {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} module Network.IRC.Handlers.MessageLogger (mkMsgHandler) where diff --git a/Network/IRC/Handlers/NickTracker.hs b/Network/IRC/Handlers/NickTracker.hs index 0e7e633..fcb96a3 100644 --- a/Network/IRC/Handlers/NickTracker.hs +++ b/Network/IRC/Handlers/NickTracker.hs @@ -1,8 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} @@ -43,58 +40,60 @@ saveNickTrack nt = do $(makeAcidic ''NickTracking ['getByNick, 'getByCanonicalNick, 'saveNickTrack]) nickTrackerMsg :: MonadMsgHandler m => IORef (AcidState NickTracking) -> Message -> m (Maybe Command) -nickTrackerMsg state = go +nickTrackerMsg state message = case message of + ChannelMsg { .. } -> updateNickTrack state user msg msgTime >> handleCommands msg + ActionMsg { .. } -> updateNickTrack state user msg msgTime >> return Nothing + JoinMsg { .. } -> updateNickTrack state user "" msgTime >> return Nothing + PartMsg { .. } -> updateNickTrack state user msg msgTime >> return Nothing + QuitMsg { .. } -> updateNickTrack state user msg msgTime >> return Nothing + NickMsg { .. } -> handleNickChange state user newNick msgTime >> return Nothing + NamesMsg { .. } -> + mapM_ (\n -> updateNickTrack state (User n "") "" msgTime) nicks >> return Nothing + _ -> return Nothing where - go ChannelMsg { .. } = updateNickTrack user msg msgTime >> handleCommands msg - go ActionMsg { .. } = updateNickTrack user msg msgTime >> return Nothing - go JoinMsg { .. } = updateNickTrack user "" msgTime >> return Nothing - go PartMsg { .. } = updateNickTrack user msg msgTime >> return Nothing - go QuitMsg { .. } = updateNickTrack user msg msgTime >> return Nothing - go NickMsg { .. } = handleNickChange user newNick msgTime >> return Nothing - go NamesMsg { .. } = - mapM_ (\n -> updateNickTrack (User n "") "" msgTime) nicks >> return Nothing - go _ = return Nothing - - updateNickTrack user message msgTime = io $ do - acid <- readIORef state - let nck = userNick user - mnt <- query acid . GetByNick $ Nick nck - (message', lastMessageOn', cn) <- case (message, mnt) of - ("", Just (NickTrack { .. })) -> return (lastMessage, lastMessageOn, canonicalNick) - (_, Just (NickTrack { .. })) -> return (message, msgTime, canonicalNick) - _ -> do - cn <- newCanonicalNick - return (message, msgTime, cn) - - update acid . SaveNickTrack $ - NickTrack (Nick nck) cn (LastSeenOn msgTime) lastMessageOn' message' - - handleNickChange user newNick msgTime = io $ do - acid <- readIORef state - let prevNick = userNick user - mpnt <- query acid . GetByNick $ Nick prevNick - mnt <- query acid . GetByNick $ Nick newNick - mInfo <- case (mpnt, mnt) of - (Nothing, _) -> newCanonicalNick >>= \cn -> return $ Just ("", cn, msgTime) - (Just pnt, Nothing) -> - return $ Just (lastMessage pnt, canonicalNick pnt, lastMessageOn pnt) - (Just pnt, Just nt) | canonicalNick pnt == canonicalNick nt -> do - let nt' = maximumByEx (comparing lastMessageOn) [pnt, nt] - return $ Just (lastMessage nt', canonicalNick nt', lastMessageOn nt') - _ -> return Nothing - - whenJust mInfo $ \(message, cn, lastMessageOn') -> - update acid . SaveNickTrack $ - NickTrack (Nick newNick) cn (LastSeenOn msgTime) lastMessageOn' message - - newCanonicalNick = map (CanonicalNick . pack . U.toString) U.nextRandom - commands = [ ("!nick", handleNickCommand) , ("!seen", handleSeenCommand) ] - handleCommands message = case find ((`isPrefixOf` message) . fst) commands of + handleCommands msg = case find ((`isPrefixOf` msg) . fst) commands of Nothing -> return Nothing - Just (_, handler) -> handler state message + Just (_, handler) -> handler state msg + +updateNickTrack :: MonadMsgHandler m => IORef (AcidState NickTracking) -> User -> Text -> UTCTime -> m () +updateNickTrack state user message msgTime = io $ do + acid <- readIORef state + let nck = userNick user + mnt <- query acid . GetByNick $ Nick nck + (message', lastMessageOn', cn) <- case (message, mnt) of + ("", Just (NickTrack { .. })) -> return (lastMessage, lastMessageOn, canonicalNick) + (_, Just (NickTrack { .. })) -> return (message, msgTime, canonicalNick) + _ -> do + cn <- newCanonicalNick + return (message, msgTime, cn) + + update acid . SaveNickTrack $ + NickTrack (Nick nck) cn (LastSeenOn msgTime) lastMessageOn' message' + +handleNickChange :: MonadMsgHandler m => IORef (AcidState NickTracking) -> User -> Text -> UTCTime -> m () +handleNickChange state user newNick msgTime = io $ do + acid <- readIORef state + let prevNick = userNick user + mpnt <- query acid . GetByNick $ Nick prevNick + mnt <- query acid . GetByNick $ Nick newNick + mInfo <- case (mpnt, mnt) of + (Nothing, _) -> newCanonicalNick >>= \cn -> return $ Just ("", cn, msgTime) + (Just pnt, Nothing) -> + return $ Just (lastMessage pnt, canonicalNick pnt, lastMessageOn pnt) + (Just pnt, Just nt) | canonicalNick pnt == canonicalNick nt -> do + let nt' = maximumByEx (comparing lastMessageOn) [pnt, nt] + return $ Just (lastMessage nt', canonicalNick nt', lastMessageOn nt') + _ -> return Nothing + + whenJust mInfo $ \(message, cn, lastMessageOn') -> + update acid . SaveNickTrack $ + NickTrack (Nick newNick) cn (LastSeenOn msgTime) lastMessageOn' message + +newCanonicalNick :: IO CanonicalNick +newCanonicalNick = map (CanonicalNick . pack . U.toString) U.nextRandom withNickTracks :: MonadMsgHandler m => (Text -> [NickTrack] -> IO Text) -> IORef (AcidState NickTracking) -> Text @@ -142,7 +141,7 @@ mkMsgHandler BotConfig { .. } _ "nicktracker" = do state <- io (openLocalState emptyNickTracking >>= newIORef) return . Just $ newMsgHandler { onMessage = nickTrackerMsg state , onStop = stopNickTracker state - , onHelp = return $ mapFromList helpMsgs} + , onHelp = return helpMsgs } where helpMsgs = mapFromList [ ("!nick", "Shows the user's other nicks. !nick "), diff --git a/Network/IRC/Handlers/NickTracker/Types.hs b/Network/IRC/Handlers/NickTracker/Types.hs index e9f4685..8bc3a66 100644 --- a/Network/IRC/Handlers/NickTracker/Types.hs +++ b/Network/IRC/Handlers/NickTracker/Types.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TemplateHaskell #-} module Network.IRC.Handlers.NickTracker.Types where @@ -14,11 +13,11 @@ newtype CanonicalNick = CanonicalNick Text deriving (Eq, Ord, Show, Data, Typeab newtype LastSeenOn = LastSeenOn UTCTime deriving (Eq, Ord, Show, Data, Typeable) data NickTrack = NickTrack { - nick :: Nick, - canonicalNick :: CanonicalNick, - lastSeenOn :: LastSeenOn, - lastMessageOn :: UTCTime, - lastMessage :: Text + nick :: !Nick, + canonicalNick :: !CanonicalNick, + lastSeenOn :: !LastSeenOn, + lastMessageOn :: !UTCTime, + lastMessage :: !Text } deriving (Eq, Ord, Show, Data, Typeable) instance Indexable NickTrack where diff --git a/Network/IRC/Protocol.hs b/Network/IRC/Protocol.hs index f64abeb..576baa0 100644 --- a/Network/IRC/Protocol.hs +++ b/Network/IRC/Protocol.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} - module Network.IRC.Protocol (msgFromLine, lineFromCommand) where import ClassyPrelude diff --git a/Network/IRC/Types.hs b/Network/IRC/Types.hs index 15c86fc..ead53e6 100644 --- a/Network/IRC/Types.hs +++ b/Network/IRC/Types.hs @@ -3,10 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} module Network.IRC.Types ( Nick diff --git a/Network/IRC/Util.hs b/Network/IRC/Util.hs index d5d6f5a..207afd3 100644 --- a/Network/IRC/Util.hs +++ b/Network/IRC/Util.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - module Network.IRC.Util where import ClassyPrelude diff --git a/hask-irc.cabal b/hask-irc.cabal index 7f88bfd..fe90d39 100644 --- a/hask-irc.cabal +++ b/hask-irc.cabal @@ -49,31 +49,32 @@ build-type: Simple cabal-version: >=1.10 library - other-extensions: Safe + default-extensions: NoImplicitPrelude, OverloadedStrings, RecordWildCards, ScopedTypeVariables, + BangPatterns, TupleSections - build-depends: base >=4.5 && <4.8, - text >=0.11 && <0.12, - mtl >=2.1 && <2.2, - network >=2.3 && <2.5, - configurator >=0.2, - time >=1.4.0, - curl-aeson ==0.0.3, - aeson >=0.6.0.0, - HTTP >=4000, - transformers >=0.3, - classy-prelude ==0.9.1, - text-format >=0.3.1, - filepath >=1.3, - directory >=1.2, - lifted-base >=0.2, - unix >=2.7, - convertible >=1.1, - hslogger >=1.2.4, - hslogger-template >=2.0, - ixset >=1.0, - acid-state >=0.12, - safecopy >=0.8, - uuid >=1.3 + build-depends: base >=4.5 && <4.8, + text >=0.11 && <0.12, + mtl >=2.1 && <2.2, + network >=2.3 && <2.5, + configurator >=0.2 && <0.3, + time >=1.4 && <1.5, + curl-aeson >=0.0.3 && <0.1, + aeson >=0.6.0.0 && <0.7, + HTTP >=4000 && <5000, + transformers >=0.3 && <0.4, + classy-prelude >=0.9 && <1.0, + text-format >=0.3 && <0.4, + filepath >=1.3 && <1.4, + directory >=1.2 && <1.3, + lifted-base >=0.2 && <0.3, + unix >=2.7 && <2.8, + convertible >=1.1 && <1.2, + hslogger >=1.2 && <1.3, + hslogger-template >=2.0 && <2.1, + ixset >=1.0 && <1.1, + acid-state >=0.12 && <0.13, + safecopy >=0.8 && <0.9, + uuid >=1.3 && <1.4 exposed-modules: Network.IRC.Types, Network.IRC.Protocol, Network.IRC.Handlers, Network.IRC.Client @@ -91,32 +92,33 @@ executable hask-irc -- other-modules: -- LANGUAGE extensions used by modules in this package. - other-extensions: Safe + default-extensions: NoImplicitPrelude, OverloadedStrings, RecordWildCards, ScopedTypeVariables, + BangPatterns, TupleSections -- Other library packages from which modules are imported. - build-depends: base >=4.5 && <4.8, - text >=0.11 && <0.12, - mtl >=2.1 && <2.2, - network >=2.3 && <2.5, - configurator >=0.2, - time >=1.4.0, - curl-aeson ==0.0.3, - aeson >=0.6.0.0, - HTTP >=4000, - transformers >=0.3, - classy-prelude ==0.9.1, - text-format >=0.3.1, - filepath >=1.3, - directory >=1.2, - lifted-base >=0.2, - unix >=2.7, - convertible >=1.1, - hslogger >=1.2.4, - hslogger-template >=2.0, - ixset >=1.0, - acid-state >=0.12, - safecopy >=0.8, - uuid >=1.3 + build-depends: base >=4.5 && <4.8, + text >=0.11 && <0.12, + mtl >=2.1 && <2.2, + network >=2.3 && <2.5, + configurator >=0.2 && <0.3, + time >=1.4 && <1.5, + curl-aeson >=0.0.3 && <0.1, + aeson >=0.6.0.0 && <0.7, + HTTP >=4000 && <5000, + transformers >=0.3 && <0.4, + classy-prelude >=0.9 && <1.0, + text-format >=0.3 && <0.4, + filepath >=1.3 && <1.4, + directory >=1.2 && <1.3, + lifted-base >=0.2 && <0.3, + unix >=2.7 && <2.8, + convertible >=1.1 && <1.2, + hslogger >=1.2 && <1.3, + hslogger-template >=2.0 && <2.1, + ixset >=1.0 && <1.1, + acid-state >=0.12 && <0.13, + safecopy >=0.8 && <0.9, + uuid >=1.3 && <1.4 -- Directories containing source files. -- hs-source-dirs: