Regex.hs

-- Note: this is an automatically generated file. Do not edit.

-- | Parser for Hydra's translingual regular-expression syntax (docs/specification/regex.md): text -> hydra.regex AST. Built on the hydra.parsers combinators. Rejects ill-formed patterns (empty alternation branches, empty classes, out-of-range code points) via the ParseResult failure channel, so 'well-formed' is portable across hosts. See issue #567.

module Hydra.Parse.Regex where

import qualified Hydra.Ast as Ast
import qualified Hydra.Coders as Coders
import qualified Hydra.Core as Core
import qualified Hydra.Docs as Docs
import qualified Hydra.Error.Checking as Checking
import qualified Hydra.Error.Core as ErrorCore
import qualified Hydra.Error.File as ErrorFile
import qualified Hydra.Error.Packaging as ErrorPackaging
import qualified Hydra.Error.System as ErrorSystem
import qualified Hydra.Errors as Errors
import qualified Hydra.File as File
import qualified Hydra.Graph as Graph
import qualified Hydra.Json.Model as Model
import qualified Hydra.Overlay.Haskell.Lib.Equality as Equality
import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists
import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic
import qualified Hydra.Overlay.Haskell.Lib.Math as Math
import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals
import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering
import qualified Hydra.Packaging as Packaging
import qualified Hydra.Parsers as Parsers
import qualified Hydra.Parsing as Parsing
import qualified Hydra.Paths as Paths
import qualified Hydra.Query as Query
import qualified Hydra.Regex as Regex
import qualified Hydra.Relational as Relational
import qualified Hydra.System as System
import qualified Hydra.Tabular as Tabular
import qualified Hydra.Testing as Testing
import qualified Hydra.Time as Time
import qualified Hydra.Topology as Topology
import qualified Hydra.Typed as Typed
import qualified Hydra.Typing as Typing
import qualified Hydra.Util as Util
import qualified Hydra.Validation as Validation
import qualified Hydra.Variants as Variants
import Prelude hiding  (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum)
import qualified Data.Scientific as Sci

-- | Parse an alternation of sequences separated by |. When there is more than one branch, each branch must be non-empty; empty branches (a|, |b, a||b, and the nested (a|)) are rejected at every level. A single empty branch is the legal empty case (empty whole pattern / empty group).
alternation :: Parsing.Parser [[Regex.Quantified]]
alternation =
    Parsers.bind (Parsers.sepBy1 regexSequence (Parsers.char 124)) (\branches ->
      let hasEmpty = Lists.foldl (\acc -> \b -> Logic.or acc (Lists.null b)) False branches
          multi = Ordering.gt (Lists.length branches) 1
      in (Logic.ifElse (Logic.and hasEmpty multi) (Parsers.fail "empty alternation branch") (Parsers.pure branches)))

-- | Parse a single atom: a group ( ... ), a class [ ... ], ., an anchor ^ or $, or a literal.
atom :: Parsing.Parser Regex.Atom
atom =
    Parsers.choice [
      Parsers.map (\g -> Regex.AtomGroup g) (Parsers.between (Parsers.char 40) (Parsers.char 41) (Parsers.lazy (\_ -> alternation))),
      characterClass,
      (Parsers.bind (Parsers.char 46) (\_ -> Parsers.pure Regex.AtomAny)),
      (Parsers.bind (Parsers.char 94) (\_ -> Parsers.pure Regex.AtomAnchorStart)),
      (Parsers.bind (Parsers.char 36) (\_ -> Parsers.pure Regex.AtomAnchorEnd)),
      literalAtom]

-- | Parse a character class [ ... ] or [^ ... ]; the class must be non-empty.
characterClass :: Parsing.Parser Regex.Atom
characterClass =
    Parsers.bind (Parsers.char 91) (\_ -> Parsers.bind (Parsers.optional (Parsers.char 94)) (\neg -> Parsers.bind (Parsers.some classItem) (\items -> Parsers.bind (Parsers.char 93) (\_2 -> Parsers.pure (Regex.AtomClass (Regex.CharacterClass {
      Regex.characterClassNegated = (Optionals.cases neg False (\_3 -> True)),
      Regex.characterClassItems = items}))))))

-- | Parse one member of a character class: a range like a-z, or a single character (escapes allowed).
classItem :: Parsing.Parser Regex.ClassItem
classItem =
    Parsers.bind classChar (\from -> Parsers.alt (Parsers.bind (Parsers.char 45) (\_ -> Parsers.map (\to -> Regex.ClassItemRange (Regex.CharacterRange {
      Regex.characterRangeFrom = from,
      Regex.characterRangeTo = to})) classChar)) (Parsers.pure (Regex.ClassItemCharacter from)))
  where
    classChar =
        Parsers.alt escapedChar (Parsers.satisfy (\c -> Logic.and (Logic.not (Equality.equal c 93)) (Logic.not (Equality.equal c 92))))

-- | Parse a backslash followed by any character; yields that character's codepoint (the escape is consumed).
escapedChar :: Parsing.Parser Int
escapedChar = Parsers.bind (Parsers.char 92) (\_ -> Parsers.anyChar)

-- | True if the codepoint is a top-level regex metacharacter that must be escaped to match literally.
isMetachar :: Int -> Bool
isMetachar c =
    Lists.foldl (\acc -> \m -> Logic.or acc (Equality.equal c m)) False [
      46,
      94,
      36,
      42,
      43,
      63,
      40,
      41,
      91,
      93,
      123,
      125,
      124,
      92]

-- | Parse a literal character (an escaped metacharacter, or any ordinary non-metacharacter) into an Atom.
literalAtom :: Parsing.Parser Regex.Atom
literalAtom =
    Parsers.map (\c -> Regex.AtomLiteral c) (Parsers.alt escapedChar (Parsers.satisfy (\c -> Logic.not (isMetachar c))))

-- | Parse a full regex pattern string into a hydra.regex AST. Returns nothing if the pattern is ill-formed or does not consume all input; a well-formed pattern is exactly one that parses here, so 'well-formed' is portable across all hosts.
parseRegex :: String -> Maybe [[Regex.Quantified]]
parseRegex input =
    (\x -> case x of
      Parsing.ParseResultSuccess v0 -> Logic.ifElse (Equality.equal (Parsing.parseSuccessRemainder v0) "") (Just (Parsing.parseSuccessValue v0)) Nothing
      Parsing.ParseResultFailure _ -> Nothing) (Parsers.runParser regex input)

-- | Parse an atom followed by an optional quantifier.
quantified :: Parsing.Parser Regex.Quantified
quantified =
    Parsers.bind atom (\a -> Parsers.map (\q -> Regex.Quantified {
      Regex.quantifiedAtom = a,
      Regex.quantifiedQuantifier = q}) quantifier)

-- | Parse an optional quantifier following an atom; yields 'one' when no quantifier is present.
quantifier :: Parsing.Parser Regex.Quantifier
quantifier =
    Parsers.alt (Parsers.choice [
      Parsers.bind (Parsers.char 42) (\_ -> Parsers.pure Regex.QuantifierZeroOrMore),
      (Parsers.bind (Parsers.char 43) (\_ -> Parsers.pure Regex.QuantifierOneOrMore)),
      (Parsers.bind (Parsers.char 63) (\_ -> Parsers.pure Regex.QuantifierZeroOrOne)),
      (Parsers.bind (Parsers.char 123) (\_ -> Parsers.bind unsignedInt (\n -> Parsers.bind (Parsers.optional (Parsers.char 44)) (\comma -> Optionals.cases comma (Parsers.bind (Parsers.char 125) (\_2 -> Parsers.pure (Regex.QuantifierExactly n))) (\_2 -> Parsers.bind (Parsers.optional unsignedInt) (\mm -> Parsers.bind (Parsers.char 125) (\_3 -> Optionals.cases mm (Parsers.pure (Regex.QuantifierAtLeast n)) (\m -> Parsers.pure (Regex.QuantifierRange_ (Regex.QuantifierRange {
        Regex.quantifierRangeMin = n,
        Regex.quantifierRangeMax = m}))))))))))]) (Parsers.pure Regex.QuantifierOne)

-- | Parse a complete regex (an alternation). The empty pattern parses to a single empty sequence.
regex :: Parsing.Parser [[Regex.Quantified]]
regex = alternation

-- | Parse a sequence of quantified atoms (a single alternation branch). May be empty only as the whole pattern; as an alternation branch it is constrained to be non-empty by the alternation parser's use of sepBy1 plus a non-empty check.
regexSequence :: Parsing.Parser [Regex.Quantified]
regexSequence = Parsers.many quantified

-- | Parse a non-negative decimal integer (one or more digits).
unsignedInt :: Parsing.Parser Int
unsignedInt =
    Parsers.map (\digits -> Lists.foldl (\acc -> \d -> Math.add (Math.mul acc 10) (Math.sub d 48)) 0 digits) (Parsers.some (Parsers.satisfy (\c -> Logic.and (Ordering.gte c 48) (Ordering.lte c 57))))