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