abnf 0.1.0.0 → 0.2.0.0

raw patch · 14 files changed

+419/−392 lines, 14 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• abnf.cabal +8/−5
• src/Text/ABNF/ABNF.hs +1/−0
• src/Text/ABNF/ABNF/Canonicalizer.hs +84/−0
• src/Text/ABNF/ABNF/Parser.hs +170/−0
• src/Text/ABNF/ABNF/Types.hs +52/−0
• src/Text/ABNF/Canonicalizer.hs +0/−74
• src/Text/ABNF/Document.hs +0/−85
• src/Text/ABNF/Document/Parser.hs +83/−0
• src/Text/ABNF/Parser.hs +0/−170
• src/Text/ABNF/Parser/Types.hs +0/−52
• src/Text/ABNF/PrettyPrinter.hs +2/−2
• test/ABNF.hs +2/−2
• test/Document.hs +2/−2
• test/Util.hs +15/−0

@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/  name:                abnf-version:             0.1.0.0+version:             0.2.0.0 synopsis:            Parse ABNF and generate parsers for the specified document description:         You can use this library to parse an ABNF document and                      generate a parser from that ABNF to read a document@@ -23,10 +23,12 @@   location:            https://github.com/Xandaros/abnf.git  library-  exposed-modules:     Text.ABNF.Parser,-                       Text.ABNF.Parser.Types,-                       Text.ABNF.Canonicalizer,+  exposed-modules:     Text.ABNF.ABNF,+                       Text.ABNF.ABNF.Parser,+                       Text.ABNF.ABNF.Types,+                       Text.ABNF.ABNF.Canonicalizer,                        Text.ABNF.Document,+                       Text.ABNF.Document.Parser,                        Text.ABNF.Document.Types,                        Text.ABNF.PrettyPrinter   ghc-options:         -W@@ -44,7 +46,8 @@   type:                exitcode-stdio-1.0   main-is:             Main.hs   other-modules:       ABNF,-                       Document+                       Document,+                       Util   hs-source-dirs:      test   build-depends:       base >= 4.8 && <4.9,                        text,

@@ -0,0 +1,1 @@+module Text.ABNF.ABNF where

@@ -0,0 +1,84 @@+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : Text.ABNF.ABNF.Canonicalizer+Description : Canonicalize a list of rules+Copyright   : (c) Martin Zeller, 2016+License     : BSD2+Maintainer  : Martin Zeller <mz.bremerhaven@gmail.com>+Stability   : experimental+Portability : non-portable+-}++module Text.ABNF.ABNF.Canonicalizer (canonicalizeRules) where++import Data.List (partition)+import Data.Monoid ((<>))+import qualified Data.Map.Strict as Map+import qualified Data.Text as Text++import Text.ABNF.ABNF.Types++type RuleMap = Map.Map Identifier Rule++canonicalizeRules :: Identifier -> [Rule] -> Maybe Rule+canonicalizeRules mainRuleIdent rules = do+    let (defs, adds) = partition isAdd rules+        ruleMap  = foldr (\rule@(Rule ident _ _) curMap ->+                              Map.insert ident rule curMap)+                         Map.empty+                         defs+        ruleMap' = foldr (\rule@(Rule ident _ _) curMap ->+                              Map.insertWith mergeRules ident rule curMap)+                         ruleMap+                         adds+    mainRule <- Map.lookup mainRuleIdent ruleMap'+    pure $ inlineRulesRule ruleMap' mainRule --TODO: Catch missing rules here+    where+        isAdd (Rule _ Equals _) = False+        isAdd (Rule _ Adds _) = True++mergeRules :: Rule -> Rule -> Rule+mergeRules (Rule ident Equals left) (Rule ident2 Adds right)+  | ident == ident2 = Rule ident Equals+    ( SumSpec [ ProductSpec [ Repetition (Repeat 1 (Just 1))+                                (GroupElement (Group left))+                            ]+              , ProductSpec [ Repetition (Repeat 1 (Just 1))+                                (GroupElement (Group right))+                            ]+              ]+    ) +  -- TODO: Print location of error+  | otherwise = error . Text.unpack+      $  "Error while canocicalizing ABNF: Rule " <> ident+      <> " appended (=/) without ever assigning(=)"+mergeRules _ _ = error "Bug in ABNF canonicalizer (mergeRules)!"++inlineRulesRule :: RuleMap -> Rule -> Rule+inlineRulesRule rulemap (Rule ident def spec) =+    Rule ident def (inlineRulesSumSpec rulemap spec)++inlineRulesSumSpec :: RuleMap -> SumSpec -> SumSpec+inlineRulesSumSpec rulemap (SumSpec specs) =+    SumSpec $ inlineRulesProdSpec rulemap <$> specs++inlineRulesProdSpec :: RuleMap -> ProductSpec -> ProductSpec+inlineRulesProdSpec rulemap (ProductSpec reps) =+    ProductSpec $ inlineRulesRepetition rulemap <$> reps++inlineRulesRepetition :: RuleMap -> Repetition -> Repetition+inlineRulesRepetition rulemap (Repetition rep elem) =+    Repetition rep $ inlineRulesElement rulemap elem++inlineRulesElement :: RuleMap -> Element -> Element+inlineRulesElement rulemap oldrule@(RuleElement' ruleName) =+    let rule = Map.lookup ruleName rulemap+    in  maybe oldrule (RuleElement . inlineRulesRule rulemap) rule+inlineRulesElement rulemap (GroupElement grp) =+    GroupElement $ inlineRulesGroup rulemap grp+inlineRulesElement rulemap (OptionElement grp) =+    OptionElement $ inlineRulesGroup rulemap grp+inlineRulesElement _ old = old++inlineRulesGroup :: RuleMap -> Group -> Group+inlineRulesGroup rulemap (Group sumspec) = Group (inlineRulesSumSpec rulemap sumspec)

@@ -0,0 +1,170 @@+{-|+Module      : Text.ABNF.ABNF.Parser+Description : ABNF Parser+Copyright   : (c) Martin Zeller, 2016+License     : BSD2+Maintainer  : Martin Zeller <mz.bremerhaven@gmail.com>+Stability   : experimental+Portability : portable++This module provides facilities to parse ABNF documents.+To parse documents using ABNF, see "Text.ABNF.Document.Parser"++The parser you will most likely be interested in is 'rulelist'+-}+module Text.ABNF.ABNF.Parser where++import Prelude hiding (repeat)++import Data.Char (ord, isHexDigit, digitToInt)+import Data.Maybe (catMaybes)+import qualified Data.Text as Text+import Numeric (readInt)+import Text.Megaparsec+import Text.Megaparsec.Text++import Text.ABNF.ABNF.Types++identifier :: Parser Identifier+identifier = Text.pack <$> do+    firstChar <- letterChar+    otherChars <- many $ alphaNumChar <|> char '-'+    pure (firstChar:otherChars)++rulelist :: Parser [Rule]+rulelist = catMaybes <$> (some $ Just <$> rule <|> (many wsp *> c_nl *> pure Nothing))++rule :: Parser Rule+rule = Rule <$> identifier+            <*> defined_as+            <*> elements+            <* c_nl++defined_as :: Parser DefinedAs+defined_as = many c_wsp *> ((try (string "=/") *> pure Adds)+                         <|> try (string "=")  *> pure Equals) <* many c_wsp++elements :: Parser SumSpec+elements = alternation <* many wsp++c_wsp :: Parser String+c_wsp = sequence [wsp] <|> (try $ do+    newl <- c_nl+    white <- wsp+    pure $ newl ++ [white])++c_nl :: Parser String+c_nl = comment <|> crlf++comment :: Parser String+comment = char ';' *> many (wsp <|> vchar) <* crlf++alternation :: Parser SumSpec+alternation = (do+    first <- concatenation+    rest <- many (try (many c_wsp *> char '/') *> many c_wsp *> concatenation)+    pure . SumSpec $ first:rest) <?> "alternation"++concatenation :: Parser ProductSpec+concatenation = (do+    first <- repetition+    rest <- many (try $ some c_wsp *> repetition)+    pure . ProductSpec $ first:rest) <?> "concatenation"++repetition :: Parser Repetition+repetition = Repetition <$> repeat <*> element++repeat :: Parser Repeat+repeat = try asteriskNumbers <|> try singleNumber <|> pure (Repeat 1 (Just 1))+    where+        singleNumber = Repeat 1 <$> (Just . read <$> some digitChar)+        asteriskNumbers = do+            firstNumber <- option 0 (read <$> some digitChar)+            char '*'+            secondNumber <- optional (read <$> some digitChar)+            pure $ Repeat firstNumber secondNumber++element :: Parser Element+element = RuleElement' <$> identifier+      <|> GroupElement <$> group+      <|> OptionElement <$> option_+      <|> LiteralElement <$> literal++group :: Parser Group+group = Group <$>+    (char '(' *> many c_wsp *> alternation <* many c_wsp <* char ')')++option_ :: Parser Group+option_ = Group <$>+    (char '[' *> many c_wsp *> alternation <* many c_wsp <* char ']')++literal :: Parser Literal+literal = CharLit <$> char_val <|> NumLit <$> num_val <|> CharLit <$> prose_val++char_val :: Parser Text.Text+char_val = Text.pack <$> (char '"' *> many schar <* char '"')+    where+        schar = satisfy (\c -> ord c >= 0x20 && ord c <= 0x21+                            || ord c >= 0x23 && ord c <= 0x7E)++num_val :: Parser NumLit+num_val = char '%' *> (bin_val <|> dec_val <|> hex_val)++{-# WARNING bin_val "readBinInt is unsafe" #-}+bin_val :: Parser NumLit+bin_val = num_val' 'b' binInt+    where+        readBinInt :: String -> Int+        readBinInt = fst . head . readInt 2+            (`elem` ['0', '1'])+            digitToInt+        binInt = readBinInt <$> many (char '0' <|> char '1')++dec_val :: Parser NumLit+dec_val = num_val' 'd' readInt+    where+        readInt :: Parser Int+        readInt = read <$> some digitChar++{-# WARNING hex_val "readHexInt is unsafe" #-}+hex_val :: Parser NumLit+hex_val = num_val' 'x' hexInt+    where+        readHexInt :: String -> Int+        readHexInt = fst . head . readInt 16 isHexDigit digitToInt+        hexInt = readHexInt <$> many hexDigitChar++num_val' :: Char -> Parser Int -> Parser NumLit+num_val' c hexInt = do+    char c+    digits <- hexInt+    intLit digits <|> rangeLit digits <|> pure (IntLit [digits])+    where+        intLit' :: Parser [Int]+        intLit' = some $ char '.' *> hexInt++        intLit first = do+            rest <- intLit'+            pure $ IntLit (first:rest)++        rangeLit :: Int -> Parser NumLit+        rangeLit startRange = do+            char '-'+            endRange <- hexInt+            pure $ RangeLit startRange endRange++        --readHexInt :: String -> Int+        --readHexInt = fst . head . readInt 16 isHexDigit digitToInt+        --hexInt = readHexInt <$> many hexDigitChar++prose_val :: Parser Text.Text+prose_val = Text.pack <$> (char '<' *> many pchar <* char '>')+    where+        pchar = satisfy (\c -> ord c >= 0x20 && ord c <= 0x3D+                            || ord c >= 0x3F && ord c <= 0x7E)++vchar :: Parser Char+vchar = satisfy (\c -> ord c >= 0x21 && ord c <= 0x7E)++wsp :: Parser Char+wsp = char ' ' <|> char '\t'

@@ -0,0 +1,52 @@+{-|+Module      : Text.ABNF.ABNF.Types+Description : Types used by the parser+Copyright   : (c) Martin Zeller, 2016+License     : BSD2+Maintainer  : Martin Zeller <mz.bremerhaven@gmail.com>+Stability   : experimental+Portability : portable++These types are used by the parser and are loosely modeled after the ABNF+privded in <https://tools.ietf.org/html/rfc5234#section-4 RFC 5234>+-}+module Text.ABNF.ABNF.Types where++import qualified Data.Text as Text++type Identifier = Text.Text++data Rule = Rule Identifier DefinedAs SumSpec+    deriving (Show, Eq)++data SumSpec = SumSpec [ProductSpec]+    deriving (Show, Eq)++data ProductSpec = ProductSpec [Repetition]+    deriving (Show, Eq)++data Repetition = Repetition Repeat Element+    deriving (Show, Eq)++data Repeat = Repeat Int (Maybe Int)+    deriving (Show, Eq)++data Element = RuleElement' Identifier+             | RuleElement Rule+             | GroupElement Group+             | OptionElement Group+             | LiteralElement Literal+             deriving (Show, Eq)++data Group = Group SumSpec+    deriving (Show, Eq)++data Literal = CharLit Text.Text | NumLit NumLit+    deriving (Show, Eq)++data NumLit = IntLit [Int]+            | RangeLit Int Int+            deriving (Show, Eq)++data DefinedAs = Equals | Adds+    deriving (Show, Eq)

@@ -1,74 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Text.ABNF.Canonicalizer (canonicalizeRules) where--import Data.List (partition)-import Data.Monoid ((<>))-import qualified Data.Map.Strict as Map-import qualified Data.Text as Text--import Text.ABNF.Parser.Types--type RuleMap = Map.Map Identifier Rule--canonicalizeRules :: Identifier -> [Rule] -> Maybe Rule-canonicalizeRules mainRuleIdent rules = do-    let (defs, adds) = partition isAdd rules-        ruleMap  = foldr (\rule@(Rule ident _ _) curMap ->-                              Map.insert ident rule curMap)-                         Map.empty-                         defs-        ruleMap' = foldr (\rule@(Rule ident _ _) curMap ->-                              Map.insertWith mergeRules ident rule curMap)-                         ruleMap-                         adds-    mainRule <- Map.lookup mainRuleIdent ruleMap'-    pure $ inlineRulesRule ruleMap' mainRule --TODO: Catch missing rules here-    where-        isAdd (Rule _ Equals _) = False-        isAdd (Rule _ Adds _) = True--mergeRules :: Rule -> Rule -> Rule-mergeRules (Rule ident Equals left) (Rule ident2 Adds right)-  | ident == ident2 = Rule ident Equals-    ( SumSpec [ ProductSpec [ Repetition (Repeat 1 (Just 1))-                                (GroupElement (Group left))-                            ]-              , ProductSpec [ Repetition (Repeat 1 (Just 1))-                                (GroupElement (Group right))-                            ]-              ]-    ) -  -- TODO: Print location of error-  | otherwise = error . Text.unpack-      $  "Error while canocicalizing ABNF: Rule " <> ident-      <> " appended (=/) without ever assigning(=)"-mergeRules _ _ = error "Bug in ABNF canonicalizer (mergeRules)!"--inlineRulesRule :: RuleMap -> Rule -> Rule-inlineRulesRule rulemap (Rule ident def spec) =-    Rule ident def (inlineRulesSumSpec rulemap spec)--inlineRulesSumSpec :: RuleMap -> SumSpec -> SumSpec-inlineRulesSumSpec rulemap (SumSpec specs) =-    SumSpec $ inlineRulesProdSpec rulemap <$> specs--inlineRulesProdSpec :: RuleMap -> ProductSpec -> ProductSpec-inlineRulesProdSpec rulemap (ProductSpec reps) =-    ProductSpec $ inlineRulesRepetition rulemap <$> reps--inlineRulesRepetition :: RuleMap -> Repetition -> Repetition-inlineRulesRepetition rulemap (Repetition rep elem) =-    Repetition rep $ inlineRulesElement rulemap elem--inlineRulesElement :: RuleMap -> Element -> Element-inlineRulesElement rulemap oldrule@(RuleElement' ruleName) =-    let rule = Map.lookup ruleName rulemap-    in  maybe oldrule (RuleElement . inlineRulesRule rulemap) rule-inlineRulesElement rulemap (GroupElement grp) =-    GroupElement $ inlineRulesGroup rulemap grp-inlineRulesElement rulemap (OptionElement grp) =-    OptionElement $ inlineRulesGroup rulemap grp-inlineRulesElement _ old = old--inlineRulesGroup :: RuleMap -> Group -> Group-inlineRulesGroup rulemap (Group sumspec) = Group (inlineRulesSumSpec rulemap sumspec)

@@ -1,86 +1,1 @@-{-# LANGUAGE OverloadedStrings #-}-{-|-Module      : Text.ABNF.Document-Description : Tools to parse ABNF into a Document-Copyright   : (c) Martin Zeller, 2016-License     : BSD2-Maintainer  : Martin Zeller <mz.bremerhaven@gmail.com>-Stability   : experimental-Portability : non-portable--This module takes a canonicalized rule to parse a document described by it.-You use the function 'generateParser' to generate an attoparsec parser.--}- module Text.ABNF.Document 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.Parser.Types-import Text.ABNF.Document.Types--import Debug.Trace--generateParser :: Rule -> Parser Document-generateParser = parseRule--parseRule :: Rule -> Parser Document-parseRule (Rule ident _ spec) = Document ident <$>-    (traceM ("Rule: " ++ Text.unpack 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]--- any number of times-parseRepetition (Repetition (Repeat 0 Nothing) elem) =-    join <$> (many $ parseElem elem)--- Zero times-parseRepetition (Repetition (Repeat 0 (Just 0)) _) = pure []--- Less than n times-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 (n-1))) elem))-      Nothing -> pure []--- Between n and m times-parseRepetition (Repetition (Repeat n (Just m)) elem) =-    liftA2 (++) (parseElem elem)-                (parseRepetition (Repetition (Repeat (n-1) (Just (m-1))) elem))--- At least n times-parseRepetition (Repetition (Repeat n x) elem) =-    liftA2 (++) (parseElem elem)-                (parseRepetition (Repetition (Repeat (n-1) 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) = trace (Text.unpack 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

@@ -0,0 +1,83 @@+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : Text.ABNF.Document.Parser+Description : Tools to parse ABNF into a Document+Copyright   : (c) Martin Zeller, 2016+License     : BSD2+Maintainer  : Martin Zeller <mz.bremerhaven@gmail.com>+Stability   : experimental+Portability : non-portable++This module takes a canonicalized rule to parse a document described by it.+You use the function 'generateParser' to generate an attoparsec parser.+-}++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]+-- any number of times+parseRepetition (Repetition (Repeat 0 Nothing) elem) =+    join <$> (many $ parseElem elem)+-- Zero times+parseRepetition (Repetition (Repeat 0 (Just 0)) _) = pure []+-- Less than n times+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 (n-1))) elem))+      Nothing -> pure []+-- Between n and m times+parseRepetition (Repetition (Repeat n (Just m)) elem) =+    liftA2 (++) (parseElem elem)+                (parseRepetition (Repetition (Repeat (n-1) (Just (m-1))) elem))+-- At least n times+parseRepetition (Repetition (Repeat n x) elem) =+    liftA2 (++) (parseElem elem)+                (parseRepetition (Repetition (Repeat (n-1) 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

@@ -1,170 +0,0 @@-{-|-Module      : Text.ABNF.Parser-Description : ABNF Parser-Copyright   : (c) Martin Zeller, 2016-License     : BSD2-Maintainer  : Martin Zeller <mz.bremerhaven@gmail.com>-Stability   : experimental-Portability : portable--This module provides facilities to parse ABNF documents.-To parse documents using ABNF, see "Text.ABNF.Document.Parser"--The parser you will most likely be interested in is 'rulelist'--}-module Text.ABNF.Parser where--import Prelude hiding (repeat)--import Data.Char (ord, isHexDigit, digitToInt)-import Data.Maybe (catMaybes)-import qualified Data.Text as Text-import Numeric (readInt)-import Text.Megaparsec-import Text.Megaparsec.Text--import Text.ABNF.Parser.Types--identifier :: Parser Identifier-identifier = Text.pack <$> do-    firstChar <- letterChar-    otherChars <- many $ alphaNumChar <|> char '-'-    pure (firstChar:otherChars)--rulelist :: Parser [Rule]-rulelist = catMaybes <$> (some $ Just <$> rule <|> (many wsp *> c_nl *> pure Nothing))--rule :: Parser Rule-rule = Rule <$> identifier-            <*> defined_as-            <*> elements-            <* c_nl--defined_as :: Parser DefinedAs-defined_as = many c_wsp *> ((try (string "=/") *> pure Adds)-                         <|> try (string "=")  *> pure Equals) <* many c_wsp--elements :: Parser SumSpec-elements = alternation <* many wsp--c_wsp :: Parser String-c_wsp = sequence [wsp] <|> (try $ do-    newl <- c_nl-    white <- wsp-    pure $ newl ++ [white])--c_nl :: Parser String-c_nl = comment <|> crlf--comment :: Parser String-comment = char ';' *> many (wsp <|> vchar) <* crlf--alternation :: Parser SumSpec-alternation = (do-    first <- concatenation-    rest <- many (try (many c_wsp *> char '/') *> many c_wsp *> concatenation)-    pure . SumSpec $ first:rest) <?> "alternation"--concatenation :: Parser ProductSpec-concatenation = (do-    first <- repetition-    rest <- many (try $ some c_wsp *> repetition)-    pure . ProductSpec $ first:rest) <?> "concatenation"--repetition :: Parser Repetition-repetition = Repetition <$> repeat <*> element--repeat :: Parser Repeat-repeat = try asteriskNumbers <|> try singleNumber <|> pure (Repeat 1 (Just 1))-    where-        singleNumber = Repeat 1 <$> (Just . read <$> some digitChar)-        asteriskNumbers = do-            firstNumber <- option 0 (read <$> some digitChar)-            char '*'-            secondNumber <- optional (read <$> some digitChar)-            pure $ Repeat firstNumber secondNumber--element :: Parser Element-element = RuleElement' <$> identifier-      <|> GroupElement <$> group-      <|> OptionElement <$> option_-      <|> LiteralElement <$> literal--group :: Parser Group-group = Group <$>-    (char '(' *> many c_wsp *> alternation <* many c_wsp <* char ')')--option_ :: Parser Group-option_ = Group <$>-    (char '[' *> many c_wsp *> alternation <* many c_wsp <* char ']')--literal :: Parser Literal-literal = CharLit <$> char_val <|> NumLit <$> num_val <|> CharLit <$> prose_val--char_val :: Parser Text.Text-char_val = Text.pack <$> (char '"' *> many schar <* char '"')-    where-        schar = satisfy (\c -> ord c >= 0x20 && ord c <= 0x21-                            || ord c >= 0x23 && ord c <= 0x7E)--num_val :: Parser NumLit-num_val = char '%' *> (bin_val <|> dec_val <|> hex_val)--{-# WARNING bin_val "readBinInt is unsafe" #-}-bin_val :: Parser NumLit-bin_val = num_val' 'b' binInt-    where-        readBinInt :: String -> Int-        readBinInt = fst . head . readInt 2-            (`elem` ['0', '1'])-            digitToInt-        binInt = readBinInt <$> many (char '0' <|> char '1')--dec_val :: Parser NumLit-dec_val = num_val' 'd' readInt-    where-        readInt :: Parser Int-        readInt = read <$> some digitChar--{-# WARNING hex_val "readHexInt is unsafe" #-}-hex_val :: Parser NumLit-hex_val = num_val' 'x' hexInt-    where-        readHexInt :: String -> Int-        readHexInt = fst . head . readInt 16 isHexDigit digitToInt-        hexInt = readHexInt <$> many hexDigitChar--num_val' :: Char -> Parser Int -> Parser NumLit-num_val' c hexInt = do-    char c-    digits <- hexInt-    intLit digits <|> rangeLit digits <|> pure (IntLit [digits])-    where-        intLit' :: Parser [Int]-        intLit' = some $ char '.' *> hexInt--        intLit first = do-            rest <- intLit'-            pure $ IntLit (first:rest)--        rangeLit :: Int -> Parser NumLit-        rangeLit startRange = do-            char '-'-            endRange <- hexInt-            pure $ RangeLit startRange endRange--        --readHexInt :: String -> Int-        --readHexInt = fst . head . readInt 16 isHexDigit digitToInt-        --hexInt = readHexInt <$> many hexDigitChar--prose_val :: Parser Text.Text-prose_val = Text.pack <$> (char '<' *> many pchar <* char '>')-    where-        pchar = satisfy (\c -> ord c >= 0x20 && ord c <= 0x3D-                            || ord c >= 0x3F && ord c <= 0x7E)--vchar :: Parser Char-vchar = satisfy (\c -> ord c >= 0x21 && ord c <= 0x7E)--wsp :: Parser Char-wsp = char ' ' <|> char '\t'

@@ -1,52 +0,0 @@-{-|-Module      : Text.ABNF.Parser.Types-Description : Types used by the parser-Copyright   : (c) Martin Zeller, 2016-License     : BSD2-Maintainer  : Martin Zeller <mz.bremerhaven@gmail.com>-Stability   : experimental-Portability : portable--These types are used by the parser and are loosely modeled after the ABNF-privded in <https://tools.ietf.org/html/rfc5234#section-4 RFC 5234>--}-module Text.ABNF.Parser.Types where--import qualified Data.Text as Text--type Identifier = Text.Text--data Rule = Rule Identifier DefinedAs SumSpec-    deriving (Show, Eq)--data SumSpec = SumSpec [ProductSpec]-    deriving (Show, Eq)--data ProductSpec = ProductSpec [Repetition]-    deriving (Show, Eq)--data Repetition = Repetition Repeat Element-    deriving (Show, Eq)--data Repeat = Repeat Int (Maybe Int)-    deriving (Show, Eq)--data Element = RuleElement' Identifier-             | RuleElement Rule-             | GroupElement Group-             | OptionElement Group-             | LiteralElement Literal-             deriving (Show, Eq)--data Group = Group SumSpec-    deriving (Show, Eq)--data Literal = CharLit Text.Text | NumLit NumLit-    deriving (Show, Eq)--data NumLit = IntLit [Int]-            | RangeLit Int Int-            deriving (Show, Eq)--data DefinedAs = Equals | Adds-    deriving (Show, Eq)

@@ -1,5 +1,5 @@ {-|-Module      : Text.ABNF.PrettyPrinter+Module      : Text.ABNF.ABNF.PrettyPrinter Description : Pretty printer for ABNF rules Copyright   : (c) Martin Zeller, 2016 License     : BSD2@@ -13,7 +13,7 @@ import Data.List (intersperse) import qualified Data.Text as Text -import Text.ABNF.Parser.Types+import Text.ABNF.ABNF.Types  class Pretty a where     prettyShow :: a -> String

@@ -8,8 +8,8 @@ import Text.Megaparsec.Text import qualified Data.Text as T -import Text.ABNF.Parser-import Text.ABNF.Parser.Types+import Text.ABNF.ABNF.Parser+import Text.ABNF.ABNF.Types import Util  testParser :: (Eq a, Show a) => Parser a -> T.Text -> a -> Assertion

@@ -6,8 +6,8 @@ import Test.Tasty import Test.Tasty.HUnit -import Text.ABNF.Parser.Types-import Text.ABNF.Document+import Text.ABNF.ABNF.Types+import Text.ABNF.Document.Parser import Text.ABNF.Document.Types  import Util

@@ -0,0 +1,15 @@+module Util where++import Text.ABNF.ABNF.Types++simpleSum :: Element -> SumSpec+simpleSum = SumSpec . (:[]) . simpleProd++simpleProd :: Element -> ProductSpec+simpleProd = ProductSpec . (:[]) . single++single :: Element -> Repetition+single = Repetition (Repeat 1 (Just 1))++wsElement :: Element+wsElement = LiteralElement (NumLit (IntLit [0x20]))