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

    , moduleInit :: ModuleT SystemState LB ()
moduleInit = do
        (ClockTime
_, TimeDiff
d) <- ModuleT SystemState LB SystemState
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
        ClockTime
t      <- IO ClockTime -> ModuleT SystemState LB ClockTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ClockTime
getClockTime
        LBState (ModuleT SystemState LB) -> ModuleT SystemState LB ()
forall (m :: * -> *). MonadLBState m => LBState m -> m ()
writeMS (ClockTime
t, TimeDiff
d)
    , moduleExit :: ModuleT SystemState LB ()
moduleExit = do
        (ClockTime
initial, TimeDiff
d) <- ModuleT SystemState LB SystemState
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
        ClockTime
now          <- IO ClockTime -> ModuleT SystemState LB ClockTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ClockTime
getClockTime
        LBState (ModuleT SystemState LB) -> ModuleT SystemState LB ()
forall (m :: * -> *). MonadLBState m => LBState m -> m ()
writeMS (ClockTime
initial, TimeDiff -> TimeDiff -> TimeDiff
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 = [Command (ModuleT SystemState LB)]
-> ModuleT SystemState LB [Command (ModuleT SystemState LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Command (ModuleT SystemState LB)]
 -> ModuleT SystemState LB [Command (ModuleT SystemState LB)])
-> [Command (ModuleT SystemState LB)]
-> ModuleT SystemState LB [Command (ModuleT SystemState LB)]
forall a b. (a -> b) -> a -> b
$
        [ (String -> Command Identity
command String
"listchans")
            { help :: Cmd (ModuleT SystemState LB) ()
help = String -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Show channels bot has joined"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
_ -> (IRCRWState -> Map FreenodeNick String)
-> Cmd (ModuleT SystemState LB) ()
forall k v.
Show k =>
(IRCRWState -> Map k v) -> Cmd (ModuleT SystemState LB) ()
listKeys ((ChanName -> FreenodeNick)
-> Map ChanName String -> Map FreenodeNick String
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeysMonotonic (Nick -> FreenodeNick
FreenodeNick (Nick -> FreenodeNick)
-> (ChanName -> Nick) -> ChanName -> FreenodeNick
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChanName -> Nick
getCN) (Map ChanName String -> Map FreenodeNick String)
-> (IRCRWState -> Map ChanName String)
-> IRCRWState
-> Map FreenodeNick String
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 = String -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"listmodules. Show available plugins"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
_ -> String -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT SystemState LB) ())
-> ([String] -> String)
-> [String]
-> Cmd (ModuleT SystemState LB) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. Show a => [a] -> String
showClean ([String] -> Cmd (ModuleT SystemState LB) ())
-> Cmd (ModuleT SystemState LB) [String]
-> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LB [String] -> Cmd (ModuleT SystemState LB) [String]
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 = String -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"listservers. Show current servers"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
_ -> (IRCRWState -> Map String (DSum ModuleID ServerRef))
-> Cmd (ModuleT SystemState LB) ()
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 = String -> Cmd (ModuleT SystemState LB) ()
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 = String -> Cmd (ModuleT SystemState LB) ()
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 = String -> Cmd (ModuleT SystemState LB) ()
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) <- ModuleT SystemState LB (TimeDiff, TimeDiff)
-> Cmd (ModuleT SystemState LB) (TimeDiff, TimeDiff)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ModuleT SystemState LB (TimeDiff, TimeDiff)
getUptime
                String -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String
"uptime: "           String -> String -> String
forall a. [a] -> [a] -> [a]
++ TimeDiff -> String
timeDiffPretty TimeDiff
uptime String -> String -> String
forall a. [a] -> [a] -> [a]
++
                     String
", longest uptime: " String -> String -> String
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 = String -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"list all commands"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
_ -> (String -> Cmd (ModuleT SystemState LB) ())
-> [String] -> Cmd (ModuleT SystemState LB) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> Cmd (ModuleT SystemState LB) ()
doList ([String] -> Cmd (ModuleT SystemState LB) ())
-> Cmd (ModuleT SystemState LB) [String]
-> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LB [String] -> Cmd (ModuleT SystemState LB) [String]
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 = String -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"join <channel>"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
rest -> do
                Nick
chan <- String -> Cmd (ModuleT SystemState LB) Nick
forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick String
rest
                LB () -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> Cmd (ModuleT SystemState LB) ())
-> LB () -> Cmd (ModuleT SystemState 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 = String -> Cmd (ModuleT SystemState LB) ()
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 <- String -> Cmd (ModuleT SystemState LB) Nick
forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick String
rest
                LB () -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> Cmd (ModuleT SystemState LB) ())
-> LB () -> Cmd (ModuleT SystemState 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 = String -> Cmd (ModuleT SystemState LB) ()
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 <- String -> Cmd (ModuleT SystemState LB) Nick
forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick String
tgt
                LB () -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> Cmd (ModuleT SystemState LB) ())
-> LB () -> Cmd (ModuleT SystemState 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 = String -> Cmd (ModuleT SystemState LB) ()
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
                LB () -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> Cmd (ModuleT SystemState LB) ())
-> LB () -> Cmd (ModuleT SystemState 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 = String -> Cmd (ModuleT SystemState LB) ()
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 <- Cmd (ModuleT SystemState LB) String
forall (m :: * -> *). Monad m => Cmd m String
getServer
                LB () -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (String -> String -> LB ()
ircQuit String
server (String -> LB ()) -> String -> LB ()
forall a b. (a -> b) -> a -> b
$ if String -> Bool
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 = String -> Cmd (ModuleT SystemState LB) ()
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
                LB () -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (String -> String -> LB ()
ircQuit String
server (String -> LB ()) -> String -> LB ()
forall a b. (a -> b) -> a -> b
$ if String -> Bool
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 = String -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"flush. flush state to disk"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
_ -> LB () -> Cmd (ModuleT SystemState 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 forall st. ModuleT st LB ()
writeGlobalState)
                
            }
        , (String -> Command Identity
command String
"admin")
            { privileged :: Bool
privileged = Bool
True
            , help :: Cmd (ModuleT SystemState LB) ()
help = String -> Cmd (ModuleT SystemState LB) ()
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 = String -> Cmd (ModuleT SystemState LB) ()
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 = String -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"reconnect to server"
            , process :: String -> Cmd (ModuleT SystemState LB) ()
process = \String
rest -> do
                String
server <- Cmd (ModuleT SystemState LB) String
forall (m :: * -> *). Monad m => Cmd m String
getServer
                LB () -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (String -> String -> LB ()
ircReconnect String
server (String -> LB ()) -> String -> LB ()
forall a b. (a -> b) -> a -> b
$ if String -> Bool
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
"" = String -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"What module?  Try @listmodules for some ideas."
doList String
m  = String -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT SystemState LB) ())
-> Cmd (ModuleT SystemState LB) String
-> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LB String -> Cmd (ModuleT SystemState LB) String
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 a. Message a => a -> Cmd (ModuleT SystemState LB) String)
-> Cmd (ModuleT SystemState LB) String
forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg (String -> Cmd (ModuleT SystemState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd (ModuleT SystemState LB) String)
-> (a -> String) -> a -> Cmd (ModuleT SystemState LB) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show)
    String
target <- Nick -> Cmd (ModuleT SystemState LB) String
forall (m :: * -> *). Monad m => Nick -> Cmd m String
showNick (Nick -> Cmd (ModuleT SystemState LB) String)
-> Cmd (ModuleT SystemState LB) Nick
-> Cmd (ModuleT SystemState LB) String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd (ModuleT SystemState LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getTarget
    String -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"echo; msg:", String
rawMsg, String
" target:" , String
target, String
" rest:", String -> String
forall a. Show a => a -> String
show String
rest])

doAdmin :: String -> Cmd System ()
doAdmin :: String -> Cmd (ModuleT SystemState LB) ()
doAdmin = ((Nick -> Set Nick -> Set Nick)
 -> Nick -> IRCRWState -> IRCRWState)
-> String -> Cmd (ModuleT SystemState LB) ()
forall a (m :: * -> *).
(Ord a, MonadLB m) =>
((a -> Set a -> Set a) -> Nick -> IRCRWState -> IRCRWState)
-> String -> Cmd m ()
toggleNick (((Nick -> Set Nick -> Set Nick)
  -> Nick -> IRCRWState -> IRCRWState)
 -> String -> Cmd (ModuleT SystemState LB) ())
-> ((Nick -> Set Nick -> Set Nick)
    -> Nick -> IRCRWState -> IRCRWState)
-> String
-> Cmd (ModuleT SystemState LB) ()
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 = ((Nick -> Set Nick -> Set Nick)
 -> Nick -> IRCRWState -> IRCRWState)
-> String -> Cmd (ModuleT SystemState LB) ()
forall a (m :: * -> *).
(Ord a, MonadLB m) =>
((a -> Set a -> Set a) -> Nick -> IRCRWState -> IRCRWState)
-> String -> Cmd m ()
toggleNick (((Nick -> Set Nick -> Set Nick)
  -> Nick -> IRCRWState -> IRCRWState)
 -> String -> Cmd (ModuleT SystemState LB) ())
-> ((Nick -> Set Nick -> Set Nick)
    -> Nick -> IRCRWState -> IRCRWState)
-> String
-> Cmd (ModuleT SystemState LB) ()
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 :: (IRCRWState -> Map k v) -> Cmd (ModuleT SystemState LB) ()
listKeys IRCRWState -> Map k v
f = String -> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT SystemState LB) ())
-> (Map k v -> String)
-> Map k v
-> Cmd (ModuleT SystemState LB) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [k] -> String
forall a. Show a => [a] -> String
showClean ([k] -> String) -> (Map k v -> [k]) -> Map k v -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [k]
forall k a. Map k a -> [k]
M.keys (Map k v -> Cmd (ModuleT SystemState LB) ())
-> Cmd (ModuleT SystemState LB) (Map k v)
-> Cmd (ModuleT SystemState LB) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LB (Map k v) -> Cmd (ModuleT SystemState LB) (Map k v)
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb ((IRCRWState -> Map k v) -> LB (Map k v)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets IRCRWState -> Map k v
f)

getUptime :: System (TimeDiff, TimeDiff)
getUptime :: ModuleT SystemState LB (TimeDiff, TimeDiff)
getUptime = do
    (ClockTime
loaded, TimeDiff
m) <- ModuleT SystemState LB SystemState
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
    ClockTime
now         <- IO ClockTime -> ModuleT SystemState LB ClockTime
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
    (TimeDiff, TimeDiff) -> ModuleT SystemState LB (TimeDiff, TimeDiff)
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeDiff
diff, TimeDiff -> TimeDiff -> TimeDiff
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 :: ((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) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
2 String
rest
    
    a -> Set a -> Set a
f <- case String
op of
        String
"+ " -> (a -> Set a -> Set a) -> Cmd m (a -> Set a -> Set a)
forall (m :: * -> *) a. Monad m => a -> m a
return a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert
        String
"- " -> (a -> Set a -> Set a) -> Cmd m (a -> Set a -> Set a)
forall (m :: * -> *) a. Monad m => a -> m a
return a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.delete
        String
_    -> String -> Cmd m (a -> Set a -> Set a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid usage"
    
    Nick
nck <- String -> Cmd m Nick
forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick String
tgt
    LB () -> Cmd m ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> Cmd m ())
-> ((IRCRWState -> IRCRWState) -> LB ())
-> (IRCRWState -> IRCRWState)
-> Cmd m ()
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) -> Cmd m ())
-> (IRCRWState -> IRCRWState) -> Cmd m ()
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 = String
-> LB String -> (forall st. ModuleT st LB String) -> LB String
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 = String
-> LB String
-> (forall st. Command (ModuleT st LB) -> ModuleT st LB String)
-> LB String
forall a.
String
-> LB a
-> (forall st. Command (ModuleT st LB) -> ModuleT st LB a)
-> LB a
withCommand String
s
        (String -> LB String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> LB String) -> String -> LB String
forall a b. (a -> b) -> a -> b
$ String
"No module \""String -> String -> String
forall a. [a] -> [a] -> [a]
++String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\" loaded") (ModuleT st LB String
-> Command (ModuleT st LB) -> ModuleT st LB String
forall a b. a -> b -> a
const ModuleT st LB String
forall st. ModuleT st LB String
printProvides)

    printProvides :: ModuleT st LB String
    printProvides :: ModuleT st LB String
printProvides = do
        [Command (ModuleT st LB)]
cmds <- Module st -> ModuleT st LB [Command (ModuleT st LB)]
forall st. Module st -> ModuleT st LB [Command (ModuleT st LB)]
moduleCmds (Module st -> ModuleT st LB [Command (ModuleT st LB)])
-> ModuleT st LB (Module st)
-> ModuleT st LB [Command (ModuleT st LB)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (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
        let cmds' :: [Command (ModuleT st LB)]
cmds' = (Command (ModuleT st LB) -> Bool)
-> [Command (ModuleT st LB)] -> [Command (ModuleT st LB)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (Command (ModuleT st LB) -> Bool)
-> Command (ModuleT st LB)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command (ModuleT st LB) -> Bool
forall (m :: * -> *). Command m -> Bool
privileged) [Command (ModuleT st LB)]
cmds
        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
        String -> ModuleT st LB String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ModuleT st LB String)
-> ([String] -> String) -> [String] -> ModuleT st LB String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> ModuleT st LB String)
-> [String] -> ModuleT st LB String
forall a b. (a -> b) -> a -> b
$ if [Command (ModuleT st LB)] -> Bool
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: ", [String] -> String
forall a. Show a => [a] -> String
showClean ((Command (ModuleT st LB) -> [String])
-> [Command (ModuleT st LB)] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Command (ModuleT st LB) -> [String]
forall (m :: * -> *). Command m -> [String]
cmdNames [Command (ModuleT st LB)]
cmds')]