diff options
| -rw-r--r-- | Hirc/Parser.hs | 4 | ||||
| -rw-r--r-- | Hirc/Types.hs | 12 | ||||
| -rw-r--r-- | hirc.hs | 31 |
3 files changed, 26 insertions, 21 deletions
diff --git a/Hirc/Parser.hs b/Hirc/Parser.hs index 2cb2451..ef34270 100644 --- a/Hirc/Parser.hs +++ b/Hirc/Parser.hs @@ -7,7 +7,7 @@ import Text.Parsec.String message :: Parser Message message = - Message <$> optionMaybe (char ':' *> prefix) <* spaces1 <*> command <*> params + Message <$> optionMaybe (char ':' *> prefix <* spaces1) <*> command <*> params where spaces1 = skipMany1 space prefix = Prefix <$> nick @@ -16,7 +16,7 @@ message = nick = many1 (noneOf " !@") user = many1 (noneOf " !@") host = many1 (noneOf " !@") - command = UnknownCommand <$> many1 nonspace + command = many1 nonspace params = many1 (spaces1 *> (trailing <|> middle)) trailing = char ':' *> many1 anyChar middle = many1 nonspace diff --git a/Hirc/Types.hs b/Hirc/Types.hs index 1bb258c..2567b53 100644 --- a/Hirc/Types.hs +++ b/Hirc/Types.hs @@ -1,5 +1,9 @@ module Hirc.Types where +type Command = String +type Param = String +type Receiver = String + data Message = Message { m_prefix :: Maybe Prefix, @@ -8,8 +12,6 @@ data Message = } deriving Show -type Param = String - data Prefix = Prefix { p_name :: String, @@ -18,9 +20,3 @@ data Prefix = } deriving Show -data Command = - PRIVMSG Receiver [Receiver] String | - UnknownCommand String - deriving Show - -type Receiver = String @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} import Data.List import Data.Monoid import Network @@ -15,6 +16,8 @@ server = "irc.freenode.org" port = 6667 chan = "#hirc-testing" nick = "hirc" + +filename = server <> (':' : show port) -- The 'Net' monad, a wrapper over IO, carrying the bot's immutable state. type Net = ReaderT Bot IO @@ -45,7 +48,6 @@ run :: Net () run = do write "NICK" nick write "USER" (nick++" 0 * :hirc bot") - write "JOIN" chan asks socket >>= listen -- Process each line from the server @@ -53,20 +55,27 @@ listen :: Handle -> Net () listen h = forever $ do s <- init `fmap` io (hGetLine h) io (putStrLn s) - io (putStrLn $ show $ parse P.message filename s) - if ping s then pong s else eval (clean s) + case parse P.message filename s of + Right m -> eval m + x -> io $ putStrLn $ show x where forever a = a >> forever a - clean = drop 1 . dropWhile (/= ':') . drop 1 - ping x = "PING :" `isPrefixOf` x - pong x = write "PONG" (':' : drop 6 x) - filename = server <> (':' : show port) -- Dispatch a command -eval :: String -> Net () -eval "!quit" = write "QUIT" ":Exiting" >> io (exitWith ExitSuccess) -eval x | "!id " `isPrefixOf` x = privmsg (drop 4 x) -eval _ = return () -- ignore everything else +eval :: Message -> Net () +eval = \case + Message _ "PING" [x] -> + write "PONG" (':' : x) + Message _ "376" _ -> -- End of /MOTD command. + write "JOIN" chan + Message _ "PRIVMSG" [chan, "!quit"] -> do + write "QUIT" ":Exiting" + io (exitWith ExitSuccess) + Message _ "PRIVMSG" [chan, x] | "!id " `isPrefixOf` x -> do + privmsg (drop 4 x) + m -> do + io (putStrLn $ show m) + return () -- ignore everything else -- Send a privmsg to the current chan + server privmsg :: String -> Net () |