module Text.ABNF.Document.Parser where
import Control.Applicative (liftA2, (<|>), many)
import Control.Monad (join, mzero)
import Data.Char (chr)
import Data.Foldable (asum)
import Data.Monoid ((<>))
import qualified Data.Text as T
import Data.Attoparsec.Text
import Text.ABNF.ABNF.Types
import Text.ABNF.Document.Types
parseDocument :: Rule
-> T.Text
-> Either String (Document T.Text)
parseDocument = parseOnly . generateParser
generateParser :: Rule -> Parser (Document T.Text)
generateParser = parseRule
parseRule :: Rule -> Parser (Document T.Text)
parseRule (Rule ident _ spec) = Document ident <$> parseSumSpec spec <?> "Rule"
parseSumSpec :: SumSpec -> Parser [Content T.Text]
parseSumSpec (SumSpec prodspecs) = asum (map parseProdSpec prodspecs) <?> "Sum"
parseProdSpec :: ProductSpec -> Parser [Content T.Text]
parseProdSpec (ProductSpec reps) =
join <$> (sequence $ map parseRepetition reps) <?> "Product"
parseRepetition :: Repetition -> Parser [Content T.Text]
parseRepetition (Repetition (Repeat 0 Nothing) elem) =
join <$> (many $ parseElem elem)
parseRepetition (Repetition (Repeat 0 (Just 0)) _) = pure []
parseRepetition (Repetition (Repeat 0 (Just n)) elem) = do
el <- (Just <$> parseElem elem) <|> pure Nothing
case el of
Just el' -> liftA2 (++) (pure el')
(parseRepetition (Repetition (Repeat 0 (Just (n1))) elem))
Nothing -> pure []
parseRepetition (Repetition (Repeat n (Just m)) elem) =
liftA2 (++) (parseElem elem)
(parseRepetition (Repetition (Repeat (n1) (Just (m1))) elem))
parseRepetition (Repetition (Repeat n x) elem) =
liftA2 (++) (parseElem elem)
(parseRepetition (Repetition (Repeat (n1) x) elem))
parseElem :: Element -> Parser [Content T.Text]
parseElem (RuleElement rule) = toList . NonTerminal <$> parseRule rule <?> "Rule element"
parseElem (RuleElement' ruleName) = fail . T.unpack $ "Unknown rule: " <> ruleName
parseElem (GroupElement (Group spec)) = parseSumSpec spec <?> "Group element"
parseElem (OptionElement (Group spec)) = parseSumSpec spec <|> pure [] <?> "Optional element"
parseElem (LiteralElement lit) = parseLiteral lit <?> "Literal element"
parseLiteral :: Literal -> Parser [Content T.Text]
parseLiteral (CharLit lit) = toList . Terminal <$> asciiCI lit <?> "String literal"
parseLiteral (NumLit lit) = toList . Terminal <$> parseNumLit lit
parseNumLit :: NumLit -> Parser T.Text
parseNumLit (IntLit ints) = (T.pack <$> (sequence (char . chr <$> ints)) <?> "Int-defined character")
parseNumLit (RangeLit x1 x2) = T.pack . toList <$> (oneOf $ chr <$> [x1..x2]) <?> "Range literal"
toList :: a -> [a]
toList = pure
oneOf :: String -> Parser Char
oneOf = foldr (<|>) mzero . fmap char