{-# 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 (GlobalPrivate () ())
basePlugin = Module (GlobalPrivate () ())
forall st. Module st
newModule
    { moduleDefState :: LB (GlobalPrivate () ())
moduleDefState = GlobalPrivate () () -> LB (GlobalPrivate () ())
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalPrivate () () -> LB (GlobalPrivate () ()))
-> GlobalPrivate () () -> LB (GlobalPrivate () ())
forall a b. (a -> b) -> a -> b
$ Int -> () -> GlobalPrivate () ()
forall g p. Int -> g -> GlobalPrivate g p
mkGlobalPrivate Int
20 ()
    , moduleInit :: ModuleT (GlobalPrivate () ()) LB ()
moduleInit = do
        OutputFilter (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. OutputFilter st -> ModuleT st LB ()
registerOutputFilter OutputFilter (GlobalPrivate () ())
forall (m :: * -> *) a. Monad m => a -> [String] -> m [String]
cleanOutput
        OutputFilter (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. OutputFilter st -> ModuleT st LB ()
registerOutputFilter OutputFilter (GlobalPrivate () ())
forall (m :: * -> *) a.
MonadConfig m =>
a -> [String] -> m [String]
lineify
        OutputFilter (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. OutputFilter st -> ModuleT st LB ()
registerOutputFilter OutputFilter (GlobalPrivate () ())
forall (m :: * -> *) a. Monad m => a -> [String] -> m [String]
cleanOutput
        
        String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback String
"PING"    Callback (GlobalPrivate () ())
doPING
        String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback String
"NOTICE"  Callback (GlobalPrivate () ())
doNOTICE
        String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback String
"PART"    Callback (GlobalPrivate () ())
doPART
        String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback String
"KICK"    Callback (GlobalPrivate () ())
doKICK
        String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback String
"JOIN"    Callback (GlobalPrivate () ())
doJOIN
        String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback String
"NICK"    Callback (GlobalPrivate () ())
doNICK
        String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback String
"MODE"    Callback (GlobalPrivate () ())
doMODE
        String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback String
"TOPIC"   Callback (GlobalPrivate () ())
doTOPIC
        String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback String
"QUIT"    Callback (GlobalPrivate () ())
doQUIT
        String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback String
"PRIVMSG" Callback (GlobalPrivate () ())
doPRIVMSG
        String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback String
"001"     Callback (GlobalPrivate () ())
doRPL_WELCOME
        
        -- registerCallback "002"     doRPL_YOURHOST
        -- registerCallback "003"     doRPL_CREATED
        -- registerCallback "004"     doRPL_MYINFO
        
        String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback String
"005"     Callback (GlobalPrivate () ())
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
        
        String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback String
"332"     Callback (GlobalPrivate () ())
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 (GlobalPrivate () ())
doIGNORE = String -> ModuleT (GlobalPrivate () ()) LB ()
forall (m :: * -> *). MonadLogging m => String -> m ()
debugM (String -> ModuleT (GlobalPrivate () ()) LB ())
-> (IrcMessage -> String) -> Callback (GlobalPrivate () ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IrcMessage -> String
forall a. Show a => a -> String
show

doPING :: IrcMessage -> Base ()
doPING :: Callback (GlobalPrivate () ())
doPING = String -> ModuleT (GlobalPrivate () ()) LB ()
forall (m :: * -> *). MonadLogging m => String -> m ()
noticeM (String -> ModuleT (GlobalPrivate () ()) LB ())
-> (IrcMessage -> String) -> Callback (GlobalPrivate () ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IrcMessage -> String
showPingMsg
    where showPingMsg :: IrcMessage -> String
showPingMsg IrcMessage
msg = String
"PING! <" String -> String -> String
forall a. [a] -> [a] -> [a]
++ IrcMessage -> String
ircMsgServer IrcMessage
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
: IrcMessage -> String
ircMsgPrefix IrcMessage
msg) String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
"> [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ IrcMessage -> String
ircMsgCommand IrcMessage
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show (IrcMessage -> [String]
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 (GlobalPrivate () ())
doNOTICE IrcMessage
msg
    | Bool
isCTCPTimeReply   = Callback (GlobalPrivate () ())
doPRIVMSG (IrcMessage -> IrcMessage
timeReply IrcMessage
msg)
        -- TODO: need to say which module to run the privmsg in
    | Bool
otherwise         = String -> ModuleT (GlobalPrivate () ()) LB ()
forall (m :: * -> *). MonadLogging m => String -> m ()
noticeM ([String] -> String
forall a. Show a => a -> String
show [String]
body)
    where
        body :: [String]
body = IrcMessage -> [String]
ircMsgParams IrcMessage
msg
        isCTCPTimeReply :: Bool
isCTCPTimeReply = String
":\SOHTIME" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` ([String] -> String
forall a. [a] -> a
last [String]
body)

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

doPART :: IrcMessage -> Base ()
doPART :: Callback (GlobalPrivate () ())
doPART IrcMessage
msg
  = Bool
-> ModuleT (GlobalPrivate () ()) LB ()
-> ModuleT (GlobalPrivate () ()) 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 (GlobalPrivate () ()) LB ()
 -> ModuleT (GlobalPrivate () ()) LB ())
-> ModuleT (GlobalPrivate () ()) LB ()
-> ModuleT (GlobalPrivate () ()) LB ()
forall a b. (a -> b) -> a -> b
$ do
        let body :: [String]
body = IrcMessage -> [String]
ircMsgParams IrcMessage
msg
            loc :: Nick
loc = String -> String -> Nick
Nick (IrcMessage -> String
forall a. Message a => a -> String
server IrcMessage
msg) ([String] -> String
forall a. [a] -> a
head [String]
body)
        LB () -> ModuleT (GlobalPrivate () ()) LB ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> ModuleT (GlobalPrivate () ()) LB ())
-> ((IRCRWState -> IRCRWState) -> LB ())
-> (IRCRWState -> IRCRWState)
-> ModuleT (GlobalPrivate () ()) 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 (GlobalPrivate () ()) LB ())
-> (IRCRWState -> IRCRWState)
-> ModuleT (GlobalPrivate () ()) LB ()
forall a b. (a -> b) -> a -> b
$ \IRCRWState
s -> IRCRWState
s
            { ircChannels :: Map ChanName String
ircChannels = ChanName -> Map ChanName String -> Map ChanName String
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (Nick -> ChanName
mkCN Nick
loc) (IRCRWState -> Map ChanName String
ircChannels IRCRWState
s) }

doKICK :: IrcMessage -> Base ()
doKICK :: Callback (GlobalPrivate () ())
doKICK IrcMessage
msg
   = do let body :: [String]
body = IrcMessage -> [String]
ircMsgParams IrcMessage
msg
            loc :: Nick
loc = String -> String -> Nick
Nick (IrcMessage -> String
forall a. Message a => a -> String
server IrcMessage
msg) ([String]
body [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
0)
            who :: Nick
who = String -> String -> Nick
Nick (IrcMessage -> String
forall a. Message a => a -> String
server IrcMessage
msg) ([String]
body [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
1)
        Bool
-> ModuleT (GlobalPrivate () ()) LB ()
-> ModuleT (GlobalPrivate () ()) 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 (GlobalPrivate () ()) LB ()
 -> ModuleT (GlobalPrivate () ()) LB ())
-> ModuleT (GlobalPrivate () ()) LB ()
-> ModuleT (GlobalPrivate () ()) LB ()
forall a b. (a -> b) -> a -> b
$ do
            String -> ModuleT (GlobalPrivate () ()) LB ()
forall (m :: * -> *). MonadLogging m => String -> m ()
noticeM (String -> ModuleT (GlobalPrivate () ()) LB ())
-> String -> ModuleT (GlobalPrivate () ()) LB ()
forall a b. (a -> b) -> a -> b
$ String -> Nick -> String
fmtNick String
"" (IrcMessage -> Nick
forall a. Message a => a -> Nick
nick IrcMessage
msg) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" KICK " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> Nick -> String
fmtNick (IrcMessage -> String
forall a. Message a => a -> String
server IrcMessage
msg) Nick
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
2 [String]
body)
            LB () -> ModuleT (GlobalPrivate () ()) LB ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LB () -> ModuleT (GlobalPrivate () ()) LB ())
-> LB () -> ModuleT (GlobalPrivate () ()) 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 :: Map ChanName String
ircChannels = ChanName -> Map ChanName String -> Map ChanName String
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (Nick -> ChanName
mkCN Nick
loc) (IRCRWState -> Map ChanName String
ircChannels IRCRWState
s) }

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

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


doTOPIC :: IrcMessage -> Base ()
doTOPIC :: Callback (GlobalPrivate () ())
doTOPIC IrcMessage
msg = LB () -> ModuleT (GlobalPrivate () ()) LB ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> ModuleT (GlobalPrivate () ()) LB ())
-> ((IRCRWState -> IRCRWState) -> LB ())
-> (IRCRWState -> IRCRWState)
-> ModuleT (GlobalPrivate () ()) 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 (GlobalPrivate () ()) LB ())
-> (IRCRWState -> IRCRWState)
-> ModuleT (GlobalPrivate () ()) LB ()
forall a b. (a -> b) -> a -> b
$ \IRCRWState
s -> IRCRWState
s
    { ircChannels :: Map ChanName String
ircChannels = ChanName -> String -> Map ChanName String -> Map ChanName String
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Nick -> ChanName
mkCN Nick
loc) (String -> String
forall a. [a] -> [a]
tail (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
tail ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ IrcMessage -> [String]
ircMsgParams IrcMessage
msg) (IRCRWState -> Map ChanName String
ircChannels IRCRWState
s) }
    where loc :: Nick
loc = String -> String -> Nick
Nick (IrcMessage -> String
forall a. Message a => a -> String
server IrcMessage
msg) ([String] -> String
forall a. [a] -> a
head (IrcMessage -> [String]
ircMsgParams IrcMessage
msg))

doRPL_WELCOME :: IrcMessage -> Base ()
doRPL_WELCOME :: Callback (GlobalPrivate () ())
doRPL_WELCOME IrcMessage
msg = LB () -> ModuleT (GlobalPrivate () ()) LB ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> ModuleT (GlobalPrivate () ()) LB ())
-> LB () -> ModuleT (GlobalPrivate () ()) 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 String Bool
persists = if Bool -> String -> Map String Bool -> Bool
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Bool
True (IrcMessage -> String
forall a. Message a => a -> String
server IrcMessage
msg) (IRCRWState -> Map String Bool
ircPersists IRCRWState
state')
                then IRCRWState -> Map String Bool
ircPersists IRCRWState
state'
                else String -> Map String Bool -> Map String Bool
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (IrcMessage -> String
forall a. Message a => a -> String
server IrcMessage
msg) (Map String Bool -> Map String Bool)
-> Map String Bool -> Map String Bool
forall a b. (a -> b) -> a -> b
$ IRCRWState -> Map String Bool
ircPersists IRCRWState
state'
         in IRCRWState
state' { ircPersists :: Map String Bool
ircPersists = Map String Bool
persists }
    Map ChanName String
chans <- (IRCRWState -> Map ChanName String) -> LB (Map ChanName String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets IRCRWState -> Map ChanName String
ircChannels
    [ChanName] -> (ChanName -> LB ()) -> LB ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map ChanName String -> [ChanName]
forall k a. Map k a -> [k]
M.keys Map ChanName String
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 -> String
nTag Nick
cn String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== IrcMessage -> String
forall a. Message a => a -> String
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 :: Map ChanName String
ircChannels = ChanName -> Map ChanName String -> Map ChanName String
forall k a. Ord k => k -> Map k a -> Map k a
M.delete ChanName
chan (Map ChanName String -> Map ChanName String)
-> Map ChanName String -> Map ChanName String
forall a b. (a -> b) -> a -> b
$ IRCRWState -> Map ChanName String
ircChannels IRCRWState
state' }
            LB () -> LB ()
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 (GlobalPrivate () ())
doQUIT IrcMessage
msg = Callback (GlobalPrivate () ())
doIGNORE IrcMessage
msg

doRPL_BOUNCE :: IrcMessage -> Base ()
doRPL_BOUNCE :: Callback (GlobalPrivate () ())
doRPL_BOUNCE IrcMessage
_msg = String -> ModuleT (GlobalPrivate () ()) LB ()
forall (m :: * -> *). MonadLogging m => String -> m ()
debugM String
"BOUNCE!"

doRPL_TOPIC :: IrcMessage -> Base ()
doRPL_TOPIC :: Callback (GlobalPrivate () ())
doRPL_TOPIC IrcMessage
msg -- nearly the same as doTOPIC but has our nick on the front of body
    = do let body :: [String]
body = IrcMessage -> [String]
ircMsgParams IrcMessage
msg
             loc :: Nick
loc = String -> String -> Nick
Nick (IrcMessage -> String
forall a. Message a => a -> String
server IrcMessage
msg) ([String]
body [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
1)
         LB () -> ModuleT (GlobalPrivate () ()) LB ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> ModuleT (GlobalPrivate () ()) LB ())
-> ((IRCRWState -> IRCRWState) -> LB ())
-> (IRCRWState -> IRCRWState)
-> ModuleT (GlobalPrivate () ()) 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 (GlobalPrivate () ()) LB ())
-> (IRCRWState -> IRCRWState)
-> ModuleT (GlobalPrivate () ()) LB ()
forall a b. (a -> b) -> a -> b
$ \IRCRWState
s -> IRCRWState
s
            { ircChannels :: Map ChanName String
ircChannels = ChanName -> String -> Map ChanName String -> Map ChanName String
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Nick -> ChanName
mkCN Nick
loc) (String -> String
forall a. [a] -> [a]
tail (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
last [String]
body) (IRCRWState -> Map ChanName String
ircChannels IRCRWState
s) }

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

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

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

doPublicMsg :: [String] -> IrcMessage -> Nick -> String -> String -> Base ()
doPublicMsg :: [String]
-> IrcMessage
-> Nick
-> String
-> String
-> ModuleT (GlobalPrivate () ()) LB ()
doPublicMsg [String]
commands IrcMessage
msg Nick
target String
s String
r
    | [String]
commands [String] -> String -> Bool
`arePrefixesOf` String
s  = IrcMessage
-> String -> String -> Nick -> ModuleT (GlobalPrivate () ()) LB ()
doMsg IrcMessage
msg (String -> String
forall a. [a] -> [a]
tail String
s) String
r Nick
target
    | Bool
otherwise                   = Callback (GlobalPrivate () ())
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
-> String -> String -> Nick -> ModuleT (GlobalPrivate () ()) LB ()
doMsg IrcMessage
msg String
cmd String
rest Nick
towhere = do
    let ircmsg :: String -> LB ()
ircmsg = Nick -> String -> LB ()
ircPrivmsg Nick
towhere
    [String]
allcmds <- LB [String] -> ModuleT (GlobalPrivate () ()) LB [String]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((IRCRWState -> [String]) -> LB [String]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Map String (DSum ModuleID CommandRef) -> [String]
forall k a. Map k a -> [k]
M.keys (Map String (DSum ModuleID CommandRef) -> [String])
-> (IRCRWState -> Map String (DSum ModuleID CommandRef))
-> IRCRWState
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRCRWState -> Map String (DSum ModuleID CommandRef)
ircCommands))
    let ms :: [String]
ms      = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
cmd) [String]
allcmds
    Int
e <- Config Int -> ModuleT (GlobalPrivate () ()) LB Int
forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config Int
editDistanceLimit
    case [String]
ms of
        [String
s] -> IrcMessage
-> Nick -> String -> String -> ModuleT (GlobalPrivate () ()) LB ()
docmd IrcMessage
msg Nick
towhere String
rest String
s                  -- a unique prefix
        [String]
_ | String
cmd String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ms -> IrcMessage
-> Nick -> String -> String -> ModuleT (GlobalPrivate () ()) LB ()
docmd IrcMessage
msg Nick
towhere String
rest String
cmd  -- correct command (usual case)
        [String]
_ | Bool
otherwise     -> case String -> [String] -> (Int, [String])
closests String
cmd [String]
allcmds of
          (Int
n,[String
s]) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
e ,  [String]
ms [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [] -> IrcMessage
-> Nick -> String -> String -> ModuleT (GlobalPrivate () ()) LB ()
docmd IrcMessage
msg Nick
towhere String
rest String
s -- unique edit match
          (Int
n,[String]
ss)  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
e Bool -> Bool -> Bool
|| [String]
ms [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= []            -- some possibilities
              -> LB () -> ModuleT (GlobalPrivate () ()) LB ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LB () -> ModuleT (GlobalPrivate () ()) LB ())
-> (String -> LB ())
-> String
-> ModuleT (GlobalPrivate () ()) LB ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LB ()
ircmsg (String -> ModuleT (GlobalPrivate () ()) LB ())
-> String -> ModuleT (GlobalPrivate () ()) LB ()
forall a b. (a -> b) -> a -> b
$ String
"Maybe you meant: "String -> String -> String
forall a. [a] -> [a] -> [a]
++[String] -> String
forall a. Show a => [a] -> String
showClean([String] -> [String]
forall a. Eq a => [a] -> [a]
nub([String]
ms[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String]
ss))
          (Int, [String])
_   -> IrcMessage
-> Nick -> String -> String -> ModuleT (GlobalPrivate () ()) LB ()
docmd IrcMessage
msg Nick
towhere String
rest String
cmd         -- no prefix, edit distance too far

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

            Bool
hasPrivs <- LB Bool -> ModuleT st LB Bool
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 <- String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
cmd' ([String] -> Bool) -> ModuleT st LB [String] -> ModuleT st LB Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config [String] -> ModuleT st LB [String]
forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config [String]
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)

            [String]
response <- if Bool -> Bool
not Bool
ok
                then [String] -> ModuleT st LB [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
"Not enough privileges"]
                else Command (ModuleT st LB)
-> IrcMessage -> Nick -> String -> String -> ModuleT st LB [String]
forall (m :: * -> *) a.
(Monad m, Message a) =>
Command m -> a -> Nick -> String -> String -> m [String]
runCommand Command (ModuleT st LB)
theCmd IrcMessage
msg Nick
towhere String
cmd' String
rest
                    ModuleT st LB [String]
-> (SomeException -> ModuleT st LB [String])
-> ModuleT st LB [String]
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
`E.catch` \exc :: SomeException
exc@SomeException{} ->
                        [String] -> ModuleT st LB [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
"Plugin `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' failed with: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
exc]
            
            -- send off our response strings
            -- TODO: expandTab here should probably be an OutputFilter
            LB () -> ModuleT st LB ()
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
$ (String -> LB ()) -> [String] -> LB ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Nick -> String -> LB ()
ircPrivmsg Nick
towhere (String -> LB ()) -> (String -> String) -> String -> LB ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
expandTab Int
8) [String]
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 -> String -> ModuleT (GlobalPrivate () ()) LB ()
doContextualMsg IrcMessage
msg Nick
target Nick
towhere String
r = LB () -> ModuleT (GlobalPrivate () ()) LB ()
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
            String
mName   <- (ModuleInfo st -> String) -> m String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ModuleInfo st -> String
forall st. ModuleInfo st -> String
moduleName
            String -> m ()
forall (m :: * -> *). MonadLogging m => String -> m ()
debugM (String
"Module " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
mName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" failed in contextual handler: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
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
            [String]
reply   <- Cmd (ModuleT st LB) ()
-> IrcMessage -> Nick -> String -> ModuleT st LB [String]
forall (m :: * -> *) a t.
(Monad m, Message a) =>
Cmd m t -> a -> Nick -> String -> m [String]
execCmd (Module st -> String -> Cmd (ModuleT st LB) ()
forall st. Module st -> String -> Cmd (ModuleT st LB) ()
contextual Module st
m String
r) IrcMessage
msg Nick
target String
"contextual"
            LB () -> ModuleT st LB ()
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
$ (String -> LB ()) -> [String] -> LB ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Nick -> String -> LB ()
ircPrivmsg Nick
towhere) [String]
reply

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

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

maybeCommand :: String -> String -> Maybe String
maybeCommand :: String -> String -> Maybe String
maybeCommand String
nm String
text = MatchResult String -> String
forall a. MatchResult a -> a
mrAfter (MatchResult String -> String)
-> Maybe (MatchResult String) -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Regex -> String -> Maybe (MatchResult String)
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM Regex
re String
text
    where
        re :: Regex
        re :: Regex
re = String -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
makeRegex (String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"[.:,]*[[: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 :: a -> [String] -> m [String]
cleanOutput a
_ [String]
msg = [String] -> m [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ Bool -> [String] -> [String]
forall a. Bool -> [[a]] -> [[a]]
remDups Bool
True [String]
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' :: [String]
msg' = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropFromEnd Char -> Bool
isSpace) [String]
msg

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