module Lambdabot.Plugin.Core.OfflineRC ( offlineRCPlugin ) where
import Lambdabot.Config.Core
import Lambdabot.IRC
import Lambdabot.Monad
import Lambdabot.Plugin
import Lambdabot.Util
import Control.Concurrent.Lifted
import Control.Exception.Lifted ( evaluate, finally )
import Control.Monad( void, when )
import Control.Monad.State( gets, modify )
import Control.Monad.Trans( lift, liftIO )
import Data.Char
import qualified Data.Map as M
import qualified Data.Set as S
import System.Console.Haskeline (InputT, Settings(..), runInputT, defaultSettings, getInputLine)
import System.IO
import System.Timeout.Lifted
import Codec.Binary.UTF8.String
type OfflineRCState = Integer
type OfflineRC = ModuleT OfflineRCState LB
offlineRCPlugin :: Module OfflineRCState
offlineRCPlugin :: Module OfflineRCState
offlineRCPlugin = Module OfflineRCState
forall st. Module st
newModule
{ moduleDefState :: LB OfflineRCState
moduleDefState = OfflineRCState -> LB OfflineRCState
forall (m :: * -> *) a. Monad m => a -> m a
return OfflineRCState
0
, moduleInit :: ModuleT OfflineRCState LB ()
moduleInit = do
LB () -> ModuleT OfflineRCState LB ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> ModuleT OfflineRCState LB ())
-> ((IRCRWState -> IRCRWState) -> LB ())
-> (IRCRWState -> IRCRWState)
-> ModuleT OfflineRCState 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 OfflineRCState LB ())
-> (IRCRWState -> IRCRWState) -> ModuleT OfflineRCState LB ()
forall a b. (a -> b) -> a -> b
$ \IRCRWState
s -> IRCRWState
s
{ ircPrivilegedUsers :: Set Nick
ircPrivilegedUsers = Nick -> Set Nick -> Set Nick
forall a. Ord a => a -> Set a -> Set a
S.insert (String -> String -> Nick
Nick String
"offlinerc" String
"null") (IRCRWState -> Set Nick
ircPrivilegedUsers IRCRWState
s)
}
ModuleT OfflineRCState LB ThreadId -> ModuleT OfflineRCState LB ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ModuleT OfflineRCState LB ThreadId
-> ModuleT OfflineRCState LB ())
-> (ModuleT OfflineRCState LB ()
-> ModuleT OfflineRCState LB ThreadId)
-> ModuleT OfflineRCState LB ()
-> ModuleT OfflineRCState LB ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleT OfflineRCState LB () -> ModuleT OfflineRCState LB ThreadId
forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
forkUnmasked (ModuleT OfflineRCState LB () -> ModuleT OfflineRCState LB ())
-> ModuleT OfflineRCState LB () -> ModuleT OfflineRCState LB ()
forall a b. (a -> b) -> a -> b
$ do
ModuleT OfflineRCState LB ()
forall (m :: * -> *). MonadLB m => m ()
waitForInit
ModuleT OfflineRCState LB ()
lockRC
[String]
cmds <- Config [String] -> ModuleT OfflineRCState LB [String]
forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config [String]
onStartupCmds
(String -> ModuleT OfflineRCState LB ())
-> [String] -> ModuleT OfflineRCState LB ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> ModuleT OfflineRCState LB ()
feed [String]
cmds ModuleT OfflineRCState LB ()
-> ModuleT OfflineRCState LB () -> ModuleT OfflineRCState LB ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`finally` ModuleT OfflineRCState LB ()
unlockRC
, moduleCmds :: ModuleT OfflineRCState LB [Command (ModuleT OfflineRCState LB)]
moduleCmds = [Command (ModuleT OfflineRCState LB)]
-> ModuleT OfflineRCState LB [Command (ModuleT OfflineRCState LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return
[ (String -> Command Identity
command String
"offline")
{ privileged :: Bool
privileged = Bool
True
, help :: Cmd (ModuleT OfflineRCState LB) ()
help = String -> Cmd (ModuleT OfflineRCState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"offline. Start a repl"
, process :: String -> Cmd (ModuleT OfflineRCState LB) ()
process = Cmd (ModuleT OfflineRCState LB) ()
-> String -> Cmd (ModuleT OfflineRCState LB) ()
forall a b. a -> b -> a
const (Cmd (ModuleT OfflineRCState LB) ()
-> String -> Cmd (ModuleT OfflineRCState LB) ())
-> (ModuleT OfflineRCState LB ()
-> Cmd (ModuleT OfflineRCState LB) ())
-> ModuleT OfflineRCState LB ()
-> String
-> Cmd (ModuleT OfflineRCState LB) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleT OfflineRCState LB () -> Cmd (ModuleT OfflineRCState LB) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ModuleT OfflineRCState LB ()
-> String -> Cmd (ModuleT OfflineRCState LB) ())
-> ModuleT OfflineRCState LB ()
-> String
-> Cmd (ModuleT OfflineRCState LB) ()
forall a b. (a -> b) -> a -> b
$ do
ModuleT OfflineRCState LB ()
lockRC
String
histFile <- LB String -> ModuleT OfflineRCState LB String
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB String -> ModuleT OfflineRCState LB String)
-> LB String -> ModuleT OfflineRCState LB String
forall a b. (a -> b) -> a -> b
$ String -> LB String
findLBFileForWriting String
"offlinerc"
let settings :: Settings (ModuleT OfflineRCState LB)
settings = Settings (ModuleT OfflineRCState LB)
forall (m :: * -> *). MonadIO m => Settings m
defaultSettings { historyFile :: Maybe String
historyFile = String -> Maybe String
forall a. a -> Maybe a
Just String
histFile }
ThreadId
_ <- ModuleT OfflineRCState LB () -> ModuleT OfflineRCState LB ThreadId
forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
fork (Settings (ModuleT OfflineRCState LB)
-> InputT (ModuleT OfflineRCState LB) ()
-> ModuleT OfflineRCState LB ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
runInputT Settings (ModuleT OfflineRCState LB)
settings InputT (ModuleT OfflineRCState LB) ()
replLoop ModuleT OfflineRCState LB ()
-> ModuleT OfflineRCState LB () -> ModuleT OfflineRCState LB ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`finally` ModuleT OfflineRCState LB ()
unlockRC)
() -> ModuleT OfflineRCState LB ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
}
, (String -> Command Identity
command String
"rc")
{ privileged :: Bool
privileged = Bool
True
, help :: Cmd (ModuleT OfflineRCState LB) ()
help = String -> Cmd (ModuleT OfflineRCState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"rc name. Read a file of commands (asynchronously). TODO: better name."
, process :: String -> Cmd (ModuleT OfflineRCState LB) ()
process = \String
fn -> ModuleT OfflineRCState LB () -> Cmd (ModuleT OfflineRCState LB) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ModuleT OfflineRCState LB ()
-> Cmd (ModuleT OfflineRCState LB) ())
-> ModuleT OfflineRCState LB ()
-> Cmd (ModuleT OfflineRCState LB) ()
forall a b. (a -> b) -> a -> b
$ do
String
txt <- IO String -> ModuleT OfflineRCState LB String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO String -> ModuleT OfflineRCState LB String)
-> IO String -> ModuleT OfflineRCState LB String
forall a b. (a -> b) -> a -> b
$ String -> IO String
readFile String
fn
IO () -> ModuleT OfflineRCState LB ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> ModuleT OfflineRCState LB ())
-> IO () -> ModuleT OfflineRCState LB ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. MonadBase IO m => a -> m a
evaluate (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Char -> () -> ()) -> () -> String -> ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> () -> ()
seq () String
txt
ModuleT OfflineRCState LB ()
lockRC
ThreadId
_ <- ModuleT OfflineRCState LB () -> ModuleT OfflineRCState LB ThreadId
forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
fork ((String -> ModuleT OfflineRCState LB ())
-> [String] -> ModuleT OfflineRCState LB ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> ModuleT OfflineRCState LB ()
feed (String -> [String]
lines String
txt) ModuleT OfflineRCState LB ()
-> ModuleT OfflineRCState LB () -> ModuleT OfflineRCState LB ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`finally` ModuleT OfflineRCState LB ()
unlockRC)
() -> ModuleT OfflineRCState LB ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
}
]
}
feed :: String -> OfflineRC ()
feed :: String -> ModuleT OfflineRCState LB ()
feed String
msg = do
String
cmdPrefix <- ([String] -> String)
-> ModuleT OfflineRCState LB [String]
-> ModuleT OfflineRCState LB String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
forall a. [a] -> a
head (Config [String] -> ModuleT OfflineRCState LB [String]
forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config [String]
commandPrefixes)
let msg' :: String
msg' = case String
msg of
Char
'>':String
xs -> String
cmdPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"run " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
xs
Char
'!':String
xs -> String
xs
String
_ -> String
cmdPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') String
msg
LB () -> ModuleT OfflineRCState LB ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> ModuleT OfflineRCState LB ())
-> (IrcMessage -> LB ())
-> IrcMessage
-> ModuleT OfflineRCState LB ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LB (Maybe ()) -> LB ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LB (Maybe ()) -> LB ())
-> (IrcMessage -> LB (Maybe ())) -> IrcMessage -> LB ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> LB () -> LB (Maybe ())
forall (m :: * -> *) a.
MonadBaseControl IO m =>
Int -> m a -> m (Maybe a)
timeout (Int
15 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000) (LB () -> LB (Maybe ()))
-> (IrcMessage -> LB ()) -> IrcMessage -> LB (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IrcMessage -> LB ()
received (IrcMessage -> ModuleT OfflineRCState LB ())
-> IrcMessage -> ModuleT OfflineRCState LB ()
forall a b. (a -> b) -> a -> b
$
IrcMessage :: String -> String -> String -> String -> [String] -> IrcMessage
IrcMessage { ircMsgServer :: String
ircMsgServer = String
"offlinerc"
, ircMsgLBName :: String
ircMsgLBName = String
"offline"
, ircMsgPrefix :: String
ircMsgPrefix = String
"null!n=user@null"
, ircMsgCommand :: String
ircMsgCommand = String
"PRIVMSG"
, ircMsgParams :: [String]
ircMsgParams = [String
"offline", String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
encodeString String
msg' ] }
handleMsg :: IrcMessage -> OfflineRC ()
handleMsg :: IrcMessage -> ModuleT OfflineRCState LB ()
handleMsg IrcMessage
msg = IO () -> ModuleT OfflineRCState LB ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ModuleT OfflineRCState LB ())
-> IO () -> ModuleT OfflineRCState LB ()
forall a b. (a -> b) -> a -> b
$ do
let str :: String
str = case ([String] -> [String]
forall a. [a] -> [a]
tail ([String] -> [String])
-> (IrcMessage -> [String]) -> IrcMessage -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IrcMessage -> [String]
ircMsgParams) IrcMessage
msg of
[] -> []
(String
x:[String]
_) -> String -> String
forall a. [a] -> [a]
tail String
x
Handle -> String -> IO ()
hPutStrLn Handle
stdout (String -> String
decodeString String
str)
Handle -> IO ()
hFlush Handle
stdout
replLoop :: InputT OfflineRC ()
replLoop :: InputT (ModuleT OfflineRCState LB) ()
replLoop = do
Maybe String
line <- String -> InputT (ModuleT OfflineRCState LB) (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
getInputLine String
"lambdabot> "
case Maybe String
line of
Maybe String
Nothing -> () -> InputT (ModuleT OfflineRCState LB) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just String
x -> do
let s' :: String
s' = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
x
Bool
-> InputT (ModuleT OfflineRCState LB) ()
-> InputT (ModuleT OfflineRCState LB) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s') (InputT (ModuleT OfflineRCState LB) ()
-> InputT (ModuleT OfflineRCState LB) ())
-> InputT (ModuleT OfflineRCState LB) ()
-> InputT (ModuleT OfflineRCState LB) ()
forall a b. (a -> b) -> a -> b
$ do
ModuleT OfflineRCState LB ()
-> InputT (ModuleT OfflineRCState LB) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ModuleT OfflineRCState LB ()
-> InputT (ModuleT OfflineRCState LB) ())
-> ModuleT OfflineRCState LB ()
-> InputT (ModuleT OfflineRCState LB) ()
forall a b. (a -> b) -> a -> b
$ String -> ModuleT OfflineRCState LB ()
feed String
s'
Bool
continue <- ModuleT OfflineRCState LB Bool
-> InputT (ModuleT OfflineRCState LB) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ModuleT OfflineRCState LB Bool
-> InputT (ModuleT OfflineRCState LB) Bool)
-> ModuleT OfflineRCState LB Bool
-> InputT (ModuleT OfflineRCState LB) Bool
forall a b. (a -> b) -> a -> b
$ LB Bool -> ModuleT OfflineRCState LB Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LB Bool -> ModuleT OfflineRCState LB Bool)
-> LB Bool -> ModuleT OfflineRCState LB Bool
forall a b. (a -> b) -> a -> b
$ (IRCRWState -> Bool) -> LB Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (String -> Map String Bool -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member String
"offlinerc" (Map String Bool -> Bool)
-> (IRCRWState -> Map String Bool) -> IRCRWState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRCRWState -> Map String Bool
ircPersists)
Bool
-> InputT (ModuleT OfflineRCState LB) ()
-> InputT (ModuleT OfflineRCState LB) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
continue InputT (ModuleT OfflineRCState LB) ()
replLoop
lockRC :: OfflineRC ()
lockRC :: ModuleT OfflineRCState LB ()
lockRC = do
(LBState (ModuleT OfflineRCState LB)
-> (LBState (ModuleT OfflineRCState LB)
-> ModuleT OfflineRCState LB ())
-> ModuleT OfflineRCState LB ())
-> ModuleT OfflineRCState LB ()
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS ((LBState (ModuleT OfflineRCState LB)
-> (LBState (ModuleT OfflineRCState LB)
-> ModuleT OfflineRCState LB ())
-> ModuleT OfflineRCState LB ())
-> ModuleT OfflineRCState LB ())
-> (LBState (ModuleT OfflineRCState LB)
-> (LBState (ModuleT OfflineRCState LB)
-> ModuleT OfflineRCState LB ())
-> ModuleT OfflineRCState LB ())
-> ModuleT OfflineRCState LB ()
forall a b. (a -> b) -> a -> b
$ \ LBState (ModuleT OfflineRCState LB)
cur LBState (ModuleT OfflineRCState LB) -> ModuleT OfflineRCState LB ()
writ -> do
Bool
-> ModuleT OfflineRCState LB () -> ModuleT OfflineRCState LB ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (OfflineRCState
LBState (ModuleT OfflineRCState LB)
cur OfflineRCState -> OfflineRCState -> Bool
forall a. Eq a => a -> a -> Bool
== OfflineRCState
0) (ModuleT OfflineRCState LB () -> ModuleT OfflineRCState LB ())
-> ModuleT OfflineRCState LB () -> ModuleT OfflineRCState LB ()
forall a b. (a -> b) -> a -> b
$ do
String
-> (IrcMessage -> ModuleT OfflineRCState LB ())
-> ModuleT OfflineRCState LB ()
forall st. String -> Server st -> ModuleT st LB ()
registerServer String
"offlinerc" IrcMessage -> ModuleT OfflineRCState LB ()
handleMsg
LB () -> ModuleT OfflineRCState LB ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LB () -> ModuleT OfflineRCState LB ())
-> LB () -> ModuleT OfflineRCState 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
$ \IRCRWState
state' ->
IRCRWState
state' { ircPersists :: Map String Bool
ircPersists = String -> Bool -> Map String Bool -> Map String Bool
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
"offlinerc" Bool
True (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' }
LBState (ModuleT OfflineRCState LB) -> ModuleT OfflineRCState LB ()
writ (OfflineRCState
LBState (ModuleT OfflineRCState LB)
cur OfflineRCState -> OfflineRCState -> OfflineRCState
forall a. Num a => a -> a -> a
+ OfflineRCState
1)
unlockRC :: OfflineRC ()
unlockRC :: ModuleT OfflineRCState LB ()
unlockRC = (LBState (ModuleT OfflineRCState LB)
-> (LBState (ModuleT OfflineRCState LB)
-> ModuleT OfflineRCState LB ())
-> ModuleT OfflineRCState LB ())
-> ModuleT OfflineRCState LB ()
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS ((LBState (ModuleT OfflineRCState LB)
-> (LBState (ModuleT OfflineRCState LB)
-> ModuleT OfflineRCState LB ())
-> ModuleT OfflineRCState LB ())
-> ModuleT OfflineRCState LB ())
-> (LBState (ModuleT OfflineRCState LB)
-> (LBState (ModuleT OfflineRCState LB)
-> ModuleT OfflineRCState LB ())
-> ModuleT OfflineRCState LB ())
-> ModuleT OfflineRCState LB ()
forall a b. (a -> b) -> a -> b
$ \ LBState (ModuleT OfflineRCState LB)
cur LBState (ModuleT OfflineRCState LB) -> ModuleT OfflineRCState LB ()
writ -> do
Bool
-> ModuleT OfflineRCState LB () -> ModuleT OfflineRCState LB ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (OfflineRCState
LBState (ModuleT OfflineRCState LB)
cur OfflineRCState -> OfflineRCState -> Bool
forall a. Eq a => a -> a -> Bool
== OfflineRCState
1) (ModuleT OfflineRCState LB () -> ModuleT OfflineRCState LB ())
-> ModuleT OfflineRCState LB () -> ModuleT OfflineRCState LB ()
forall a b. (a -> b) -> a -> b
$ String -> ModuleT OfflineRCState LB ()
forall mod. String -> ModuleT mod LB ()
unregisterServer String
"offlinerc"
LBState (ModuleT OfflineRCState LB) -> ModuleT OfflineRCState LB ()
writ (OfflineRCState
LBState (ModuleT OfflineRCState LB)
cur OfflineRCState -> OfflineRCState -> OfflineRCState
forall a. Num a => a -> a -> a
- OfflineRCState
1)