aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Reaktor/Plugins/System.hs146
1 files changed, 72 insertions, 74 deletions
diff --git a/src/Reaktor/Plugins/System.hs b/src/Reaktor/Plugins/System.hs
index c6c0ef3..3d6ec5c 100644
--- a/src/Reaktor/Plugins/System.hs
+++ b/src/Reaktor/Plugins/System.hs
@@ -10,6 +10,7 @@ import Control.Applicative
import Control.Concurrent (forkIO,threadDelay)
import Control.Concurrent.Async (race)
import Control.Exception
+import Control.Monad (forM_)
import qualified Data.HashMap.Lazy as M
import qualified Data.List as L
import qualified Data.Text.Extended as T
@@ -78,80 +79,77 @@ run1 Config{..} Actions{..} Hook{..} prefix msgtarget text = do
-- what if our nick has changed?
isQuery = msgtarget == nick
- case isActivated of
- Just trigger -> do
- let
- cmdline = T.dropWhile (==' ') $ T.drop (T.length trigger) text
- resultPrefix = if isQuery then [] else [from <> ":"]
-
- captures = V.fromList $ fromMaybe [] (match cmdline)
- capture i = captures V.!? i
-
- name =
- case hCommand of
- Capture i -> fromMaybe "<unnamed>" (capture i)
- CaptureOr Command{..} -> T.pack $ takeBaseName $ commandPath
-
- command =
- case hCommand of
- Capture i -> (`M.lookup` hCommands) =<< capture i
- CaptureOr c -> Just c
-
- args =
- map (maybe "" T.unpack)
- $ L.dropWhileEnd isNothing
- -- $ map getArgument hArguments
- $ flip map hArguments
- $ \case
- Capture i -> capture i
- CaptureOr s -> Just s
-
- case command of
- Just Command{..} -> do
- baseEnv <- getEnvironment
-
- let
- logStr pid s = do
- let p = name <> "[" <> T.show pid <> "] "
- aLog $ SGR [38,5,247] (Plain p <> s)
-
- red :: Text -> Blessings Text
- red = SGR [31] . Plain
-
- onStart pid = logStr pid "started"
- onErrLine pid s = logStr pid $ "stderr: " <> red s
- onOutLine _ s = aSend (privmsg audience [s])
- onError pid e = logStr pid $ "failed: " <> red (T.show e)
-
- onExit pid = \case
- ExitSuccess ->
- logStr pid "stopped"
- ExitFailure i ->
- logStr pid $ "stopped with exit code " <>
- red (T.show $ if i <= 127 then i else -256 + i)
-
- extraEnv =
- [ ("_prefix", T.unpack prefix)
- , ("_from", T.unpack from)
- , ("_msgtarget", T.unpack msgtarget)
- ]
-
- env =
- M.toList $ mconcat
- [ M.fromList extraEnv
- , maybe mempty id commandEnv
- , M.fromList baseEnv
- ]
-
- cwd = commandWorkDir <|> hWorkDir <|> cWorkDir
-
- fork commandPath args cwd (Just env) "" hTimeout Callbacks{..}
-
- Nothing -> do
- let s = name <> ": command not found"
- aSend (privmsg audience (resultPrefix <> [s]))
-
- Nothing -> return ()
+ forM_ isActivated $ \activationPrefix -> do
+ let
+ text' = T.drop (T.length activationPrefix) text
+ resultPrefix = if isQuery then [] else [from <> ":"]
+
+ captures = V.fromList $ fromMaybe [] (match text')
+ capture i = captures V.!? i
+
+ name =
+ case hCommand of
+ Capture i -> fromMaybe "<unnamed>" (capture i)
+ CaptureOr Command{..} -> T.pack $ takeBaseName $ commandPath
+
+ command =
+ case hCommand of
+ Capture i -> (`M.lookup` hCommands) =<< capture i
+ CaptureOr c -> Just c
+
+ args =
+ map (maybe "" T.unpack)
+ $ L.dropWhileEnd isNothing
+ $ flip map hArguments
+ $ \case
+ Capture i -> capture i
+ CaptureOr s -> Just s
+
+ case command of
+ Just Command{..} -> do
+ baseEnv <- getEnvironment
+
+ let
+ logStr pid s = do
+ let p = name <> "[" <> T.show pid <> "] "
+ aLog $ SGR [38,5,247] (Plain p <> s)
+
+ red :: Text -> Blessings Text
+ red = SGR [31] . Plain
+
+ onStart pid = logStr pid "started"
+ onErrLine pid s = logStr pid $ "stderr: " <> red s
+ onOutLine _ s = aSend (privmsg audience [s])
+ onError pid e = logStr pid $ "failed: " <> red (T.show e)
+
+ onExit pid = \case
+ ExitSuccess ->
+ logStr pid "stopped"
+ ExitFailure i ->
+ logStr pid $ "stopped with exit code " <>
+ red (T.show $ if i <= 127 then i else -256 + i)
+
+ extraEnv =
+ [ ("_prefix", T.unpack prefix)
+ , ("_from", T.unpack from)
+ , ("_msgtarget", T.unpack msgtarget)
+ ]
+
+ env =
+ M.toList $ mconcat
+ [ M.fromList extraEnv
+ , maybe mempty id commandEnv
+ , M.fromList baseEnv
+ ]
+
+ cwd = commandWorkDir <|> hWorkDir <|> cWorkDir
+
+ fork commandPath args cwd (Just env) "" hTimeout Callbacks{..}
+
+ Nothing -> do
+ let s = name <> ": command not found"
+ aSend (privmsg audience (resultPrefix <> [s]))
+
data Callbacks = Callbacks
{ onOutLine :: Pid -> Text -> IO ()