abhin4v
/
hask-irc
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Moved to basic-prelude, sanitized imports

This commit is contained in:
Abhinav Sarkar 2014-05-10 20:01:25 +05:30
parent f8471130e4
commit cfc796564a
7 changed files with 59 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
Main.hs
View File

@ -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 ++ " <config file path>")
putStrLn $ "Usage: " ++ T.pack prog ++ " <config file path>"
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

22
Network/IRC/Client.hs
View File

@ -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

14
Network/IRC/Handlers.hs
View File

@ -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

30
Network/IRC/Handlers/SongSearch.hs
View File

@ -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

23
Network/IRC/Protocol.hs
View File

@ -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

4
Network/IRC/Types.hs
View File

@ -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

6
hask-irc.cabal
View File

@ -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: