module Marvin.Adapter.Shell where
import Control.Concurrent.Async.Lifted
import Control.Concurrent.MVar.Lifted
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Loops
import Data.Char (isSpace)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.Lazy as L
import Data.Time.Clock (getCurrentTime)
import Marvin.Adapter
import Marvin.Internal (defaultBotName)
import Marvin.Internal.Types
import Marvin.Interpolate.String
import Marvin.Run (lookupFromAppConfig)
import System.Console.Haskeline
import qualified Data.Configurator as C
data ShellAdapter = ShellAdapter
{ output :: MVar (Maybe L.Text)
}
instance IsAdapter ShellAdapter where
type User ShellAdapter = ()
type Channel ShellAdapter = ()
adapterId = "shell"
messageChannel ShellAdapter{output} _ = putMVar output . Just
getUsername _ _ = return "shell"
getChannelName _ _ = return "shell"
resolveChannel _ _ = return $ Just ()
runWithAdapter cfg initializer = do
bot <- liftIO $ fromMaybe defaultBotName <$> lookupFromAppConfig cfg "name"
histfile <- liftIO $ C.lookup cfg "history-file"
out <- liftIO newEmptyMVar
let ada = ShellAdapter out
handler <- liftIO $ initializer ada
liftIO $ runInputT defaultSettings {historyFile=histfile} $ forever $ do
input <- getInputLine $(isS "#{bot}> ")
case input of
Nothing -> return ()
Just i -> do
h <- liftIO $ async $ do
botname <- L.toLower . fromMaybe defaultBotName <$> liftIO (lookupFromAppConfig cfg "name")
let mtext = L.pack i
ts <- TimeStamp <$> getCurrentTime
handler $ case L.stripPrefix botname $ L.stripStart mtext of
Just cmd | fmap (isSpace . fst) (L.uncons cmd) == Just True ->
CommandEvent () () (L.stripStart cmd) ts
_ -> MessageEvent () () mtext ts
putMVar out Nothing
whileJust_ (liftIO $ takeMVar out) $ outputStrLn . L.unpack
liftIO $ wait h