blob: 78c8802fe4a44db2103868d53a46e4789599c179 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Reaktor.Plugins.System.Internal where
import Prelude.Extended
import Data.Aeson
import Reaktor ()
import qualified Reaktor.IRC as IRC
import Text.Regex.PCRE.Light (Regex)
import qualified Text.Regex.PCRE.Light as RE
-- TODO this needs better names :)
data CaptureOr a = Capture Int | CaptureOr a
deriving Show -- TODO killme
instance FromJSON a => FromJSON (CaptureOr a) where
parseJSON o@(Number _) = Capture <$> parseJSON o -- TODO don't parse twice
parseJSON o = CaptureOr <$> parseJSON o
-- TODO query means via direct privmsg and <nick>:
data Activate = Always | Match | Query
deriving Show
instance FromJSON Activate where
parseJSON = \case
String "always" -> pure Always
String "match" -> pure Match
String "query" -> pure Query
_ -> undefined
data Config = Config
{ cWorkDir :: Maybe FilePath
, cHooks :: HashMap IRC.Command [Hook]
}
deriving Show
instance Default Config where
def = Config Nothing mempty
instance FromJSON Config where
parseJSON = \case
Object v ->
Config
<$> v .:? "workdir"
<*> v .:? "hooks" .!= mempty
_ -> undefined
data Hook = Hook
{ hActivate :: Activate
, hPattern :: Maybe Regex
, hCommand :: CaptureOr SystemCommand
, hArguments :: [CaptureOr Text]
, hWorkDir :: Maybe FilePath
, hCommands :: HashMap Text SystemCommand
, hTimeout :: Maybe Int
}
deriving Show
instance FromJSON Hook where
parseJSON = \case
Object v ->
Hook
<$> v .:? "activate" .!= Query
<*> (fmap (flip RE.compile [RE.utf8]) <$> v .:? "pattern")
<*> v .: "command"
<*> v .:? "arguments" .!= []
<*> v .:? "workdir"
<*> v .:? "commands" .!= mempty
<*> (fmap (*1000000) <$> v .:? "timeoutSec" .!= Just 10)
_ -> undefined
data SystemCommand = SystemCommand
{ scPath :: FilePath
, scWorkDir :: Maybe FilePath
, scEnv :: Maybe (HashMap String String)
}
deriving Show
instance FromJSON SystemCommand where
parseJSON = \case
Object v ->
SystemCommand
<$> v .: "filename"
<*> v .:? "workdir"
<*> v .:? "env"
_ -> undefined
|
