GHC -Wall ed

master
Abhinav Sarkar 2014-05-07 14:35:25 +05:30
parent 2f758c1a34
commit f8471130e4
8 changed files with 45 additions and 28 deletions

1
.gitignore vendored
View File

@ -4,3 +4,4 @@
cabal.sandbox.config
dist
config.cfg
*sublime*

View File

@ -12,7 +12,7 @@ import Data.Maybe
import System.Environment
import System.Exit
import Network.IRC.Types
import Network.IRC.Types (BotConfig(BotConfig))
import Network.IRC.Client
instance Configured a => Configured [a] where

View File

@ -10,7 +10,7 @@ import Control.Monad
import Control.Monad.Reader
import Control.Monad.State
import Network
import Prelude hiding (log, catch)
import Prelude hiding (log)
import System.IO
import System.Time
import System.Timeout
@ -20,8 +20,10 @@ import Network.IRC.Handlers
import Network.IRC.Protocol
import Network.IRC.Types
oneSec :: Int
oneSec = 1000000
log :: String -> IO ()
log msg = getClockTime >>= \t -> printf "[%s] ** %s\n" (show t) msg
sendCommand :: Bot -> Command -> IO ()
@ -43,10 +45,10 @@ listen = do
case mLine of
Nothing -> return Disconnected
Just line -> do
time <- getClockTime
printf "[%s] %s\n" (show time) line
now <- getClockTime
printf "[%s] %s\n" (show now) line
let message = msgFromLine botConfig time (T.pack line)
let message = msgFromLine botConfig now (T.pack line)
case message of
JoinMsg { .. } | userNick user == nick -> log "Joined" >> return Joined
KickMsg { .. } | kicked == nick -> log "Kicked" >> return Kicked
@ -54,11 +56,15 @@ listen = do
forkIO $ case message of
Ping { .. } -> sendCommand bot $ Pong msg
ModeMsg { user = Self, .. } -> sendCommand bot JoinCmd
msg -> forM_ (handlers botConfig) $ \handler -> forkIO $ do
cmd <- runHandler (getHandler handler) botConfig msg
case cmd of
Nothing -> return ()
Just cmd -> sendCommand bot cmd
msg -> forM_ (handlers botConfig) $ \handlerName -> forkIO $ do
let mHandler = getHandler handlerName
case mHandler of
Nothing -> log $ "No handler found with name: " ++ T.unpack handlerName
Just handler -> do
mCmd <- runHandler handler botConfig msg
case mCmd of
Nothing -> return ()
Just cmd -> sendCommand bot cmd
return status
put nStatus
@ -67,11 +73,11 @@ listen = do
connect :: BotConfig -> IO Bot
connect botConfig@BotConfig { .. } = do
log "Connecting ..."
handle <- connectToWithRetry
hSetBuffering handle LineBuffering
socket <- connectToWithRetry
hSetBuffering socket LineBuffering
hSetBuffering stdout LineBuffering
log "Connected"
return $ Bot botConfig handle
return $ Bot botConfig socket
where
connectToWithRetry = connectTo server (PortNumber (fromIntegral port))
`catch` (\(e :: SomeException) -> do
@ -93,6 +99,7 @@ run botConfig = withSocketsDo $ do
case status of
Disconnected -> log "Connection timed out" >> run botConfig
Errored -> return ()
_ -> error "Unsupported status"
where
run_ = bracket (connect botConfig) disconnect $ \bot ->
go bot `catch` \(e :: SomeException) -> do

View File

@ -10,14 +10,19 @@ import Prelude hiding ((++))
import Network.IRC.Handlers.SongSearch
import Network.IRC.Types
clean :: Text -> Text
clean = toLower . strip
(++) :: Text -> Text -> Text
(++) = append
getHandler :: HandlerName -> Handler
getHandler "greeter" = Handler greeter
getHandler "welcomer" = Handler welcomer
getHandler "songsearch" = Handler songSearch
getHandler :: HandlerName -> Maybe Handler
getHandler "greeter" = Just $ Handler greeter
getHandler "welcomer" = Just $ Handler welcomer
getHandler "songsearch" = Just $ Handler songSearch
getHandler _ = Nothing
greeter :: Monad m => BotConfig -> Message -> m (Maybe Command)
greeter _ ChannelMsg { .. } = case L.find (== clean msg) greetings of
Nothing -> return Nothing
Just greeting -> return . Just . ChannelMsgReply $ greeting ++ " " ++ userNick user
@ -27,6 +32,7 @@ greeter _ ChannelMsg { .. } = case L.find (== clean msg) greetings of
, "ohayo", "oyasumi"]
greeter _ _ = return Nothing
welcomer :: Monad m => BotConfig -> Message -> m (Maybe Command)
welcomer BotConfig { .. } JoinMsg { .. }
| userNick user /= botNick = return . Just . ChannelMsgReply $ "welcome back " ++ userNick user
welcomer _ _ = return Nothing

View File

@ -10,15 +10,12 @@ import Data.Aeson
import Data.Aeson.Types (emptyArray)
import Data.Configurator
import Data.Text
import Data.Text.IO
import Network.Curl.Aeson
import Network.HTTP.Base
import Prelude hiding (putStrLn, drop, lookup)
import Network.IRC.Types
(+++) = append
data Song = NoSong | Song { url :: Text, name :: Text, artist :: Text }
deriving (Show, Eq)
@ -27,7 +24,8 @@ instance FromJSON Song where
parseJSON a | a == emptyArray = return NoSong
parseJSON _ = mzero
songSearch bot@BotConfig { .. } ChannelMsg { .. }
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"
@ -45,4 +43,6 @@ songSearch bot@BotConfig { .. } ChannelMsg { .. }
Song { .. } -> "Listen to " +++ artist +++ " - " +++ name +++ " at " +++ url
NoSong -> "No song found for: " +++ query
| otherwise = return Nothing
where
(+++) = append
songSearch _ _ = return Nothing

View File

@ -10,8 +10,6 @@ import System.Time
import Network.IRC.Types
(++) = append
msgFromLine :: BotConfig -> ClockTime -> Text -> Message
msgFromLine (BotConfig { .. }) time line
| "PING :" `isPrefixOf` line = Ping time . drop 6 $ line
@ -50,3 +48,5 @@ lineFromCommand (BotConfig { .. }) reply = case reply of
JoinCmd -> "JOIN " ++ channel
ChannelMsgReply { .. } -> "PRIVMSG " ++ channel ++ " :" ++ rmsg
PrivMsgReply (User { .. }) rmsg -> "PRIVMSG " ++ botNick ++ " :" ++ rmsg
where
(++) = append

View File

@ -1,11 +1,10 @@
{-# LANGUAGE RecordWildCards, DeriveDataTypeable, RankNTypes, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards, RankNTypes, GeneralizedNewtypeDeriving #-}
module Network.IRC.Types where
import Control.Monad.Reader
import Control.Monad.State
import Data.Configurator.Types
import Data.Dynamic
import Data.Text (Text)
import System.IO
import System.Time
@ -68,5 +67,4 @@ newtype IRC a = IRC { _runIRC :: StateT BotStatus (ReaderT Bot IO) a }
deriving (Functor, Monad, MonadIO, MonadReader Bot, MonadState BotStatus)
runIRC :: Bot -> BotStatus -> IRC a -> IO BotStatus
runIRC bot botStatus irc =
fmap snd $ runReaderT (runStateT (_runIRC irc) Connected) bot
runIRC bot botStatus = flip runReaderT bot . flip execStateT botStatus . _runIRC

View File

@ -58,6 +58,9 @@ library
default-language: Haskell2010
ghc-options: -Wall -fno-warn-unused-do-bind -O2 -funbox-strict-fields
executable hask-irc
-- .hs or .lhs file containing the Main module.
main-is: Main.hs
@ -66,7 +69,7 @@ executable hask-irc
-- other-modules:
-- LANGUAGE extensions used by modules in this package.
other-extensions: RecordWildCards, OverloadedStrings, ScopedTypeVariables
other-extensions: RecordWildCards, OverloadedStrings, ScopedTypeVariables, OverlappingInstances
-- 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,
@ -79,3 +82,5 @@ executable hask-irc
-- Base language which the package is written in.
default-language: Haskell2010
ghc-options: -Wall -fno-warn-unused-do-bind -funbox-strict-fields