{-# LANGUAGE PatternGuards, FlexibleContexts #-}
-- | Lambdabot base module. Controls message send and receive
module Lambdabot.Plugin.Core.Base (basePlugin) where

import Lambdabot.Bot
import Lambdabot.Command
import Lambdabot.Config.Core
import Lambdabot.IRC
import Lambdabot.Logging
import Lambdabot.Message
import Lambdabot.Module
import Lambdabot.Monad
import Lambdabot.Nick
import Lambdabot.Plugin
import Lambdabot.Util

import Control.Applicative
import Control.Exception.Lifted as E
import Control.Monad
import Control.Monad.Reader
import Control.Monad.State
import Data.Char
import Data.List
import Data.List.Split
import qualified Data.Map as M
import Text.EditDistance
import Text.Regex.TDFA

type BaseState = GlobalPrivate () ()
type Base = ModuleT BaseState LB

basePlugin :: Module (GlobalPrivate () ())
basePlugin :: Module BaseState
basePlugin = Module BaseState
forall st. Module st
newModule
    { moduleDefState = return $ mkGlobalPrivate 20 ()
    , moduleInit = do
        registerOutputFilter cleanOutput
        registerOutputFilter lineify
        registerOutputFilter cleanOutput
        
        registerCallback "PING"    doPING
        registerCallback "NOTICE"  doNOTICE
        registerCallback "PART"    doPART
        registerCallback "KICK"    doKICK
        registerCallback "JOIN"    doJOIN
        registerCallback "NICK"    doNICK
        registerCallback "MODE"    doMODE
        registerCallback "TOPIC"   doTOPIC
        registerCallback "QUIT"    doQUIT
        registerCallback "PRIVMSG" doPRIVMSG
        registerCallback "001"     doRPL_WELCOME
        
        -- registerCallback "002"     doRPL_YOURHOST
        -- registerCallback "003"     doRPL_CREATED
        -- registerCallback "004"     doRPL_MYINFO
        
        registerCallback "005"     doRPL_BOUNCE
        
        -- registerCallback "250"     doRPL_STATSCONN
        -- registerCallback "251"     doRPL_LUSERCLIENT
        -- registerCallback "252"     doRPL_LUSEROP
        -- registerCallback "253"     doRPL_LUSERUNKNOWN
        -- registerCallback "254"     doRPL_LUSERCHANNELS
        -- registerCallback "255"     doRPL_LUSERME
        -- registerCallback "265"     doRPL_LOCALUSERS
        -- registerCallback "266"     doRPL_GLOBALUSERS
        
        registerCallback "332"     doRPL_TOPIC
        
        -- registerCallback "353"     doRPL_NAMRELY
        -- registerCallback "366"     doRPL_ENDOFNAMES
        -- registerCallback "372"     doRPL_MOTD
        -- registerCallback "375"     doRPL_MOTDSTART
        -- registerCallback "376"     doRPL_ENDOFMOTD
    }

doIGNORE :: IrcMessage -> Base ()
doIGNORE :: Callback BaseState
doIGNORE = [Char] -> ModuleT BaseState LB ()
forall (m :: * -> *). MonadLogging m => [Char] -> m ()
debugM ([Char] -> ModuleT BaseState LB ())
-> (IrcMessage -> [Char]) -> Callback BaseState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IrcMessage -> [Char]
forall a. Show a => a -> [Char]
show

doPING :: IrcMessage -> Base ()
doPING :: Callback BaseState
doPING = [Char] -> ModuleT BaseState LB ()
forall (m :: * -> *). MonadLogging m => [Char] -> m ()
noticeM ([Char] -> ModuleT BaseState LB ())
-> (IrcMessage -> [Char]) -> Callback BaseState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IrcMessage -> [Char]
showPingMsg
    where showPingMsg :: IrcMessage -> [Char]
showPingMsg IrcMessage
msg = [Char]
"PING! <" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ IrcMessage -> [Char]
ircMsgServer IrcMessage
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Char
':' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: IrcMessage -> [Char]
ircMsgPrefix IrcMessage
msg) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            [Char]
"> [" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ IrcMessage -> [Char]
ircMsgCommand IrcMessage
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"] " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall a. Show a => a -> [Char]
show (IrcMessage -> [[Char]]
ircMsgParams IrcMessage
msg)

-- If this is a "TIME" then we need to pass it over to the localtime plugin
-- otherwise, dump it to stdout
doNOTICE :: IrcMessage -> Base ()
doNOTICE :: Callback BaseState
doNOTICE IrcMessage
msg
    | Bool
isCTCPTimeReply   = Callback BaseState
doPRIVMSG (IrcMessage -> IrcMessage
timeReply IrcMessage
msg)
        -- TODO: need to say which module to run the privmsg in
    | Bool
otherwise         = [Char] -> ModuleT BaseState LB ()
forall (m :: * -> *). MonadLogging m => [Char] -> m ()
noticeM ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
body)
    where
        body :: [[Char]]
body = IrcMessage -> [[Char]]
ircMsgParams IrcMessage
msg
        isCTCPTimeReply :: Bool
isCTCPTimeReply = [Char]
":\SOHTIME" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` ([[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
last [[Char]]
body)

doJOIN :: IrcMessage -> Base ()
doJOIN :: Callback BaseState
doJOIN IrcMessage
msg 
    | IrcMessage -> Nick
forall a. Message a => a -> Nick
lambdabotName IrcMessage
msg Nick -> Nick -> Bool
forall a. Eq a => a -> a -> Bool
/= IrcMessage -> Nick
forall a. Message a => a -> Nick
nick IrcMessage
msg = Callback BaseState
doIGNORE IrcMessage
msg
    | Bool
otherwise                     = do
        let msgArg :: [Char]
msgArg  = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
take Int
1 (IrcMessage -> [[Char]]
ircMsgParams IrcMessage
msg))
            chan :: [Char]
chan    = case (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') [Char]
msgArg of
                []      -> [Char]
msgArg
                [Char]
aloc    -> [Char]
aloc
            loc :: Nick
loc = [Char] -> [Char] -> Nick
Nick (IrcMessage -> [Char]
forall a. Message a => a -> [Char]
server IrcMessage
msg) ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') [Char]
chan)
        
        -- the empty topic causes problems
        -- TODO: find out what they are and fix them properly
        LB () -> ModuleT BaseState LB ()
forall a. LB a -> ModuleT BaseState LB a
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> ModuleT BaseState LB ())
-> ((IRCRWState -> IRCRWState) -> LB ())
-> (IRCRWState -> IRCRWState)
-> ModuleT BaseState LB ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IRCRWState -> IRCRWState) -> LB ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((IRCRWState -> IRCRWState) -> ModuleT BaseState LB ())
-> (IRCRWState -> IRCRWState) -> ModuleT BaseState LB ()
forall a b. (a -> b) -> a -> b
$ \IRCRWState
s -> IRCRWState
s
            { ircChannels = M.insert  (mkCN loc) "[currently unknown]" (ircChannels s)}
        LB () -> ModuleT BaseState LB ()
forall a. LB a -> ModuleT BaseState LB a
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> ModuleT BaseState LB ())
-> (IrcMessage -> LB ()) -> Callback BaseState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IrcMessage -> LB ()
send Callback BaseState -> Callback BaseState
forall a b. (a -> b) -> a -> b
$ Nick -> IrcMessage
getTopic Nick
loc -- initialize topic
   where 

doPART :: IrcMessage -> Base ()
doPART :: Callback BaseState
doPART IrcMessage
msg
  = Bool -> ModuleT BaseState LB () -> ModuleT BaseState LB ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IrcMessage -> Nick
forall a. Message a => a -> Nick
lambdabotName IrcMessage
msg Nick -> Nick -> Bool
forall a. Eq a => a -> a -> Bool
== IrcMessage -> Nick
forall a. Message a => a -> Nick
nick IrcMessage
msg) (ModuleT BaseState LB () -> ModuleT BaseState LB ())
-> ModuleT BaseState LB () -> ModuleT BaseState LB ()
forall a b. (a -> b) -> a -> b
$ do
        let body :: [[Char]]
body = IrcMessage -> [[Char]]
ircMsgParams IrcMessage
msg
            loc :: Nick
loc = [Char] -> [Char] -> Nick
Nick (IrcMessage -> [Char]
forall a. Message a => a -> [Char]
server IrcMessage
msg) ([[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
body)
        LB () -> ModuleT BaseState LB ()
forall a. LB a -> ModuleT BaseState LB a
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> ModuleT BaseState LB ())
-> ((IRCRWState -> IRCRWState) -> LB ())
-> (IRCRWState -> IRCRWState)
-> ModuleT BaseState LB ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IRCRWState -> IRCRWState) -> LB ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((IRCRWState -> IRCRWState) -> ModuleT BaseState LB ())
-> (IRCRWState -> IRCRWState) -> ModuleT BaseState LB ()
forall a b. (a -> b) -> a -> b
$ \IRCRWState
s -> IRCRWState
s
            { ircChannels = M.delete (mkCN loc) (ircChannels s) }

doKICK :: IrcMessage -> Base ()
doKICK :: Callback BaseState
doKICK IrcMessage
msg
   = do let body :: [[Char]]
body = IrcMessage -> [[Char]]
ircMsgParams IrcMessage
msg
            loc :: Nick
loc = [Char] -> [Char] -> Nick
Nick (IrcMessage -> [Char]
forall a. Message a => a -> [Char]
server IrcMessage
msg) ([[Char]]
body [[Char]] -> Int -> [Char]
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
            who :: Nick
who = [Char] -> [Char] -> Nick
Nick (IrcMessage -> [Char]
forall a. Message a => a -> [Char]
server IrcMessage
msg) ([[Char]]
body [[Char]] -> Int -> [Char]
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)
        Bool -> ModuleT BaseState LB () -> ModuleT BaseState LB ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IrcMessage -> Nick
forall a. Message a => a -> Nick
lambdabotName IrcMessage
msg Nick -> Nick -> Bool
forall a. Eq a => a -> a -> Bool
== Nick
who) (ModuleT BaseState LB () -> ModuleT BaseState LB ())
-> ModuleT BaseState LB () -> ModuleT BaseState LB ()
forall a b. (a -> b) -> a -> b
$ do
            [Char] -> ModuleT BaseState LB ()
forall (m :: * -> *). MonadLogging m => [Char] -> m ()
noticeM ([Char] -> ModuleT BaseState LB ())
-> [Char] -> ModuleT BaseState LB ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Nick -> [Char]
fmtNick [Char]
"" (IrcMessage -> Nick
forall a. Message a => a -> Nick
nick IrcMessage
msg) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" KICK " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> Nick -> [Char]
fmtNick (IrcMessage -> [Char]
forall a. Message a => a -> [Char]
server IrcMessage
msg) Nick
loc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop Int
2 [[Char]]
body)
            LB () -> ModuleT BaseState LB ()
forall (m :: * -> *) a. Monad m => m a -> ModuleT BaseState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LB () -> ModuleT BaseState LB ())
-> LB () -> ModuleT BaseState LB ()
forall a b. (a -> b) -> a -> b
$ (IRCRWState -> IRCRWState) -> LB ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((IRCRWState -> IRCRWState) -> LB ())
-> (IRCRWState -> IRCRWState) -> LB ()
forall a b. (a -> b) -> a -> b
$ \IRCRWState
s ->
                IRCRWState
s { ircChannels = M.delete (mkCN loc) (ircChannels s) }

doNICK :: IrcMessage -> Base ()
doNICK :: Callback BaseState
doNICK IrcMessage
msg
  = Callback BaseState
doIGNORE IrcMessage
msg

doMODE :: IrcMessage -> Base ()
doMODE :: Callback BaseState
doMODE IrcMessage
msg
  = Callback BaseState
doIGNORE IrcMessage
msg


doTOPIC :: IrcMessage -> Base ()
doTOPIC :: Callback BaseState
doTOPIC IrcMessage
msg = LB () -> ModuleT BaseState LB ()
forall a. LB a -> ModuleT BaseState LB a
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> ModuleT BaseState LB ())
-> ((IRCRWState -> IRCRWState) -> LB ())
-> (IRCRWState -> IRCRWState)
-> ModuleT BaseState LB ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IRCRWState -> IRCRWState) -> LB ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((IRCRWState -> IRCRWState) -> ModuleT BaseState LB ())
-> (IRCRWState -> IRCRWState) -> ModuleT BaseState LB ()
forall a b. (a -> b) -> a -> b
$ \IRCRWState
s -> IRCRWState
s
    { ircChannels = M.insert (mkCN loc) (tail $ head $ tail $ ircMsgParams msg) (ircChannels s) }
    where loc :: Nick
loc = [Char] -> [Char] -> Nick
Nick (IrcMessage -> [Char]
forall a. Message a => a -> [Char]
server IrcMessage
msg) ([[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head (IrcMessage -> [[Char]]
ircMsgParams IrcMessage
msg))

doRPL_WELCOME :: IrcMessage -> Base ()
doRPL_WELCOME :: Callback BaseState
doRPL_WELCOME IrcMessage
msg = LB () -> ModuleT BaseState LB ()
forall a. LB a -> ModuleT BaseState LB a
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> ModuleT BaseState LB ())
-> LB () -> ModuleT BaseState LB ()
forall a b. (a -> b) -> a -> b
$ do
    (IRCRWState -> IRCRWState) -> LB ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((IRCRWState -> IRCRWState) -> LB ())
-> (IRCRWState -> IRCRWState) -> LB ()
forall a b. (a -> b) -> a -> b
$ \IRCRWState
state' -> 
        let persists :: Map [Char] Bool
persists = if Bool -> [Char] -> Map [Char] Bool -> Bool
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Bool
True (IrcMessage -> [Char]
forall a. Message a => a -> [Char]
server IrcMessage
msg) (IRCRWState -> Map [Char] Bool
ircPersists IRCRWState
state')
                then IRCRWState -> Map [Char] Bool
ircPersists IRCRWState
state'
                else [Char] -> Map [Char] Bool -> Map [Char] Bool
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (IrcMessage -> [Char]
forall a. Message a => a -> [Char]
server IrcMessage
msg) (Map [Char] Bool -> Map [Char] Bool)
-> Map [Char] Bool -> Map [Char] Bool
forall a b. (a -> b) -> a -> b
$ IRCRWState -> Map [Char] Bool
ircPersists IRCRWState
state'
         in IRCRWState
state' { ircPersists = persists }
    Map ChanName [Char]
chans <- (IRCRWState -> Map ChanName [Char]) -> LB (Map ChanName [Char])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets IRCRWState -> Map ChanName [Char]
ircChannels
    [ChanName] -> (ChanName -> LB ()) -> LB ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map ChanName [Char] -> [ChanName]
forall k a. Map k a -> [k]
M.keys Map ChanName [Char]
chans) ((ChanName -> LB ()) -> LB ()) -> (ChanName -> LB ()) -> LB ()
forall a b. (a -> b) -> a -> b
$ \ChanName
chan -> do
        let cn :: Nick
cn = ChanName -> Nick
getCN ChanName
chan
        Bool -> LB () -> LB ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Nick -> [Char]
nTag Nick
cn [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== IrcMessage -> [Char]
forall a. Message a => a -> [Char]
server IrcMessage
msg) (LB () -> LB ()) -> LB () -> LB ()
forall a b. (a -> b) -> a -> b
$ do
            (IRCRWState -> IRCRWState) -> LB ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((IRCRWState -> IRCRWState) -> LB ())
-> (IRCRWState -> IRCRWState) -> LB ()
forall a b. (a -> b) -> a -> b
$ \IRCRWState
state' -> IRCRWState
state' { ircChannels = M.delete chan $ ircChannels state' }
            LB () -> LB ()
forall a. LB a -> LB a
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> LB ()) -> LB () -> LB ()
forall a b. (a -> b) -> a -> b
$ IrcMessage -> LB ()
send (IrcMessage -> LB ()) -> IrcMessage -> LB ()
forall a b. (a -> b) -> a -> b
$ Nick -> IrcMessage
joinChannel Nick
cn

doQUIT :: IrcMessage -> Base ()
doQUIT :: Callback BaseState
doQUIT IrcMessage
msg = Callback BaseState
doIGNORE IrcMessage
msg

doRPL_BOUNCE :: IrcMessage -> Base ()
doRPL_BOUNCE :: Callback BaseState
doRPL_BOUNCE IrcMessage
_msg = [Char] -> ModuleT BaseState LB ()
forall (m :: * -> *). MonadLogging m => [Char] -> m ()
debugM [Char]
"BOUNCE!"

doRPL_TOPIC :: IrcMessage -> Base ()
doRPL_TOPIC :: Callback BaseState
doRPL_TOPIC IrcMessage
msg -- nearly the same as doTOPIC but has our nick on the front of body
    = do let body :: [[Char]]
body = IrcMessage -> [[Char]]
ircMsgParams IrcMessage
msg
             loc :: Nick
loc = [Char] -> [Char] -> Nick
Nick (IrcMessage -> [Char]
forall a. Message a => a -> [Char]
server IrcMessage
msg) ([[Char]]
body [[Char]] -> Int -> [Char]
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)
         LB () -> ModuleT BaseState LB ()
forall a. LB a -> ModuleT BaseState LB a
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> ModuleT BaseState LB ())
-> ((IRCRWState -> IRCRWState) -> LB ())
-> (IRCRWState -> IRCRWState)
-> ModuleT BaseState LB ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IRCRWState -> IRCRWState) -> LB ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((IRCRWState -> IRCRWState) -> ModuleT BaseState LB ())
-> (IRCRWState -> IRCRWState) -> ModuleT BaseState LB ()
forall a b. (a -> b) -> a -> b
$ \IRCRWState
s -> IRCRWState
s
            { ircChannels = M.insert (mkCN loc) (tail $ last body) (ircChannels s) }

doPRIVMSG :: IrcMessage -> Base ()
doPRIVMSG :: Callback BaseState
doPRIVMSG IrcMessage
msg = do
    Bool
ignored     <- LB Bool -> ModuleT BaseState LB Bool
forall (m :: * -> *) a. Monad m => m a -> ModuleT BaseState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LB Bool -> ModuleT BaseState LB Bool)
-> LB Bool -> ModuleT BaseState LB Bool
forall a b. (a -> b) -> a -> b
$ IrcMessage -> LB Bool
checkIgnore IrcMessage
msg
    [[Char]]
commands    <- Config [[Char]] -> ModuleT BaseState LB [[Char]]
forall a. Config a -> ModuleT BaseState LB a
forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config [[Char]]
commandPrefixes
    
    if Bool
ignored
        then Callback BaseState
doIGNORE IrcMessage
msg
        else (Nick -> ModuleT BaseState LB ())
-> [Nick] -> ModuleT BaseState LB ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([[Char]] -> Nick -> IrcMessage -> Nick -> ModuleT BaseState LB ()
doPRIVMSG' [[Char]]
commands (IrcMessage -> Nick
forall a. Message a => a -> Nick
lambdabotName IrcMessage
msg) IrcMessage
msg) [Nick]
targets
    where
        alltargets :: [Char]
alltargets = [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head (IrcMessage -> [[Char]]
ircMsgParams IrcMessage
msg)
        targets :: [Nick]
targets = ([Char] -> Nick) -> [[Char]] -> [Nick]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char] -> Nick
parseNick (IrcMessage -> [Char]
ircMsgServer IrcMessage
msg)) ([[Char]] -> [Nick]) -> [[Char]] -> [Nick]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
"," [Char]
alltargets

--
-- | What does the bot respond to?
--
doPRIVMSG' :: [String] -> Nick -> IrcMessage -> Nick -> Base ()
doPRIVMSG' :: [[Char]] -> Nick -> IrcMessage -> Nick -> ModuleT BaseState LB ()
doPRIVMSG' [[Char]]
commands Nick
myname IrcMessage
msg Nick
target
    | Nick
myname Nick -> Nick -> Bool
forall a. Eq a => a -> a -> Bool
== Nick
target
    = let ([Char]
cmd, [Char]
params) = [Char] -> ([Char], [Char])
splitFirstWord [Char]
text
      in [[Char]]
-> IrcMessage
-> Nick
-> [Char]
-> [Char]
-> [Char]
-> ModuleT BaseState LB ()
doPersonalMsg [[Char]]
commands IrcMessage
msg Nick
target [Char]
text [Char]
cmd [Char]
params
    
    | ((Char -> Bool) -> [Char] -> Bool)
-> [Char] -> (Char -> Bool) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [Char]
":," ((Char -> Bool) -> Bool) -> (Char -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \Char
c -> ([Char] -> Nick -> [Char]
fmtNick (IrcMessage -> [Char]
ircMsgServer IrcMessage
msg) Nick
myname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
c]) [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
text
    = let Just [Char]
wholeCmd = [Char] -> [Char] -> Maybe [Char]
maybeCommand ([Char] -> Nick -> [Char]
fmtNick (IrcMessage -> [Char]
ircMsgServer IrcMessage
msg) Nick
myname) [Char]
text
          ([Char]
cmd, [Char]
params) = [Char] -> ([Char], [Char])
splitFirstWord [Char]
wholeCmd
      in [[Char]]
-> IrcMessage
-> Nick
-> [Char]
-> [Char]
-> ModuleT BaseState LB ()
doPublicMsg [[Char]]
commands IrcMessage
msg Nick
target [Char]
cmd [Char]
params
    
    | ([[Char]]
commands [[Char]] -> [Char] -> Bool
`arePrefixesOf` [Char]
text)
    Bool -> Bool -> Bool
&& [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
text Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
    Bool -> Bool -> Bool
&& ([Char]
text [Char] -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! Int
1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') -- elem of prefixes
    Bool -> Bool -> Bool
&& (Bool -> Bool
not ([[Char]]
commands [[Char]] -> [Char] -> Bool
`arePrefixesOf` [[Char]
text [Char] -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! Int
1]) Bool -> Bool -> Bool
||
      ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
text Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 Bool -> Bool -> Bool
&& [Char]
text [Char] -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! Int
2 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')) -- ignore @@ prefix, but not the @@ command itself
    = let ([Char]
cmd, [Char]
params) = [Char] -> ([Char], [Char])
splitFirstWord ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') [Char]
text)
      in [[Char]]
-> IrcMessage
-> Nick
-> [Char]
-> [Char]
-> ModuleT BaseState LB ()
doPublicMsg [[Char]]
commands IrcMessage
msg Nick
target [Char]
cmd [Char]
params
    
    | Bool
otherwise =  IrcMessage -> Nick -> Nick -> [Char] -> ModuleT BaseState LB ()
doContextualMsg IrcMessage
msg Nick
target Nick
target [Char]
text
    
    where
        text :: [Char]
text = [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
tail ([[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head ([[Char]] -> [[Char]]
forall a. HasCallStack => [a] -> [a]
tail (IrcMessage -> [[Char]]
ircMsgParams IrcMessage
msg)))

doPersonalMsg :: [String] -> IrcMessage -> Nick -> String -> String -> String -> Base ()
doPersonalMsg :: [[Char]]
-> IrcMessage
-> Nick
-> [Char]
-> [Char]
-> [Char]
-> ModuleT BaseState LB ()
doPersonalMsg [[Char]]
commands IrcMessage
msg Nick
target [Char]
text [Char]
s [Char]
r
    | [[Char]]
commands [[Char]] -> [Char] -> Bool
`arePrefixesOf` [Char]
s  = IrcMessage -> [Char] -> [Char] -> Nick -> ModuleT BaseState LB ()
doMsg IrcMessage
msg ([Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
tail [Char]
s) [Char]
r Nick
who
    | Bool
otherwise                   = IrcMessage -> Nick -> Nick -> [Char] -> ModuleT BaseState LB ()
doContextualMsg IrcMessage
msg Nick
target Nick
who [Char]
text
    where
      who :: Nick
who = IrcMessage -> Nick
forall a. Message a => a -> Nick
nick IrcMessage
msg

doPublicMsg :: [String] -> IrcMessage -> Nick -> String -> String -> Base ()
doPublicMsg :: [[Char]]
-> IrcMessage
-> Nick
-> [Char]
-> [Char]
-> ModuleT BaseState LB ()
doPublicMsg [[Char]]
commands IrcMessage
msg Nick
target [Char]
s [Char]
r
    | [[Char]]
commands [[Char]] -> [Char] -> Bool
`arePrefixesOf` [Char]
s  = IrcMessage -> [Char] -> [Char] -> Nick -> ModuleT BaseState LB ()
doMsg IrcMessage
msg ([Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
tail [Char]
s) [Char]
r Nick
target
    | Bool
otherwise                   = Callback BaseState
doIGNORE IrcMessage
msg

--
-- normal commands.
--
-- check privledges, do any spell correction, dispatch, handling
-- possible timeouts.
--
-- todo, refactor
--
doMsg :: IrcMessage -> String -> String -> Nick -> Base ()
doMsg :: IrcMessage -> [Char] -> [Char] -> Nick -> ModuleT BaseState LB ()
doMsg IrcMessage
msg [Char]
cmd [Char]
rest Nick
towhere = do
    let ircmsg :: [Char] -> LB ()
ircmsg = Nick -> [Char] -> LB ()
ircPrivmsg Nick
towhere
    [[Char]]
allcmds <- LB [[Char]] -> ModuleT BaseState LB [[Char]]
forall (m :: * -> *) a. Monad m => m a -> ModuleT BaseState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((IRCRWState -> [[Char]]) -> LB [[Char]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Map [Char] (DSum ModuleID CommandRef) -> [[Char]]
forall k a. Map k a -> [k]
M.keys (Map [Char] (DSum ModuleID CommandRef) -> [[Char]])
-> (IRCRWState -> Map [Char] (DSum ModuleID CommandRef))
-> IRCRWState
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRCRWState -> Map [Char] (DSum ModuleID CommandRef)
ircCommands))
    let ms :: [[Char]]
ms      = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
cmd) [[Char]]
allcmds
    Int
e <- Config Int -> ModuleT BaseState LB Int
forall a. Config a -> ModuleT BaseState LB a
forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config Int
editDistanceLimit
    case [[Char]]
ms of
        [[Char]
s] -> IrcMessage -> Nick -> [Char] -> [Char] -> ModuleT BaseState LB ()
docmd IrcMessage
msg Nick
towhere [Char]
rest [Char]
s                  -- a unique prefix
        [[Char]]
_ | [Char]
cmd [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
ms -> IrcMessage -> Nick -> [Char] -> [Char] -> ModuleT BaseState LB ()
docmd IrcMessage
msg Nick
towhere [Char]
rest [Char]
cmd  -- correct command (usual case)
        [[Char]]
_ | Bool
otherwise     -> case [Char] -> [[Char]] -> (Int, [[Char]])
closests [Char]
cmd [[Char]]
allcmds of
          (Int
n,[[Char]
s]) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
e ,  [[Char]]
ms [[Char]] -> [[Char]] -> Bool
forall a. Eq a => a -> a -> Bool
== [] -> IrcMessage -> Nick -> [Char] -> [Char] -> ModuleT BaseState LB ()
docmd IrcMessage
msg Nick
towhere [Char]
rest [Char]
s -- unique edit match
          (Int
n,[[Char]]
ss)  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
e Bool -> Bool -> Bool
|| [[Char]]
ms [[Char]] -> [[Char]] -> Bool
forall a. Eq a => a -> a -> Bool
/= []            -- some possibilities
              -> LB () -> ModuleT BaseState LB ()
forall (m :: * -> *) a. Monad m => m a -> ModuleT BaseState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LB () -> ModuleT BaseState LB ())
-> ([Char] -> LB ()) -> [Char] -> ModuleT BaseState LB ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> LB ()
ircmsg ([Char] -> ModuleT BaseState LB ())
-> [Char] -> ModuleT BaseState LB ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Maybe you meant: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[[Char]] -> [Char]
forall a. Show a => [a] -> [Char]
showClean([[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub([[Char]]
ms[[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++[[Char]]
ss))
          (Int, [[Char]])
_   -> IrcMessage -> Nick -> [Char] -> [Char] -> ModuleT BaseState LB ()
docmd IrcMessage
msg Nick
towhere [Char]
rest [Char]
cmd         -- no prefix, edit distance too far

docmd :: IrcMessage -> Nick -> [Char] -> String -> Base ()
docmd :: IrcMessage -> Nick -> [Char] -> [Char] -> ModuleT BaseState LB ()
docmd IrcMessage
msg Nick
towhere [Char]
rest [Char]
cmd' = Nick
-> (Maybe () -> (Maybe () -> LB ()) -> LB ())
-> ModuleT BaseState LB ()
forall (m :: * -> *) g p a.
(MonadLBState m, LBState m ~ GlobalPrivate g p) =>
Nick -> (Maybe p -> (Maybe p -> LB ()) -> LB a) -> m a
withPS Nick
towhere ((Maybe () -> (Maybe () -> LB ()) -> LB ())
 -> ModuleT BaseState LB ())
-> (Maybe () -> (Maybe () -> LB ()) -> LB ())
-> ModuleT BaseState LB ()
forall a b. (a -> b) -> a -> b
$ \Maybe ()
_ Maybe () -> LB ()
_ -> do
    [Char]
-> LB ()
-> (forall st. Command (ModuleT st LB) -> ModuleT st LB ())
-> LB ()
forall a.
[Char]
-> LB a
-> (forall st. Command (ModuleT st LB) -> ModuleT st LB a)
-> LB a
withCommand [Char]
cmd'   -- Important.
        (Nick -> [Char] -> LB ()
ircPrivmsg Nick
towhere [Char]
"Unknown command, try @list")
        (\Command (ModuleT st LB)
theCmd -> do
            [Char]
name'   <- (ModuleInfo st -> [Char]) -> ModuleT st LB [Char]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ModuleInfo st -> [Char]
forall st. ModuleInfo st -> [Char]
moduleName

            Bool
hasPrivs <- LB Bool -> ModuleT st LB Bool
forall a. LB a -> ModuleT st LB a
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (IrcMessage -> LB Bool
checkPrivs IrcMessage
msg)
            
            -- TODO: handle disabled commands earlier
            -- users should probably see no difference between a
            -- command that is disabled and one that doesn't exist.
            Bool
disabled <- [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char]
cmd' ([[Char]] -> Bool) -> ModuleT st LB [[Char]] -> ModuleT st LB Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config [[Char]] -> ModuleT st LB [[Char]]
forall a. Config a -> ModuleT st LB a
forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config [[Char]]
disabledCommands
            let ok :: Bool
ok = Bool -> Bool
not Bool
disabled Bool -> Bool -> Bool
&& (Bool -> Bool
not (Command (ModuleT st LB) -> Bool
forall (m :: * -> *). Command m -> Bool
privileged Command (ModuleT st LB)
theCmd) Bool -> Bool -> Bool
|| Bool
hasPrivs)

            [[Char]]
response <- if Bool -> Bool
not Bool
ok
                then [[Char]] -> ModuleT st LB [[Char]]
forall a. a -> ModuleT st LB a
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]
"Not enough privileges"]
                else Command (ModuleT st LB)
-> IrcMessage -> Nick -> [Char] -> [Char] -> ModuleT st LB [[Char]]
forall (m :: * -> *) a.
(Monad m, Message a) =>
Command m -> a -> Nick -> [Char] -> [Char] -> m [[Char]]
runCommand Command (ModuleT st LB)
theCmd IrcMessage
msg Nick
towhere [Char]
cmd' [Char]
rest
                    ModuleT st LB [[Char]]
-> (SomeException -> ModuleT st LB [[Char]])
-> ModuleT st LB [[Char]]
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
`E.catch` \exc :: SomeException
exc@SomeException{} ->
                        [[Char]] -> ModuleT st LB [[Char]]
forall a. a -> ModuleT st LB a
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]
"Plugin `" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' failed with: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
exc]
            
            -- send off our response strings
            -- TODO: expandTab here should probably be an OutputFilter
            LB () -> ModuleT st LB ()
forall (m :: * -> *) a. Monad m => m a -> ModuleT st m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LB () -> ModuleT st LB ()) -> LB () -> ModuleT st LB ()
forall a b. (a -> b) -> a -> b
$ ([Char] -> LB ()) -> [[Char]] -> LB ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Nick -> [Char] -> LB ()
ircPrivmsg Nick
towhere ([Char] -> LB ()) -> ([Char] -> [Char]) -> [Char] -> LB ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [Char]
expandTab Int
8) [[Char]]
response
        )

--
-- contextual messages are all input that isn't an explicit command.
-- they're passed to all modules (todo, sounds inefficient) for
-- scanning, and any that implement 'contextual' will reply.
--
-- we try to run the contextual functions from all modules, on every
-- non-command. better hope this is efficient.
--
-- Note how we catch any plugin errors here, rather than letting
-- them bubble back up to the mainloop
--
doContextualMsg :: IrcMessage -> Nick -> Nick -> [Char] -> Base ()
doContextualMsg :: IrcMessage -> Nick -> Nick -> [Char] -> ModuleT BaseState LB ()
doContextualMsg IrcMessage
msg Nick
target Nick
towhere [Char]
r = LB () -> ModuleT BaseState LB ()
forall a. LB a -> ModuleT BaseState LB a
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb ((forall st. ModuleT st LB ()) -> LB ()
forall a. (forall st. ModuleT st LB a) -> LB ()
withAllModules (ModuleT st LB () -> ModuleT st LB ()
forall {m :: * -> *} {st}.
(MonadBaseControl IO m, MonadReader (ModuleInfo st) m,
 MonadLogging m) =>
m () -> m ()
withHandler ModuleT st LB ()
forall st. ModuleT st LB ()
invokeContextual))
    where
        withHandler :: m () -> m ()
withHandler m ()
x = m () -> (SomeException -> m ()) -> m ()
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
E.catch m ()
x ((SomeException -> m ()) -> m ())
-> (SomeException -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \e :: SomeException
e@SomeException{} -> do
            [Char]
mName   <- (ModuleInfo st -> [Char]) -> m [Char]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ModuleInfo st -> [Char]
forall st. ModuleInfo st -> [Char]
moduleName
            [Char] -> m ()
forall (m :: * -> *). MonadLogging m => [Char] -> m ()
debugM ([Char]
"Module " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
mName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" failed in contextual handler: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)
        
        invokeContextual :: ModuleT st LB ()
invokeContextual = do
            Module st
m       <- (ModuleInfo st -> Module st) -> ModuleT st LB (Module st)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ModuleInfo st -> Module st
forall st. ModuleInfo st -> Module st
theModule
            [[Char]]
reply   <- Cmd (ModuleT st LB) ()
-> IrcMessage -> Nick -> [Char] -> ModuleT st LB [[Char]]
forall (m :: * -> *) a t.
(Monad m, Message a) =>
Cmd m t -> a -> Nick -> [Char] -> m [[Char]]
execCmd (Module st -> [Char] -> Cmd (ModuleT st LB) ()
forall st. Module st -> [Char] -> Cmd (ModuleT st LB) ()
contextual Module st
m [Char]
r) IrcMessage
msg Nick
target [Char]
"contextual"
            LB () -> ModuleT st LB ()
forall a. LB a -> ModuleT st LB a
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> ModuleT st LB ()) -> LB () -> ModuleT st LB ()
forall a b. (a -> b) -> a -> b
$ ([Char] -> LB ()) -> [[Char]] -> LB ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Nick -> [Char] -> LB ()
ircPrivmsg Nick
towhere) [[Char]]
reply

------------------------------------------------------------------------

closests :: String -> [String] -> (Int,[String])
closests :: [Char] -> [[Char]] -> (Int, [[Char]])
closests [Char]
pat [[Char]]
ss = Map Int [[Char]] -> (Int, [[Char]])
forall k a. Map k a -> (k, a)
M.findMin Map Int [[Char]]
m
    where
        m :: Map Int [[Char]]
m = ([[Char]] -> [[Char]] -> [[Char]])
-> [(Int, [[Char]])] -> Map Int [[Char]]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
(++) [(Int, [[Char]])]
ls
        ls :: [(Int, [[Char]])]
ls = [ (EditCosts -> [Char] -> [Char] -> Int
levenshteinDistance EditCosts
defaultEditCosts [Char]
pat [Char]
s, [[Char]
s]) | [Char]
s <- [[Char]]
ss ]

maybeCommand :: String -> String -> Maybe String
maybeCommand :: [Char] -> [Char] -> Maybe [Char]
maybeCommand [Char]
nm [Char]
text = MatchResult [Char] -> [Char]
forall a. MatchResult a -> a
mrAfter (MatchResult [Char] -> [Char])
-> Maybe (MatchResult [Char]) -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Regex -> [Char] -> Maybe (MatchResult [Char])
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
forall (m :: * -> *).
MonadFail m =>
Regex -> [Char] -> m (MatchResult [Char])
matchM Regex
re [Char]
text
    where
        re :: Regex
        re :: Regex
re = [Char] -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
makeRegex ([Char]
nm [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"[.:,]*[[:space:]]*")

--
-- And stuff we don't care about
--

{-
doRPL_YOURHOST :: IrcMessage -> LB ()
doRPL_YOURHOST _msg = return ()

doRPL_CREATED :: IrcMessage -> LB ()
doRPL_CREATED _msg = return ()

doRPL_MYINFO :: IrcMessage -> LB ()
doRPL_MYINFO _msg = return ()

doRPL_STATSCONN :: IrcMessage -> LB ()
doRPL_STATSCONN _msg = return ()

doRPL_LUSERCLIENT :: IrcMessage -> LB ()
doRPL_LUSERCLIENT _msg = return ()

doRPL_LUSEROP :: IrcMessage -> LB ()
doRPL_LUSEROP _msg = return ()

doRPL_LUSERUNKNOWN :: IrcMessage -> LB ()
doRPL_LUSERUNKNOWN _msg = return ()

doRPL_LUSERCHANNELS :: IrcMessage -> LB ()
doRPL_LUSERCHANNELS _msg = return ()

doRPL_LUSERME :: IrcMessage -> LB ()
doRPL_LUSERME _msg = return ()

doRPL_LOCALUSERS :: IrcMessage -> LB ()
doRPL_LOCALUSERS _msg = return ()

doRPL_GLOBALUSERS :: IrcMessage -> LB ()
doRPL_GLOBALUSERS _msg = return ()

doUNKNOWN :: IrcMessage -> Base ()
doUNKNOWN msg
    = debugM $ "UNKNOWN> <" ++ msgPrefix msg ++
      "> [" ++ msgCommand msg ++ "] " ++ show (body msg)

doRPL_NAMREPLY :: IrcMessage -> LB ()
doRPL_NAMREPLY _msg = return ()

doRPL_ENDOFNAMES :: IrcMessage -> LB ()
doRPL_ENDOFNAMES _msg = return ()

doRPL_MOTD :: IrcMessage -> LB ()
doRPL_MOTD _msg = return ()

doRPL_MOTDSTART :: IrcMessage -> LB ()
doRPL_MOTDSTART _msg = return ()

doRPL_ENDOFMOTD :: IrcMessage -> LB ()
doRPL_ENDOFMOTD _msg = return ()
-}

-- Initial output filters

-- | For now, this just checks for duplicate empty lines.
cleanOutput :: Monad m => a -> [String] -> m [String]
cleanOutput :: forall (m :: * -> *) a. Monad m => a -> [[Char]] -> m [[Char]]
cleanOutput a
_ [[Char]]
msg = [[Char]] -> m [[Char]]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> m [[Char]]) -> [[Char]] -> m [[Char]]
forall a b. (a -> b) -> a -> b
$ Bool -> [[Char]] -> [[Char]]
forall {a}. Bool -> [[a]] -> [[a]]
remDups Bool
True [[Char]]
msg'
    where
        remDups :: Bool -> [[a]] -> [[a]]
remDups Bool
True  ([]:[[a]]
xs) =    Bool -> [[a]] -> [[a]]
remDups Bool
True [[a]]
xs
        remDups Bool
False ([]:[[a]]
xs) = [][a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:Bool -> [[a]] -> [[a]]
remDups Bool
True [[a]]
xs
        remDups Bool
_     ([a]
x: [[a]]
xs) = [a]
x[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Bool -> [[a]] -> [[a]]
remDups Bool
False [[a]]
xs
        remDups Bool
_     []      = []
        msg' :: [[Char]]
msg' = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropFromEnd Char -> Bool
isSpace) [[Char]]
msg

-- | wrap long lines.
lineify :: MonadConfig m => a -> [String] -> m [String]
lineify :: forall (m :: * -> *) a.
MonadConfig m =>
a -> [[Char]] -> m [[Char]]
lineify a
_ [[Char]]
msg = do
    Int
w <- Config Int -> m Int
forall a. Config a -> m a
forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config Int
textWidth
    [[Char]] -> m [[Char]]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> [[Char]]
lines ([[Char]] -> [Char]
unlines [[Char]]
msg) [[Char]] -> ([Char] -> [[Char]]) -> [[Char]]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> [Char] -> [[Char]]
mbreak Int
w)
    where
        -- | break into lines
        mbreak :: Int -> [Char] -> [[Char]]
mbreak Int
w [Char]
xs
            | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
bs   = [[Char]
as]
            | Bool
otherwise = ([Char]
as[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
cs) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (Int -> [Char] -> [[Char]]
mbreak Int
w [Char]
ds)
            where
                ([Char]
as,[Char]
bs) = Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n) [Char]
xs
                breaks :: [([Char], [Char])]
breaks  = (([Char], [Char]) -> Bool)
-> [([Char], [Char])] -> [([Char], [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (([Char], [Char]) -> Bool) -> ([Char], [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlphaNum (Char -> Bool)
-> (([Char], [Char]) -> Char) -> ([Char], [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Char
forall a. HasCallStack => [a] -> a
last ([Char] -> Char)
-> (([Char], [Char]) -> [Char]) -> ([Char], [Char]) -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst) ([([Char], [Char])] -> [([Char], [Char])])
-> [([Char], [Char])] -> [([Char], [Char])]
forall a b. (a -> b) -> a -> b
$ Int -> [([Char], [Char])] -> [([Char], [Char])]
forall a. Int -> [a] -> [a]
drop Int
1 ([([Char], [Char])] -> [([Char], [Char])])
-> [([Char], [Char])] -> [([Char], [Char])]
forall a b. (a -> b) -> a -> b
$
                                  Int -> [([Char], [Char])] -> [([Char], [Char])]
forall a. Int -> [a] -> [a]
take Int
n ([([Char], [Char])] -> [([Char], [Char])])
-> [([Char], [Char])] -> [([Char], [Char])]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]] -> [([Char], [Char])]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Char] -> [[Char]]
forall a. [a] -> [[a]]
inits [Char]
bs) ([Char] -> [[Char]]
forall a. [a] -> [[a]]
tails [Char]
bs)
                ([Char]
cs,[Char]
ds) = [([Char], [Char])] -> ([Char], [Char])
forall a. HasCallStack => [a] -> a
last ([([Char], [Char])] -> ([Char], [Char]))
-> [([Char], [Char])] -> ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
n [Char]
bs, Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
n [Char]
bs)([Char], [Char]) -> [([Char], [Char])] -> [([Char], [Char])]
forall a. a -> [a] -> [a]
: [([Char], [Char])]
breaks
                n :: Int
n = Int
10