{-# LANGUAGE PatternGuards, FlexibleContexts #-}
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 = forall st. Module st
newModule
{ moduleDefState :: LB BaseState
moduleDefState = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall g p. Int -> g -> GlobalPrivate g p
mkGlobalPrivate Int
20 ()
, moduleInit :: ModuleT BaseState LB ()
moduleInit = do
forall st. OutputFilter st -> ModuleT st LB ()
registerOutputFilter forall (m :: * -> *) a. Monad m => a -> [[Char]] -> m [[Char]]
cleanOutput
forall st. OutputFilter st -> ModuleT st LB ()
registerOutputFilter forall (m :: * -> *) a.
MonadConfig m =>
a -> [[Char]] -> m [[Char]]
lineify
forall st. OutputFilter st -> ModuleT st LB ()
registerOutputFilter forall (m :: * -> *) a. Monad m => a -> [[Char]] -> m [[Char]]
cleanOutput
forall st. [Char] -> Callback st -> ModuleT st LB ()
registerCallback [Char]
"PING" IrcMessage -> ModuleT BaseState LB ()
doPING
forall st. [Char] -> Callback st -> ModuleT st LB ()
registerCallback [Char]
"NOTICE" IrcMessage -> ModuleT BaseState LB ()
doNOTICE
forall st. [Char] -> Callback st -> ModuleT st LB ()
registerCallback [Char]
"PART" IrcMessage -> ModuleT BaseState LB ()
doPART
forall st. [Char] -> Callback st -> ModuleT st LB ()
registerCallback [Char]
"KICK" IrcMessage -> ModuleT BaseState LB ()
doKICK
forall st. [Char] -> Callback st -> ModuleT st LB ()
registerCallback [Char]
"JOIN" IrcMessage -> ModuleT BaseState LB ()
doJOIN
forall st. [Char] -> Callback st -> ModuleT st LB ()
registerCallback [Char]
"NICK" IrcMessage -> ModuleT BaseState LB ()
doNICK
forall st. [Char] -> Callback st -> ModuleT st LB ()
registerCallback [Char]
"MODE" IrcMessage -> ModuleT BaseState LB ()
doMODE
forall st. [Char] -> Callback st -> ModuleT st LB ()
registerCallback [Char]
"TOPIC" IrcMessage -> ModuleT BaseState LB ()
doTOPIC
forall st. [Char] -> Callback st -> ModuleT st LB ()
registerCallback [Char]
"QUIT" IrcMessage -> ModuleT BaseState LB ()
doQUIT
forall st. [Char] -> Callback st -> ModuleT st LB ()
registerCallback [Char]
"PRIVMSG" IrcMessage -> ModuleT BaseState LB ()
doPRIVMSG
forall st. [Char] -> Callback st -> ModuleT st LB ()
registerCallback [Char]
"001" IrcMessage -> ModuleT BaseState LB ()
doRPL_WELCOME
forall st. [Char] -> Callback st -> ModuleT st LB ()
registerCallback [Char]
"005" IrcMessage -> ModuleT BaseState LB ()
doRPL_BOUNCE
forall st. [Char] -> Callback st -> ModuleT st LB ()
registerCallback [Char]
"332" IrcMessage -> ModuleT BaseState LB ()
doRPL_TOPIC
}
doIGNORE :: IrcMessage -> Base ()
doIGNORE :: IrcMessage -> ModuleT BaseState LB ()
doIGNORE = forall (m :: * -> *). MonadLogging m => [Char] -> m ()
debugM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show
doPING :: IrcMessage -> Base ()
doPING :: IrcMessage -> ModuleT BaseState LB ()
doPING = forall (m :: * -> *). MonadLogging m => [Char] -> m ()
noticeM forall b c a. (b -> c) -> (a -> b) -> a -> c
. IrcMessage -> [Char]
showPingMsg
where showPingMsg :: IrcMessage -> [Char]
showPingMsg IrcMessage
msg = [Char]
"PING! <" forall a. [a] -> [a] -> [a]
++ IrcMessage -> [Char]
ircMsgServer IrcMessage
msg forall a. [a] -> [a] -> [a]
++ (Char
':' forall a. a -> [a] -> [a]
: IrcMessage -> [Char]
ircMsgPrefix IrcMessage
msg) forall a. [a] -> [a] -> [a]
++
[Char]
"> [" forall a. [a] -> [a] -> [a]
++ IrcMessage -> [Char]
ircMsgCommand IrcMessage
msg forall a. [a] -> [a] -> [a]
++ [Char]
"] " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (IrcMessage -> [[Char]]
ircMsgParams IrcMessage
msg)
doNOTICE :: IrcMessage -> Base ()
doNOTICE :: IrcMessage -> ModuleT BaseState LB ()
doNOTICE IrcMessage
msg
| Bool
isCTCPTimeReply = IrcMessage -> ModuleT BaseState LB ()
doPRIVMSG (IrcMessage -> IrcMessage
timeReply IrcMessage
msg)
| Bool
otherwise = forall (m :: * -> *). MonadLogging m => [Char] -> m ()
noticeM (forall a. Show a => a -> [Char]
show [[Char]]
body)
where
body :: [[Char]]
body = IrcMessage -> [[Char]]
ircMsgParams IrcMessage
msg
isCTCPTimeReply :: Bool
isCTCPTimeReply = [Char]
":\SOHTIME" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` (forall a. [a] -> a
last [[Char]]
body)
doJOIN :: IrcMessage -> Base ()
doJOIN :: IrcMessage -> ModuleT BaseState LB ()
doJOIN IrcMessage
msg
| forall a. Message a => a -> Nick
lambdabotName IrcMessage
msg forall a. Eq a => a -> a -> Bool
/= forall a. Message a => a -> Nick
nick IrcMessage
msg = IrcMessage -> ModuleT BaseState LB ()
doIGNORE IrcMessage
msg
| Bool
otherwise = do
let msgArg :: [Char]
msgArg = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. Int -> [a] -> [a]
take Int
1 (IrcMessage -> [[Char]]
ircMsgParams IrcMessage
msg))
chan :: [Char]
chan = case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
':') [Char]
msgArg of
[] -> [Char]
msgArg
[Char]
aloc -> [Char]
aloc
loc :: Nick
loc = [Char] -> [Char] -> Nick
Nick (forall a. Message a => a -> [Char]
server IrcMessage
msg) (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
':') [Char]
chan)
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \IRCRWState
s -> IRCRWState
s
{ ircChannels :: Map ChanName [Char]
ircChannels = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Nick -> ChanName
mkCN Nick
loc) [Char]
"[currently unknown]" (IRCRWState -> Map ChanName [Char]
ircChannels IRCRWState
s)}
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb forall b c a. (b -> c) -> (a -> b) -> a -> c
. IrcMessage -> LB ()
send forall a b. (a -> b) -> a -> b
$ Nick -> IrcMessage
getTopic Nick
loc
where
doPART :: IrcMessage -> Base ()
doPART :: IrcMessage -> ModuleT BaseState LB ()
doPART IrcMessage
msg
= forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Message a => a -> Nick
lambdabotName IrcMessage
msg forall a. Eq a => a -> a -> Bool
== forall a. Message a => a -> Nick
nick IrcMessage
msg) forall a b. (a -> b) -> a -> b
$ do
let body :: [[Char]]
body = IrcMessage -> [[Char]]
ircMsgParams IrcMessage
msg
loc :: Nick
loc = [Char] -> [Char] -> Nick
Nick (forall a. Message a => a -> [Char]
server IrcMessage
msg) (forall a. [a] -> a
head [[Char]]
body)
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \IRCRWState
s -> IRCRWState
s
{ ircChannels :: Map ChanName [Char]
ircChannels = forall k a. Ord k => k -> Map k a -> Map k a
M.delete (Nick -> ChanName
mkCN Nick
loc) (IRCRWState -> Map ChanName [Char]
ircChannels IRCRWState
s) }
doKICK :: IrcMessage -> Base ()
doKICK :: IrcMessage -> ModuleT BaseState LB ()
doKICK IrcMessage
msg
= do let body :: [[Char]]
body = IrcMessage -> [[Char]]
ircMsgParams IrcMessage
msg
loc :: Nick
loc = [Char] -> [Char] -> Nick
Nick (forall a. Message a => a -> [Char]
server IrcMessage
msg) ([[Char]]
body forall a. [a] -> Int -> a
!! Int
0)
who :: Nick
who = [Char] -> [Char] -> Nick
Nick (forall a. Message a => a -> [Char]
server IrcMessage
msg) ([[Char]]
body forall a. [a] -> Int -> a
!! Int
1)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Message a => a -> Nick
lambdabotName IrcMessage
msg forall a. Eq a => a -> a -> Bool
== Nick
who) forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). MonadLogging m => [Char] -> m ()
noticeM forall a b. (a -> b) -> a -> b
$ [Char] -> Nick -> [Char]
fmtNick [Char]
"" (forall a. Message a => a -> Nick
nick IrcMessage
msg) forall a. [a] -> [a] -> [a]
++ [Char]
" KICK " forall a. [a] -> [a] -> [a]
++ [Char] -> Nick -> [Char]
fmtNick (forall a. Message a => a -> [Char]
server IrcMessage
msg) Nick
loc forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a. Int -> [a] -> [a]
drop Int
2 [[Char]]
body)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \IRCRWState
s ->
IRCRWState
s { ircChannels :: Map ChanName [Char]
ircChannels = forall k a. Ord k => k -> Map k a -> Map k a
M.delete (Nick -> ChanName
mkCN Nick
loc) (IRCRWState -> Map ChanName [Char]
ircChannels IRCRWState
s) }
doNICK :: IrcMessage -> Base ()
doNICK :: IrcMessage -> ModuleT BaseState LB ()
doNICK IrcMessage
msg
= IrcMessage -> ModuleT BaseState LB ()
doIGNORE IrcMessage
msg
doMODE :: IrcMessage -> Base ()
doMODE :: IrcMessage -> ModuleT BaseState LB ()
doMODE IrcMessage
msg
= IrcMessage -> ModuleT BaseState LB ()
doIGNORE IrcMessage
msg
doTOPIC :: IrcMessage -> Base ()
doTOPIC :: IrcMessage -> ModuleT BaseState LB ()
doTOPIC IrcMessage
msg = forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \IRCRWState
s -> IRCRWState
s
{ ircChannels :: Map ChanName [Char]
ircChannels = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Nick -> ChanName
mkCN Nick
loc) (forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ IrcMessage -> [[Char]]
ircMsgParams IrcMessage
msg) (IRCRWState -> Map ChanName [Char]
ircChannels IRCRWState
s) }
where loc :: Nick
loc = [Char] -> [Char] -> Nick
Nick (forall a. Message a => a -> [Char]
server IrcMessage
msg) (forall a. [a] -> a
head (IrcMessage -> [[Char]]
ircMsgParams IrcMessage
msg))
doRPL_WELCOME :: IrcMessage -> Base ()
doRPL_WELCOME :: IrcMessage -> ModuleT BaseState LB ()
doRPL_WELCOME IrcMessage
msg = forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb forall a b. (a -> b) -> a -> b
$ do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \IRCRWState
state' ->
let persists :: Map [Char] Bool
persists = if forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Bool
True (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 forall k a. Ord k => k -> Map k a -> Map k a
M.delete (forall a. Message a => a -> [Char]
server IrcMessage
msg) forall a b. (a -> b) -> a -> b
$ IRCRWState -> Map [Char] Bool
ircPersists IRCRWState
state'
in IRCRWState
state' { ircPersists :: Map [Char] Bool
ircPersists = Map [Char] Bool
persists }
Map ChanName [Char]
chans <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets IRCRWState -> Map ChanName [Char]
ircChannels
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [k]
M.keys Map ChanName [Char]
chans) forall a b. (a -> b) -> a -> b
$ \ChanName
chan -> do
let cn :: Nick
cn = ChanName -> Nick
getCN ChanName
chan
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Nick -> [Char]
nTag Nick
cn forall a. Eq a => a -> a -> Bool
== forall a. Message a => a -> [Char]
server IrcMessage
msg) forall a b. (a -> b) -> a -> b
$ do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \IRCRWState
state' -> IRCRWState
state' { ircChannels :: Map ChanName [Char]
ircChannels = forall k a. Ord k => k -> Map k a -> Map k a
M.delete ChanName
chan forall a b. (a -> b) -> a -> b
$ IRCRWState -> Map ChanName [Char]
ircChannels IRCRWState
state' }
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb forall a b. (a -> b) -> a -> b
$ IrcMessage -> LB ()
send forall a b. (a -> b) -> a -> b
$ Nick -> IrcMessage
joinChannel Nick
cn
doQUIT :: IrcMessage -> Base ()
doQUIT :: IrcMessage -> ModuleT BaseState LB ()
doQUIT IrcMessage
msg = IrcMessage -> ModuleT BaseState LB ()
doIGNORE IrcMessage
msg
doRPL_BOUNCE :: IrcMessage -> Base ()
doRPL_BOUNCE :: IrcMessage -> ModuleT BaseState LB ()
doRPL_BOUNCE IrcMessage
_msg = forall (m :: * -> *). MonadLogging m => [Char] -> m ()
debugM [Char]
"BOUNCE!"
doRPL_TOPIC :: IrcMessage -> Base ()
doRPL_TOPIC :: IrcMessage -> ModuleT BaseState LB ()
doRPL_TOPIC IrcMessage
msg
= do let body :: [[Char]]
body = IrcMessage -> [[Char]]
ircMsgParams IrcMessage
msg
loc :: Nick
loc = [Char] -> [Char] -> Nick
Nick (forall a. Message a => a -> [Char]
server IrcMessage
msg) ([[Char]]
body forall a. [a] -> Int -> a
!! Int
1)
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \IRCRWState
s -> IRCRWState
s
{ ircChannels :: Map ChanName [Char]
ircChannels = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Nick -> ChanName
mkCN Nick
loc) (forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [[Char]]
body) (IRCRWState -> Map ChanName [Char]
ircChannels IRCRWState
s) }
doPRIVMSG :: IrcMessage -> Base ()
doPRIVMSG :: IrcMessage -> ModuleT BaseState LB ()
doPRIVMSG IrcMessage
msg = do
Bool
ignored <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IrcMessage -> LB Bool
checkIgnore IrcMessage
msg
[[Char]]
commands <- forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config [[Char]]
commandPrefixes
if Bool
ignored
then IrcMessage -> ModuleT BaseState LB ()
doIGNORE IrcMessage
msg
else 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 (forall a. Message a => a -> Nick
lambdabotName IrcMessage
msg) IrcMessage
msg) [Nick]
targets
where
alltargets :: [Char]
alltargets = forall a. [a] -> a
head (IrcMessage -> [[Char]]
ircMsgParams IrcMessage
msg)
targets :: [Nick]
targets = forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char] -> Nick
parseNick (IrcMessage -> [Char]
ircMsgServer IrcMessage
msg)) forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
"," [Char]
alltargets
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 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
| forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [Char]
":," forall a b. (a -> b) -> a -> b
$ \Char
c -> ([Char] -> Nick -> [Char]
fmtNick (IrcMessage -> [Char]
ircMsgServer IrcMessage
msg) Nick
myname forall a. [a] -> [a] -> [a]
++ [Char
c]) 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
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
text forall a. Ord a => a -> a -> Bool
> Int
1
Bool -> Bool -> Bool
&& ([Char]
text forall a. [a] -> Int -> a
!! Int
1 forall a. Eq a => a -> a -> Bool
/= Char
' ')
Bool -> Bool -> Bool
&& (Bool -> Bool
not ([[Char]]
commands [[Char]] -> [Char] -> Bool
`arePrefixesOf` [[Char]
text forall a. [a] -> Int -> a
!! Int
1]) Bool -> Bool -> Bool
||
(forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
text forall a. Ord a => a -> a -> Bool
> Int
2 Bool -> Bool -> Bool
&& [Char]
text forall a. [a] -> Int -> a
!! Int
2 forall a. Eq a => a -> a -> Bool
== Char
' '))
= let ([Char]
cmd, [Char]
params) = [Char] -> ([Char], [Char])
splitFirstWord (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (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 = forall a. [a] -> [a]
tail (forall a. [a] -> a
head (forall a. [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 (forall a. [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 = 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 (forall a. [a] -> [a]
tail [Char]
s) [Char]
r Nick
target
| Bool
otherwise = IrcMessage -> ModuleT BaseState LB ()
doIGNORE IrcMessage
msg
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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall k a. Map k a -> [k]
M.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRCRWState -> Map [Char] (DSum ModuleID CommandRef)
ircCommands))
let ms :: [[Char]]
ms = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
cmd) [[Char]]
allcmds
Int
e <- 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
[[Char]]
_ | [Char]
cmd 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
[[Char]]
_ | Bool
otherwise -> case [Char] -> [[Char]] -> (Int, [[Char]])
closests [Char]
cmd [[Char]]
allcmds of
(Int
n,[[Char]
s]) | Int
n forall a. Ord a => a -> a -> Bool
< Int
e , [[Char]]
ms forall a. Eq a => a -> a -> Bool
== [] -> IrcMessage -> Nick -> [Char] -> [Char] -> ModuleT BaseState LB ()
docmd IrcMessage
msg Nick
towhere [Char]
rest [Char]
s
(Int
n,[[Char]]
ss) | Int
n forall a. Ord a => a -> a -> Bool
< Int
e Bool -> Bool -> Bool
|| [[Char]]
ms forall a. Eq a => a -> a -> Bool
/= []
-> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> LB ()
ircmsg forall a b. (a -> b) -> a -> b
$ [Char]
"Maybe you meant: "forall a. [a] -> [a] -> [a]
++forall a. Show a => [a] -> [Char]
showClean(forall a. Eq a => [a] -> [a]
nub([[Char]]
msforall a. [a] -> [a] -> [a]
++[[Char]]
ss))
(Int, [[Char]])
_ -> IrcMessage -> Nick -> [Char] -> [Char] -> ModuleT BaseState LB ()
docmd IrcMessage
msg Nick
towhere [Char]
rest [Char]
cmd
docmd :: IrcMessage -> Nick -> [Char] -> String -> Base ()
docmd :: IrcMessage -> Nick -> [Char] -> [Char] -> ModuleT BaseState LB ()
docmd IrcMessage
msg Nick
towhere [Char]
rest [Char]
cmd' = 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 forall a b. (a -> b) -> a -> b
$ \Maybe ()
_ Maybe () -> LB ()
_ -> do
forall a.
[Char]
-> LB a
-> (forall st. Command (ModuleT st LB) -> ModuleT st LB a)
-> LB a
withCommand [Char]
cmd'
(Nick -> [Char] -> LB ()
ircPrivmsg Nick
towhere [Char]
"Unknown command, try @list")
(\Command (ModuleT st LB)
theCmd -> do
[Char]
name' <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall st. ModuleInfo st -> [Char]
moduleName
Bool
hasPrivs <- forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (IrcMessage -> LB Bool
checkPrivs IrcMessage
msg)
Bool
disabled <- forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char]
cmd' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (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 forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]
"Not enough privileges"]
else 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
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
`E.catch` \exc :: SomeException
exc@SomeException{} ->
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]
"Plugin `" forall a. [a] -> [a] -> [a]
++ [Char]
name' forall a. [a] -> [a] -> [a]
++ [Char]
"' failed with: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SomeException
exc]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Nick -> [Char] -> LB ()
ircPrivmsg Nick
towhere forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [Char]
expandTab Int
8) [[Char]]
response
)
doContextualMsg :: IrcMessage -> Nick -> Nick -> [Char] -> Base ()
doContextualMsg :: IrcMessage -> Nick -> Nick -> [Char] -> ModuleT BaseState LB ()
doContextualMsg IrcMessage
msg Nick
target Nick
towhere [Char]
r = forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (forall a. (forall st. ModuleT st LB a) -> LB ()
withAllModules (forall {m :: * -> *} {st}.
(MonadBaseControl IO m, MonadReader (ModuleInfo st) m,
MonadLogging m) =>
m () -> m ()
withHandler forall {st}. ModuleT st LB ()
invokeContextual))
where
withHandler :: m () -> m ()
withHandler m ()
x = forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
E.catch m ()
x forall a b. (a -> b) -> a -> b
$ \e :: SomeException
e@SomeException{} -> do
[Char]
mName <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall st. ModuleInfo st -> [Char]
moduleName
forall (m :: * -> *). MonadLogging m => [Char] -> m ()
debugM ([Char]
"Module " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
mName forall a. [a] -> [a] -> [a]
++ [Char]
" failed in contextual handler: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SomeException
e)
invokeContextual :: ModuleT st LB ()
invokeContextual = do
Module st
m <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall st. ModuleInfo st -> Module st
theModule
[[Char]]
reply <- forall (m :: * -> *) a t.
(Monad m, Message a) =>
Cmd m t -> a -> Nick -> [Char] -> m [[Char]]
execCmd (forall st. Module st -> [Char] -> Cmd (ModuleT st LB) ()
contextual Module st
m [Char]
r) IrcMessage
msg Nick
target [Char]
"contextual"
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb forall a b. (a -> b) -> a -> b
$ 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 = forall k a. Map k a -> (k, a)
M.findMin Map Int [[Char]]
m
where
m :: Map Int [[Char]]
m = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith 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 = forall a. MatchResult a -> a
mrAfter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM Regex
re [Char]
text
where
re :: Regex
re :: Regex
re = forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
makeRegex ([Char]
nm forall a. [a] -> [a] -> [a]
++ [Char]
"[.:,]*[[:space:]]*")
cleanOutput :: Monad m => a -> [String] -> m [String]
cleanOutput :: forall (m :: * -> *) a. Monad m => a -> [[Char]] -> m [[Char]]
cleanOutput a
_ [[Char]]
msg = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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) = []forall a. a -> [a] -> [a]
:Bool -> [[a]] -> [[a]]
remDups Bool
True [[a]]
xs
remDups Bool
_ ([a]
x: [[a]]
xs) = [a]
xforall a. a -> [a] -> [a]
: Bool -> [[a]] -> [[a]]
remDups Bool
False [[a]]
xs
remDups Bool
_ [] = []
msg' :: [[Char]]
msg' = forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> Bool) -> [a] -> [a]
dropFromEnd Char -> Bool
isSpace) [[Char]]
msg
lineify :: MonadConfig m => a -> [String] -> m [String]
lineify :: forall (m :: * -> *) a.
MonadConfig m =>
a -> [[Char]] -> m [[Char]]
lineify a
_ [[Char]]
msg = do
Int
w <- forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config Int
textWidth
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> [[Char]]
lines ([[Char]] -> [Char]
unlines [[Char]]
msg) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> [Char] -> [[Char]]
mbreak Int
w)
where
mbreak :: Int -> [Char] -> [[Char]]
mbreak Int
w [Char]
xs
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
bs = [[Char]
as]
| Bool
otherwise = ([Char]
asforall a. [a] -> [a] -> [a]
++[Char]
cs) forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (Int -> [Char] -> [[Char]]
mbreak Int
w [Char]
ds)
where
([Char]
as,[Char]
bs) = forall a. Int -> [a] -> ([a], [a])
splitAt (Int
wforall a. Num a => a -> a -> a
-Int
n) [Char]
xs
breaks :: [([Char], [Char])]
breaks = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlphaNum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$
forall a. Int -> [a] -> [a]
take Int
n forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. [a] -> [[a]]
inits [Char]
bs) (forall a. [a] -> [[a]]
tails [Char]
bs)
([Char]
cs,[Char]
ds) = forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$ (forall a. Int -> [a] -> [a]
take Int
n [Char]
bs, forall a. Int -> [a] -> [a]
drop Int
n [Char]
bs)forall a. a -> [a] -> [a]
: [([Char], [Char])]
breaks
n :: Int
n = Int
10