-- | System module : IRC control functions
module Lambdabot.Plugin.Core.System (systemPlugin) where

import Lambdabot.Bot
import Lambdabot.Compat.AltTime
import Lambdabot.Compat.FreenodeNick
import Lambdabot.IRC
import Lambdabot.Module
import Lambdabot.Monad
import Lambdabot.Plugin
import Lambdabot.Util

import Control.Monad.Reader
import Control.Monad.State (gets, modify)
import qualified Data.Map as M
import qualified Data.Set as S

type SystemState = (ClockTime, TimeDiff)
type System = ModuleT SystemState LB

systemPlugin :: Module SystemState
systemPlugin :: Module SystemState
systemPlugin = forall st. Module st
newModule
    { moduleDefState :: LB SystemState
moduleDefState = forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) TimeDiff
noTimeDiff forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ClockTime
getClockTime
    , moduleSerialize :: Maybe (Serial SystemState)
moduleSerialize  = forall a. a -> Maybe a
Just forall s. (Show s, Read s) => Serial s
stdSerial

    , moduleInit :: ModuleT SystemState LB ()
moduleInit = do
        (ClockTime
_, TimeDiff
d) <- forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
        ClockTime
t      <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ClockTime
getClockTime
        forall (m :: * -> *). MonadLBState m => LBState m -> m ()
writeMS (ClockTime
t, TimeDiff
d)
    , moduleExit :: ModuleT SystemState LB ()
moduleExit = do
        (ClockTime
initial, TimeDiff
d) <- forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
        ClockTime
now          <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ClockTime
getClockTime
        forall (m :: * -> *). MonadLBState m => LBState m -> m ()
writeMS (ClockTime
initial, forall a. Ord a => a -> a -> a
max TimeDiff
d (ClockTime -> ClockTime -> TimeDiff
diffClockTimes ClockTime
now ClockTime
initial))
    
    , moduleCmds :: ModuleT SystemState LB [Command (ModuleT SystemState LB)]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        [ (String -> Command Identity
command String
"listchans")
            { help :: Cmd (ModuleT SystemState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Show channels bot has joined"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
_ -> forall k v.
Show k =>
(IRCRWState -> Map k v) -> Cmd (ModuleT SystemState LB) ()
listKeys (forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeysMonotonic (Nick -> FreenodeNick
FreenodeNick forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChanName -> Nick
getCN) forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRCRWState -> Map ChanName String
ircChannels)
            }
        , (String -> Command Identity
command String
"listmodules")
            { help :: Cmd (ModuleT SystemState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"listmodules. Show available plugins"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
_ -> forall (m :: * -> *). Monad m => String -> Cmd m ()
say forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => [a] -> String
showClean forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb LB [String]
listModules
            }
        , (String -> Command Identity
command String
"listservers")
            { help :: Cmd (ModuleT SystemState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"listservers. Show current servers"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
_ -> forall k v.
Show k =>
(IRCRWState -> Map k v) -> Cmd (ModuleT SystemState LB) ()
listKeys IRCRWState -> Map String (DSum ModuleID ServerRef)
ircServerMap
            }
        , (String -> Command Identity
command String
"list")
            { help :: Cmd (ModuleT SystemState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"list [module|command]. Show commands for [module] or the module providing [command]."
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = String -> Cmd (ModuleT SystemState LB) ()
doList
            }
        , (String -> Command Identity
command String
"echo")
            { help :: Cmd (ModuleT SystemState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"echo <msg>. echo irc protocol string"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = String -> Cmd (ModuleT SystemState LB) ()
doEcho
            }
        , (String -> Command Identity
command String
"uptime")
            { help :: Cmd (ModuleT SystemState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"uptime. Show uptime"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
_ -> do
                (TimeDiff
uptime, TimeDiff
maxUptime) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift System (TimeDiff, TimeDiff)
getUptime
                forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String
"uptime: "           forall a. [a] -> [a] -> [a]
++ TimeDiff -> String
timeDiffPretty TimeDiff
uptime forall a. [a] -> [a] -> [a]
++
                     String
", longest uptime: " forall a. [a] -> [a] -> [a]
++ TimeDiff -> String
timeDiffPretty TimeDiff
maxUptime)
            }
        
        , (String -> Command Identity
command String
"listall")
            { privileged :: Bool
privileged = Bool
True
            , help :: Cmd (ModuleT SystemState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"list all commands"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
_ -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> Cmd (ModuleT SystemState LB) ()
doList forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb LB [String]
listModules
            }
        , (String -> Command Identity
command String
"join")
            { privileged :: Bool
privileged = Bool
True
            , help :: Cmd (ModuleT SystemState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"join <channel>"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
rest -> do
                Nick
chan <- forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick String
rest
                forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb forall a b. (a -> b) -> a -> b
$ IrcMessage -> LB ()
send (Nick -> IrcMessage
joinChannel Nick
chan)
            }
        , (String -> Command Identity
command String
"part")
            { privileged :: Bool
privileged = Bool
True
            , help :: Cmd (ModuleT SystemState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"part <channel>"
            , aliases :: [String]
aliases = [String
"leave"]
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
rest -> do
                Nick
chan <- forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick String
rest
                forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb forall a b. (a -> b) -> a -> b
$ IrcMessage -> LB ()
send (Nick -> IrcMessage
partChannel Nick
chan)
            }
        , (String -> Command Identity
command String
"msg")
            { privileged :: Bool
privileged = Bool
True
            , help :: Cmd (ModuleT SystemState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"msg <nick or channel> <msg>"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
rest -> do
                -- writes to another location:
                let (String
tgt, String
txt) = String -> (String, String)
splitFirstWord String
rest
                Nick
tgtNick <- forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick String
tgt
                forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb forall a b. (a -> b) -> a -> b
$ Nick -> String -> LB ()
ircPrivmsg Nick
tgtNick String
txt
            }
        , (String -> Command Identity
command String
"codepage")
            { privileged :: Bool
privileged = Bool
True
            , help :: Cmd (ModuleT SystemState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"codepage <server> <CP-name>"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
rest -> do
                let (String
server, String
cp) = String -> (String, String)
splitFirstWord String
rest
                forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb forall a b. (a -> b) -> a -> b
$ String -> String -> LB ()
ircCodepage String
server String
cp
            }
        , (String -> Command Identity
command String
"quit")
            { privileged :: Bool
privileged = Bool
True
            , help :: Cmd (ModuleT SystemState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"quit [msg], have the bot exit with msg"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
rest -> do
                String
server <- forall (m :: * -> *). Monad m => Cmd m String
getServer
                forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (String -> String -> LB ()
ircQuit String
server forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest then String
"requested" else String
rest)
            }
        , (String -> Command Identity
command String
"disconnect")
            { privileged :: Bool
privileged = Bool
True
            , help :: Cmd (ModuleT SystemState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"disconnect <server> [msg], disconnect from a server with msg"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
rest -> do
                let (String
server, String
msg) = String -> (String, String)
splitFirstWord String
rest
                forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (String -> String -> LB ()
ircQuit String
server forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
msg then String
"requested" else String
msg)
            }
        , (String -> Command Identity
command String
"flush")
            { privileged :: Bool
privileged = Bool
True
            , help :: Cmd (ModuleT SystemState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"flush. flush state to disk"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
_ -> forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (forall a. (forall st. ModuleT st LB a) -> LB ()
withAllModules forall st. ModuleT st LB ()
writeGlobalState)
                
            }
        , (String -> Command Identity
command String
"admin")
            { privileged :: Bool
privileged = Bool
True
            , help :: Cmd (ModuleT SystemState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"admin [+|-] nick. change a user's admin status."
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = String -> Cmd (ModuleT SystemState LB) ()
doAdmin
            }
        , (String -> Command Identity
command String
"ignore")
            { privileged :: Bool
privileged = Bool
True
            , help :: Cmd (ModuleT SystemState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"ignore [+|-] nick. change a user's ignore status."
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = String -> Cmd (ModuleT SystemState LB) ()
doIgnore
            }
        , (String -> Command Identity
command String
"reconnect")
            { privileged :: Bool
privileged = Bool
True
            , help :: Cmd (ModuleT SystemState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"reconnect to server"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
rest -> do
                String
server <- forall (m :: * -> *). Monad m => Cmd m String
getServer
                forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (String -> String -> LB ()
ircReconnect String
server forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest then String
"reconnect requested" else String
rest)
            }
        ]
    }

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

doList :: String -> Cmd System ()
doList :: String -> Cmd (ModuleT SystemState LB) ()
doList String
"" = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"What module?  Try @listmodules for some ideas."
doList String
m  = forall (m :: * -> *). Monad m => String -> Cmd m ()
say forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (String -> LB String
listModule String
m)

doEcho :: String -> Cmd System ()
doEcho :: String -> Cmd (ModuleT SystemState LB) ()
doEcho String
rest = do
    String
rawMsg <- forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
    String
target <- forall (m :: * -> *). Monad m => Nick -> Cmd m String
showNick forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). Monad m => Cmd m Nick
getTarget
    forall (m :: * -> *). Monad m => String -> Cmd m ()
say (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"echo; msg:", String
rawMsg, String
" target:" , String
target, String
" rest:", forall a. Show a => a -> String
show String
rest])

doAdmin :: String -> Cmd System ()
doAdmin :: String -> Cmd (ModuleT SystemState LB) ()
doAdmin = forall a (m :: * -> *).
(Ord a, MonadLB m) =>
((a -> Set a -> Set a) -> Nick -> IRCRWState -> IRCRWState)
-> String -> Cmd m ()
toggleNick forall a b. (a -> b) -> a -> b
$ \Nick -> Set Nick -> Set Nick
op Nick
nck IRCRWState
s -> IRCRWState
s { ircPrivilegedUsers :: Set Nick
ircPrivilegedUsers = Nick -> Set Nick -> Set Nick
op Nick
nck (IRCRWState -> Set Nick
ircPrivilegedUsers IRCRWState
s) }

doIgnore :: String -> Cmd System ()
doIgnore :: String -> Cmd (ModuleT SystemState LB) ()
doIgnore = forall a (m :: * -> *).
(Ord a, MonadLB m) =>
((a -> Set a -> Set a) -> Nick -> IRCRWState -> IRCRWState)
-> String -> Cmd m ()
toggleNick forall a b. (a -> b) -> a -> b
$ \Nick -> Set Nick -> Set Nick
op Nick
nck IRCRWState
s -> IRCRWState
s { ircIgnoredUsers :: Set Nick
ircIgnoredUsers = Nick -> Set Nick -> Set Nick
op Nick
nck (IRCRWState -> Set Nick
ircIgnoredUsers IRCRWState
s) }

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

--  | Print map keys
listKeys :: Show k => (IRCRWState -> M.Map k v) -> Cmd System ()
listKeys :: forall k v.
Show k =>
(IRCRWState -> Map k v) -> Cmd (ModuleT SystemState LB) ()
listKeys IRCRWState -> Map k v
f = forall (m :: * -> *). Monad m => String -> Cmd m ()
say forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => [a] -> String
showClean forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [k]
M.keys forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets IRCRWState -> Map k v
f)

getUptime :: System (TimeDiff, TimeDiff)
getUptime :: System (TimeDiff, TimeDiff)
getUptime = do
    (ClockTime
loaded, TimeDiff
m) <- forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
    ClockTime
now         <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ClockTime
getClockTime
    let diff :: TimeDiff
diff = ClockTime
now ClockTime -> ClockTime -> TimeDiff
`diffClockTimes` ClockTime
loaded
    forall (m :: * -> *) a. Monad m => a -> m a
return (TimeDiff
diff, forall a. Ord a => a -> a -> a
max TimeDiff
diff TimeDiff
m)

toggleNick :: (Ord a, MonadLB m) =>
    ((a -> S.Set a -> S.Set a) -> Nick -> IRCRWState -> IRCRWState)
    -> String -> Cmd m ()
toggleNick :: forall a (m :: * -> *).
(Ord a, MonadLB m) =>
((a -> Set a -> Set a) -> Nick -> IRCRWState -> IRCRWState)
-> String -> Cmd m ()
toggleNick (a -> Set a -> Set a) -> Nick -> IRCRWState -> IRCRWState
edit String
rest = do
    let (String
op, String
tgt) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
2 String
rest
    
    a -> Set a -> Set a
f <- case String
op of
        String
"+ " -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Ord a => a -> Set a -> Set a
S.insert
        String
"- " -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Ord a => a -> Set a -> Set a
S.delete
        String
_    -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid usage"
    
    Nick
nck <- forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick String
tgt
    forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ (a -> Set a -> Set a) -> Nick -> IRCRWState -> IRCRWState
edit a -> Set a -> Set a
f Nick
nck

listModule :: String -> LB String
listModule :: String -> LB String
listModule String
s = forall a. String -> LB a -> (forall st. ModuleT st LB a) -> LB a
inModuleNamed String
s LB String
fromCommand forall st. ModuleT st LB String
printProvides
  where
    fromCommand :: LB String
fromCommand = forall a.
String
-> LB a
-> (forall st. Command (ModuleT st LB) -> ModuleT st LB a)
-> LB a
withCommand String
s
        (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"No module \""forall a. [a] -> [a] -> [a]
++String
sforall a. [a] -> [a] -> [a]
++String
"\" loaded") (forall a b. a -> b -> a
const forall st. ModuleT st LB String
printProvides)

    printProvides :: ModuleT st LB String
    printProvides :: forall st. ModuleT st LB String
printProvides = do
        [Command (ModuleT st LB)]
cmds <- forall st. Module st -> ModuleT st LB [Command (ModuleT st LB)]
moduleCmds forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall st. ModuleInfo st -> Module st
theModule
        let cmds' :: [Command (ModuleT st LB)]
cmds' = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Command m -> Bool
privileged) [Command (ModuleT st LB)]
cmds
        String
name' <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall st. ModuleInfo st -> String
moduleName
        forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Command (ModuleT st LB)]
cmds'
                          then [String
name', String
" has no visible commands"]
                          else [String
name', String
" provides: ", forall a. Show a => [a] -> String
showClean (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (m :: * -> *). Command m -> [String]
cmdNames [Command (ModuleT st LB)]
cmds')]