From 964d2fbb35722b4bd38e99ac525f5d5c9c187f67 Mon Sep 17 00:00:00 2001 From: Abhinav Sarkar Date: Sat, 10 May 2014 21:45:16 +0530 Subject: [PATCH] Moved to classy-prelude --- Main.hs | 9 ++++----- Network/IRC/Client.hs | 24 +++++++++++------------- Network/IRC/Handlers.hs | 7 +++---- Network/IRC/Handlers/SongSearch.hs | 14 +++++++------- Network/IRC/Protocol.hs | 26 ++++++++++++-------------- Network/IRC/Types.hs | 25 +++++++++++-------------- hask-irc.cabal | 8 ++++---- 7 files changed, 52 insertions(+), 61 deletions(-) diff --git a/Main.hs b/Main.hs index d523c3e..d25c331 100644 --- a/Main.hs +++ b/Main.hs @@ -3,9 +3,8 @@ module Main (main) where import qualified Data.Configurator as CF -import qualified Data.Text as T -import BasicPrelude hiding (try, getArgs) +import ClassyPrelude hiding (try, getArgs) import Control.Exception import Data.Configurator.Types import System.Environment @@ -24,10 +23,10 @@ main = do prog <- getProgName when (length args < 1) $ do - putStrLn $ "Usage: " ++ T.pack prog ++ " " + putStrLn $ "Usage: " ++ pack prog ++ " " exitFailure - let configFile = head args + let configFile = headEx args loadBotConfig configFile >>= run loadBotConfig :: String -> IO BotConfig @@ -46,5 +45,5 @@ loadBotConfig configFile = do return $ BotConfig server port channel botNick timeout handlers cfg case eBotConfig of - Left (KeyError k) -> error $ "Error while reading key from config: " ++ T.unpack k + Left (KeyError k) -> error $ "Error while reading key from config: " ++ unpack k Right botConfig -> return botConfig diff --git a/Network/IRC/Client.hs b/Network/IRC/Client.hs index f5e4704..f696632 100644 --- a/Network/IRC/Client.hs +++ b/Network/IRC/Client.hs @@ -2,17 +2,15 @@ module Network.IRC.Client (run) where -import qualified Data.Text as T import qualified Data.Text.Format as TF import qualified Data.Text.Format.Params as TF -import BasicPrelude hiding (log) +import ClassyPrelude hiding (log) import Control.Concurrent -import Control.Monad.Reader -import Control.Monad.State +import Control.Monad.Reader hiding (forM_) +import Control.Monad.State hiding (forM_) import Network -import System.IO -import System.Time +import System.IO (hSetBuffering, BufferMode(..)) import System.Timeout import Network.IRC.Handlers @@ -23,7 +21,7 @@ oneSec :: Int oneSec = 1000000 log :: Text -> IO () -log msg = getClockTime >>= \t -> TF.print "[{}] ** {}\n" $ TF.buildParams (show t, msg) +log msg = getCurrentTime >>= \t -> TF.print "[{}] ** {}\n" $ TF.buildParams (t, msg) sendCommand :: Bot -> Command -> IO () sendCommand Bot { .. } reply = do @@ -41,14 +39,14 @@ listen = do when (status == Kicked) $ threadDelay (5 * oneSec) >> sendCommand bot JoinCmd - mLine <- fmap (fmap init) . timeout (oneSec * botTimeout botConfig) . hGetLine $ socket + mLine <- map (map initEx) . timeout (oneSec * botTimeout botConfig) . hGetLine $ socket case mLine of Nothing -> return Disconnected Just line -> do - now <- getClockTime - TF.print "[{}] {}\n" $ TF.buildParams (show now, line) + now <- getCurrentTime + TF.print "[{}] {}\n" $ TF.buildParams (now, line) - let message = msgFromLine botConfig now (T.pack line) + let message = msgFromLine botConfig now line case message of JoinMsg { .. } | userNick user == nick -> log "Joined" >> return Joined KickMsg { .. } | kicked == nick -> log "Kicked" >> return Kicked @@ -81,7 +79,7 @@ connect botConfig@BotConfig { .. } = do where connectToWithRetry = connectTo server (PortNumber (fromIntegral port)) `catch` (\(e :: SomeException) -> do - log ("Error: " ++ show e ++ ". Waiting.") + log ("Error while connecting: " ++ pack (show e) ++ ". Waiting.") threadDelay (5 * oneSec) connectToWithRetry) @@ -103,7 +101,7 @@ run botConfig = withSocketsDo $ do where run_ = bracket (connect botConfig) disconnect $ \bot -> go bot `catch` \(e :: SomeException) -> do - log $ "Exception! " ++ show e + log $ "Exception! " ++ pack (show e) return Errored go bot = do diff --git a/Network/IRC/Handlers.hs b/Network/IRC/Handlers.hs index 8576c59..a40f777 100644 --- a/Network/IRC/Handlers.hs +++ b/Network/IRC/Handlers.hs @@ -2,15 +2,14 @@ module Network.IRC.Handlers (getHandler) where -import qualified Data.Text as T - -import BasicPrelude +import ClassyPrelude +import Data.Text (strip) import Network.IRC.Handlers.SongSearch import Network.IRC.Types clean :: Text -> Text -clean = T.toLower . T.strip +clean = toLower . strip getHandler :: HandlerName -> Maybe Handler getHandler "greeter" = Just $ Handler greeter diff --git a/Network/IRC/Handlers/SongSearch.hs b/Network/IRC/Handlers/SongSearch.hs index 6bc0f5b..c1f33a9 100644 --- a/Network/IRC/Handlers/SongSearch.hs +++ b/Network/IRC/Handlers/SongSearch.hs @@ -3,12 +3,12 @@ module Network.IRC.Handlers.SongSearch (songSearch) where import qualified Data.Configurator as CF -import qualified Data.Text as T -import BasicPrelude hiding (try) +import ClassyPrelude hiding (try) import Control.Exception import Data.Aeson import Data.Aeson.Types (emptyArray) +import Data.Text (strip) import Network.Curl.Aeson import Network.HTTP.Base @@ -20,18 +20,18 @@ data Song = NoSong | Song { url :: Text, name :: Text, artist :: Text } instance FromJSON Song where parseJSON (Object o) = Song <$> o .: "Url" <*> o .: "SongName" <*> o .: "ArtistName" parseJSON a | a == emptyArray = return NoSong - parseJSON _ = mzero + parseJSON _ = mempty songSearch :: MonadIO m => BotConfig -> Message -> m (Maybe Command) songSearch BotConfig { .. } ChannelMsg { .. } - | "!m " `T.isPrefixOf` msg = liftIO $ do - let query = T.strip . T.drop 3 $ msg + | "!m " `isPrefixOf` msg = liftIO $ do + let query = strip . drop 3 $ msg mApiKey <- CF.lookup config "songsearch.tinysong_apikey" - fmap (Just . ChannelMsgReply) $ case mApiKey of + map (Just . ChannelMsgReply) $ case mApiKey of Nothing -> -- do log "tinysong api key not found in config" return $ "Error while searching for " ++ query Just apiKey -> do - let apiUrl = "http://tinysong.com/b/" ++ urlEncode (T.unpack query) + let apiUrl = "http://tinysong.com/b/" ++ urlEncode (unpack query) ++ "?format=json&key=" ++ apiKey result <- try $ curlAesonGet apiUrl >>= evaluate diff --git a/Network/IRC/Protocol.hs b/Network/IRC/Protocol.hs index 6e053ef..eb5b185 100644 --- a/Network/IRC/Protocol.hs +++ b/Network/IRC/Protocol.hs @@ -2,17 +2,15 @@ module Network.IRC.Protocol (msgFromLine, lineFromCommand) where -import qualified Data.List as L -import qualified Data.Text as T - -import BasicPrelude -import System.Time +import ClassyPrelude +import Data.List ((!!)) +import Data.Text (split) import Network.IRC.Types -msgFromLine :: BotConfig -> ClockTime -> Text -> Message +msgFromLine :: BotConfig -> UTCTime -> Text -> Message msgFromLine (BotConfig { .. }) time line - | "PING :" `T.isPrefixOf` line = Ping time . T.drop 6 $ line + | "PING :" `isPrefixOf` line = Ping time . drop 6 $ line | otherwise = case command of "JOIN" -> JoinMsg time user "QUIT" -> QuitMsg time user message @@ -21,7 +19,7 @@ msgFromLine (BotConfig { .. }) time line "MODE" -> if source == botNick then ModeMsg time Self target message [] else ModeMsg time user target mode modeArgs - "NICK" -> NickMsg time user (T.drop 1 target) + "NICK" -> NickMsg time user (drop 1 target) "PRIVMSG" -> if target == channel then ChannelMsg time user message else PrivMsg time user message @@ -29,16 +27,16 @@ msgFromLine (BotConfig { .. }) time line where isSpc = (== ' ') isNotSpc = not . isSpc - splits = T.split isSpc line - source = T.drop 1 . T.takeWhile isNotSpc $ line + splits = split isSpc line + source = drop 1 . takeWhile isNotSpc $ line target = splits !! 2 command = splits !! 1 - message = T.drop 1 . unwords . L.drop 3 $ splits - user = let u = T.split (== '!') source in User (u !! 0) (u !! 1) + message = drop 1 . unwords . drop 3 $ splits + user = let u = split (== '!') source in User (u !! 0) (u !! 1) mode = splits !! 3 - modeArgs = L.drop 4 splits + modeArgs = drop 4 splits kicked = splits !! 3 - kickReason = T.drop 1 . unwords . L.drop 4 $ splits + kickReason = drop 1 . unwords . drop 4 $ splits lineFromCommand :: BotConfig -> Command -> Text lineFromCommand (BotConfig { .. }) reply = case reply of diff --git a/Network/IRC/Types.hs b/Network/IRC/Types.hs index d556253..219d33f 100644 --- a/Network/IRC/Types.hs +++ b/Network/IRC/Types.hs @@ -3,13 +3,10 @@ module Network.IRC.Types where -import BasicPrelude hiding (show) +import ClassyPrelude import Control.Monad.Reader import Control.Monad.State import Data.Configurator.Types -import Prelude (Show(..)) -import System.IO -import System.Time type Channel = Text type Nick = Text @@ -23,16 +20,16 @@ data User = Self | User { userNick :: Nick, userServer :: Text } deriving (Show, Eq) data Message = - ChannelMsg { time :: ClockTime, user :: User, msg :: Text } - | PrivMsg { time :: ClockTime, user :: User, msg :: Text } - | Ping { time :: ClockTime, msg :: Text } - | JoinMsg { time :: ClockTime, user :: User } - | ModeMsg { time :: ClockTime, user :: User, target :: Text , mode :: Text, modeArgs :: [Text] } - | NickMsg { time :: ClockTime, user :: User, nick :: Text } - | QuitMsg { time :: ClockTime, user :: User, msg :: Text } - | PartMsg { time :: ClockTime, user :: User, msg :: Text } - | KickMsg { time :: ClockTime, user :: User, kicked :: Text , msg :: Text } - | OtherMsg { time :: ClockTime, source :: Text, command :: Text , target :: Text, msg :: Text } + ChannelMsg { time :: UTCTime, user :: User, msg :: Text } + | PrivMsg { time :: UTCTime, user :: User, msg :: Text } + | Ping { time :: UTCTime, msg :: Text } + | JoinMsg { time :: UTCTime, user :: User } + | ModeMsg { time :: UTCTime, user :: User, target :: Text , mode :: Text, modeArgs :: [Text] } + | NickMsg { time :: UTCTime, user :: User, nick :: Text } + | QuitMsg { time :: UTCTime, user :: User, msg :: Text } + | PartMsg { time :: UTCTime, user :: User, msg :: Text } + | KickMsg { time :: UTCTime, user :: User, kicked :: Text , msg :: Text } + | OtherMsg { time :: UTCTime, source :: Text, command :: Text , target :: Text, msg :: Text } deriving (Show, Eq) data Command = diff --git a/hask-irc.cabal b/hask-irc.cabal index 858995b..b35717c 100644 --- a/hask-irc.cabal +++ b/hask-irc.cabal @@ -50,9 +50,9 @@ cabal-version: >=1.10 library build-depends: base >=4.5 && <4.7, text >=0.11 && <0.12, mtl >=2.1 && <2.2, - network >=2.3 && <2.5, old-time >=1.1 && <1.2, configurator >= 0.2, + network >=2.3 && <2.5, configurator >= 0.2, time >=1.4.0, curl-aeson ==0.0.3, aeson >=0.6.0.0, HTTP, transformers >=0.3, - basic-prelude ==0.3.8, text-format >= 0.3.1 + classy-prelude ==0.9.1, text-format >= 0.3.1 exposed-modules: Network.IRC.Types, Network.IRC.Protocol, Network.IRC.Handlers, Network.IRC.Client @@ -74,9 +74,9 @@ executable hask-irc -- Other library packages from which modules are imported. build-depends: base >=4.5 && <4.7, text >=0.11 && <0.12, mtl >=2.1 && <2.2, - network >=2.3 && <2.5, old-time >=1.1 && <1.2, configurator >= 0.2, + network >=2.3 && <2.5, configurator >= 0.2, time >=1.4.0, curl-aeson ==0.0.3, aeson >=0.6.0.0, HTTP, transformers >=0.3, - basic-prelude ==0.3.8, text-format >= 0.3.1 + classy-prelude ==0.9.1, text-format >= 0.3.1 -- Directories containing source files. -- hs-source-dirs: