diff --git a/Main.hs b/Main.hs index 9aeaab5..d523c3e 100644 --- a/Main.hs +++ b/Main.hs @@ -1,14 +1,13 @@ -{-# LANGUAGE OverloadedStrings, OverlappingInstances #-} +{-# LANGUAGE OverloadedStrings, OverlappingInstances, NoImplicitPrelude #-} module Main (main) where +import qualified Data.Configurator as CF import qualified Data.Text as T +import BasicPrelude hiding (try, getArgs) import Control.Exception -import Control.Monad -import Data.Configurator import Data.Configurator.Types -import Data.Maybe import System.Environment import System.Exit @@ -25,25 +24,25 @@ main = do prog <- getProgName when (length args < 1) $ do - putStrLn ("Usage: " ++ prog ++ " ") + putStrLn $ "Usage: " ++ T.pack prog ++ " " exitFailure let configFile = head args loadBotConfig configFile >>= run -loadBotConfig :: FilePath -> IO BotConfig +loadBotConfig :: String -> IO BotConfig loadBotConfig configFile = do - eCfg <- try $ load [Required configFile] + eCfg <- try $ CF.load [Required configFile] case eCfg of Left (ParseError _ _) -> error "Error while loading config" Right cfg -> do eBotConfig <- try $ do - server <- require cfg "server" - port <- require cfg "port" - channel <- require cfg "channel" - botNick <- require cfg "nick" - timeout <- require cfg "timeout" - handlers <- require cfg "handlers" + server <- CF.require cfg "server" + port <- CF.require cfg "port" + channel <- CF.require cfg "channel" + botNick <- CF.require cfg "nick" + timeout <- CF.require cfg "timeout" + handlers <- CF.require cfg "handlers" return $ BotConfig server port channel botNick timeout handlers cfg case eBotConfig of diff --git a/Network/IRC/Client.hs b/Network/IRC/Client.hs index af46696..f5e4704 100644 --- a/Network/IRC/Client.hs +++ b/Network/IRC/Client.hs @@ -1,20 +1,19 @@ -{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-} +{-# LANGUAGE RecordWildCards, ScopedTypeVariables, NoImplicitPrelude, OverloadedStrings #-} 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 Control.Exception +import BasicPrelude hiding (log) import Control.Concurrent -import Control.Monad import Control.Monad.Reader import Control.Monad.State import Network -import Prelude hiding (log) import System.IO import System.Time import System.Timeout -import Text.Printf import Network.IRC.Handlers import Network.IRC.Protocol @@ -23,13 +22,14 @@ import Network.IRC.Types oneSec :: Int oneSec = 1000000 -log :: String -> IO () -log msg = getClockTime >>= \t -> printf "[%s] ** %s\n" (show t) msg +log :: Text -> IO () +log msg = getClockTime >>= \t -> TF.print "[{}] ** {}\n" $ TF.buildParams (show t, msg) sendCommand :: Bot -> Command -> IO () sendCommand Bot { .. } reply = do - let line = T.unpack $ lineFromCommand botConfig reply - hPrintf socket "%s\r\n" line >> printf "> %s\n" line + let line = lineFromCommand botConfig reply + TF.hprint socket "{}\r\n" $ TF.Only line + TF.print "> {}\n" $ TF.Only line listen :: IRC () listen = do @@ -46,7 +46,7 @@ listen = do Nothing -> return Disconnected Just line -> do now <- getClockTime - printf "[%s] %s\n" (show now) line + TF.print "[{}] {}\n" $ TF.buildParams (show now, line) let message = msgFromLine botConfig now (T.pack line) case message of @@ -59,7 +59,7 @@ listen = do msg -> forM_ (handlers botConfig) $ \handlerName -> forkIO $ do let mHandler = getHandler handlerName case mHandler of - Nothing -> log $ "No handler found with name: " ++ T.unpack handlerName + Nothing -> log $ "No handler found with name: " ++ handlerName Just handler -> do mCmd <- runHandler handler botConfig msg case mCmd of diff --git a/Network/IRC/Handlers.hs b/Network/IRC/Handlers.hs index 09a7325..8576c59 100644 --- a/Network/IRC/Handlers.hs +++ b/Network/IRC/Handlers.hs @@ -1,20 +1,16 @@ -{-# LANGUAGE RecordWildCards, OverloadedStrings #-} +{-# LANGUAGE RecordWildCards, OverloadedStrings, NoImplicitPrelude #-} module Network.IRC.Handlers (getHandler) where -import qualified Data.List as L +import qualified Data.Text as T -import Data.Text -import Prelude hiding ((++)) +import BasicPrelude import Network.IRC.Handlers.SongSearch import Network.IRC.Types clean :: Text -> Text -clean = toLower . strip - -(++) :: Text -> Text -> Text -(++) = append +clean = T.toLower . T.strip getHandler :: HandlerName -> Maybe Handler getHandler "greeter" = Just $ Handler greeter @@ -23,7 +19,7 @@ getHandler "songsearch" = Just $ Handler songSearch getHandler _ = Nothing greeter :: Monad m => BotConfig -> Message -> m (Maybe Command) -greeter _ ChannelMsg { .. } = case L.find (== clean msg) greetings of +greeter _ ChannelMsg { .. } = case find (== clean msg) greetings of Nothing -> return Nothing Just greeting -> return . Just . ChannelMsgReply $ greeting ++ " " ++ userNick user where diff --git a/Network/IRC/Handlers/SongSearch.hs b/Network/IRC/Handlers/SongSearch.hs index 86d3871..6bc0f5b 100644 --- a/Network/IRC/Handlers/SongSearch.hs +++ b/Network/IRC/Handlers/SongSearch.hs @@ -1,18 +1,16 @@ -{-# LANGUAGE RecordWildCards, OverloadedStrings, ScopedTypeVariables #-} +{-# LANGUAGE RecordWildCards, OverloadedStrings, ScopedTypeVariables, NoImplicitPrelude #-} module Network.IRC.Handlers.SongSearch (songSearch) where -import Control.Applicative +import qualified Data.Configurator as CF +import qualified Data.Text as T + +import BasicPrelude hiding (try) import Control.Exception -import Control.Monad -import Control.Monad.Trans import Data.Aeson import Data.Aeson.Types (emptyArray) -import Data.Configurator -import Data.Text import Network.Curl.Aeson import Network.HTTP.Base -import Prelude hiding (putStrLn, drop, lookup) import Network.IRC.Types @@ -26,23 +24,21 @@ instance FromJSON Song where songSearch :: MonadIO m => BotConfig -> Message -> m (Maybe Command) songSearch BotConfig { .. } ChannelMsg { .. } - | "!m " `isPrefixOf` msg = liftIO $ do - let query = strip . drop 3 $ msg - mApiKey <- lookup config "songsearch.tinysong_apikey" + | "!m " `T.isPrefixOf` msg = liftIO $ do + let query = T.strip . T.drop 3 $ msg + mApiKey <- CF.lookup config "songsearch.tinysong_apikey" fmap (Just . ChannelMsgReply) $ case mApiKey of Nothing -> -- do log "tinysong api key not found in config" - return $ "Error while searching for " +++ query + return $ "Error while searching for " ++ query Just apiKey -> do - let apiUrl = "http://tinysong.com/b/" ++ urlEncode (unpack query) + let apiUrl = "http://tinysong.com/b/" ++ urlEncode (T.unpack query) ++ "?format=json&key=" ++ apiKey result <- try $ curlAesonGet apiUrl >>= evaluate return $ case result of - Left (_ :: CurlAesonException) -> "Error while searching for " +++ query + Left (_ :: CurlAesonException) -> "Error while searching for " ++ query Right song -> case song of - Song { .. } -> "Listen to " +++ artist +++ " - " +++ name +++ " at " +++ url - NoSong -> "No song found for: " +++ query + Song { .. } -> "Listen to " ++ artist ++ " - " ++ name ++ " at " ++ url + NoSong -> "No song found for: " ++ query | otherwise = return Nothing - where - (+++) = append songSearch _ _ = return Nothing diff --git a/Network/IRC/Protocol.hs b/Network/IRC/Protocol.hs index acbe64b..6e053ef 100644 --- a/Network/IRC/Protocol.hs +++ b/Network/IRC/Protocol.hs @@ -1,18 +1,18 @@ -{-# LANGUAGE RecordWildCards, OverloadedStrings #-} +{-# LANGUAGE RecordWildCards, OverloadedStrings, NoImplicitPrelude #-} module Network.IRC.Protocol (msgFromLine, lineFromCommand) where import qualified Data.List as L +import qualified Data.Text as T -import Data.Text -import Prelude hiding (drop, unwords, takeWhile, (++)) +import BasicPrelude import System.Time import Network.IRC.Types msgFromLine :: BotConfig -> ClockTime -> Text -> Message msgFromLine (BotConfig { .. }) time line - | "PING :" `isPrefixOf` line = Ping time . drop 6 $ line + | "PING :" `T.isPrefixOf` line = Ping time . T.drop 6 $ line | otherwise = case command of "JOIN" -> JoinMsg time user "QUIT" -> QuitMsg time user message @@ -21,7 +21,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 (drop 1 target) + "NICK" -> NickMsg time user (T.drop 1 target) "PRIVMSG" -> if target == channel then ChannelMsg time user message else PrivMsg time user message @@ -29,16 +29,16 @@ msgFromLine (BotConfig { .. }) time line where isSpc = (== ' ') isNotSpc = not . isSpc - splits = split isSpc line - source = drop 1 . takeWhile isNotSpc $ line + splits = T.split isSpc line + source = T.drop 1 . T.takeWhile isNotSpc $ line target = splits !! 2 command = splits !! 1 - message = drop 1 . unwords . L.drop 3 $ splits - user = let u = split (== '!') source in User (u !! 0) (u !! 1) + message = T.drop 1 . unwords . L.drop 3 $ splits + user = let u = T.split (== '!') source in User (u !! 0) (u !! 1) mode = splits !! 3 modeArgs = L.drop 4 splits kicked = splits !! 3 - kickReason = drop 1 . unwords . L.drop 4 $ splits + kickReason = T.drop 1 . unwords . L.drop 4 $ splits lineFromCommand :: BotConfig -> Command -> Text lineFromCommand (BotConfig { .. }) reply = case reply of @@ -48,5 +48,4 @@ lineFromCommand (BotConfig { .. }) reply = case reply of JoinCmd -> "JOIN " ++ channel ChannelMsgReply { .. } -> "PRIVMSG " ++ channel ++ " :" ++ rmsg PrivMsgReply (User { .. }) rmsg -> "PRIVMSG " ++ botNick ++ " :" ++ rmsg - where - (++) = append + diff --git a/Network/IRC/Types.hs b/Network/IRC/Types.hs index db92572..d556253 100644 --- a/Network/IRC/Types.hs +++ b/Network/IRC/Types.hs @@ -1,11 +1,13 @@ {-# LANGUAGE RecordWildCards, RankNTypes, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-} module Network.IRC.Types where +import BasicPrelude hiding (show) import Control.Monad.Reader import Control.Monad.State import Data.Configurator.Types -import Data.Text (Text) +import Prelude (Show(..)) import System.IO import System.Time diff --git a/hask-irc.cabal b/hask-irc.cabal index 5b9b048..858995b 100644 --- a/hask-irc.cabal +++ b/hask-irc.cabal @@ -51,7 +51,8 @@ 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, - curl-aeson ==0.0.3, aeson >=0.6.0.0, HTTP, transformers >=0.3 + curl-aeson ==0.0.3, aeson >=0.6.0.0, HTTP, transformers >=0.3, + basic-prelude ==0.3.8, text-format >= 0.3.1 exposed-modules: Network.IRC.Types, Network.IRC.Protocol, Network.IRC.Handlers, Network.IRC.Client @@ -74,7 +75,8 @@ 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, - curl-aeson ==0.0.3, aeson >=0.6.0.0, HTTP, transformers >=0.3 + curl-aeson ==0.0.3, aeson >=0.6.0.0, HTTP, transformers >=0.3, + basic-prelude ==0.3.8, text-format >= 0.3.1 -- Directories containing source files. -- hs-source-dirs: