{-# 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 = 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
        
        -- registerCallback "002"     doRPL_YOURHOST
        -- registerCallback "003"     doRPL_CREATED
        -- registerCallback "004"     doRPL_MYINFO
        
        forall st. [Char] -> Callback st -> ModuleT st LB ()
registerCallback [Char]
"005"     IrcMessage -> ModuleT BaseState LB ()
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
        
        forall st. [Char] -> Callback st -> ModuleT st LB ()
registerCallback [Char]
"332"     IrcMessage -> ModuleT BaseState LB ()
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 :: 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)

-- 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 :: IrcMessage -> ModuleT BaseState LB ()
doNOTICE IrcMessage
msg
    | Bool
isCTCPTimeReply   = IrcMessage -> ModuleT BaseState LB ()
doPRIVMSG (IrcMessage -> IrcMessage
timeReply IrcMessage
msg)
        -- TODO: need to say which module to run the privmsg in
    | 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)
        
        -- the empty topic causes problems
        -- TODO: find out what they are and fix them properly
        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 -- initialize topic
   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 -- 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 (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

--
-- | 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 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
' ') -- elem of prefixes
    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
' ')) -- ignore @@ prefix, but not the @@ command itself
    = 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

--
-- 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 <- 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                  -- a unique prefix
        [[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  -- correct command (usual case)
        [[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 -- unique edit match
          (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
/= []            -- some possibilities
              -> 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         -- 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' = 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'   -- Important.
        (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)
            
            -- 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 <- 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]
            
            -- send off our response strings
            -- TODO: expandTab here should probably be an OutputFilter
            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
        )

--
-- 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 = 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:]]*")

--
-- 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 = 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

-- | 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 <- 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
        -- | break into lines
        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