module Sos.Rule
( Rule(..)
, RawRule(..)
, RawPattern
, buildRule
, buildRawRule
) where
import Sos.Exception
import Sos.Template
import Control.Applicative
import Control.Monad.Except
import Data.Aeson.Types
import Data.ByteString (ByteString)
import Data.Either
import Data.Text (Text)
import Text.Regex.TDFA
import Text.Regex.TDFA.ByteString (compile)
import qualified Data.Text.Encoding as Text
type RawPattern = ByteString
data Rule = Rule
{ ruleRegex :: Regex
, ruleTemplates :: [Template]
}
buildRule
:: forall m. MonadError SosException m
=> RawPattern
-> [RawTemplate]
-> m Rule
buildRule pattrn templates0 = do
templates <- mapM parseTemplate templates0
let (comp_opt, exec_opt) =
case concatMap lefts templates of
[] -> ( CompOption
{ caseSensitive = True
, multiline = False
, rightAssoc = True
, newSyntax = True
, lastStarGreedy = True
}
, ExecOption
{ captureGroups = False }
)
_ -> (defaultCompOpt, defaultExecOpt)
regex <-
case compile comp_opt exec_opt pattrn of
Left err -> throwError (SosRegexException pattrn err)
Right x -> return x
return (Rule regex templates)
data RawRule = RawRule [RawPattern] [RawTemplate]
instance FromJSON RawRule where
parseJSON (Object o) = RawRule <$> parsePatterns <*> parseCommands
where
parsePatterns :: Parser [RawPattern]
parsePatterns = fmap go (o .: "pattern" <|> o .: "patterns")
parseCommands :: Parser [RawTemplate]
parseCommands = fmap go (o .: "command" <|> o .: "commands")
go :: OneOrList Text -> [ByteString]
go = map Text.encodeUtf8 . listify
parseJSON v = typeMismatch "command" v
buildRawRule :: forall m. MonadError SosException m => RawRule -> m [Rule]
buildRawRule (RawRule patterns templates) =
mapM (\pattrn -> buildRule pattrn templates) patterns
data OneOrList a
= One a
| List [a]
deriving Functor
instance FromJSON a => FromJSON (OneOrList a) where
parseJSON v@(String _) = One <$> parseJSON v
parseJSON v@(Array _) = List <$> parseJSON v
parseJSON v = typeMismatch "element or list of elements" v
listify :: OneOrList a -> [a]
listify (One x) = [x]
listify (List xs) = xs