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 Text
import Data.Attoparsec.Text
import Text.ABNF.ABNF.Types
import Text.ABNF.Document.Types
generateParser :: Rule -> Parser Document
generateParser = parseRule
parseRule :: Rule -> Parser Document
parseRule (Rule ident _ spec) = Document ident <$> parseSumSpec spec <?> "Rule"
parseSumSpec :: SumSpec -> Parser [Content]
parseSumSpec (SumSpec prodspecs) = asum (map parseProdSpec prodspecs) <?> "Sum"
parseProdSpec :: ProductSpec -> Parser [Content]
parseProdSpec (ProductSpec reps) =
join <$> (sequence $ map parseRepetition reps) <?> "Product"
parseRepetition :: Repetition -> Parser [Content]
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]
parseElem (RuleElement rule) = toList . NonTerminal <$> parseRule rule <?> "Rule element"
parseElem (RuleElement' ruleName) = fail . Text.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]
parseLiteral (CharLit lit) = toList . Terminal <$> asciiCI lit <?> "String literal"
parseLiteral (NumLit lit) = toList . Terminal <$> parseNumLit lit
parseNumLit :: NumLit -> Parser Text.Text
parseNumLit (IntLit ints) = (Text.pack <$> (sequence (char . chr <$> ints)) <?> "Int-defined character")
parseNumLit (RangeLit x1 x2) = Text.pack . toList <$> (oneOf $ chr <$> [x1..x2]) <?> "Range literal"
toList :: a -> [a]
toList = pure
oneOf :: String -> Parser Char
oneOf = foldr (<|>) mzero . fmap char