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 = flip (,) noTimeDiff `fmap` io getClockTime
, moduleSerialize = Just stdSerial
, moduleInit = do
(_, d) <- readMS
t <- io getClockTime
writeMS (t, d)
, moduleExit = do
(initial, d) <- readMS
now <- liftIO getClockTime
writeMS (initial, max d (diffClockTimes now initial))
, moduleCmds = return $
[ (command "listchans")
{ help = say "Show channels bot has joined"
, 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)
}
, (command "listmodules")
{ help = say "listmodules. Show available plugins"
, 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 a. LB a -> Cmd (ModuleT SystemState LB) a
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb LB [String]
listModules
}
, (command "listservers")
{ help = say "listservers. Show current servers"
, 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
}
, (command "list")
{ help = say "list [module|command]. Show commands for [module] or the module providing [command]."
, process = doList
}
, (command "echo")
{ help = say "echo <msg>. echo irc protocol string"
, process = doEcho
}
, (command "uptime")
{ help = say "uptime. Show uptime"
, process = \String
_ -> do
(TimeDiff
uptime, TimeDiff
maxUptime) <- ModuleT SystemState LB (TimeDiff, TimeDiff)
-> Cmd (ModuleT SystemState LB) (TimeDiff, TimeDiff)
forall (m :: * -> *) a. Monad m => m a -> Cmd m a
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)
}
, (command "listall")
{ privileged = True
, help = say "list all commands"
, 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 a. LB a -> Cmd (ModuleT SystemState LB) a
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb LB [String]
listModules
}
, (command "join")
{ privileged = True
, help = say "join <channel>"
, 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 a. LB a -> Cmd (ModuleT SystemState LB) a
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)
}
, (command "part")
{ privileged = True
, help = say "part <channel>"
, aliases = ["leave"]
, 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 a. LB a -> Cmd (ModuleT SystemState LB) a
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)
}
, (command "msg")
{ privileged = True
, help = say "msg <nick or channel> <msg>"
, process = \String
rest -> do
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 a. LB a -> Cmd (ModuleT SystemState LB) a
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
}
, (command "codepage")
{ privileged = True
, help = say "codepage <server> <CP-name>"
, process = \String
rest -> do
let (String
server, String
cp) = String -> (String, String)
splitFirstWord String
rest
LB () -> Cmd (ModuleT SystemState LB) ()
forall a. LB a -> Cmd (ModuleT SystemState LB) a
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
}
, (command "quit")
{ privileged = True
, help = say "quit [msg], have the bot exit with msg"
, 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 a. LB a -> Cmd (ModuleT SystemState LB) a
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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest then String
"requested" else String
rest)
}
, (command "disconnect")
{ privileged = True
, help = say "disconnect <server> [msg], disconnect from a server with msg"
, process = \String
rest -> do
let (String
server, String
msg) = String -> (String, String)
splitFirstWord String
rest
LB () -> Cmd (ModuleT SystemState LB) ()
forall a. LB a -> Cmd (ModuleT SystemState LB) a
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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
msg then String
"requested" else String
msg)
}
, (command "flush")
{ privileged = True
, help = say "flush. flush state to disk"
, process = \String
_ -> LB () -> Cmd (ModuleT SystemState LB) ()
forall a. LB a -> Cmd (ModuleT SystemState 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 ()
forall st. ModuleT st LB ()
writeGlobalState)
}
, (command "admin")
{ privileged = True
, help = say "admin [+|-] nick. change a user's admin status."
, process = doAdmin
}
, (command "ignore")
{ privileged = True
, help = say "ignore [+|-] nick. change a user's ignore status."
, process = doIgnore
}
, (command "reconnect")
{ privileged = True
, help = say "reconnect to server"
, 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 a. LB a -> Cmd (ModuleT SystemState LB) a
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 a. [a] -> 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 a. LB a -> Cmd (ModuleT SystemState LB) a
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 a. a -> Cmd (ModuleT SystemState LB) a
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 = op nck (ircPrivilegedUsers 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 = op nck (ircIgnoredUsers s) }
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 = 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 a. LB a -> Cmd (ModuleT SystemState LB) a
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
ModuleT SystemState LB (LBState (ModuleT SystemState LB))
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 a. a -> ModuleT SystemState LB a
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 :: 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) = 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 a. a -> Cmd m 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 a. a -> Cmd m 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 a. String -> Cmd m 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 a. LB a -> Cmd m a
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 ModuleT st LB String
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 a. a -> LB a
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 :: forall st. 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 a. a -> ModuleT st LB a
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 a. [a] -> 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')]