definitive-parser-1.0: Algebra/Parser/Regex.hs

module Algebra.Parser.Regex (regex,runRegex) where

import Algebra.Parser

runRegex :: String -> String -> [([(String,String)],String)]
runRegex re = join (pure re >*> regex)^..parser <&> map snd

regex :: Parser String (Parser String ([(String,String)],String))
regex = _union
  where _union = (adjacent`sepBy`single '|') <&> sum
        adjacent = many postfixed <&> map concat.sequence
        atom = dot <+> range <+> otherChar <+> between (single '(') (single ')') _union
        postfixed = comp<$>atom<*>many postfun
          where postfun = satisfy (`elem`"*+?") <&> \c -> case c of
                  '*' -> map sum.many
                  '+' -> map sum.many1
                  '?' -> (+ pure ([],""))
                  _ -> undefined
                comp a fs = compose fs a
        dot = shallow token <$ single '.'
        otherChar = shallow.char<$>noneOf "()[*?|+"
        range = between (single '[') (single ']') ranges
          where ranges = sum <$> many subRange
                subRange = mkRange<$>subChar<*single '-' <*>subChar
                           <+> shallow.char<$>subChar
                mkRange a b = shallow $ satisfy (\c -> c>=a && c<=b)
                subChar = noneOf "]"
        shallow = (([],).pure<$>)
        char c = c<$single c