content: module Sos.Rule
    ( Rule(..)
    , RawRule(..)
    , RawPattern
    , buildRule
    , buildRawRule
    ) where
  
  import Sos.Exception
  import Sos.Template
  
  import Control.Applicative
  import Control.Monad.Catch (MonadThrow, throwM)
  import Data.Aeson ((.:), FromJSON(..), Value(..))
  import Data.Aeson.Types (Parser, typeMismatch)
  import Data.ByteString (ByteString)
  import Data.ByteString.Internal (c2w)
  import Data.Either
  import Text.Regex.TDFA
  import Text.Regex.TDFA.ByteString (compile)
  
  import qualified Data.ByteString as ByteString (intercalate, singleton)
  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 pattern to match, optional pattern to exclude, and 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
    { rulePattern   :: Regex       -- Compiled regex of file pattern.
    , ruleExclude   :: Maybe Regex -- Compiled regex of file patterns to exclude.
    , ruleTemplates :: [Template]  -- Command template.
    }
  
  -- Build a 'Rule' from a 'RawPattern', a list of 'RawPattern' (patterns to
  -- exclude), and a list of 'RawTemplate' by:
  --
  -- - Compiling the pattern regex
  -- - Compiling the exclude regexes combined with ||
  -- - Parsing each template.
  --
  buildRule
    :: forall m.
       MonadThrow m
    => RawPattern -> [RawPattern] -> [RawTemplate] -> m Rule
  buildRule pattrn excludes templates0 = do
    templates <- mapM parseTemplate templates0
  
    regex <-
      -- Improve performance for patterns with no capture groups.
      case concatMap lefts templates of
        [] ->
          compileRegex
            (CompOption
              { caseSensitive  = True
              , multiline      = False
              , rightAssoc     = True
              , newSyntax      = True
              , lastStarGreedy = True
              })
            (ExecOption
              { captureGroups = False })
            pattrn
        _ -> compileRegex defaultCompOpt defaultExecOpt pattrn
  
    case excludes of
      [] ->
        pure (Rule
          { rulePattern = regex
          , ruleExclude = Nothing
          , ruleTemplates = templates
          })
      _ -> do
        exclude <-
          compileRegex defaultCompOpt defaultExecOpt
            (ByteString.intercalate (ByteString.singleton (c2w '|')) excludes)
        pure (Rule
          { rulePattern = regex
          , ruleExclude = Just exclude
          , ruleTemplates = templates
          })
   where
    compileRegex :: CompOption -> ExecOption -> RawPattern -> m Regex
    compileRegex co eo patt =
      case compile co eo patt of
        Left err -> throwM (SosRegexException patt err)
        Right x -> pure x
  
  -- A "raw" Rule that is post-processed after being parsed from a yaml
  -- file.
  data RawRule = RawRule [RawPattern] [RawPattern] [RawTemplate]
  
  instance FromJSON RawRule where
    parseJSON (Object o) =
      RawRule <$> parsePatterns <*> parseExcludes <*> parseCommands
     where
      parsePatterns :: Parser [RawPattern]
      parsePatterns = go ["pattern", "patterns"]
  
      parseExcludes :: Parser [RawPattern]
      parseExcludes = go ["exclude", "excludes", "excluding"] <|> pure []
  
      parseCommands :: Parser [RawTemplate]
      parseCommands = go ["command", "commands"]
  
      go = fmap (map Text.encodeUtf8 . listify) . asum . map (o .:)
    parseJSON v = typeMismatch "command" v
  
  buildRawRule :: MonadThrow m => RawRule -> m [Rule]
  buildRawRule (RawRule patterns excludes templates) =
    mapM (\pattrn -> buildRule pattrn excludes 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
  