{-# 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 (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 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 "PING" Callback (GlobalPrivate () ())
doPING
String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback "NOTICE" Callback (GlobalPrivate () ())
doNOTICE
String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback "PART" Callback (GlobalPrivate () ())
doPART
String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback "KICK" Callback (GlobalPrivate () ())
doKICK
String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback "JOIN" Callback (GlobalPrivate () ())
doJOIN
String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback "NICK" Callback (GlobalPrivate () ())
doNICK
String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback "MODE" Callback (GlobalPrivate () ())
doMODE
String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback "TOPIC" Callback (GlobalPrivate () ())
doTOPIC
String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback "QUIT" Callback (GlobalPrivate () ())
doQUIT
String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback "PRIVMSG" Callback (GlobalPrivate () ())
doPRIVMSG
String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback "001" Callback (GlobalPrivate () ())
doRPL_WELCOME
String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback "005" Callback (GlobalPrivate () ())
doRPL_BOUNCE
String
-> Callback (GlobalPrivate () ())
-> ModuleT (GlobalPrivate () ()) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback "332" Callback (GlobalPrivate () ())
doRPL_TOPIC
}
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 msg :: IrcMessage
msg = "PING! <" String -> String -> String
forall a. [a] -> [a] -> [a]
++ IrcMessage -> String
ircMsgServer IrcMessage
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ (':' Char -> String -> String
forall a. a -> [a] -> [a]
: IrcMessage -> String
ircMsgPrefix IrcMessage
msg) String -> String -> String
forall a. [a] -> [a] -> [a]
++
"> [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ IrcMessage -> String
ircMsgCommand IrcMessage
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ "] " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show (IrcMessage -> [String]
ircMsgParams IrcMessage
msg)
doNOTICE :: IrcMessage -> Base ()
doNOTICE :: Callback (GlobalPrivate () ())
doNOTICE msg :: IrcMessage
msg
| Bool
isCTCPTimeReply = Callback (GlobalPrivate () ())
doPRIVMSG (IrcMessage -> IrcMessage
timeReply IrcMessage
msg)
| 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 = ":\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 msg :: 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 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
/= ':') String
msgArg of
[] -> String
msgArg
aloc :: 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
== ':') String
chan)
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
$ \s :: 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) "[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
where
doPART :: IrcMessage -> Base ()
doPART :: Callback (GlobalPrivate () ())
doPART msg :: 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
$ \s :: 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 msg :: 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
!! 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
!! 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 "" (IrcMessage -> Nick
forall a. Message a => a -> Nick
nick IrcMessage
msg) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " 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
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop 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
$ \s :: 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 msg :: IrcMessage
msg
= Callback (GlobalPrivate () ())
doIGNORE IrcMessage
msg
doMODE :: IrcMessage -> Base ()
doMODE :: Callback (GlobalPrivate () ())
doMODE msg :: IrcMessage
msg
= Callback (GlobalPrivate () ())
doIGNORE IrcMessage
msg
doTOPIC :: IrcMessage -> Base ()
doTOPIC :: Callback (GlobalPrivate () ())
doTOPIC msg :: 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
$ \s :: 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 msg :: 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
$ \state' :: 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
$ \chan :: 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
$ \state' :: 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 msg :: IrcMessage
msg = Callback (GlobalPrivate () ())
doIGNORE IrcMessage
msg
doRPL_BOUNCE :: IrcMessage -> Base ()
doRPL_BOUNCE :: Callback (GlobalPrivate () ())
doRPL_BOUNCE _msg :: IrcMessage
_msg = String -> ModuleT (GlobalPrivate () ()) LB ()
forall (m :: * -> *). MonadLogging m => String -> m ()
debugM "BOUNCE!"
doRPL_TOPIC :: IrcMessage -> Base ()
doRPL_TOPIC :: Callback (GlobalPrivate () ())
doRPL_TOPIC msg :: 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
!! 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
$ \s :: 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 msg :: 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
alltargets
doPRIVMSG' :: [String] -> Nick -> IrcMessage -> Nick -> Base ()
doPRIVMSG' :: [String]
-> Nick
-> IrcMessage
-> Nick
-> ModuleT (GlobalPrivate () ()) LB ()
doPRIVMSG' commands :: [String]
commands myname :: Nick
myname msg :: IrcMessage
msg target :: Nick
target
| Nick
myname Nick -> Nick -> Bool
forall a. Eq a => a -> a -> Bool
== Nick
target
= let (cmd :: String
cmd, params :: 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 ":," ((Char -> Bool) -> Bool) -> (Char -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \c :: 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 wholeCmd :: String
wholeCmd = String -> String -> Maybe String
maybeCommand (String -> Nick -> String
fmtNick (IrcMessage -> String
ircMsgServer IrcMessage
msg) Nick
myname) String
text
(cmd :: String
cmd, params :: 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
> 1
Bool -> Bool -> Bool
&& (String
text String -> Int -> Char
forall a. [a] -> Int -> a
!! 1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ' ')
Bool -> Bool -> Bool
&& (Bool -> Bool
not ([String]
commands [String] -> String -> Bool
`arePrefixesOf` [String
text String -> Int -> Char
forall a. [a] -> Int -> a
!! 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
> 2 Bool -> Bool -> Bool
&& String
text String -> Int -> Char
forall a. [a] -> Int -> a
!! 2 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' '))
= let (cmd :: String
cmd, params :: 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
==' ') 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 commands :: [String]
commands msg :: IrcMessage
msg target :: Nick
target text :: String
text s :: String
s r :: 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 commands :: [String]
commands msg :: IrcMessage
msg target :: Nick
target s :: String
s r :: 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
doMsg :: IrcMessage -> String -> String -> Nick -> Base ()
doMsg :: IrcMessage
-> String -> String -> Nick -> ModuleT (GlobalPrivate () ()) LB ()
doMsg msg :: IrcMessage
msg cmd :: String
cmd rest :: String
rest towhere :: 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
[s :: String
s] -> IrcMessage
-> Nick -> String -> String -> ModuleT (GlobalPrivate () ()) LB ()
docmd IrcMessage
msg Nick
towhere String
rest String
s
_ | 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
_ | Bool
otherwise -> case String -> [String] -> (Int, [String])
closests String
cmd [String]
allcmds of
(n :: Int
n,[s :: 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
(n :: Int
n,ss :: [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
/= []
-> 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
$ "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))
_ -> IrcMessage
-> Nick -> String -> String -> ModuleT (GlobalPrivate () ()) LB ()
docmd IrcMessage
msg Nick
towhere String
rest String
cmd
docmd :: IrcMessage -> Nick -> [Char] -> String -> Base ()
docmd :: IrcMessage
-> Nick -> String -> String -> ModuleT (GlobalPrivate () ()) LB ()
docmd msg :: IrcMessage
msg towhere :: Nick
towhere rest :: String
rest cmd' :: 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
$ \_ _ -> 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'
(Nick -> String -> LB ()
ircPrivmsg Nick
towhere "Unknown command, try @list")
(\theCmd :: 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)
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 ["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 ["Plugin `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name' String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' failed with: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
exc]
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 8) [String]
response
)
doContextualMsg :: IrcMessage -> Nick -> Nick -> [Char] -> Base ()
doContextualMsg :: IrcMessage
-> Nick -> Nick -> String -> ModuleT (GlobalPrivate () ()) LB ()
doContextualMsg msg :: IrcMessage
msg target :: Nick
target towhere :: Nick
towhere r :: 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 x :: 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 ("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]
++ " 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 "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 pat :: String
pat ss :: [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 nm :: String
nm text :: 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]
++ "[.:,]*[[:space:]]*")
cleanOutput :: Monad m => a -> [String] -> m [String]
cleanOutput :: a -> [String] -> m [String]
cleanOutput _ msg :: [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 True ([]:xs :: [[a]]
xs) = Bool -> [[a]] -> [[a]]
remDups Bool
True [[a]]
xs
remDups False ([]:xs :: [[a]]
xs) = [][a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:Bool -> [[a]] -> [[a]]
remDups Bool
True [[a]]
xs
remDups _ (x :: [a]
x: xs :: [[a]]
xs) = [a]
x[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Bool -> [[a]] -> [[a]]
remDups Bool
False [[a]]
xs
remDups _ [] = []
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
lineify :: MonadConfig m => a -> [String] -> m [String]
lineify :: a -> [String] -> m [String]
lineify _ msg :: [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
mbreak :: Int -> String -> [String]
mbreak w :: Int
w xs :: 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
(as :: String
as,bs :: 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 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)
(cs :: String
cs,ds :: 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 = 10