abnf (empty) → 0.1.0.0
raw patch · 12 files changed
+806/−0 lines, 12 filesdep +HUnitdep +abnfdep +attoparsecsetup-changed
Dependencies added: HUnit, abnf, attoparsec, base, containers, megaparsec, tasty, tasty-hunit, test-framework, test-framework-hunit, text
Files
- LICENSE +26/−0
- Setup.hs +2/−0
- abnf.cabal +60/−0
- src/Text/ABNF/Canonicalizer.hs +74/−0
- src/Text/ABNF/Document.hs +86/−0
- src/Text/ABNF/Document/Types.hs +21/−0
- src/Text/ABNF/Parser.hs +170/−0
- src/Text/ABNF/Parser/Types.hs +52/−0
- src/Text/ABNF/PrettyPrinter.hs +70/−0
- test/ABNF.hs +84/−0
- test/Document.hs +138/−0
- test/Main.hs +23/−0
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2016, Xandaros+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the+ distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ abnf.cabal view
@@ -0,0 +1,60 @@+-- Initial abnf.cabal generated by cabal init. For further documentation, +-- see http://haskell.org/cabal/users-guide/++name: abnf+version: 0.1.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+ described by the ABNF.+license: BSD2+license-file: LICENSE+author: Xandaros+maintainer: mz.bremerhaven@gmail.com+-- copyright: +homepage: https://github.com/Xandaros/abnf.git+category: Text+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++source-repository head+ type: git+ location: https://github.com/Xandaros/abnf.git++library+ exposed-modules: Text.ABNF.Parser,+ Text.ABNF.Parser.Types,+ Text.ABNF.Canonicalizer,+ Text.ABNF.Document,+ Text.ABNF.Document.Types,+ Text.ABNF.PrettyPrinter+ ghc-options: -W+ -- other-modules: + -- other-extensions: + build-depends: base >=4.8 && <4.9,+ text,+ megaparsec,+ attoparsec,+ containers+ hs-source-dirs: src+ default-language: Haskell2010++test-suite test+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules: ABNF,+ Document+ hs-source-dirs: test+ build-depends: base >= 4.8 && <4.9,+ text,+ containers,+ test-framework,+ test-framework-hunit,+ megaparsec,+ attoparsec,+ HUnit,+ tasty,+ tasty-hunit,+ abnf+ default-language: Haskell2010
+ src/Text/ABNF/Canonicalizer.hs view
@@ -0,0 +1,74 @@+{-# 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)
+ src/Text/ABNF/Document.hs view
@@ -0,0 +1,86 @@+{-# 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
+ src/Text/ABNF/Document/Types.hs view
@@ -0,0 +1,21 @@+{-|+Module : Text.ABNF.Document.Types+Description : Document type+Copyright : (c) Martin Zeller, 2016+License : BSD2+Maintainer : Martin Zeller <mz.bremerhaven@gmail.com>+Stability : experimental+Portability : portable+-}+module Text.ABNF.Document.Types where++import qualified Data.Text as Text++type Identifier = Text.Text++data Document = Document Identifier [Content]+ deriving (Show, Eq)++data Content = Terminal Text.Text+ | NonTerminal Document+ deriving (Show, Eq)
+ src/Text/ABNF/Parser.hs view
@@ -0,0 +1,170 @@+{-|+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'
+ src/Text/ABNF/Parser/Types.hs view
@@ -0,0 +1,52 @@+{-|+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)
+ src/Text/ABNF/PrettyPrinter.hs view
@@ -0,0 +1,70 @@+{-|+Module : Text.ABNF.PrettyPrinter+Description : Pretty printer for ABNF rules+Copyright : (c) Martin Zeller, 2016+License : BSD2+Maintainer : Martin Zeller <mz.bremerhaven@gmail.com>+Stability : experimental+Portability : portable+-}++module Text.ABNF.PrettyPrinter where++import Data.List (intersperse)+import qualified Data.Text as Text++import Text.ABNF.Parser.Types++class Pretty a where+ prettyShow :: a -> String++instance Pretty a => Pretty [a] where+ prettyShow = unlines . map prettyShow++instance Pretty Rule where+ prettyShow (Rule ident definedAs sumSpec) = Text.unpack ident+ ++ " "+ ++ prettyShow definedAs+ ++ " "+ ++ prettyShow sumSpec++instance Pretty DefinedAs where+ prettyShow Equals = "="+ prettyShow Adds = "=/"++instance Pretty SumSpec where+ prettyShow (SumSpec prodspecs) = concat $+ intersperse " / " (map prettyShow prodspecs)++instance Pretty ProductSpec where+ prettyShow (ProductSpec reps) = concat $+ intersperse " " (map prettyShow reps)++instance Pretty Repetition where+ prettyShow (Repetition repeat elem) = prettyShow repeat+ ++ prettyShow elem++instance Pretty Repeat where+ prettyShow (Repeat 1 (Just 1)) = ""+ prettyShow (Repeat 0 Nothing) = "*"+ prettyShow (Repeat l Nothing) = show l ++ "*"+ prettyShow (Repeat l (Just h)) = show l ++ "*" ++ show h++instance Pretty Element where+ prettyShow (RuleElement' ident) = Text.unpack ident+ prettyShow (RuleElement rule) = prettyShow rule+ prettyShow (GroupElement group) = "(" ++ prettyShow group ++ ")"+ prettyShow (OptionElement option) = "[" ++ prettyShow option ++ "]"+ prettyShow (LiteralElement lit) = prettyShow lit++instance Pretty Group where+ prettyShow (Group sumSpec) = prettyShow sumSpec++instance Pretty Literal where+ prettyShow (CharLit lit) = "\"" ++ Text.unpack lit ++ "\""+ prettyShow (NumLit lit) = prettyShow lit++instance Pretty NumLit where+ prettyShow (IntLit lit) = "%d" ++ concat (intersperse "." (map show lit))+ prettyShow (RangeLit lit1 lit2) = "%d" ++ show lit1 ++ "-" ++ show lit2+
+ test/ABNF.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BinaryLiterals #-}+module ABNF where++import Test.Tasty+import Test.Tasty.HUnit+import Text.Megaparsec+import Text.Megaparsec.Text+import qualified Data.Text as T++import Text.ABNF.Parser+import Text.ABNF.Parser.Types+import Util++testParser :: (Eq a, Show a) => Parser a -> T.Text -> a -> Assertion+testParser parser input expected = case parse parser "" input of+ Left msg -> assertFailure (show msg)+ Right a -> assertEqual "" expected a++abnfTests :: TestTree+abnfTests = testGroup "ABNF Parser"+ [ let testLit = testParser literal+ in testGroup "Literals" $+ [ testCase "CharLit" $ testLit "\"a\""+ (CharLit "a")+ , testCase "Long CharLit" $ testLit "\"asdfghjkl\""+ (CharLit "asdfghjkl")+ , testCase "IntLit" $ testLit "%x20"+ (NumLit $ IntLit [0x20])+ , testCase "IntLit.conat" $ testLit "%x20.20"+ (NumLit $ IntLit [0x20,0x20])+ , testCase "IntLit decimal" $ testLit "%d32"+ (NumLit $ IntLit [32])+ , testCase "IntLit binary" $ testLit "%b00100000"+ (NumLit $ IntLit [0b00100000])+ , testCase "RangeLit" $ testLit "%x41-5A"+ (NumLit $ RangeLit 0x41 0x5A)+ ]+ , let testRep = testParser repetition+ in testGroup "Repetition" $+ [ testCase "single" $ testRep "%x20"+ (single wsElement)+ , testCase "1-2 times" $ testRep "1*2%x20"+ (Repetition (Repeat 1 (Just 2)) wsElement)+ , testCase "1-* times" $ testRep "1*%x20"+ (Repetition (Repeat 1 Nothing) wsElement)+ , testCase "* times" $ testRep "*%x20"+ (Repetition (Repeat 0 Nothing) wsElement)+ ]+ , let testProd = testParser concatenation+ in testGroup "Concatenation" $+ [ testCase "simple" $ testProd "%x20 %x20"+ (ProductSpec [single wsElement, single wsElement])+ , testCase "group" $ testProd "%x20 (%x20 %x20)"+ (ProductSpec [ single wsElement+ , single $ GroupElement (Group (SumSpec+ [ ProductSpec [ single wsElement+ , single wsElement+ ]+ ]))+ ])+ ]+ , let testSum = testParser elements+ in testGroup "Elements" $+ [ testCase "simple" $ testSum "%x20"+ (SumSpec [simpleProd wsElement])+ , testCase "sum" $ testSum "%x20 / %x09"+ (SumSpec [ simpleProd wsElement+ , simpleProd (LiteralElement . NumLit $ IntLit [0x09])])+ , testCase "complex" $ testSum "%x20 / %x20 (%x20 / %x20)"+ (SumSpec [ simpleProd wsElement+ , ProductSpec [ single wsElement+ , single $ GroupElement (Group (SumSpec [simpleProd wsElement, simpleProd wsElement]))+ ]+ ])+ ]+ , let testRule = testParser rule+ in testGroup "Rule" $+ [ testCase "equals" $ testRule "a = %x20\r\n"+ (Rule "a" Equals (simpleSum wsElement))+ , testCase "adds" $ testRule "a =/ %x20\r\n"+ (Rule "a" Adds (simpleSum wsElement))+ ]+ ]
+ test/Document.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE OverloadedStrings #-}+module Document where++import qualified Data.Text as T+import Data.Attoparsec.Text+import Test.Tasty+import Test.Tasty.HUnit++import Text.ABNF.Parser.Types+import Text.ABNF.Document+import Text.ABNF.Document.Types++import Util++testDoc :: (Eq a, Show a) => Parser a -> T.Text -> a -> Assertion+testDoc parser input expected = case parseOnly parser input of+ Left msg -> assertFailure msg+ Right a -> assertEqual "" expected a++documentTests :: TestTree+documentTests = testGroup "Document Parser" $+ [ let testLit l = testDoc (parseLiteral l)+ in testGroup "literal" $+ [ testCase "IntLit" $+ testLit wsLiteral " " [Terminal " "]+ , testCase "IntLit concat" $+ testLit (NumLit (IntLit [0x20,0x20])) " " [Terminal " "]+ , testCase "RangeLit left edge" $+ testLit (NumLit (RangeLit 0x41 0x5A)) "A" [Terminal "A"]+ , testCase "RangeLit mid" $+ testLit (NumLit (RangeLit 0x41 0x5A)) "L" [Terminal "L"]+ , testCase "RangeLit right edge" $+ testLit (NumLit (RangeLit 0x41 0x5A)) "Z" [Terminal "Z"]+ , testCase "CharLit" $+ testLit (CharLit " ") " " [Terminal " "]+ ]+ , let testElem l = testDoc (parseElem l)+ in testGroup "element" $+ [ testCase "RuleElement" $+ testElem (RuleElement $ simpleRule "x" wsElement) " "+ [NonTerminal (Document "x" [Terminal " "])]+ , testCase "GroupElement" $+ testElem (GroupElement (Group (simpleSum wsElement))) " "+ [Terminal " "]+ , testCase "OptionElement - empty" $+ testElem (OptionElement (Group (simpleSum wsElement))) ""+ []+ , testCase "OptionElement - non-empty" $+ testElem (OptionElement (Group (simpleSum wsElement))) " "+ [Terminal " "]+ , testCase "LiteralElement" $+ testElem wsElement " " [Terminal " "]+ ]+ , let testRep l = testDoc (parseRepetition l)+ in testGroup "repetition" $+ [ testCase "single" $+ testRep (single wsElement) " " [Terminal " "]+ , testCase "1-3 - 1" $+ testRep (Repetition (Repeat 1 (Just 3)) wsElement) " "+ [Terminal " "]+ , testCase "1-3 - 2" $+ testRep (Repetition (Repeat 1 (Just 3)) wsElement) " "+ [Terminal " ", Terminal " "]+ , testCase "1-3 - 3" $+ testRep (Repetition (Repeat 1 (Just 3)) wsElement) " "+ [Terminal " ", Terminal " ", Terminal " "]+ , testCase "1-* - 1" $+ testRep (Repetition (Repeat 1 Nothing) wsElement) " "+ [Terminal " "]+ , testCase "1-* - 3" $+ testRep (Repetition (Repeat 1 Nothing) wsElement) " "+ [Terminal " ", Terminal " ", Terminal " "]+ , testCase "* - 0" $+ testRep (Repetition (Repeat 0 Nothing) wsElement) ""+ []+ , testCase "* - 3" $+ testRep (Repetition (Repeat 0 Nothing) wsElement) " "+ [Terminal " ", Terminal " ", Terminal " "]+ ]+ , let testProd l = testDoc (parseProdSpec l)+ in testGroup "concatenation" $+ [ testCase "simple" $+ testProd (simpleProd wsElement) " "+ [Terminal " "]+ , testCase "two" $+ testProd (ProductSpec [single wsElement, single wsElement]) " "+ [Terminal " ", Terminal " "]+ ]+ , let testSum l = testDoc (parseSumSpec l)+ in testGroup "alternation" $+ [ testCase "simple" $+ testSum (simpleSum wsElement) " "+ [Terminal " "]+ , testCase "3-choice - 1st" $+ testSum (SumSpec [ simpleProd wsElement+ , simpleProd (lit "a")+ , simpleProd (lit "b")+ ]) " "+ [Terminal " "]+ , testCase "3-choice - 2nd" $+ testSum (SumSpec [ simpleProd wsElement+ , simpleProd (lit "a")+ , simpleProd (lit "b")+ ]) "a"+ [Terminal "a"]+ , testCase "3-choice - 3rd" $+ testSum (SumSpec [ simpleProd wsElement+ , simpleProd (lit "a")+ , simpleProd (lit "b")+ ]) "b"+ [Terminal "b"]+ , testCase "group - 1st" $+ testSum (SumSpec [ProductSpec [ single wsElement+ , single $ GroupElement (Group (SumSpec+ [ simpleProd (lit "a")+ , simpleProd (lit "b")+ ]))+ ]]) " a"+ [Terminal " ", Terminal "a"]+ , testCase "group - 2nd" $+ testSum (SumSpec [ProductSpec [ single wsElement+ , single $ GroupElement (Group (SumSpec+ [ simpleProd (lit "a")+ , simpleProd (lit "b")+ ]))+ ]]) " b"+ [Terminal " ", Terminal "b"]+ ]+ ]++lit :: T.Text -> Element+lit = LiteralElement . CharLit++simpleRule :: T.Text -> Element -> Rule+simpleRule ident = Rule ident Equals . simpleSum++wsLiteral :: Literal+wsLiteral = NumLit $ IntLit [0x20]
+ test/Main.hs view
@@ -0,0 +1,23 @@+{-|+Module : Main+Description : Testsuite+Copyright : (c) Martin Zeller, 2016+License : BSD2+Maintainer : Martin Zeller <mz.bremerhaven@gmail.com>+Stability : experimental+Portability : non-portable+-}++module Main where++import Test.Tasty++import ABNF (abnfTests)+import Document (documentTests)++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "tests" $ [abnfTests, documentTests]+