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 -- | A 'ByteString' representing a pattern, e.g. "foo\.hs" or ".*\.c" type RawPattern = ByteString -- A Rule is a regex paired with a list of templates to execute on files -- that match the regex. Any mismatching of captured variables with the -- associated templates will be caught at runtime. -- -- For example, this definition from a .sosrc yaml file is incorrect: -- -- - pattern: .*.c -- - commands: -- - gcc -c \1 -- -- because there is only one capture variable, and it has with index 0. -- data Rule = Rule { ruleRegex :: Regex -- Compiled regex of command pattern. , ruleTemplates :: [Template] -- Command template. } -- Build a 'Rule' from a 'RawPattern' and a list of 'RawTemplate' by compiling -- the pattern regex and parsing each template. buildRule :: forall m. MonadError SosException m => RawPattern -> [RawTemplate] -> m Rule buildRule pattrn templates0 = do templates <- mapM parseTemplate templates0 -- Improve performance for patterns with no capture groups. 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) -- A "raw" Rule that is post-processed after being parsed from a yaml -- file. Namely, the regex is compiled and the commands are parsed into -- 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