aboutsummaryrefslogtreecommitdiffstats
path: root/src/Reaktor/Plugins/System/Internal.hs
blob: e4356df550992df07c69c65b10c39b8d4239e284 (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 Data.Aeson.Types (typeMismatch)
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
      invalid -> typeMismatch "Activate" invalid

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
      invalid -> typeMismatch "Config" invalid

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)
      invalid -> typeMismatch "Hook" invalid


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"
      invalid -> typeMismatch "SystemCommand" invalid