module Network.Anticiv.Modules.Base (initBase,listBase) where
import Control.Monad
import Data.Char
import Data.Chatty.Atoms
import Data.Chatty.AVL
import Data.Chatty.Hetero
import Network.Anticiv.Convenience
import Network.Anticiv.Masks
import Network.Anticiv.Monad
import Text.Printf
initBase :: Packciv (Packciv [String])
initBase = do
regPriorityChanmsg $ msg False addressfl
regPriorityQuerymsg $ msg True privatefl
return listBase
listBase :: Packciv [String]
listBase = return ["hello", "about", "echo", "translate","reauth"]
msg :: Bool -> Speaker -> HandlerA -> UserA -> String -> Anticiv Bool
msg p speak _ u s = do
pref <- bprefix
s & pref :-: LocalT u "hello" :-: ChannelUser #-> (\t -> speak t "Hello" . userNick =<< getAtom t)
.|| pref :-: LocalT u "about" :-: ChannelUser #-> (getAtom >=> \t -> speak u "About" (userNick t) (show t))
.|| pref :-: LocalT u "echo" :-: Remaining #-> (\t -> speak u "Id" $ dropWhile isSpace t)
.|| pref :-: LocalT u "translate" :-: Remaining #-> translate p speak u
.|| pref :-: LocalT u "reauth" :-: CatchInt :-: CatchInt :-: Remaining #-> \(ai,t,_) -> reauth speak u (Atom ai) t
translate :: Bool -> Speaker -> UserA -> String -> Anticiv ()
translate False speak u li = do
bmodify $ \b -> b{botLingua=dropWhile isSpace li}
globalfl "Speaks"
translate True speak u li = do
bmodify $ \b -> b{linguaOverride=avlInsert (u,dropWhile isSpace li) $ linguaOverride b}
speak u "Speaks"
reauth :: Speaker -> UserA -> UserA -> Int -> Anticiv ()
reauth speak u ai t = do
cus <- bgets channelUsers
case ai `elem` cus of
False -> speak u "ReauthFail"
_ -> do
u' <- getAtom u
i' <- getAtom ai
if reauthId i' /= t
then speak u "ReauthFail"
else do
putAtom u i'{reauthId = reauthId u'}
putAtom ai u'{reauthId = reauthId i'}
speak ai "Reauthed"