Added support for reading configs from file, added songsearch handler
parent
a1d2b86b81
commit
89c0ffefc7
|
@ -3,3 +3,4 @@
|
||||||
.cabal-sandbox
|
.cabal-sandbox
|
||||||
cabal.sandbox.config
|
cabal.sandbox.config
|
||||||
dist
|
dist
|
||||||
|
config.cfg
|
||||||
|
|
30
Main.hs
30
Main.hs
|
@ -1,24 +1,38 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings, OverlappingInstances #-}
|
||||||
|
|
||||||
module Main (main) where
|
module Main (main) where
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
|
||||||
|
import qualified Data.Configurator as C
|
||||||
|
import Data.Configurator.Types
|
||||||
|
|
||||||
|
import Data.Maybe
|
||||||
import System.Environment
|
import System.Environment
|
||||||
import System.Exit
|
import System.Exit
|
||||||
|
|
||||||
import Network.IRC.Types
|
import Network.IRC.Types
|
||||||
import Network.IRC.Client
|
import Network.IRC.Client
|
||||||
|
|
||||||
|
instance Configured a => Configured [a] where
|
||||||
|
convert (List xs) = Just . mapMaybe convert $ xs
|
||||||
|
convert _ = Nothing
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
args <- getArgs
|
args <- getArgs
|
||||||
prog <- getProgName
|
prog <- getProgName
|
||||||
|
|
||||||
let server = args !! 0
|
let configFile = head args
|
||||||
let port = read (args !! 1)
|
cfg <- C.load [C.Required configFile]
|
||||||
let channel = T.pack $ args !! 2
|
|
||||||
let botNick = T.pack $ args !! 3
|
|
||||||
let handlers = map T.pack ["greeter", "welcomer"]
|
|
||||||
|
|
||||||
if length args < 4
|
server <- C.require cfg "server"
|
||||||
then putStrLn ("Usage: " ++ prog ++ " <server> <port> <channel> <nick>") >> exitFailure
|
port <- C.require cfg "port"
|
||||||
else run $ BotConfig server port channel botNick 180 handlers
|
channel <- C.require cfg "channel"
|
||||||
|
botNick <- C.require cfg "nick"
|
||||||
|
timeout <- C.require cfg "timeout"
|
||||||
|
handlers <- C.require cfg "handlers"
|
||||||
|
|
||||||
|
if length args < 1
|
||||||
|
then putStrLn ("Usage: " ++ prog ++ " <config file path>") >> exitFailure
|
||||||
|
else run $ BotConfig server port channel botNick timeout handlers cfg
|
||||||
|
|
|
@ -89,6 +89,8 @@ disconnect bot = do
|
||||||
|
|
||||||
run :: BotConfig -> IO ()
|
run :: BotConfig -> IO ()
|
||||||
run botConfig = withSocketsDo $ do
|
run botConfig = withSocketsDo $ do
|
||||||
|
log "Running with config:"
|
||||||
|
print botConfig
|
||||||
status <- run_
|
status <- run_
|
||||||
case status of
|
case status of
|
||||||
Disconnected -> log "Connection timed out" >> run botConfig
|
Disconnected -> log "Connection timed out" >> run botConfig
|
||||||
|
|
|
@ -7,14 +7,16 @@ import qualified Data.List as L
|
||||||
import Data.Text
|
import Data.Text
|
||||||
import Prelude hiding ((++))
|
import Prelude hiding ((++))
|
||||||
|
|
||||||
import Network.IRC.Protocol
|
import Network.IRC.Handlers.SongSearch
|
||||||
import Network.IRC.Types
|
import Network.IRC.Types
|
||||||
|
|
||||||
|
clean = toLower . strip
|
||||||
(++) = append
|
(++) = append
|
||||||
|
|
||||||
handleMessage :: HandlerName -> Handler
|
handleMessage :: HandlerName -> Handler
|
||||||
handleMessage "greeter" = greeter
|
handleMessage "greeter" = greeter
|
||||||
handleMessage "welcomer" = welcomer
|
handleMessage "welcomer" = welcomer
|
||||||
|
handleMessage "songsearch" = songSearch
|
||||||
|
|
||||||
greeter bot ChannelMsg { .. } = case L.find (== clean msg) greetings of
|
greeter bot ChannelMsg { .. } = case L.find (== clean msg) greetings of
|
||||||
Nothing -> return Nothing
|
Nothing -> return Nothing
|
||||||
|
@ -24,7 +26,6 @@ greeter bot ChannelMsg { .. } = case L.find (== clean msg) greetings of
|
||||||
, "good morning", "good evening", "good night"
|
, "good morning", "good evening", "good night"
|
||||||
, "ohayo", "oyasumi"]
|
, "ohayo", "oyasumi"]
|
||||||
|
|
||||||
clean = toLower . strip
|
|
||||||
greeter _ _ = return Nothing
|
greeter _ _ = return Nothing
|
||||||
|
|
||||||
welcomer bot@BotConfig { .. } JoinMsg { .. }
|
welcomer bot@BotConfig { .. } JoinMsg { .. }
|
||||||
|
|
|
@ -0,0 +1,45 @@
|
||||||
|
{-# LANGUAGE RecordWildCards, OverloadedStrings, ScopedTypeVariables, BangPatterns #-}
|
||||||
|
|
||||||
|
module Network.IRC.Handlers.SongSearch (songSearch) where
|
||||||
|
|
||||||
|
import qualified Data.Configurator as C
|
||||||
|
|
||||||
|
import Control.Applicative
|
||||||
|
import Control.Exception
|
||||||
|
import Control.Monad
|
||||||
|
import Data.Aeson
|
||||||
|
import Data.Aeson.Types (emptyArray)
|
||||||
|
import Data.Text
|
||||||
|
import Data.Text.IO
|
||||||
|
import Network.Curl.Aeson
|
||||||
|
import Network.HTTP.Base
|
||||||
|
import Prelude hiding (putStrLn, drop)
|
||||||
|
|
||||||
|
import Network.IRC.Types
|
||||||
|
|
||||||
|
(+++) = append
|
||||||
|
|
||||||
|
data Song = NoSong | Song { url :: Text, name :: Text, artist :: Text }
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
|
instance FromJSON Song where
|
||||||
|
parseJSON (Object o) = Song <$> o .: "Url" <*> o .: "SongName" <*> o .: "ArtistName"
|
||||||
|
parseJSON a | a == emptyArray = return NoSong
|
||||||
|
parseJSON _ = mzero
|
||||||
|
|
||||||
|
songSearch bot@BotConfig { .. } ChannelMsg { .. }
|
||||||
|
| "!m " `isPrefixOf` msg = do
|
||||||
|
let query = strip . drop 3 $ msg
|
||||||
|
apiKey <- C.require config "songsearch.tinysong_apikey"
|
||||||
|
let apiUrl = "http://tinysong.com/b/" ++ urlEncode (unpack query)
|
||||||
|
++ "?format=json&key=" ++ apiKey
|
||||||
|
|
||||||
|
result <- try $ curlAesonGet apiUrl >>= evaluate
|
||||||
|
|
||||||
|
return . Just . ChannelMsgReply $ case result of
|
||||||
|
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
|
||||||
|
| otherwise = return Nothing
|
||||||
|
songSearch _ _ = return Nothing
|
|
@ -1,6 +1,9 @@
|
||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
|
||||||
module Network.IRC.Types where
|
module Network.IRC.Types where
|
||||||
|
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
|
import Data.Configurator.Types
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import System.IO
|
import System.IO
|
||||||
import System.Time
|
import System.Time
|
||||||
|
@ -40,8 +43,17 @@ data BotConfig = BotConfig { server :: String
|
||||||
, channel :: Text
|
, channel :: Text
|
||||||
, botNick :: Text
|
, botNick :: Text
|
||||||
, botTimeout :: Int
|
, botTimeout :: Int
|
||||||
, handlers :: [HandlerName] }
|
, handlers :: [HandlerName]
|
||||||
deriving (Show, Eq)
|
, config :: Config }
|
||||||
data Bot = Bot { botConfig :: BotConfig, socket :: Handle } deriving (Show, Eq)
|
|
||||||
|
instance Show BotConfig where
|
||||||
|
show BotConfig { .. } = "server = " ++ show server ++ "\n" ++
|
||||||
|
"port = " ++ show port ++ "\n" ++
|
||||||
|
"channel = " ++ show channel ++ "\n" ++
|
||||||
|
"nick = " ++ show botNick ++ "\n" ++
|
||||||
|
"timeout = " ++ show botTimeout ++ "\n" ++
|
||||||
|
"handlers = " ++ show handlers ++ "\n"
|
||||||
|
|
||||||
|
data Bot = Bot { botConfig :: BotConfig, socket :: Handle } deriving (Show)
|
||||||
|
|
||||||
type IRC = ReaderT Bot IO
|
type IRC = ReaderT Bot IO
|
||||||
|
|
|
@ -0,0 +1,9 @@
|
||||||
|
server = "irc.freenode.net"
|
||||||
|
port = 6667
|
||||||
|
channel = "#testtesttest"
|
||||||
|
nick = "haskman"
|
||||||
|
handlers = ["greeter", "welcomer"]
|
||||||
|
|
||||||
|
songsearch {
|
||||||
|
tinysong_apikey = "xxxyyyzzz"
|
||||||
|
}
|
|
@ -60,8 +60,9 @@ executable hask-irc
|
||||||
other-extensions: RecordWildCards, OverloadedStrings, ScopedTypeVariables
|
other-extensions: RecordWildCards, OverloadedStrings, ScopedTypeVariables
|
||||||
|
|
||||||
-- Other library packages from which modules are imported.
|
-- Other library packages from which modules are imported.
|
||||||
build-depends: base >=4.6 && <4.7, text >=0.11 && <0.12, mtl >=2.1 && <2.2,
|
build-depends: base >=4.5 && <4.7, text >=0.11 && <0.12, mtl >=2.1 && <2.2,
|
||||||
network >=2.4 && <2.5, old-time >=1.1 && <1.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
|
||||||
|
|
||||||
-- Directories containing source files.
|
-- Directories containing source files.
|
||||||
-- hs-source-dirs:
|
-- hs-source-dirs:
|
||||||
|
|
Loading…
Reference in New Issue