babynf (empty) → 0.1.0.2
raw patch · 74 files changed
+5104/−0 lines, 74 filesdep +attoparsecdep +babynfdep +base
Dependencies added: attoparsec, babynf, base, bytestring, tasty, tasty-hunit
Files
- CHANGELOG.md +14/−0
- LICENSE +20/−0
- babynf.cabal +119/−0
- lib/Data/BAByNF/ABNF.hs +11/−0
- lib/Data/BAByNF/ABNF/Core.hs +387/−0
- lib/Data/BAByNF/ABNF/Model.hs +102/−0
- lib/Data/BAByNF/ABNF/Parse.hs +44/−0
- lib/Data/BAByNF/ABNF/PrettyPrint.hs +104/−0
- lib/Data/BAByNF/ABNF/Rules.hs +59/−0
- lib/Data/BAByNF/ABNF/Rules/Alternation.hs +55/−0
- lib/Data/BAByNF/ABNF/Rules/Alternation.hs-boot +13/−0
- lib/Data/BAByNF/ABNF/Rules/BinVal.hs +118/−0
- lib/Data/BAByNF/ABNF/Rules/CNl.hs +23/−0
- lib/Data/BAByNF/ABNF/Rules/CWsp.hs +26/−0
- lib/Data/BAByNF/ABNF/Rules/CaseInsensitiveString.hs +47/−0
- lib/Data/BAByNF/ABNF/Rules/CaseSensitiveString.hs +41/−0
- lib/Data/BAByNF/ABNF/Rules/CharVal.hs +42/−0
- lib/Data/BAByNF/ABNF/Rules/Comment.hs +28/−0
- lib/Data/BAByNF/ABNF/Rules/Concatenation.hs +47/−0
- lib/Data/BAByNF/ABNF/Rules/DecVal.hs +114/−0
- lib/Data/BAByNF/ABNF/Rules/DefinedAs.hs +60/−0
- lib/Data/BAByNF/ABNF/Rules/Element.hs +68/−0
- lib/Data/BAByNF/ABNF/Rules/Elements.hs +34/−0
- lib/Data/BAByNF/ABNF/Rules/Group.hs +72/−0
- lib/Data/BAByNF/ABNF/Rules/HexVal.hs +111/−0
- lib/Data/BAByNF/ABNF/Rules/NumVal.hs +67/−0
- lib/Data/BAByNF/ABNF/Rules/Option.hs +69/−0
- lib/Data/BAByNF/ABNF/Rules/Option.hs-boot +13/−0
- lib/Data/BAByNF/ABNF/Rules/ProseVal.hs +69/−0
- lib/Data/BAByNF/ABNF/Rules/QuotedString.hs +51/−0
- lib/Data/BAByNF/ABNF/Rules/Repeat.hs +84/−0
- lib/Data/BAByNF/ABNF/Rules/Repetition.hs +45/−0
- lib/Data/BAByNF/ABNF/Rules/Rule.hs +40/−0
- lib/Data/BAByNF/ABNF/Rules/Rulelist.hs +48/−0
- lib/Data/BAByNF/ABNF/Rules/Rulename.hs +38/−0
- lib/Data/BAByNF/ABNF/ToParseable.hs +105/−0
- lib/Data/BAByNF/Core/Parseable.hs +153/−0
- lib/Data/BAByNF/Core/Ref.hs +8/−0
- lib/Data/BAByNF/Core/RefDict.hs +33/−0
- lib/Data/BAByNF/Core/Repeat.hs +68/−0
- lib/Data/BAByNF/Core/Tree.hs +132/−0
- lib/Data/BAByNF/Util/Ascii.hs +181/−0
- lib/Data/BAByNF/Util/Binary.hs +34/−0
- lib/Data/BAByNF/Util/Decimal.hs +69/−0
- lib/Data/BAByNF/Util/Hex.hs +94/−0
- lib/Data/BAByNF/Util/List.hs +66/−0
- lib/Data/BAByNF/Util/Stream.hs +102/−0
- test/Data/BAByNF/ABNF/Parse/Test.hs +78/−0
- test/Data/BAByNF/ABNF/Rules/Alternation/Test.hs +74/−0
- test/Data/BAByNF/ABNF/Rules/BinVal/Test.hs +75/−0
- test/Data/BAByNF/ABNF/Rules/CNl/Test.hs +38/−0
- test/Data/BAByNF/ABNF/Rules/CWsp/Test.hs +39/−0
- test/Data/BAByNF/ABNF/Rules/CaseInsensitiveString/Test.hs +61/−0
- test/Data/BAByNF/ABNF/Rules/CaseSensitiveString/Test.hs +58/−0
- test/Data/BAByNF/ABNF/Rules/CharVal/Test.hs +62/−0
- test/Data/BAByNF/ABNF/Rules/Comment/Test.hs +37/−0
- test/Data/BAByNF/ABNF/Rules/Concatenation/Test.hs +63/−0
- test/Data/BAByNF/ABNF/Rules/DecVal/Test.hs +74/−0
- test/Data/BAByNF/ABNF/Rules/DefinedAs/Test.hs +68/−0
- test/Data/BAByNF/ABNF/Rules/Element/Test.hs +86/−0
- test/Data/BAByNF/ABNF/Rules/Elements/Test.hs +66/−0
- test/Data/BAByNF/ABNF/Rules/Group/Test.hs +61/−0
- test/Data/BAByNF/ABNF/Rules/HexVal/Test.hs +74/−0
- test/Data/BAByNF/ABNF/Rules/NumVal/Test.hs +71/−0
- test/Data/BAByNF/ABNF/Rules/Option/Test.hs +64/−0
- test/Data/BAByNF/ABNF/Rules/ProseVal/Test.hs +59/−0
- test/Data/BAByNF/ABNF/Rules/QuotedString/Test.hs +62/−0
- test/Data/BAByNF/ABNF/Rules/Repeat/Test.hs +68/−0
- test/Data/BAByNF/ABNF/Rules/Repetition/Test.hs +67/−0
- test/Data/BAByNF/ABNF/Rules/Rule/Test.hs +71/−0
- test/Data/BAByNF/ABNF/Rules/Rulelist/Test.hs +88/−0
- test/Data/BAByNF/ABNF/Rules/Rulename/Test.hs +58/−0
- test/Data/BAByNF/Util/Ascii/Test.hs +91/−0
- test/Main.hs +63/−0
+ CHANGELOG.md view
@@ -0,0 +1,14 @@+# Revision history for babynf + +## 0.1.0.0 -- 2024-08-03 + +* First version. Released on an unsuspecting world. Not official. + +## 0.1.0.1 -- 2024-08-04 + +* Update for publishability. Not official. + +## 0.1.0.2 -- 2024-08-05 + +* Dependency bounds improvements. +* First release to Hackage.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2024 Barnaba Piotrowski + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ babynf.cabal view
@@ -0,0 +1,119 @@+cabal-version: 3.4 +name: babynf +version: 0.1.0.2 +synopsis: Library for generating parsers from ABNF +description: A library for parsing ABNF grammars and generating parsers from ABNF grammars. +license: MIT +license-file: LICENSE +author: Barnaba Piotrowski +maintainer: barnaba.piotrowski@gmail.com +category: Data +build-type: Simple +extra-doc-files: CHANGELOG.md +tested-with: GHC == 9.2.1, GHC == 9.6.4, GHC == 9.8.2 + +source-repository this + type: git + location: https://github.com/barny-dev/babynf.git + tag: 0.1.0.2 + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: + Data.BAByNF.Util.Ascii, + Data.BAByNF.Util.List, + Data.BAByNF.Util.Stream, + Data.BAByNF.Util.Hex, + Data.BAByNF.Util.Binary, + Data.BAByNF.Util.Decimal, + Data.BAByNF.Core.Repeat, + Data.BAByNF.Core.Parseable, + Data.BAByNF.Core.Tree, + Data.BAByNF.Core.Ref, + Data.BAByNF.Core.RefDict, + Data.BAByNF.ABNF, + Data.BAByNF.ABNF.Model, + Data.BAByNF.ABNF.Core, + Data.BAByNF.ABNF.Parse, + Data.BAByNF.ABNF.Rules, + Data.BAByNF.ABNF.Rules.Rule, + Data.BAByNF.ABNF.Rules.Rulename, + Data.BAByNF.ABNF.Rules.Rulelist, + Data.BAByNF.ABNF.Rules.Alternation, + Data.BAByNF.ABNF.Rules.Concatenation, + Data.BAByNF.ABNF.Rules.Repetition, + Data.BAByNF.ABNF.Rules.Repeat, + Data.BAByNF.ABNF.Rules.DefinedAs, + Data.BAByNF.ABNF.Rules.Element, + Data.BAByNF.ABNF.Rules.Elements, + Data.BAByNF.ABNF.Rules.Group, + Data.BAByNF.ABNF.Rules.Option, + Data.BAByNF.ABNF.Rules.CharVal, + Data.BAByNF.ABNF.Rules.CaseInsensitiveString, + Data.BAByNF.ABNF.Rules.CaseSensitiveString, + Data.BAByNF.ABNF.Rules.QuotedString, + Data.BAByNF.ABNF.Rules.NumVal, + Data.BAByNF.ABNF.Rules.BinVal, + Data.BAByNF.ABNF.Rules.DecVal, + Data.BAByNF.ABNF.Rules.HexVal, + Data.BAByNF.ABNF.Rules.ProseVal, + Data.BAByNF.ABNF.Rules.Comment, + Data.BAByNF.ABNF.Rules.CWsp, + Data.BAByNF.ABNF.Rules.CNl, + Data.BAByNF.ABNF.PrettyPrint, + Data.BAByNF.ABNF.ToParseable + other-modules: + -- other-extensions: + build-depends: + base >= 4.16 && < 4.20, + bytestring >= 0.11.1 && < 0.12, + attoparsec >= 0.14.2 && < 0.15 + hs-source-dirs: lib + default-language: GHC2021 + +test-suite babynf-test + import: warnings + default-language: GHC2021 + other-modules: + Data.BAByNF.Util.Ascii.Test, + Data.BAByNF.ABNF.Rules.Alternation.Test, + Data.BAByNF.ABNF.Rules.BinVal.Test, + Data.BAByNF.ABNF.Rules.CaseInsensitiveString.Test, + Data.BAByNF.ABNF.Rules.CaseSensitiveString.Test, + Data.BAByNF.ABNF.Rules.CharVal.Test, + Data.BAByNF.ABNF.Rules.CNl.Test, + Data.BAByNF.ABNF.Rules.Comment.Test, + Data.BAByNF.ABNF.Rules.Concatenation.Test, + Data.BAByNF.ABNF.Rules.CWsp.Test, + Data.BAByNF.ABNF.Rules.DecVal.Test, + Data.BAByNF.ABNF.Rules.DefinedAs.Test, + Data.BAByNF.ABNF.Rules.Element.Test, + Data.BAByNF.ABNF.Rules.Elements.Test, + Data.BAByNF.ABNF.Rules.Group.Test, + Data.BAByNF.ABNF.Rules.HexVal.Test, + Data.BAByNF.ABNF.Rules.NumVal.Test, + Data.BAByNF.ABNF.Rules.Option.Test, + Data.BAByNF.ABNF.Rules.ProseVal.Test, + Data.BAByNF.ABNF.Rules.QuotedString.Test, + Data.BAByNF.ABNF.Rules.Repeat.Test, + Data.BAByNF.ABNF.Rules.Repetition.Test, + Data.BAByNF.ABNF.Rules.Rule.Test, + Data.BAByNF.ABNF.Rules.Rulelist.Test, + Data.BAByNF.ABNF.Rules.Rulename.Test, + Data.BAByNF.ABNF.Parse.Test + -- other-extensions: + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + build-depends: + babynf, + base, + bytestring, + attoparsec, + tasty >= 1.2 && < 1.6, + tasty-hunit >= 0.10 && < 0.11 + +
+ lib/Data/BAByNF/ABNF.hs view
@@ -0,0 +1,11 @@+module Data.BAByNF.ABNF + ( module Data.BAByNF.ABNF.Model + , module Data.BAByNF.ABNF.ToParseable + , module Data.BAByNF.ABNF.PrettyPrint + ) where + +import Data.BAByNF.ABNF.Model +import Data.BAByNF.ABNF.ToParseable +import Data.BAByNF.ABNF.PrettyPrint + +
+ lib/Data/BAByNF/ABNF/Core.hs view
@@ -0,0 +1,387 @@+module Data.BAByNF.ABNF.Core + ( rules + , ruleRefs + , alphaRef + , alphaRule + , bitRef + , bitRule + , charRef + , charRule + , crRef + , crRule + , crlfRef + , crlfRule + , ctlRef + , ctlRule + , digitRef + , digitRule + , dquoteRef + , dquoteRule + , hexdigRef + , hexdigRule + , htabRef + , htabRule + , lfRef + , lfRule + , lwspRef + , lwspRule + , octetRef + , octetRule + , spRef + , spRule + , vcharRef + , vcharRule + , wspRef + , wspRule + ) where + +import Data.List qualified as List + +import Data.BAByNF.Util.Ascii qualified as Ascii +import Data.BAByNF.Util.Hex qualified as Hex +import Data.BAByNF.ABNF.Model qualified as Model + +rules :: [Model.Rule] +rules = + [ alphaRule + , bitRule + , charRule + , crRule + , crlfRule + , ctlRule + , digitRule + , dquoteRule + , hexdigRule + , htabRule + , lfRule + , lwspRule + , octetRule + , spRule + , vcharRule + , wspRule + ] + +ruleRefs :: [Model.Rulename] +ruleRefs = map (\(Model.Rule r _ _) -> r) rules + +alphaRef :: Model.Rulename +alphaRef = Model.Rulename (Ascii.stringAsBytesUnsafe "ALPHA") + +alphaRule :: Model.Rule +alphaRule = Model.Rule alphaRef Model.BasicDefinition . + Model.Elements . Model.Alternation $ + [ Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.NumValElement + . Model.HexNumVal + $ Model.RangeHexVal (Hex.Seq [Hex.X4, Hex.X1]) (Hex.Seq [Hex.X5, Hex.XA]) + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.NumValElement + . Model.HexNumVal + $ Model.RangeHexVal (Hex.Seq [Hex.X6, Hex.X1]) (Hex.Seq [Hex.X7, Hex.XA]) + ] + +bitRef :: Model.Rulename +bitRef = Model.Rulename (Ascii.stringAsBytesUnsafe "BIT") + +bitRule :: Model.Rule +bitRule = Model.Rule bitRef Model.BasicDefinition + $ Model.Elements + $ Model.Alternation + [ Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.bs '0' + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.bs '1' + ] + +charRef :: Model.Rulename +charRef = Model.Rulename (Ascii.stringAsBytesUnsafe "CHAR") + +charRule :: Model.Rule +charRule = Model.Rule charRef Model.BasicDefinition + $ Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.NumValElement + . Model.HexNumVal + $ Model.RangeHexVal (Hex.Seq [Hex.X0, Hex.X1]) (Hex.Seq [Hex.X7, Hex.XF]) + +crRef :: Model.Rulename +crRef = Model.Rulename (Ascii.stringAsBytesUnsafe "CR") + +crRule :: Model.Rule +crRule = Model.Rule crRef Model.BasicDefinition + $ Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.NumValElement + . Model.HexNumVal + $ Model.SeqHexVal [Hex.Seq [Hex.X0, Hex.XD]] + +crlfRef :: Model.Rulename +crlfRef = Model.Rulename (Ascii.stringAsBytesUnsafe "CRLF") + +crlfRule :: Model.Rule +crlfRule = Model.Rule crlfRef Model.BasicDefinition + $ Model.Elements + . Model.Alternation + . List.singleton + $ Model.Concatenation + [ Model.Repetition Model.NoRepeat + $ Model.RulenameElement crRef + , Model.Repetition Model.NoRepeat + $ Model.RulenameElement lfRef + ] + +ctlRef :: Model.Rulename +ctlRef = Model.Rulename (Ascii.stringAsBytesUnsafe "CTL") + +ctlRule :: Model.Rule +ctlRule = Model.Rule ctlRef Model.BasicDefinition + $ Model.Elements + $ Model.Alternation + [ Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.NumValElement + . Model.HexNumVal + $ Model.RangeHexVal (Hex.Seq [Hex.X0, Hex.X0]) (Hex.Seq [Hex.X1, Hex.XF]) + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.NumValElement + . Model.HexNumVal + $ Model.SeqHexVal [Hex.Seq [Hex.X7, Hex.XF]] + ] + +digitRef :: Model.Rulename +digitRef = Model.Rulename (Ascii.stringAsBytesUnsafe "DIGIT") + +digitRule :: Model.Rule +digitRule = Model.Rule digitRef Model.BasicDefinition + $ Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.NumValElement + . Model.HexNumVal + $ Model.RangeHexVal (Hex.Seq [Hex.X3, Hex.X0]) (Hex.Seq [Hex.X3, Hex.X9]) + +dquoteRef :: Model.Rulename +dquoteRef = Model.Rulename (Ascii.stringAsBytesUnsafe "DQUOTE") + +dquoteRule :: Model.Rule +dquoteRule = Model.Rule dquoteRef Model.BasicDefinition + $ Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.NumValElement + . Model.HexNumVal + $ Model.SeqHexVal [Hex.Seq [Hex.X2, Hex.X2]] + +hexdigRef :: Model.Rulename +hexdigRef = Model.Rulename (Ascii.stringAsBytesUnsafe "HEXDIG") + +hexdigRule :: Model.Rule +hexdigRule = Model.Rule hexdigRef Model.BasicDefinition + $ Model.Elements + $ Model.Alternation + [ Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + $ Model.RulenameElement digitRef + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.bs 'A' + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.bs 'B' + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.bs 'C' + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.bs 'D' + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.bs 'E' + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.bs 'F' + ] + +htabRef :: Model.Rulename +htabRef = Model.Rulename (Ascii.stringAsBytesUnsafe "HTAB") + +htabRule :: Model.Rule +htabRule = Model.Rule htabRef Model.BasicDefinition + $ Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.NumValElement + . Model.HexNumVal + $ Model.SeqHexVal [Hex.Seq [Hex.X0, Hex.X9]] + +lfRef :: Model.Rulename +lfRef = Model.Rulename (Ascii.stringAsBytesUnsafe "LF") + +lfRule :: Model.Rule +lfRule = Model.Rule lfRef Model.BasicDefinition + $ Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.NumValElement + . Model.HexNumVal + $ Model.SeqHexVal [Hex.Seq [Hex.X0, Hex.XA]] + +lwspRef :: Model.Rulename +lwspRef = Model.Rulename (Ascii.stringAsBytesUnsafe "LWSP") + +lwspRule :: Model.Rule +lwspRule = Model.Rule lwspRef Model.BasicDefinition + $ Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + . List.singleton + . Model.Repetition (Model.RangedRepeat Model.UnBound Model.UnBound) + . Model.GroupElement + . Model.Group + $ Model.Alternation + [ Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + $ Model.RulenameElement wspRef + , Model.Concatenation + [ Model.Repetition Model.NoRepeat + $ Model.RulenameElement crlfRef + , Model.Repetition Model.NoRepeat + $ Model.RulenameElement wspRef + ] + ] + + +octetRef :: Model.Rulename +octetRef = Model.Rulename (Ascii.stringAsBytesUnsafe "OCTET") + +octetRule :: Model.Rule +octetRule = Model.Rule octetRef Model.BasicDefinition + $ Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.NumValElement + . Model.HexNumVal + $ Model.RangeHexVal (Hex.Seq [Hex.X0, Hex.X0]) (Hex.Seq [Hex.XF, Hex.XF]) + +spRef :: Model.Rulename +spRef = Model.Rulename (Ascii.stringAsBytesUnsafe "SP") + +spRule :: Model.Rule +spRule = Model.Rule spRef Model.BasicDefinition + $ Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.NumValElement + . Model.HexNumVal + $ Model.SeqHexVal [Hex.Seq [Hex.X2, Hex.X0]] + +vcharRef :: Model.Rulename +vcharRef = Model.Rulename (Ascii.stringAsBytesUnsafe "VCHAR") + +vcharRule :: Model.Rule +vcharRule = Model.Rule vcharRef Model.BasicDefinition + $ Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.NumValElement + . Model.HexNumVal + $ Model.RangeHexVal (Hex.Seq [Hex.X2, Hex.X1]) (Hex.Seq [Hex.X7, Hex.XE]) + + +wspRef :: Model.Rulename +wspRef = Model.Rulename (Ascii.stringAsBytesUnsafe "WSP") + +wspRule :: Model.Rule +wspRule = Model.Rule wspRef Model.BasicDefinition + $ Model.Elements + $ Model.Alternation + [ Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + $ Model.RulenameElement spRef + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + $ Model.RulenameElement htabRef + ]
+ lib/Data/BAByNF/ABNF/Model.hs view
@@ -0,0 +1,102 @@+module Data.BAByNF.ABNF.Model + ( Rulelist (..) + , DefinedAs (..) + , Rule (..) + , Rulename (..) + , Elements (..) + , Alternation (..) + , Concatenation (..) + , Repetition (..) + , Repeat (..) + , Bound (..) + , Element (..) + , Group (..) + , Option (..) + , CharVal (..) + , CaseInsensitiveString (..) + , CaseSensitiveString (..) + , QuotedString (..) + , NumVal (..) + , BinVal (..) + , DecVal (..) + , HexVal (..) + , ProseVal (..) + ) where + +import Data.ByteString (ByteString) +import Data.ByteString.Char8 qualified as ByteString.Char8 + +import Data.BAByNF.Util.Ascii qualified as Ascii +import Data.BAByNF.Util.Binary qualified as Binary +import Data.BAByNF.Util.Decimal qualified as Decimal +import Data.BAByNF.Util.Hex qualified as Hex + +import Data.BAByNF.Core.Ref (Ref) +import Data.BAByNF.Core.Ref qualified as Ref + +newtype Rulelist = Rulelist [Rule] deriving (Eq, Show) + +data DefinedAs = BasicDefinition | IncrementalAlternative deriving (Eq, Show) + +data Rule = Rule Rulename DefinedAs Elements deriving (Eq, Show) + +newtype Rulename = Rulename ByteString deriving Eq + +instance Show Rulename where + show (Rulename b) = "Rulename[" ++ ByteString.Char8.unpack b ++ "]" + +instance Ref Rulename where + eq (Rulename x) (Rulename y) = Ascii.eqNoCaseBS x y + display (Rulename x) = show x + +newtype Elements = Elements Alternation deriving (Eq, Show) +newtype Alternation = Alternation [Concatenation] deriving (Eq, Show) + +newtype Concatenation = Concatenation [Repetition] deriving (Eq, Show) + +data Repetition = Repetition Repeat Element deriving (Eq, Show) + +data Repeat = NoRepeat | FixedRepeat Integer | RangedRepeat Bound Bound deriving (Eq, Show) +data Bound = UnBound | FixedBound Integer deriving (Eq, Show) + +data Element = RulenameElement Rulename + | GroupElement Group + | OptionElement Option + | CharValElement CharVal + | NumValElement NumVal + | ProseValElement ProseVal + deriving (Eq, Show) + + +newtype Group = Group Alternation deriving (Eq, Show) + +newtype Option = Option Alternation deriving (Eq, Show) + +data CharVal = CaseInsensitiveCharVal CaseInsensitiveString + | CaseSensitiveCharVal CaseSensitiveString + deriving (Eq, Show) + +newtype CaseInsensitiveString = CaseInsensitiveString QuotedString deriving (Eq, Show) + +newtype CaseSensitiveString = CaseSensitiveString QuotedString deriving (Eq, Show) + +newtype QuotedString = QuotedString ByteString deriving Eq + +instance Show QuotedString where + show (QuotedString b) = show (ByteString.Char8.unpack b) + +data NumVal = BinNumVal BinVal + | DecNumVal DecVal + | HexNumVal HexVal + deriving (Eq, Show) + + +data BinVal = SeqBinVal [Binary.Seq] | RangeBinVal Binary.Seq Binary.Seq deriving (Eq, Show) + +data DecVal = SeqDecVal [Decimal.Seq] | RangeDecVal Decimal.Seq Decimal.Seq deriving (Eq, Show) + +data HexVal = SeqHexVal [Hex.Seq] | RangeHexVal Hex.Seq Hex.Seq deriving (Eq, Show) + +newtype ProseVal = ProseVal ByteString deriving Eq +instance Show ProseVal where + show (ProseVal b) = "ProseVal " ++ show (ByteString.Char8.unpack b)
+ lib/Data/BAByNF/ABNF/Parse.hs view
@@ -0,0 +1,44 @@+module Data.BAByNF.ABNF.Parse + ( parse + , parseRulelist + ) where + +import Data.List qualified as List + +import Data.ByteString (ByteString) + +import Data.Attoparsec.ByteString qualified as Attoparsec.ByteString + +import Data.BAByNF.Core.Ref qualified as Ref + +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.Core.RefDict (RefDict (..)) +import Data.BAByNF.Core.Parseable qualified as Parseable +import Data.BAByNF.Core.Parseable (Parseable) +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Rules.Rulelist qualified as Rulelist +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.ToParseable + +-- TODO: split parse til end of input? +parse :: ToParseable p => Model.Rulelist -> p -> ByteString -> Either String (Tree Model.Rulename) +parse r p t = + let parser = Parseable.toParser (toRefDict r) (toParseable p) + in Attoparsec.ByteString.parseOnly parser t + +parseRulelist :: ByteString -> Either String Model.Rulelist +parseRulelist t = + let toTree = parse rules Rulelist.ref t + in toTree + >>= \tree -> case Tree.nodes tree of + [Tree.RefNode ref subtree] + | Ref.eq ref Rulelist.ref -> Right subtree + | otherwise -> Left "structural mismatch for <rulelist>" + _ -> Left "structural mismatch for <rulelist>" + >>= joinErrors . Rulelist.fromTree + where joinErrors (Right x) = Right x + joinErrors (Left errors) = Left $ "Errors found:\n" ++ List.intercalate "\n" errors + +toRefDict :: Model.Rulelist -> RefDict Model.Rulename (Parseable Model.Rulename) +toRefDict (Model.Rulelist r) = RefDict (map (\(Model.Rule ref _ (Model.Elements a)) -> (ref, toParseable a)) r)
+ lib/Data/BAByNF/ABNF/PrettyPrint.hs view
@@ -0,0 +1,104 @@+module Data.BAByNF.ABNF.PrettyPrint + ( PrettyPrint + , prettyPrint + ) where + +import Data.List qualified as List + +import Data.ByteString.Char8 qualified as ByteString.Char8 + +import Data.BAByNF.ABNF.Model qualified as Model + +class PrettyPrint a where + prettyPrint :: a -> String + +instance PrettyPrint Model.Rulelist where + prettyPrint (Model.Rulelist x) = concatMap ((++ "\r\n") . prettyPrint) x + +instance PrettyPrint Model.Rule where + prettyPrint (Model.Rule rulename definedAs elements) = prettyPrint rulename ++ " " ++ prettyPrint definedAs ++ " " ++ prettyPrint elements + +instance PrettyPrint Model.Rulename where + prettyPrint (Model.Rulename x) = ByteString.Char8.unpack x + +instance PrettyPrint Model.DefinedAs where + prettyPrint Model.BasicDefinition = "=" + prettyPrint Model.IncrementalAlternative = "=/" + +instance PrettyPrint Model.Elements where + prettyPrint (Model.Elements a) = prettyPrint a + +instance PrettyPrint Model.Alternation where + prettyPrint (Model.Alternation x) = List.intercalate " / " (map prettyPrint x) + +instance PrettyPrint Model.Concatenation where + prettyPrint (Model.Concatenation x) = unwords (map prettyPrint x) + +instance PrettyPrint Model.Repetition where + prettyPrint (Model.Repetition r e) = prettyPrint r ++ prettyPrint e + +instance PrettyPrint Model.Repeat where + prettyPrint Model.NoRepeat = "" + prettyPrint (Model.FixedRepeat i) = show i + prettyPrint (Model.RangedRepeat mn mx) = toString mn ++ "*" ++ toString mx + where toString Model.UnBound = "" + toString (Model.FixedBound i) = show i + +instance PrettyPrint Model.Element where + prettyPrint (Model.RulenameElement x) = prettyPrint x + prettyPrint (Model.GroupElement x) = prettyPrint x + prettyPrint (Model.OptionElement x) = prettyPrint x + prettyPrint (Model.NumValElement x) = prettyPrint x + prettyPrint (Model.CharValElement x) = prettyPrint x + prettyPrint (Model.ProseValElement x) = prettyPrint x + +instance PrettyPrint Model.Group where + prettyPrint (Model.Group x) = "(" ++ prettyPrint x ++ ")" + +instance PrettyPrint Model.Option where + prettyPrint (Model.Option x) = "[" ++ prettyPrint x ++ "]" + +instance PrettyPrint Model.NumVal where + prettyPrint x = "%" ++ + ( case x of + Model.BinNumVal y -> prettyPrint y + Model.DecNumVal y -> prettyPrint y + Model.HexNumVal y -> prettyPrint y + ) + +instance PrettyPrint Model.BinVal where + prettyPrint x = "b" ++ + (case x of + Model.SeqBinVal y -> List.intercalate "." (map show y) + Model.RangeBinVal y z -> show y ++ "-" ++ show z + ) + +instance PrettyPrint Model.DecVal where + prettyPrint x = "d" ++ + (case x of + Model.SeqDecVal y -> List.intercalate "." (map show y) + Model.RangeDecVal y z -> show y ++ "-" ++ show z + ) + +instance PrettyPrint Model.HexVal where + prettyPrint x = "x" ++ + (case x of + Model.SeqHexVal y -> List.intercalate "." (map show y) + Model.RangeHexVal y z -> show y ++ "-" ++ show z + ) + +instance PrettyPrint Model.CharVal where + prettyPrint (Model.CaseInsensitiveCharVal x) = prettyPrint x + prettyPrint (Model.CaseSensitiveCharVal x) = prettyPrint x + +instance PrettyPrint Model.CaseInsensitiveString where + prettyPrint (Model.CaseInsensitiveString x) = prettyPrint x + +instance PrettyPrint Model.CaseSensitiveString where + prettyPrint (Model.CaseSensitiveString x) = "%s" ++ prettyPrint x + +instance PrettyPrint Model.QuotedString where + prettyPrint (Model.QuotedString b) = "\"" ++ ByteString.Char8.unpack b ++ "\"" + +instance PrettyPrint Model.ProseVal where + prettyPrint (Model.ProseVal b) = "<" ++ ByteString.Char8.unpack b ++ ">"
+ lib/Data/BAByNF/ABNF/Rules.hs view
@@ -0,0 +1,59 @@+module Data.BAByNF.ABNF.Rules + ( rules + ) where + +import Data.BAByNF.ABNF.Core qualified as Core +import Data.BAByNF.ABNF.Rules.Option qualified as Option +import Data.BAByNF.ABNF.Rules.CharVal qualified as CharVal +import Data.BAByNF.ABNF.Rules.NumVal qualified as NumVal +import Data.BAByNF.ABNF.Rules.BinVal qualified as BinVal +import Data.BAByNF.ABNF.Rules.DecVal qualified as DecVal +import Data.BAByNF.ABNF.Rules.HexVal qualified as HexVal +import Data.BAByNF.ABNF.Rules.ProseVal qualified as ProseVal +import Data.BAByNF.ABNF.Rules.Element qualified as Element +import Data.BAByNF.ABNF.Rules.Elements qualified as Elements +import Data.BAByNF.ABNF.Rules.Rule qualified as Rule +import Data.BAByNF.ABNF.Rules.Group qualified as Group +import Data.BAByNF.ABNF.Rules.Repeat qualified as Repeat +import Data.BAByNF.ABNF.Rules.Repetition qualified as Repetition +import Data.BAByNF.ABNF.Rules.Concatenation qualified as Concatenation +import Data.BAByNF.ABNF.Rules.Alternation qualified as Alternation +import Data.BAByNF.ABNF.Rules.Comment qualified as Comment +import Data.BAByNF.ABNF.Rules.CNl qualified as CNl +import Data.BAByNF.ABNF.Rules.CWsp qualified as CWsp +import Data.BAByNF.ABNF.Rules.DefinedAs qualified as DefinedAs +import Data.BAByNF.ABNF.Rules.Rulename qualified as Rulename +import Data.BAByNF.ABNF.Rules.Rulelist qualified as Rulelist +import Data.BAByNF.ABNF.Rules.CaseInsensitiveString qualified as CaseInsensitiveString +import Data.BAByNF.ABNF.Rules.CaseSensitiveString qualified as CaseSensitiveString +import Data.BAByNF.ABNF.Rules.QuotedString qualified as QuotedString +import Data.BAByNF.ABNF.Model qualified as Model + +-- todo: move out core rules to opt-in abnf parser configuration element +rules :: Model.Rulelist +rules = Model.Rulelist $ Core.rules ++ + [ Rulelist.rule + , Rule.rule + , Rulename.rule + , DefinedAs.rule + , Elements.rule + , CWsp.rule + , CNl.rule + , Comment.rule + , Alternation.rule + , Concatenation.rule + , Repetition.rule + , Repeat.rule + , Element.rule + , Group.rule + , Option.rule + , CharVal.rule + , NumVal.rule + , BinVal.rule + , DecVal.rule + , HexVal.rule + , ProseVal.rule + , CaseInsensitiveString.rule + , CaseSensitiveString.rule + , QuotedString.rule + ]
+ lib/Data/BAByNF/ABNF/Rules/Alternation.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE LambdaCase #-} +module Data.BAByNF.ABNF.Rules.Alternation + ( ref + , rule + , fromTree + ) where + +import Data.List qualified as List + +import Data.BAByNF.Util.Ascii qualified as Ascii + +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Rules.Concatenation qualified as Concatenation +import Data.BAByNF.ABNF.Rules.CWsp qualified as CWsp + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "alternation") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition + $ Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition Model.NoRepeat (Model.RulenameElement Concatenation.ref) + , Model.Repetition (Model.RangedRepeat Model.UnBound Model.UnBound) + $ Model.GroupElement + . Model.Group + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition (Model.RangedRepeat Model.UnBound Model.UnBound) (Model.RulenameElement CWsp.ref) + , Model.Repetition Model.NoRepeat + $ Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.stringAsBytesUnsafe "/" + , Model.Repetition (Model.RangedRepeat Model.UnBound Model.UnBound) (Model.RulenameElement CWsp.ref) + , Model.Repetition Model.NoRepeat (Model.RulenameElement Concatenation.ref) + ] + ] + +fromTree :: Tree Model.Rulename -> Either String Model.Alternation +fromTree tree = + let concatTrees = Tree.getChildrenWithRef Concatenation.ref tree + in mapM Concatenation.fromTree concatTrees >>= + \case + [] -> Left "Alternation.hs: empty alt" + lst@(_:_) -> Right $ Model.Alternation lst
+ lib/Data/BAByNF/ABNF/Rules/Alternation.hs-boot view
@@ -0,0 +1,13 @@+module Data.BAByNF.ABNF.Rules.Alternation + ( ref + , rule + , fromTree + ) where + +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.ABNF.Model qualified as Model + + +ref :: Model.Rulename +rule :: Model.Rule +fromTree :: Tree Model.Rulename -> Either String Model.Alternation
+ lib/Data/BAByNF/ABNF/Rules/BinVal.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE LambdaCase #-} +module Data.BAByNF.ABNF.Rules.BinVal + ( ref + , rule + , fromTree + ) where + +import Data.Functor ((<&>)) +import Data.List qualified as List + +import Data.BAByNF.Util.Ascii qualified as Ascii +import Data.BAByNF.Util.Binary qualified as Binary +import Data.BAByNF.Util.Stream (Stream) +import Data.BAByNF.Util.Stream qualified as Stream + +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Core qualified as Core + + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "bin-val") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition + $ Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.stringAsBytesUnsafe "b" + , Model.Repetition (Model.RangedRepeat (Model.FixedBound 1) Model.UnBound) (Model.RulenameElement Core.bitRef) + , Model.Repetition Model.NoRepeat + $ Model.OptionElement + . Model.Option + . Model.Alternation + $ + [ Model.Concatenation + . List.singleton + . Model.Repetition (Model.RangedRepeat (Model.FixedBound 1) Model.UnBound) + . Model.GroupElement + . Model.Group + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition Model.NoRepeat . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.stringAsBytesUnsafe "." + , Model.Repetition (Model.RangedRepeat (Model.FixedBound 1) Model.UnBound) (Model.RulenameElement Core.bitRef) + ] + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.GroupElement + . Model.Group + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition Model.NoRepeat . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.stringAsBytesUnsafe "-" + , Model.Repetition (Model.RangedRepeat (Model.FixedBound 1) Model.UnBound) (Model.RulenameElement Core.bitRef) + ] + ] + ] + +fromTree :: Tree Model.Rulename -> Either String Model.BinVal +fromTree tree = Stream.runStream_ stream (Tree.nodes tree) + where stream :: Stream (Tree.Node Model.Rulename) (Either String Model.BinVal) + stream = expectB `Stream.propagate'` + takeByteOrLeft `Stream.propagate` + (\firstByte -> Stream.peek >>= + (\case + Nothing -> return . Right . singleByte $ firstByte + Just (Tree.StringNode s) + | s == Ascii.bs '-' -> + dashBits <&> (<&> Model.RangeBinVal firstByte) + | s == Ascii.bs '.' -> + exhaust dotBits [] <&> + fmap (\byteRest -> + let bytes = firstByte : byteRest + in Model.SeqBinVal bytes + ) + | otherwise -> return (Left "unexpected char") + _ -> return (Left "bin-num pattern not matched") + ) + ) + expectB = Stream.takeIf isB <&> maybe (Left "expected b or B") (const (Right ())) + isB node = Tree.isStringEq node (Ascii.bs 'b') || Tree.isStringEq node (Ascii.bs 'B') + nodeToBit node = if not (Tree.isRefOf node Core.bitRef) then Nothing + else let b = Tree.stringifyNode node in + if b == Ascii.bs '0' then Just Binary.B0 + else if b == Ascii.bs '1' then Just Binary.B1 + else Nothing + takeByte = Stream.takeWhileMap nodeToBit <&> + \case + [] -> Nothing + bits -> Just (Binary.Seq bits) + takeByteOrLeft = takeByte <&> maybe (Left "not bits") Right + dashBits = (Stream.takeIf (`Tree.isStringEq` Ascii.bs '-') `Stream.propagate'` takeByte) <&> maybe (Left "not dash-bits") Right + dotBits = (Stream.takeIf (`Tree.isStringEq` Ascii.bs '.') `Stream.propagate'` takeByte) <&> maybe (Left "not dot-bits") Right + exhaust m acc = Stream.hasNext >>= \cond -> if cond + then m `Stream.propagate` (\e -> exhaust m (e:acc)) + else return (Right (reverse acc)) + singleByte = Model.SeqBinVal . List.singleton
+ lib/Data/BAByNF/ABNF/Rules/CNl.hs view
@@ -0,0 +1,23 @@+module Data.BAByNF.ABNF.Rules.CNl + ( ref + , rule + ) where + +import Data.List qualified as List + +import Data.BAByNF.Util.Ascii qualified as Ascii + +import Data.BAByNF.ABNF.Core qualified as Core +import Data.BAByNF.ABNF.Rules.Comment qualified as Comment +import Data.BAByNF.ABNF.Model qualified as Model + + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "c-nl") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition $ + Model.Elements . Model.Alternation $ + [ Model.Concatenation . List.singleton . Model.Repetition Model.NoRepeat . Model.RulenameElement $ Comment.ref + , Model.Concatenation . List.singleton . Model.Repetition Model.NoRepeat . Model.RulenameElement $ Core.crlfRef + ]
+ lib/Data/BAByNF/ABNF/Rules/CWsp.hs view
@@ -0,0 +1,26 @@+module Data.BAByNF.ABNF.Rules.CWsp + ( ref + , rule + ) where + +import Data.List qualified as List + +import Data.BAByNF.Util.Ascii qualified as Ascii + +import Data.BAByNF.ABNF.Core qualified as Core +import Data.BAByNF.ABNF.Rules.CNl qualified as CNl +import Data.BAByNF.ABNF.Model qualified as Model + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "c-wsp") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition . Model.Elements . Model.Alternation $ + [ Model.Concatenation . List.singleton . Model.Repetition Model.NoRepeat . Model.RulenameElement $ + Core.wspRef + , Model.Concatenation . List.singleton . Model.Repetition Model.NoRepeat . Model.GroupElement . Model.Group . + Model.Alternation . List.singleton . Model.Concatenation $ + [ Model.Repetition Model.NoRepeat $ Model.RulenameElement CNl.ref + , Model.Repetition Model.NoRepeat $ Model.RulenameElement Core.wspRef + ] + ]
+ lib/Data/BAByNF/ABNF/Rules/CaseInsensitiveString.hs view
@@ -0,0 +1,47 @@+module Data.BAByNF.ABNF.Rules.CaseInsensitiveString + ( ref + , rule + , fromTree + ) where + +import Data.List qualified as List +import Data.Functor ( (<&>) ) + +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.Util.Ascii qualified as Ascii +import Data.BAByNF.ABNF.Rules.QuotedString qualified as QuotedString +import Data.BAByNF.ABNF.Model qualified as Model + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "case-insensitive-string") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition + . Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition Model.NoRepeat + . Model.OptionElement + . Model.Option + . Model.Alternation + . List.singleton + . Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.stringAsBytesUnsafe "%i" + , Model.Repetition Model.NoRepeat + . Model.RulenameElement + $ QuotedString.ref + ] + +fromTree :: Tree Model.Rulename -> Either String Model.CaseInsensitiveString +fromTree tree = maybe (Left "no quoted-string") + QuotedString.fromTree (Tree.getChildWithRef QuotedString.ref tree) + <&> Model.CaseInsensitiveString
+ lib/Data/BAByNF/ABNF/Rules/CaseSensitiveString.hs view
@@ -0,0 +1,41 @@+module Data.BAByNF.ABNF.Rules.CaseSensitiveString + ( ref + , rule + , fromTree + ) where + +import Data.List qualified as List +import Data.Functor ((<&>)) + +import Data.BAByNF.Util.Ascii qualified as Ascii +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.ABNF.Rules.QuotedString qualified as QuotedString +import Data.BAByNF.ABNF.Model qualified as Model + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "case-sensitive-string") + + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition + . Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.stringAsBytesUnsafe "%s" + , Model.Repetition Model.NoRepeat + . Model.RulenameElement + $ QuotedString.ref + ] + +fromTree :: Tree Model.Rulename -> Either String Model.CaseSensitiveString +fromTree tree = maybe (Left "no quoted-string") + QuotedString.fromTree (Tree.getChildWithRef QuotedString.ref tree) + <&> Model.CaseSensitiveString
+ lib/Data/BAByNF/ABNF/Rules/CharVal.hs view
@@ -0,0 +1,42 @@+module Data.BAByNF.ABNF.Rules.CharVal + ( ref + , rule + , fromTree + ) where + +import Data.Functor ((<&>)) + +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.Maybe (fromMaybe) +import Data.List qualified as List + +import Control.Applicative ((<|>)) + +import Data.BAByNF.Util.Ascii qualified as Ascii +import Data.BAByNF.ABNF.Rules.CaseInsensitiveString qualified as CaseInsensitiveString +import Data.BAByNF.ABNF.Rules.CaseSensitiveString qualified as CaseSensitiveString +import Data.BAByNF.ABNF.Model qualified as Model + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "char-val") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition + . Model.Elements + . Model.Alternation + $ + [ Model.Concatenation . List.singleton . Model.Repetition Model.NoRepeat $ Model.RulenameElement CaseInsensitiveString.ref + , Model.Concatenation . List.singleton . Model.Repetition Model.NoRepeat $ Model.RulenameElement CaseSensitiveString.ref + ] + +fromTree :: Tree Model.Rulename -> Either String Model.CharVal +fromTree tree = + fromMaybe (Left "no string") $ tryGetInsensitive tree <|> tryGetSensitive tree + where tryGetInsensitive t = do + subtree <- Tree.getChildWithRef CaseInsensitiveString.ref t + return $ CaseInsensitiveString.fromTree subtree <&> Model.CaseInsensitiveCharVal + tryGetSensitive t = do + subtree <- Tree.getChildWithRef CaseSensitiveString.ref t + return $ CaseSensitiveString.fromTree subtree <&> Model.CaseSensitiveCharVal
+ lib/Data/BAByNF/ABNF/Rules/Comment.hs view
@@ -0,0 +1,28 @@+module Data.BAByNF.ABNF.Rules.Comment + ( ref + , rule + ) where + +import Data.List qualified as List + +import Data.BAByNF.Util.Ascii qualified as Ascii +import Data.BAByNF.ABNF.Core qualified as Core +import Data.BAByNF.ABNF.Model qualified as Model + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "comment") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition $ + Model.Elements . Model.Alternation . List.singleton . Model.Concatenation $ + [ Model.Repetition Model.NoRepeat $ + Model.CharValElement . Model.CaseInsensitiveCharVal . Model.CaseInsensitiveString . Model.QuotedString $ + Ascii.stringAsBytesUnsafe ";" + , Model.Repetition (Model.RangedRepeat Model.UnBound Model.UnBound) $ + Model.GroupElement . Model.Group . Model.Alternation $ + [ Model.Concatenation . List.singleton . Model.Repetition Model.NoRepeat . Model.RulenameElement $ Core.wspRef + , Model.Concatenation . List.singleton . Model.Repetition Model.NoRepeat . Model.RulenameElement $ Core.vcharRef + ] + , Model.Repetition Model.NoRepeat $ + Model.RulenameElement Core.crlfRef + ]
+ lib/Data/BAByNF/ABNF/Rules/Concatenation.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE LambdaCase #-} +module Data.BAByNF.ABNF.Rules.Concatenation + ( ref + , rule + , fromTree + ) where + +import Data.List qualified as List + +import Data.BAByNF.Util.Ascii qualified as Ascii + +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Rules.Repetition qualified as Repetition +import Data.BAByNF.ABNF.Rules.CWsp qualified as CWsp +import Data.BAByNF.ABNF.Model qualified as Model + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "concatenation") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition $ Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition Model.NoRepeat (Model.RulenameElement Repetition.ref) + , Model.Repetition (Model.RangedRepeat Model.UnBound Model.UnBound) + . Model.GroupElement + . Model.Group + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition (Model.RangedRepeat (Model.FixedBound 1) Model.UnBound) (Model.RulenameElement CWsp.ref) + , Model.Repetition Model.NoRepeat (Model.RulenameElement Repetition.ref) + ] + ] + +fromTree :: Tree Model.Rulename -> Either String Model.Concatenation +fromTree tree = mapM Repetition.fromTree + ( + Tree.getChildrenWithRef Repetition.ref tree + ) >>= \case + [] -> Left "empty concat" + x -> Right $ Model.Concatenation x
+ lib/Data/BAByNF/ABNF/Rules/DecVal.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE LambdaCase #-} +module Data.BAByNF.ABNF.Rules.DecVal + ( ref + , rule + , fromTree + ) where + +import Data.Functor ((<&>)) + +import Data.BAByNF.ABNF.Core qualified as Core +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.Util.Stream (Stream) +import Data.BAByNF.Util.Stream qualified as Stream + +import Data.List qualified as List + +import Data.BAByNF.Util.Ascii qualified as Ascii +import Data.BAByNF.Util.Decimal qualified as Decimal +import Data.BAByNF.ABNF.Model qualified as Model + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "dec-val") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition + $ Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.stringAsBytesUnsafe "d" + , Model.Repetition (Model.RangedRepeat (Model.FixedBound 1) Model.UnBound) (Model.RulenameElement Core.digitRef) + , Model.Repetition Model.NoRepeat + $ Model.OptionElement + . Model.Option + . Model.Alternation + $ + [ Model.Concatenation + . List.singleton + . Model.Repetition (Model.RangedRepeat (Model.FixedBound 1) Model.UnBound) + . Model.GroupElement + . Model.Group + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition Model.NoRepeat . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.stringAsBytesUnsafe "." + , Model.Repetition (Model.RangedRepeat (Model.FixedBound 1) Model.UnBound) (Model.RulenameElement Core.digitRef) + ] + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.GroupElement + . Model.Group + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition Model.NoRepeat . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.stringAsBytesUnsafe "-" + , Model.Repetition (Model.RangedRepeat (Model.FixedBound 1) Model.UnBound) (Model.RulenameElement Core.digitRef) + ] + ] + ] + +fromTree :: Tree Model.Rulename -> Either String Model.DecVal +fromTree tree = Stream.runStream_ stream (Tree.nodes tree) + where stream :: Stream (Tree.Node Model.Rulename) (Either String Model.DecVal) + stream = expectD `Stream.propagate'` + takeByteOrLeft `Stream.propagate` + (\firstByte -> Stream.peek >>= + (\case + Nothing -> return . Right . singleByte $ firstByte + Just (Tree.StringNode s) + | s == Ascii.bs '-' -> + dashDecimals <&> (<&> Model.RangeDecVal firstByte) + | s == Ascii.bs '.' -> + exhaust dotDecimals [] <&> + fmap (\byteRest -> + let bytes = firstByte : byteRest + in Model.SeqDecVal bytes + ) + | otherwise -> return (Left "unexpected char") + _ -> return (Left "dec-num pattern not matched") + ) + ) + expectD = Stream.takeIf isD <&> maybe (Left "expected d or D") (const (Right ())) + isD node = Tree.isStringEq node (Ascii.bs 'd') || Tree.isStringEq node (Ascii.bs 'D') + nodeToDecimal node = if not (Tree.isRefOf node Core.digitRef) then Nothing + else let b = Tree.stringifyNode node in Ascii.bsToDecimalDigit b + takeByte = Stream.takeWhileMap nodeToDecimal <&> + \case + [] -> Nothing + decimals -> Just (Decimal.Seq decimals) + takeByteOrLeft = takeByte <&> maybe (Left "not digits") Right + dashDecimals = (Stream.takeIf (`Tree.isStringEq` Ascii.bs '-') `Stream.propagate'` takeByte) <&> maybe (Left "not dash-bits") Right + dotDecimals = (Stream.takeIf (`Tree.isStringEq` Ascii.bs '.') `Stream.propagate'` takeByte) <&> maybe (Left "not dot-bits") Right + exhaust m acc = Stream.hasNext >>= \cond -> if cond + then m `Stream.propagate` (\e -> exhaust m (e:acc)) + else return (Right (reverse acc)) + singleByte = Model.SeqDecVal . List.singleton
+ lib/Data/BAByNF/ABNF/Rules/DefinedAs.hs view
@@ -0,0 +1,60 @@+module Data.BAByNF.ABNF.Rules.DefinedAs + ( ref + , rule + , fromTree + ) where + +import Data.List qualified as List + +import Data.BAByNF.Util.Ascii qualified as Ascii +import Data.BAByNF.Util.List qualified as Util.List +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.ABNF.Rules.CWsp qualified as CWsp +import Data.BAByNF.ABNF.Model qualified as Model + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "defined-as") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition $ Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + $ [ + Model.Repetition (Model.RangedRepeat Model.UnBound Model.UnBound) (Model.RulenameElement CWsp.ref), + Model.Repetition Model.NoRepeat + $ Model.GroupElement + . Model.Group + . Model.Alternation + $ + [ Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.stringAsBytesUnsafe "=" + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.stringAsBytesUnsafe "=/" + ], + Model.Repetition (Model.RangedRepeat Model.UnBound Model.UnBound) (Model.RulenameElement CWsp.ref) + ] + +fromTree :: Tree Model.Rulename -> Either String Model.DefinedAs +fromTree tree = + let (_, mid, _) = Util.List.lrsplitWhenNot (Tree.nodes tree) isCWsp + in case mid of + [Tree.StringNode x] | x == Ascii.stringAsBytesUnsafe "=" -> Right Model.BasicDefinition + | x == Ascii.stringAsBytesUnsafe "=/" -> Right Model.IncrementalAlternative + | otherwise -> Left "DefinedAs must be \'=\' | \'=/\'" + _ -> Left "structural mismatch for <defined-as>" + where isCWsp node = Tree.isRefOf node CWsp.ref +
+ lib/Data/BAByNF/ABNF/Rules/Element.hs view
@@ -0,0 +1,68 @@+module Data.BAByNF.ABNF.Rules.Element + ( ref + , rule + , fromTree + ) where + +import Data.Functor ((<&>)) +import Data.List qualified as List + +import Data.BAByNF.ABNF.Model qualified as Model +import {-# SOURCE #-} Data.BAByNF.ABNF.Rules.Option qualified as Option +import Data.BAByNF.ABNF.Rules.CharVal qualified as CharVal +import Data.BAByNF.ABNF.Rules.NumVal qualified as NumVal +import Data.BAByNF.ABNF.Rules.Rulename qualified as Rulename +import Data.BAByNF.ABNF.Rules.Group qualified as Group +import Data.BAByNF.ABNF.Rules.ProseVal qualified as ProseVal +import Data.BAByNF.Util.Ascii qualified as Ascii +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.Core.Ref qualified as Ref + + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "element") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition + . Model.Elements + . Model.Alternation + $ + [ Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + $ Model.RulenameElement Rulename.ref + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + $ Model.RulenameElement Group.ref + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + $ Model.RulenameElement Option.ref + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + $ Model.RulenameElement CharVal.ref + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + $ Model.RulenameElement NumVal.ref + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + $ Model.RulenameElement ProseVal.ref + ] + +fromTree :: Tree Model.Rulename -> Either String Model.Element +fromTree tree = + case Tree.nodes tree of + [Tree.RefNode r subtree] -> + if Ref.eq r Rulename.ref then Right . Model.RulenameElement . Rulename.fromTree $ subtree + else if Ref.eq r Group.ref then Group.fromTree subtree <&> Model.GroupElement + else if Ref.eq r Option.ref then Option.fromTree subtree <&> Model.OptionElement + else if Ref.eq r CharVal.ref then CharVal.fromTree subtree <&> Model.CharValElement + else if Ref.eq r NumVal.ref then NumVal.fromTree subtree <&> Model.NumValElement + else if Ref.eq r ProseVal.ref then ProseVal.fromTree subtree <&> Model.ProseValElement + else Left "element must be rulename | group | option | char-val | num-val | prose-val" + _ -> Left "structural mismatch for <element>"
+ lib/Data/BAByNF/ABNF/Rules/Elements.hs view
@@ -0,0 +1,34 @@+module Data.BAByNF.ABNF.Rules.Elements + ( ref + , rule + , fromTree + ) where + +import Data.Functor ((<&>)) +import Data.List qualified as List + +import Data.BAByNF.Util.Ascii qualified as Ascii +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.ABNF.Rules.Alternation qualified as Alternation +import Data.BAByNF.ABNF.Rules.CWsp qualified as CWsp +import Data.BAByNF.ABNF.Model qualified as Model + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "elements") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition + . Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition Model.NoRepeat (Model.RulenameElement Alternation.ref) + , Model.Repetition (Model.RangedRepeat Model.UnBound Model.UnBound) (Model.RulenameElement CWsp.ref) + ] + +fromTree :: Tree Model.Rulename -> Either String Model.Elements +fromTree tree = Tree.tryGetChildWithRef Alternation.ref tree >>= Alternation.fromTree <&> Model.Elements + +
+ lib/Data/BAByNF/ABNF/Rules/Group.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE LambdaCase #-} +module Data.BAByNF.ABNF.Rules.Group + ( ref + , rule + , fromTree + ) where + +import Data.Functor ((<&>)) +import Data.List qualified as List + +import Data.BAByNF.Util.Ascii qualified as Ascii + +import Data.BAByNF.Core.Ref qualified as Ref +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree + +import {-# SOURCE #-} Data.BAByNF.ABNF.Rules.Alternation qualified as Alternation +import Data.BAByNF.ABNF.Rules.CWsp qualified as CWsp +import Data.BAByNF.ABNF.Model qualified as Model + + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "group") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition + . Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + $ Model.QuotedString (Ascii.stringAsBytesUnsafe "(") + , Model.Repetition (Model.RangedRepeat Model.UnBound Model.UnBound) (Model.RulenameElement CWsp.ref) + , Model.Repetition Model.NoRepeat (Model.RulenameElement Alternation.ref) + , Model.Repetition (Model.RangedRepeat Model.UnBound Model.UnBound) (Model.RulenameElement CWsp.ref) + , Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + $ Model.QuotedString (Ascii.stringAsBytesUnsafe ")") + ] + +fromTree :: Tree Model.Rulename -> Either String Model.Group +fromTree tree = + let nodes = Tree.nodes tree + in (tryDropLeftParens nodes + >>= (\case + (Tree.RefNode r subtree):rest + | Ref.eq Alternation.ref r -> Right (subtree, rest) + | otherwise -> Left "group must contain alternation" + _ -> Left "structural mismatch for <group>" + ) . dropCWsp) + >>= \(altSubtree, rest) -> (tryDropRightParens . dropCWsp $ rest) + >>= \case + [] -> Alternation.fromTree altSubtree <&> Model.Group + _ -> Left "structural mismatch for <group>" + where tryDropLeftParens nodes = + case nodes of + (Tree.StringNode bs):rest | bs == Ascii.stringAsBytesUnsafe "(" -> Right rest + | otherwise -> Left "structural mismatch for <group>" + _ -> Left "structural mismatch for <group>" + dropCWsp = dropWhile (`Tree.isRefOf` CWsp.ref) + tryDropRightParens nodes = + case nodes of + (Tree.StringNode bs):rest | bs == Ascii.stringAsBytesUnsafe ")" -> Right rest + | otherwise -> Left "structural mismatch for <group>" + _ -> Left "structural mismatch for <group>" +
+ lib/Data/BAByNF/ABNF/Rules/HexVal.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE LambdaCase #-} +module Data.BAByNF.ABNF.Rules.HexVal + ( ref + , rule + , fromTree + ) where + +import Data.List qualified as List + +import Data.ByteString qualified as ByteString + +import Data.BAByNF.ABNF.Core qualified as Core +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.Util.Ascii qualified as Ascii +import Data.BAByNF.Util.List qualified as Util.List +import Data.BAByNF.Util.Hex qualified as Hex +import Data.BAByNF.ABNF.Model qualified as Model + + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "hex-val") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition$ Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.stringAsBytesUnsafe "x" + , Model.Repetition (Model.RangedRepeat (Model.FixedBound 1) Model.UnBound) (Model.RulenameElement Core.hexdigRef) + , Model.Repetition Model.NoRepeat + $ Model.OptionElement + . Model.Option + . Model.Alternation + $ + [ Model.Concatenation + . List.singleton + . Model.Repetition (Model.RangedRepeat (Model.FixedBound 1) Model.UnBound) + . Model.GroupElement + . Model.Group + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition Model.NoRepeat . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.stringAsBytesUnsafe "." + , Model.Repetition (Model.RangedRepeat (Model.FixedBound 1) Model.UnBound) (Model.RulenameElement Core.hexdigRef) + ] + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.GroupElement + . Model.Group + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition Model.NoRepeat . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.stringAsBytesUnsafe "-" + , Model.Repetition (Model.RangedRepeat (Model.FixedBound 1) Model.UnBound) (Model.RulenameElement Core.hexdigRef) + ] + ] + ] + +fromTree :: Tree Model.Rulename -> Either String Model.HexVal +fromTree tree = + let nodes = Tree.nodes tree + in (case List.uncons nodes of + Just (h, rest) -> + if isB h + then Right rest + else Left "hex-val must start with x | X" + _ -> Left "structural mismatch for <hex-val>") + >>= takeHexSeq + >>= \(firstSeq, rest) -> + case List.uncons rest of + Nothing -> Right (Model.SeqHexVal [firstSeq]) + Just (c, rest') | isDash c -> takeHexSeq rest' >>= \(secondSeq, end) -> + case end of + [] -> Right (Model.RangeHexVal firstSeq secondSeq) + _ -> Left "structural mismatch for <hex-val>" + | isDot c -> let takeSeq x = takeHexSeq x >>= (\(nextSeq, rest'') -> case rest'' of + [] -> Right [nextSeq] + c':rest''' -> if isDot c' + then takeSeq rest''' >>= \seqs -> Right (nextSeq : seqs) + else Left "structural mismatch for <hex-val>") + in takeSeq rest' >>= \seqs -> Right (Model.SeqHexVal $ firstSeq : seqs) + | otherwise -> Left "structural mismatch for <hex-val>" + where takeHexSeq :: [Tree.Node Model.Rulename] -> Either String (Hex.Seq, [Tree.Node Model.Rulename]) + takeHexSeq nodes = case Util.List.lsplitWhenNot nodes isHexDig of + (hexno@(_:_), rest) -> + case Ascii.toHexSeq $ ByteString.concat (map Tree.stringifyNode hexno) of + Just hexseq -> Right (hexseq, rest) + Nothing -> Left "invalid hex digits in <hex-val>" + _ -> Left "structural mismatch for <hex-val>" + isB node = Tree.isStringEq node (Ascii.bs 'x') || Tree.isStringEq node (Ascii.bs 'X') + isHexDig node = Tree.isRefOf node Core.hexdigRef + isDot node = Tree.isStringEq node (Ascii.stringAsBytesUnsafe ".") + isDash node = Tree.isStringEq node (Ascii.stringAsBytesUnsafe "-")
+ lib/Data/BAByNF/ABNF/Rules/NumVal.hs view
@@ -0,0 +1,67 @@+module Data.BAByNF.ABNF.Rules.NumVal + ( ref + , rule + , fromTree + ) where + +import Data.Functor ((<&>)) +import Data.List qualified as List + +import Data.ByteString qualified as ByteString + +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.ABNF.Rules.BinVal qualified as BinVal +import Data.BAByNF.ABNF.Rules.DecVal qualified as DecVal +import Data.BAByNF.ABNF.Rules.HexVal qualified as HexVal +import Data.BAByNF.Util.Ascii qualified as Ascii +import Data.BAByNF.Core.Ref qualified as Ref +import Data.BAByNF.ABNF.Model qualified as Model + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "num-val") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition + . Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + $ Model.QuotedString (Ascii.stringAsBytesUnsafe "%") + + , Model.Repetition Model.NoRepeat + . Model.GroupElement + . Model.Group + . Model.Alternation + $ + [ Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + $ Model.RulenameElement BinVal.ref + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + $ Model.RulenameElement DecVal.ref + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + $ Model.RulenameElement HexVal.ref + ] + ] + +fromTree :: Tree Model.Rulename -> Either String Model.NumVal +fromTree tree = case Tree.nodes tree of + [Tree.StringNode b, Tree.RefNode r subtree] -> + if b /= ByteString.singleton 37 + then Left "expected % prefix" + else if Ref.eq r BinVal.ref then BinVal.fromTree subtree <&> Model.BinNumVal + else if Ref.eq r DecVal.ref then DecVal.fromTree subtree <&> Model.DecNumVal + else if Ref.eq r HexVal.ref then HexVal.fromTree subtree <&> Model.HexNumVal + else Left "unexpected rule ref" + _ -> Left "exactly two nodes expected - \"%\" and bin-val | dec-val | hex-val" +
+ lib/Data/BAByNF/ABNF/Rules/Option.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE LambdaCase #-} +module Data.BAByNF.ABNF.Rules.Option + ( ref + , rule + , fromTree + ) where + +import Data.List qualified as List +import Data.Functor ((<&>)) + +import Data.BAByNF.Core.Ref qualified as Ref +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.ABNF.Rules.Alternation qualified as Alternation +import Data.BAByNF.ABNF.Rules.CWsp qualified as CWsp +import Data.BAByNF.Util.Ascii qualified as Ascii +import Data.BAByNF.ABNF.Model qualified as Model + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "option") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition + . Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + $ Model.QuotedString (Ascii.stringAsBytesUnsafe "[") + , Model.Repetition (Model.RangedRepeat Model.UnBound Model.UnBound) (Model.RulenameElement CWsp.ref) + , Model.Repetition Model.NoRepeat (Model.RulenameElement Alternation.ref) + , Model.Repetition (Model.RangedRepeat Model.UnBound Model.UnBound) (Model.RulenameElement CWsp.ref) + , Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + $ Model.QuotedString (Ascii.stringAsBytesUnsafe "]") + ] + +fromTree :: Tree Model.Rulename -> Either String Model.Option +fromTree tree = + let nodes = Tree.nodes tree + in (tryDropLeftParens nodes + >>= (\case + (Tree.RefNode r subtree):rest + | Ref.eq Alternation.ref r -> Right (subtree, rest) + | otherwise -> Left "option must contain alternation" + _ -> Left "structural mismatch for <option>" + ) . dropCWsp) + >>= \(altSubtree, rest) -> (tryDropRightParens . dropCWsp $ rest) + >>= \case + [] -> Alternation.fromTree altSubtree <&> Model.Option + _ -> Left "structural mismatch for <option>" + where tryDropLeftParens nodes = + case nodes of + (Tree.StringNode bs):rest | bs == Ascii.stringAsBytesUnsafe "[" -> Right rest + | otherwise -> Left "structural mismatch for <option>" + _ -> Left "structural mismatch for <option>" + dropCWsp = dropWhile (`Tree.isRefOf` CWsp.ref) + tryDropRightParens nodes = + case nodes of + (Tree.StringNode bs):rest | bs == Ascii.stringAsBytesUnsafe "]" -> Right rest + | otherwise -> Left "structural mismatch for <group>" + _ -> Left "structural mismatch for <group>" +
+ lib/Data/BAByNF/ABNF/Rules/Option.hs-boot view
@@ -0,0 +1,13 @@+module Data.BAByNF.ABNF.Rules.Option + ( ref + , rule + , fromTree + ) where + +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.ABNF.Model qualified as Model + +ref :: Model.Rulename +rule :: Model.Rule +fromTree :: Tree Model.Rulename -> Either String Model.Option +
+ lib/Data/BAByNF/ABNF/Rules/ProseVal.hs view
@@ -0,0 +1,69 @@+module Data.BAByNF.ABNF.Rules.ProseVal + ( ref + , rule + , fromTree + ) where + +import Data.Functor ((<&>)) + +import Data.Maybe qualified as Maybe +import Data.List qualified as List + +import Data.ByteString qualified as ByteString + +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.Util.Ascii qualified as Ascii +import Data.BAByNF.Util.Hex qualified as Hex + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "prose-val") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition + . Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.stringAsBytesUnsafe "<" + , Model.Repetition (Model.RangedRepeat Model.UnBound Model.UnBound) + . Model.GroupElement + . Model.Group + . Model.Alternation + $ + [ Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.NumValElement + . Model.HexNumVal + $ Model.RangeHexVal (Hex.Seq [Hex.X2, Hex.X0]) (Hex.Seq [Hex.X3, Hex.XD]) + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.NumValElement + . Model.HexNumVal + $ Model.RangeHexVal (Hex.Seq [Hex.X3, Hex.XF]) (Hex.Seq [Hex.X7, Hex.XE]) + ] + , Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.stringAsBytesUnsafe ">" + + ] + +fromTree :: Tree Model.Rulename -> Either String Model.ProseVal +fromTree tree = + let whole = Tree.stringify tree + proseOrErr = Maybe.fromMaybe (Left "prose must be between < and >") $ ByteString.uncons whole >>= \(h, t) -> + ByteString.unsnoc t <&> \(prose', l) -> + if h == 60 && l == 62 then Right prose' else Left "prose must be between < and >" + in proseOrErr <&> Model.ProseVal
+ lib/Data/BAByNF/ABNF/Rules/QuotedString.hs view
@@ -0,0 +1,51 @@+module Data.BAByNF.ABNF.Rules.QuotedString + ( ref + , rule + , fromTree + ) where + +import Data.Functor ((<&>)) +import Data.Word (Word8) + +import Data.ByteString (ByteString) +import Data.ByteString qualified as ByteString + +import Data.BAByNF.Util.Ascii qualified as Ascii +import Data.BAByNF.Util.Hex qualified as Hex + +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.ABNF.Core qualified as Core +import Data.BAByNF.ABNF.Model qualified as Model + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "quoted-string") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition + ( Model.Elements $ + Model.Alternation [Model.Concatenation + [ Model.Repetition Model.NoRepeat (Model.RulenameElement Core.dquoteRef) + , Model.Repetition (Model.RangedRepeat Model.UnBound Model.UnBound) (Model.GroupElement . Model.Group . Model.Alternation $ + [ Model.Concatenation [ Model.Repetition Model.NoRepeat $ Model.NumValElement . Model.HexNumVal $ + Model.RangeHexVal (Hex.Seq [Hex.X2, Hex.X0]) (Hex.Seq [Hex.X2, Hex.X1])] + , Model.Concatenation [ Model.Repetition Model.NoRepeat $ Model.NumValElement . Model.HexNumVal $ + Model.RangeHexVal (Hex.Seq [Hex.X2, Hex.X3]) (Hex.Seq [Hex.X7, Hex.XE])] + ]) + + , Model.Repetition Model.NoRepeat (Model.RulenameElement Core.dquoteRef) + ] + ] + ) + +fromTree :: Tree Model.Rulename -> Either String Model.QuotedString +fromTree tree = + maybe (Left "quoted-string must be between \" and \"") Right $ + unconsnoc (Tree.stringify tree) >>= \(h, m, l) -> + if h == 34 && l == 34 + then Just (Model.QuotedString m) + else Nothing + +unconsnoc :: ByteString -> Maybe (Word8, ByteString, Word8) +unconsnoc bs = ByteString.uncons bs >>= \(h, t) -> ByteString.unsnoc t <&> \(m, l) -> (h, m, l) +
+ lib/Data/BAByNF/ABNF/Rules/Repeat.hs view
@@ -0,0 +1,84 @@+module Data.BAByNF.ABNF.Rules.Repeat + ( ref + , rule + , fromTree + ) where + +import Data.Functor ((<&>)) +import Data.Maybe qualified as Maybe +import Data.List qualified as List + +import Data.ByteString qualified as ByteString +import Data.ByteString.Char8 qualified as ByteString.Char8 + +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.ABNF.Core qualified as Core +import Data.BAByNF.Util.Stream qualified as Stream +import Data.BAByNF.Util.Ascii qualified as Ascii +import Data.BAByNF.Core.Ref qualified as Ref +import Data.BAByNF.ABNF.Model qualified as Model + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "repeat") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition + . Model.Elements + . Model.Alternation + $ + [ Model.Concatenation + . List.singleton + . Model.Repetition (Model.RangedRepeat (Model.FixedBound 1) Model.UnBound) + $ Model.RulenameElement Core.digitRef + , Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + . Model.GroupElement + . Model.Group + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition (Model.RangedRepeat Model.UnBound Model.UnBound) + $ Model.RulenameElement Core.digitRef + , Model.Repetition Model.NoRepeat + . Model.CharValElement + . Model.CaseInsensitiveCharVal + . Model.CaseInsensitiveString + . Model.QuotedString + $ Ascii.stringAsBytesUnsafe "*" + , Model.Repetition (Model.RangedRepeat Model.UnBound Model.UnBound) + $ Model.RulenameElement Core.digitRef + ] + ] + +fromTree :: Tree Model.Rulename -> Either String Model.Repeat +fromTree tree = + let stream = do + mnOpt <- takeDigits + hasStar <- Stream.take <&> Maybe.isJust + mxOpt <- if hasStar then takeDigits else return Nothing + case (mnOpt, hasStar, mxOpt) of + (Just mns, False, _) -> return $ tryToInteger mns >>= \mn -> return $ Model.FixedRepeat mn + (_, True, _) -> return $ + let toBound = Maybe.maybe (Right Model.UnBound) (\x -> tryToInteger x >>= return . Model.FixedBound) + in do + lo <- toBound mnOpt + hi <- toBound mxOpt + Right (Model.RangedRepeat lo hi) + _ -> return $ Left "structural mismatch for <repeat>" + in Stream.runStream_ stream (Tree.nodes tree) + where takeDigits = Stream.takeWhileMap (\e -> + case e of + Tree.RefNode r subtree -> + if Ref.eq r Core.digitRef + then Just $ Tree.stringify subtree + else Nothing + _ -> Nothing + ) <&> \bs -> case bs of [] -> Nothing; _ -> Just . ByteString.concat $ bs + tryToInteger bs = + case ByteString.Char8.readInteger bs of + Nothing -> Left "not integer" + Just (no, rest) | ByteString.null rest -> Right no + | otherwise -> Left "more than an integer read"
+ lib/Data/BAByNF/ABNF/Rules/Repetition.hs view
@@ -0,0 +1,45 @@+module Data.BAByNF.ABNF.Rules.Repetition + ( ref + , rule + , fromTree + ) where + +import Data.List qualified as List + +import Data.BAByNF.Util.Ascii qualified as Ascii + +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.ABNF.Rules.Repeat qualified as Repeat +import Data.BAByNF.ABNF.Rules.Element qualified as Element +import Data.BAByNF.ABNF.Model qualified as Model + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "repetition") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition + . Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + $ + [ Model.Repetition Model.NoRepeat + . Model.OptionElement + . Model.Option + . Model.Alternation + . List.singleton + . Model.Concatenation + . List.singleton + . Model.Repetition Model.NoRepeat + $ Model.RulenameElement Repeat.ref + , Model.Repetition Model.NoRepeat + $ Model.RulenameElement Element.ref + ] + +fromTree :: Tree Model.Rulename -> Either String Model.Repetition +fromTree tree = + let rd = maybe (Right Model.NoRepeat) Repeat.fromTree (Tree.getChildWithRef Repeat.ref tree) + e = Tree.tryGetChildWithRef Element.ref tree >>= Element.fromTree + in rd >>= \rd' -> + e >>= \e' -> return $ Model.Repetition rd' e'
+ lib/Data/BAByNF/ABNF/Rules/Rule.hs view
@@ -0,0 +1,40 @@+module Data.BAByNF.ABNF.Rules.Rule + ( ref + , rule + , fromTree + ) where + +import Data.Functor ((<&>)) +import Data.List qualified as List + +import Data.BAByNF.Util.Ascii qualified as Ascii + +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.ABNF.Rules.Rulename qualified as Rulename +import Data.BAByNF.ABNF.Rules.DefinedAs qualified as DefinedAs +import Data.BAByNF.ABNF.Rules.Elements qualified as Elements +import Data.BAByNF.ABNF.Rules.CNl qualified as CNl +import Data.BAByNF.ABNF.Model qualified as Model + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "rule") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition $ + Model.Elements . Model.Alternation . List.singleton . Model.Concatenation $ + [ Model.Repetition Model.NoRepeat (Model.RulenameElement Rulename.ref) + , Model.Repetition Model.NoRepeat (Model.RulenameElement DefinedAs.ref) + , Model.Repetition Model.NoRepeat (Model.RulenameElement Elements.ref) + , Model.Repetition Model.NoRepeat (Model.RulenameElement CNl.ref) + ] + +fromTree :: Tree Model.Rulename -> Either String Model.Rule +fromTree tree = + name >>= \name' -> + definedAs >>= \definedAs' -> + elements >>= \elements' -> + return $ Model.Rule name' definedAs' elements' + where name = Tree.tryGetChildWithRef Rulename.ref tree <&> Rulename.fromTree + definedAs = Tree.tryGetChildWithRef DefinedAs.ref tree >>= DefinedAs.fromTree + elements = Tree.tryGetChildWithRef Elements.ref tree >>= Elements.fromTree
+ lib/Data/BAByNF/ABNF/Rules/Rulelist.hs view
@@ -0,0 +1,48 @@+module Data.BAByNF.ABNF.Rules.Rulelist + ( ref + , rule + , fromTree + ) where + + + +import Data.List qualified as List + +import Data.BAByNF.Util.Ascii qualified as Ascii + +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Rules.CWsp qualified as CWsp +import Data.BAByNF.ABNF.Rules.CNl qualified as CNl +import Data.BAByNF.ABNF.Rules.Rule qualified as Rule +import Data.BAByNF.ABNF.Model qualified as Model + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "rulelist") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition $ + Model.Elements . Model.Alternation . List.singleton . Model.Concatenation . List.singleton . + Model.Repetition (Model.RangedRepeat (Model.FixedBound 1) Model.UnBound) . + Model.GroupElement . Model.Group . Model.Alternation $ + [ Model.Concatenation . List.singleton . Model.Repetition Model.NoRepeat . Model.RulenameElement $ + Rule.ref + , Model.Concatenation . List.singleton . Model.Repetition Model.NoRepeat . + Model.GroupElement . Model.Group . Model.Alternation . List.singleton . Model.Concatenation $ + [ Model.Repetition (Model.RangedRepeat Model.UnBound Model.UnBound) $ Model.RulenameElement CWsp.ref + , Model.Repetition Model.NoRepeat $ Model.RulenameElement CNl.ref + ] + ] + +fromTree :: Tree Model.Rulename -> Either [String] Model.Rulelist +fromTree tree = + let errorsAndDecls = groupBySide $ map Rule.fromTree $ + Tree.getChildrenWithRef Rule.ref tree + in case errorsAndDecls of + (err:errors, _) -> Left $ err : errors + ([], decls) -> Right $ Model.Rulelist decls + where groupBySide :: [Either l r] -> ([l], [r]) + groupBySide = foldr (\lr (ls, rs) -> case lr of Left l -> (l:ls, rs); Right r -> (ls, r:rs)) ([], []) + +
+ lib/Data/BAByNF/ABNF/Rules/Rulename.hs view
@@ -0,0 +1,38 @@+module Data.BAByNF.ABNF.Rules.Rulename + ( ref + , rule + , fromTree + ) where + +import Data.List qualified as List + +import Data.BAByNF.Util.Ascii qualified as Ascii + +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.ABNF.Core qualified as Core +import Data.BAByNF.ABNF.Model qualified as Model + +ref :: Model.Rulename +ref = Model.Rulename (Ascii.stringAsBytesUnsafe "rulename") + +rule :: Model.Rule +rule = Model.Rule ref Model.BasicDefinition + (Model.Elements . Model.Alternation . List.singleton . Model.Concatenation $ + [ Model.Repetition Model.NoRepeat (Model.RulenameElement Core.alphaRef) + , Model.Repetition (Model.RangedRepeat Model.UnBound Model.UnBound) $ + Model.GroupElement . Model.Group . Model.Alternation $ + [ Model.Concatenation . List.singleton $ + Model.Repetition Model.NoRepeat $ Model.RulenameElement Core.alphaRef + , Model.Concatenation . List.singleton $ + Model.Repetition Model.NoRepeat $ Model.RulenameElement Core.digitRef + , Model.Concatenation . List.singleton + $ Model.Repetition Model.NoRepeat $ + Model.CharValElement . Model.CaseInsensitiveCharVal . Model.CaseInsensitiveString . Model.QuotedString $ + Ascii.stringAsBytesUnsafe "-" + ] + + ]) + +fromTree :: Tree Model.Rulename -> Model.Rulename +fromTree = Model.Rulename . Tree.stringify
+ lib/Data/BAByNF/ABNF/ToParseable.hs view
@@ -0,0 +1,105 @@+module Data.BAByNF.ABNF.ToParseable + ( ToParseable + , toParseable + ) where + +import Data.Functor ((<&>)) +import Data.List.NonEmpty qualified as List.NonEmpty + +import Data.ByteString qualified as ByteString + +import Data.Attoparsec.ByteString qualified as Attoparsec.ByteString + +import Data.BAByNF.Util.Ascii qualified as Ascii +import Data.BAByNF.Util.Binary qualified as Binary +import Data.BAByNF.Util.Decimal qualified as Decimal +import Data.BAByNF.Util.Hex qualified as Hex +import Data.BAByNF.Core.Parseable (Parseable) +import Data.BAByNF.Core.Parseable qualified as Parseable +import Data.BAByNF.Core.Repeat qualified as Core.Repeat +import Data.BAByNF.Core.Tree (Tree (..)) +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.ABNF.Model +import Data.BAByNF.ABNF.PrettyPrint + +class ToParseable a where + toParseable :: a -> Parseable Rulename + +instance ToParseable Alternation where + toParseable (Alternation x) = case x of + [] -> error "empty alt" + [z'] -> toParseable z' + _:_ -> Parseable.Alt . List.NonEmpty.fromList . map toParseable $ x + +instance ToParseable Concatenation where + toParseable (Concatenation x) = case x of + [] -> error "empty seq" + [z'] -> toParseable z' + _:_ -> Parseable.Seq . List.NonEmpty.fromList . map toParseable $ x + +instance ToParseable Repetition where + toParseable (Repetition r x) = + case r of + NoRepeat -> toParseable x + _ -> Parseable.Rep (toParseable x) (toRepeat r) + where toRepeat NoRepeat = Core.Repeat.once + toRepeat (FixedRepeat i) = Core.Repeat.exactly (fromInteger i) + toRepeat (RangedRepeat lo hi) = + let req = case lo of UnBound -> 0; (FixedBound l) -> fromInteger l + opt = case hi of UnBound -> Nothing; (FixedBound h) -> if req > fromInteger h then error "fail" else Just $ fromInteger h - req + in Core.Repeat.from req opt + +instance ToParseable Element where + toParseable e = case e of + (RulenameElement r) -> toParseable r + (GroupElement g) -> toParseable g + (OptionElement o) -> toParseable o + (CharValElement c) -> toParseable c + (NumValElement n) -> toParseable n + (ProseValElement p) -> toParseable p + +instance ToParseable Rulename where + toParseable = Parseable.Rule + +instance ToParseable Group where + toParseable (Group a) = toParseable a + +instance ToParseable Option where + toParseable (Option a) = Parseable.Rep (toParseable a) Core.Repeat.maybeOnce + +instance ToParseable CharVal where + toParseable charVal = case charVal of + CaseInsensitiveCharVal ci -> toParseable ci + CaseSensitiveCharVal cs -> toParseable cs + +instance ToParseable CaseInsensitiveString where + toParseable (CaseInsensitiveString x@(QuotedString b)) = Parseable.Unit (prettyPrint x) (Ascii.parseCaseInsensitive b <&> (\b' -> (Tree [Tree.StringNode b']))) + +instance ToParseable CaseSensitiveString where + toParseable (CaseSensitiveString x@(QuotedString b)) = Parseable.Unit (prettyPrint x) (Ascii.parseCaseSensitive b <&> (\b' -> (Tree [Tree.StringNode b']))) + +instance ToParseable ProseVal where + toParseable x = Parseable.Unit (prettyPrint x) (fail "prose-val not supported yet") + + +instance ToParseable NumVal where + toParseable numVal = case numVal of + BinNumVal b -> toParseable b + DecNumVal d -> toParseable d + HexNumVal x -> toParseable x + +instance ToParseable BinVal where + toParseable x = case x of + SeqBinVal s -> Parseable.Unit (prettyPrint x) $ Attoparsec.ByteString.string (ByteString.pack $ map Binary.toNum s) <&> (\b' -> Tree [Tree.StringNode b']) + RangeBinVal lo hi -> Parseable.Unit (prettyPrint x) $ Attoparsec.ByteString.satisfy (\w -> w >= Binary.toNum lo && w <= Binary.toNum hi) <&> \w -> Tree [Tree.StringNode (ByteString.singleton w)] + +instance ToParseable DecVal where + toParseable x = case x of + SeqDecVal s -> Parseable.Unit (prettyPrint x) $ Attoparsec.ByteString.string (ByteString.pack $ map Decimal.toNum s) <&> (\b' -> Tree [Tree.StringNode b']) + RangeDecVal lo hi -> Parseable.Unit (prettyPrint x) $ Attoparsec.ByteString.satisfy (\w -> w >= Decimal.toNum lo && w <= Decimal.toNum hi) <&> \w -> Tree [Tree.StringNode (ByteString.singleton w)] + +instance ToParseable HexVal where + toParseable x = case x of + SeqHexVal s -> Parseable.Unit (prettyPrint x) $ Attoparsec.ByteString.string (ByteString.pack $ map Hex.toNum s) <&> (\b' -> Tree [Tree.StringNode b']) + RangeHexVal lo hi -> Parseable.Unit (prettyPrint x) $ Attoparsec.ByteString.satisfy (\w -> w >= Hex.toNum lo && w <= Hex.toNum hi) <&> \w -> Tree [Tree.StringNode (ByteString.singleton w)] +
+ lib/Data/BAByNF/Core/Parseable.hs view
@@ -0,0 +1,153 @@+module Data.BAByNF.Core.Parseable + ( Parseable (..) + , toParser + , Dict + , TreeParser + ) where + +import Data.List.NonEmpty (NonEmpty ((:|))) +import Data.List.NonEmpty qualified as List.NonEmpty + +import Data.Attoparsec.ByteString qualified as Attoparsec +import Data.BAByNF.Core.Tree (Tree) +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.Core.Ref (Ref) +import Data.BAByNF.Core.Ref qualified as Ref +import Data.BAByNF.Core.RefDict (RefDict) +import Data.BAByNF.Core.RefDict qualified as RefDict +import Data.BAByNF.Core.Repeat (Repeat, RepeatCount) +import Data.BAByNF.Core.Repeat qualified as Repeat + +type Dict a = RefDict a (Parseable a) +type TreeParser a = Attoparsec.Parser (Tree a) + +data ParserEnvironment a where + ParserEnvironment :: (Ref a) => { parserGrammar :: Dict a, parserContextStack :: [ParserContext a] } -> ParserEnvironment a +deriving instance (Show a) => Show (ParserEnvironment a) + +data ParserState a where + ParserState :: (Ref a) => { parserEnvironment :: ParserEnvironment a , parserFocus :: ParserFocus a } -> ParserState a +deriving instance (Show a) => Show (ParserState a) + +data ParserContext a where + SeqContext :: (Ref a) => { seqPrev :: Tree a, seqNext :: [Parseable a]} -> ParserContext a + RepContext :: (Ref a) => { repPrev :: Tree a, repParse :: Parseable a, repCount :: RepeatCount} -> ParserContext a + AltContext :: (Ref a) => { altNext :: [Parseable a]} -> ParserContext a + RuleContext :: (Ref a) => { ruleRef :: a } -> ParserContext a +deriving instance (Show a) => Show (ParserContext a) + +data Parseable a where + Seq :: (Ref a) => NonEmpty (Parseable a) -> Parseable a + Alt :: (Ref a) => NonEmpty (Parseable a) -> Parseable a + Rep :: (Ref a) => (Parseable a) -> Repeat -> Parseable a + Rule :: (Ref a) => a -> Parseable a + Unit :: String -> (TreeParser a) -> Parseable a + +instance (Show a) => Show (Parseable a) where + show :: Parseable a -> String + show x = case x of + Seq y -> "Seq( " ++ show (List.NonEmpty.toList y) ++ " )" + Alt y -> "Alt( " ++ show (List.NonEmpty.toList y) ++ " )" + Rep a b -> "Rep( {" ++ show (Repeat.required b) ++ "," ++ show (Repeat.optional b) ++ "}->" ++ show a ++ ")" + Rule r -> "Rule (" ++ show r ++ ")" + Unit desc _ -> "Unit <" ++ desc ++ ">" + +data ParserFocus a where + Before :: Ref a => Parseable a -> ParserFocus a + OnReturn :: Ref a => ParserContext a -> Tree a -> ParserFocus a + OnFailure :: Ref a => ParserContext a -> ParserFocus a + After :: Ref a => Tree a -> ParserFocus a +deriving instance (Show a) => Show (ParserFocus a) + +toParser :: (Ref a, Show a) => Dict a -> Parseable a -> TreeParser a +toParser grammar parseable = toParser' $ ParserState { parserEnvironment = ParserEnvironment { parserGrammar = grammar, parserContextStack = []}, parserFocus = Before (Seq $ parseable :| [Unit "endOfInput" $ Attoparsec.endOfInput >> return Tree.empty]) } + +alts :: (Ref a) => [Parseable a] -> Maybe (Parseable a) +alts [] = Nothing +alts [x] = Just x +alts (x:xs) = Just $ Alt (x :| xs) + +data Action a where + Return :: Ref a => Tree a -> Action a + Split :: Ref a => ParserContext a -> Parseable a -> Action a + Branch :: Ref a => ParserContext a -> Parseable a -> Action a + Parse :: Ref a => TreeParser a -> Action a + Panic :: String -> Action a + +applyAction :: (Ref a, Show a) => ParserEnvironment a -> Action a -> TreeParser a +applyAction env (Return tree) = + case pop env of + Nothing -> return tree + Just (env', ctx) -> + toParser' ParserState { parserEnvironment = env' + , parserFocus = OnReturn ctx tree + } +applyAction env (Split ctx p) = + let env' = push env ctx + in toParser' ParserState { parserEnvironment = env' + , parserFocus = Before p + } +applyAction env (Branch ctx p) = + Attoparsec.choice [ applyAction env (Split ctx p) + , toParser' ParserState { parserEnvironment = env, parserFocus = OnFailure ctx } + ] +applyAction env (Parse p) = + p >>= \tree -> toParser' ParserState { parserEnvironment = env + , parserFocus = After tree + } +applyAction _ (Panic withMsg) = fail withMsg + +pop :: (Ref a) => ParserEnvironment a -> Maybe (ParserEnvironment a, ParserContext a) +pop ParserEnvironment { parserGrammar = grammar, parserContextStack = contextStack } = + case contextStack of + [] -> Nothing + ctx : rest -> Just (ParserEnvironment { parserGrammar = grammar, parserContextStack = rest }, ctx) + +push :: (Ref a) => ParserEnvironment a -> ParserContext a -> ParserEnvironment a +push ParserEnvironment { parserGrammar = grammar, parserContextStack = contextStack} ctx = ParserEnvironment { parserGrammar = grammar, parserContextStack = ctx : contextStack } + +toParser' :: (Ref a, Show a) => ParserState a -> TreeParser a +toParser' state = + let action = case parserFocus state of + Before (Unit _ p) -> Parse p + Before (Rule ref) -> + let maybeP = lookupDef ref (parserEnvironment state) + in maybe (Panic $ "undefined " ++ Ref.display ref) (Split RuleContext { ruleRef = ref }) maybeP + Before (Seq (p :| ps)) -> Split SeqContext { seqPrev = Tree.empty, seqNext = ps } p + Before (Alt (p :| ps)) -> Branch AltContext { altNext = ps} p + Before (Rep p rep) -> + let rc = Repeat.initCount rep + in case Repeat.state rc of + Repeat.Satisfied -> Return Tree.empty + Repeat.WantMore -> Branch RepContext { repPrev = Tree.empty, repParse = p, repCount = rc } p + Repeat.NeedMore -> Split RepContext { repPrev = Tree.empty, repParse = p, repCount = rc} p + OnReturn SeqContext { seqPrev = prev, seqNext = next } tree -> + case next of + [] -> Return $ prev <> tree + p : next' -> Split SeqContext { seqPrev = prev <> tree, seqNext = next' } p + OnReturn AltContext { altNext = _ } tree -> Return tree + OnReturn RepContext { repParse = p, repPrev = prev, repCount = rc } tree -> + case Repeat.tryIncrementCount rc of + Nothing -> Panic "repetitions already satisfied" + Just rc' -> + case Repeat.state rc' of + Repeat.Satisfied -> Return $ prev <> tree + Repeat.WantMore -> Branch RepContext { repPrev = prev <> tree, repParse = p, repCount = rc' } p + Repeat.NeedMore -> Split RepContext { repPrev = prev <> tree, repParse = p, repCount = rc' } p + OnReturn RuleContext { ruleRef = ref } tree -> Return $ Tree.singleton $ Tree.RefNode ref tree + OnFailure AltContext { altNext = next } -> + case next of + [] -> Panic "no more alts" + p : next' -> Branch AltContext { altNext = next' } p + OnFailure RepContext { repParse = _, repPrev = prev, repCount = rc } -> + case Repeat.state rc of + Repeat.NeedMore -> Panic "more repetitions required" + _ -> Return prev + OnFailure _ -> Panic "failure in non-safeguarded context" + After tree -> Return tree + in applyAction (parserEnvironment state) action + +lookupDef :: Ref a => a -> ParserEnvironment a -> Maybe (Parseable a) +lookupDef ref env = lookupDef' ref (parserGrammar env) +lookupDef' :: Ref a => a -> Dict a -> Maybe (Parseable a) +lookupDef' ref grammar = alts $ RefDict.lookup ref grammar
+ lib/Data/BAByNF/Core/Ref.hs view
@@ -0,0 +1,8 @@+module Data.BAByNF.Core.Ref + ( Ref (..) + ) where + +class Ref a where + eq :: a -> a -> Bool + display :: a -> String +
+ lib/Data/BAByNF/Core/RefDict.hs view
@@ -0,0 +1,33 @@+module Data.BAByNF.Core.RefDict + ( RefDict (..) + , lookup + , lookup1 + ) where + +import Prelude hiding (lookup) + +import Data.BAByNF.Core.Ref (Ref) +import Data.BAByNF.Core.Ref qualified as Ref + +data RefDict a b where RefDict :: (Ref a) => [(a, b)] -> RefDict a b +deriving instance (Show a, Show b) => Show (RefDict a b) + +lookup :: a -> RefDict a b -> [b] +lookup ref (RefDict list) = lookup' ref list + where lookup' r l = case l of + [] -> [] + (r', e) : rest -> + let cont = lookup' r rest + in if Ref.eq r r' + then e : cont + else cont + +lookup1 :: a -> RefDict a b -> Maybe b +lookup1 ref (RefDict list) = lookup1' ref list + where lookup1' r l = case l of + [] -> Nothing + (r', e) : rest -> + if Ref.eq r r' + then Just e + else lookup1' ref rest +
+ lib/Data/BAByNF/Core/Repeat.hs view
@@ -0,0 +1,68 @@+module Data.BAByNF.Core.Repeat + ( Repeat + , RepeatCount + , required + , optional + , from + , exactly + , once + , upTo + , maybeOnce + , zeroOrMore + , oneOrMore + , nOrMore + , repeatDef + , count + , initCount + , State (..) + , tryIncrementCount + , state + ) where +import Numeric.Natural (Natural) + + +data Repeat = Repeat { required :: Natural, optional :: Maybe Natural } deriving (Eq, Show) + +from :: Natural -> Maybe Natural -> Repeat +from req opt = Repeat { required = req, optional = opt } + +exactly :: Natural -> Repeat +exactly val = Repeat { required = val, optional = Just 0} + +once :: Repeat +once = exactly 1 + +upTo :: Natural -> Repeat +upTo val = Repeat { required = 0, optional = Just val } + +maybeOnce :: Repeat +maybeOnce = upTo 1 + +zeroOrMore :: Repeat +zeroOrMore = nOrMore 0 + +oneOrMore :: Repeat +oneOrMore = nOrMore 1 + +nOrMore :: Natural -> Repeat +nOrMore val = Repeat { required = val, optional = Nothing } + + +initCount :: Repeat -> RepeatCount +initCount r = RepeatCount { repeatDef = r, count = 0 } + +data RepeatCount = RepeatCount { repeatDef :: Repeat, count :: Natural } deriving (Eq, Show) + +tryIncrementCount :: RepeatCount -> Maybe RepeatCount +tryIncrementCount x = + case state x of + Satisfied -> Nothing + _ -> Just $ RepeatCount { repeatDef = repeatDef x, count = count x + 1 } + +data State = NeedMore | WantMore | Satisfied +state :: RepeatCount -> State +state RepeatCount { repeatDef = Repeat { required = required, optional = maybeOptional }, count = count} = + if count < required then NeedMore else + case maybeOptional of + Nothing -> WantMore + Just optional -> if optional > (count - required) then WantMore else Satisfied
+ lib/Data/BAByNF/Core/Tree.hs view
@@ -0,0 +1,132 @@+module Data.BAByNF.Core.Tree + ( Tree (..) + , Node (..) + , nodes + , empty + , singleton + , asSingleton + , stringify + , stringifyNode + , mergeStrings + , mergeStringsInNode + , dropRefs + , getChildrenWithRef + , getChildWithRef + , tryGetChildWithRef + , getDescendantsWithPath + , getFirstDescendantWithPath + , tryGetFirstPath + , getSubtreeIfRef + , isStringEq + , isRefOf + ) where + +import Data.ByteString (ByteString) +import Data.ByteString qualified as ByteString + +import Data.BAByNF.Core.Ref (Ref) +import Data.List.NonEmpty (NonEmpty ((:|))) +import qualified Data.BAByNF.Core.Ref as Ref + +data Tree a where Tree :: Ref a => [Node a] -> Tree a + +deriving instance (Eq a) => Eq (Tree a) +deriving instance (Show a) => Show (Tree a) + +data Node a where + StringNode :: ByteString -> Node a + RefNode :: (Ref a) => a -> Tree a -> Node a + +deriving instance (Eq a) => Eq (Node a) +deriving instance (Show a) => Show (Node a) + +instance Semigroup (Tree a) where + (<>) :: Tree a -> Tree a -> Tree a + (<>) (Tree a) (Tree b) = Tree $ a ++ b + +nodes :: (Ref a) => Tree a -> [Node a] +nodes (Tree ns) = ns + +empty :: (Ref a) => Tree a +empty = Tree [] + +singleton :: (Ref a) => Node a -> Tree a +singleton node = Tree [node] + +asSingleton :: (Ref a) => Tree a -> Maybe (Node a) +asSingleton (Tree [x]) = Just x +asSingleton _ = Nothing + +stringify :: Tree a -> ByteString +stringify (Tree ns) = ByteString.concat . map stringifyNode $ ns + +stringifyNode :: Node a -> ByteString +stringifyNode (RefNode _ tree) = stringify tree +stringifyNode (StringNode bs) = bs + +mergeStrings :: Tree a -> Tree a +mergeStrings (Tree ns) = Tree $ merge ns + where merge [] = [] + merge [x] = [mergeStringsInNode x] + merge (x:xs) = mergeStringsInNode x : merge xs + + +mergeStringsInNode :: Node a -> Node a +mergeStringsInNode (RefNode ref tree) = RefNode ref (mergeStrings tree) +mergeStringsInNode node = node + +dropRefs :: [a] -> Tree a -> Tree a +dropRefs refs (Tree ns) = Tree $ ns >>= applyDrop + where applyDrop node@(StringNode _) = [node] + applyDrop (RefNode ref tree) = + let tree'@(Tree ns') = dropRefs refs tree + in if any (Ref.eq ref) refs + then ns' + else [RefNode ref tree'] + +getChildrenWithRef :: a -> Tree a -> [Tree a] +getChildrenWithRef ref (Tree ns) = ns >>= filterOnRef + where filterOnRef (RefNode ref' subtree) = [subtree | Ref.eq ref ref'] + filterOnRef _ = [] + +getChildWithRef :: a -> Tree a -> Maybe (Tree a) +getChildWithRef ref tree = + case getChildrenWithRef ref tree of + [] -> Nothing + x : _ -> Just x + +tryGetChildWithRef :: (Ref a) => a -> Tree a -> Either String (Tree a) +tryGetChildWithRef ref tree = + case getChildWithRef ref tree of + Nothing -> Left $ "no subtree with ref <" ++ Ref.display ref ++ "> defined" + Just subtree -> Right subtree + +getDescendantsWithPath :: (Ref a) => NonEmpty a -> Tree a -> [Tree a] +getDescendantsWithPath (r :| rs) tree = + let matching = getChildrenWithRef r tree + in case rs of + [] -> matching + r' : rs' -> matching >>= getDescendantsWithPath (r' :| rs') +getFirstDescendantWithPath :: (Ref a) => NonEmpty a -> Tree a -> Maybe (Tree a) +getFirstDescendantWithPath refs tree = case getDescendantsWithPath refs tree of + [] -> Nothing + x:_ -> Just x + +tryGetFirstPath :: (Ref a) => NonEmpty a -> Tree a -> Either String (Tree a) +tryGetFirstPath (r :| rs) tree = + let e = tryGetChildWithRef r tree + in case rs of + [] -> e + (r':rs') -> e >>= tryGetFirstPath (r' :| rs') + +getSubtreeIfRef :: (Ref a) => a -> Node a -> Maybe (Tree a) +getSubtreeIfRef ref (RefNode ref' subtree) = if Ref.eq ref ref' then Just subtree else Nothing +getSubtreeIfRef _ _ = Nothing + +isStringEq :: (Ref a) => Node a -> ByteString -> Bool +isStringEq (StringNode bs) bs' = bs == bs' +isStringEq _ _ = False + +isRefOf :: (Ref a) => Node a -> a -> Bool +isRefOf (RefNode ref _) ref' = Ref.eq ref ref' +isRefOf _ _ = False
+ lib/Data/BAByNF/Util/Ascii.hs view
@@ -0,0 +1,181 @@+module Data.BAByNF.Util.Ascii + ( lowerAlphaFirst + , lowerAlphaLast + , upperAlphaFirst + , upperAlphaLast + , rangedCompare + , AlphaClass (..) + , classifyAlpha + , lowerToUpperUnsafe + , lowerToUpper + , eqNoCase + , eqNoCaseSeq + , eqNoCaseBS + , fromChar + , fromCharOrNull + , bs + , parseHex + , toHexDigit + , bsToHexDigit + , toHexSeq + , toDecimalDigit + , bsToDecimalDigit + , toBinaryDigit + , bsToBinaryDigit + , stringAsBytesUnsafe + , parseCaseInsensitive + , parseCaseSensitive + ) where + +import Data.Functor ((<&>)) +import Data.Char qualified as Char +import Data.Maybe qualified as Maybe +import Data.Word (Word8) +import Data.List qualified as List + +import Data.ByteString (ByteString) +import Data.ByteString qualified as ByteString +import Data.ByteString.Char8 qualified as ByteString.Char8 + +import Data.Attoparsec.ByteString qualified as Attoparsec.ByteString + +import Data.BAByNF.Util.Binary qualified as Binary +import Data.BAByNF.Util.Decimal qualified as Decimal +import Data.BAByNF.Util.Hex qualified as Hex +import Control.Applicative ((<|>)) + +lowerAlphaFirst :: Word8 +lowerAlphaFirst = 97 + +lowerAlphaLast :: Word8 +lowerAlphaLast = 122 + +upperAlphaFirst :: Word8 +upperAlphaFirst = 65 + +upperAlphaLast :: Word8 +upperAlphaLast = 90 + + +rangedCompare :: Ord a => a -> a -> a -> Ordering +rangedCompare lo hi x + | x < lo = LT + | x > hi = GT + | otherwise = EQ + +data AlphaClass = UpperAlpha | LowerAlpha deriving (Eq, Show) + +classifyAlpha :: Word8 -> Maybe AlphaClass +classifyAlpha a = case rangedCompare upperAlphaFirst upperAlphaLast a of + LT -> Nothing + EQ -> Just UpperAlpha + GT -> case rangedCompare lowerAlphaFirst lowerAlphaLast a of + EQ -> Just LowerAlpha + _ -> Nothing + +lowerToUpperUnsafe :: Word8 -> Word8 +lowerToUpperUnsafe a = a - lowerUpperDiff + where lowerUpperDiff = lowerAlphaFirst - upperAlphaFirst + +lowerToUpper :: Word8 -> Maybe Word8 +lowerToUpper a = do + alphaClass <- classifyAlpha a + if alphaClass == LowerAlpha + then Just (lowerToUpperUnsafe a) + else Nothing + +eqNoCase :: Word8 -> Word8 -> Bool +eqNoCase a b = + case classifyAlpha a of + Nothing -> a == b + Just ac -> case classifyAlpha b of + Nothing -> False + Just bc -> if bc == ac + then a == b + else if ac == UpperAlpha + then a == lowerToUpperUnsafe b + else b == lowerToUpperUnsafe a + +eqNoCaseSeq :: [Word8] -> [Word8] -> Bool +eqNoCaseSeq [] [] = True +eqNoCaseSeq _ [] = False +eqNoCaseSeq [] _ = False +eqNoCaseSeq (x:xs) (y:ys) = eqNoCase x y && eqNoCaseSeq xs ys + +eqNoCaseBS :: ByteString -> ByteString -> Bool +eqNoCaseBS a b = ByteString.length a == ByteString.length b && all eq' pairs + where eq' = uncurry eqNoCase + pairs = ByteString.zip a b + +fromChar :: Char -> Maybe Word8 +fromChar ch = + if Char.isAscii ch + then Just (fromIntegral (Char.ord ch)) + else Nothing + +fromCharOrNull :: Char -> Word8 +fromCharOrNull ch = Maybe.fromMaybe 0 (fromChar ch) + +bs :: Char -> ByteString +bs ch = ByteString.singleton (fromCharOrNull ch) + +parseHex :: (Integral a) => ByteString -> Maybe a +parseHex s = fmap (Hex.toNum . Hex.Seq) (mapM toHexDigit (ByteString.unpack s)) + +toHexDigit :: Word8 -> Maybe Hex.Digit +toHexDigit w + | w >= 48 && w <= 57 = Hex.fromVal (w - 48) + | w >= 97 && w <= 102 = Hex.fromVal (w - 97 + 10) + | w >= 65 && w <= 70 = Hex.fromVal (w - 65 + 10) + | otherwise = Nothing + +bsToHexDigit :: ByteString -> Maybe Hex.Digit +bsToHexDigit b = + case ByteString.uncons b of + Just (w, t) | ByteString.null t -> toHexDigit w + | otherwise -> Nothing + _ -> Nothing +toHexSeq :: ByteString -> Maybe Hex.Seq +toHexSeq b = toHexDigs b <&> Hex.Seq + where toHexDigs x = ByteString.uncons x >>= + \(h, rest) -> toHexDigit h >>= + \hexdig -> if ByteString.null rest + then Just [hexdig] + else toHexDigs rest >>= \hexdigs -> Just (hexdig:hexdigs) + +toDecimalDigit :: Word8 -> Maybe Decimal.Digit +toDecimalDigit w + | w >= 48 && w <= 57 = Decimal.fromVal (w - 48) + | otherwise = Nothing + +bsToDecimalDigit :: ByteString -> Maybe Decimal.Digit +bsToDecimalDigit b = + case ByteString.uncons b of + Just (w, t) | ByteString.null t -> toDecimalDigit w + | otherwise -> Nothing + _ -> Nothing + +toBinaryDigit :: Word8 -> Maybe Binary.Digit +toBinaryDigit w + | w `elem` [48, 49] = Binary.fromVal (w - 48) + | otherwise = Nothing + +bsToBinaryDigit :: ByteString -> Maybe Binary.Digit +bsToBinaryDigit b = + case ByteString.uncons b of + Just (w, t) | ByteString.null t -> toBinaryDigit w + | otherwise -> Nothing + _ -> Nothing + +stringAsBytesUnsafe :: String -> ByteString +stringAsBytesUnsafe s = + case List.find (not . Char.isAscii) s of + Just _ -> error "string contains non-ascii characters" + Nothing -> ByteString.Char8.pack s + +parseCaseInsensitive :: ByteString -> Attoparsec.ByteString.Parser ByteString +parseCaseInsensitive b = Attoparsec.ByteString.take (ByteString.length b) + >>= \b' -> if b `eqNoCaseBS` b' then return b' else fail "case insensitive match fail" + +parseCaseSensitive :: ByteString -> Attoparsec.ByteString.Parser ByteString +parseCaseSensitive b = Attoparsec.ByteString.string b <|> fail "case sensitive match fail"
+ lib/Data/BAByNF/Util/Binary.hs view
@@ -0,0 +1,34 @@+module Data.BAByNF.Util.Binary + ( Digit (..) + , Seq (..) + , val + , toNum + , fromVal + , toChar + ) where + +data Digit = B0 | B1 deriving (Eq, Ord) +newtype Seq = Seq [Digit] deriving Eq + +val :: Integral a => Digit -> a +val B0 = 0 +val B1 = 1 + +toNum :: Integral a => Seq -> a +toNum (Seq digits) = toNum' digits 0 + where toNum' [] acc = acc + toNum' (d : ds) acc = + let newAcc = (acc * 2) + val d + in toNum' ds newAcc + +fromVal :: Integral a => a -> Maybe Digit +fromVal 0 = Just B0 +fromVal 1 = Just B1 +fromVal _ = Nothing + +instance Show Seq where + show (Seq x) = map toChar x + +toChar :: Digit -> Char +toChar B0 = '0' +toChar B1 = '1'
+ lib/Data/BAByNF/Util/Decimal.hs view
@@ -0,0 +1,69 @@+module Data.BAByNF.Util.Decimal + ( Digit (..) + , Seq (..) + , val + , toNum + , fromVal + , toChar + ) where + +data Digit = D0 + | D1 + | D2 + | D3 + | D4 + | D5 + | D6 + | D7 + | D8 + | D9 + deriving (Eq, Ord) +newtype Seq = Seq [Digit] deriving Eq + +val :: Integral a => Digit -> a +val D0 = 0 +val D1 = 1 +val D2 = 2 +val D3 = 3 +val D4 = 4 +val D5 = 5 +val D6 = 6 +val D7 = 7 +val D8 = 8 +val D9 = 9 + +toNum :: Integral a => Seq -> a +toNum (Seq digits) = toNum' digits 0 + where toNum' [] acc = acc + toNum' (d : ds) acc = + let newAcc = (acc * 10) + val d + in toNum' ds newAcc + +fromVal :: Integral a => a -> Maybe Digit +fromVal 0 = Just D0 +fromVal 1 = Just D1 +fromVal 2 = Just D2 +fromVal 3 = Just D3 +fromVal 4 = Just D4 +fromVal 5 = Just D5 +fromVal 6 = Just D6 +fromVal 7 = Just D7 +fromVal 8 = Just D8 +fromVal 9 = Just D9 +fromVal _ = Nothing + +instance Show Seq where + show (Seq x) = map toChar x + +toChar :: Digit -> Char +toChar d = case d of + D0 -> '0' + D1 -> '1' + D2 -> '2' + D3 -> '3' + D4 -> '4' + D5 -> '5' + D6 -> '6' + D7 -> '7' + D8 -> '8' + D9 -> '9'
+ lib/Data/BAByNF/Util/Hex.hs view
@@ -0,0 +1,94 @@+module Data.BAByNF.Util.Hex + ( Digit (..) + , Seq (..) + , val + , toNum + , fromVal + , toChar + ) where + +data Digit + = X0 + | X1 + | X2 + | X3 + | X4 + | X5 + | X6 + | X7 + | X8 + | X9 + | XA + | XB + | XC + | XD + | XE + | XF + deriving (Eq, Ord) +newtype Seq = Seq [Digit] deriving Eq + +val :: (Integral a) => Digit -> a +val X0 = 0 +val X1 = 1 +val X2 = 2 +val X3 = 3 +val X4 = 4 +val X5 = 5 +val X6 = 6 +val X7 = 7 +val X8 = 8 +val X9 = 9 +val XA = 10 +val XB = 11 +val XC = 12 +val XD = 13 +val XE = 14 +val XF = 15 + +toNum :: (Integral a) => Seq -> a +toNum (Seq digits) = toNum' digits 0 + where toNum' [] acc = acc + toNum' (d : ds) acc = + let newAcc = (acc * 16) + val d + in toNum' ds newAcc + +fromVal :: (Integral a) => a -> Maybe Digit +fromVal 0 = Just X0 +fromVal 1 = Just X1 +fromVal 2 = Just X2 +fromVal 3 = Just X3 +fromVal 4 = Just X4 +fromVal 5 = Just X5 +fromVal 6 = Just X6 +fromVal 7 = Just X7 +fromVal 8 = Just X8 +fromVal 9 = Just X9 +fromVal 10 = Just XA +fromVal 11 = Just XB +fromVal 12 = Just XC +fromVal 13 = Just XD +fromVal 14 = Just XE +fromVal 15 = Just XF +fromVal _ = Nothing + +instance Show Seq where + show (Seq x) = map toChar x + +toChar :: Digit -> Char +toChar d = case d of + X0 -> '0' + X1 -> '1' + X2 -> '2' + X3 -> '3' + X4 -> '4' + X5 -> '5' + X6 -> '6' + X7 -> '7' + X8 -> '8' + X9 -> '9' + XA -> 'A' + XB -> 'B' + XC -> 'C' + XD -> 'D' + XE -> 'E' + XF -> 'F'
+ lib/Data/BAByNF/Util/List.hs view
@@ -0,0 +1,66 @@+module Data.BAByNF.Util.List + ( drainOnce + , drainIf + , drainWhile + , lsplitWhenNot + , rsplitWhenNot + , lstrip + , rstrip + , lrsplitWhenNot + ) where + +drainOnce :: [a] -> [a] -> ([a], [a]) +drainOnce from to = + case from of + [] -> (from, to) + x:xs -> (xs, x:to) + +drainIf :: [a] -> [a] -> (a -> Bool) -> Maybe ([a], [a]) +drainIf from to cond = + case from of + [] -> Nothing + x:xs -> + if cond x + then Just (xs, x:to) + else Nothing + +drainWhile :: [a] -> [a] -> (a -> Bool) -> ([a], [a]) +drainWhile from to cond = + case drainIf from to cond of + Just (from', to') -> drainWhile from' to' cond + Nothing -> (from, to) + +lsplitWhenNot :: [a] -> (a -> Bool) -> ([a], [a]) +lsplitWhenNot l matches = + case l of + [] -> ([], []) + (focus:rest) -> + if matches focus + then let (prefixTail, suffix) = lsplitWhenNot rest matches + in (focus:prefixTail, suffix) + else ([], l) + +rsplitWhenNot :: [a] -> (a -> Bool) -> ([a], [a]) +rsplitWhenNot l matches = foldr fn ([], []) l + where fn x acc = case acc of + ([], back) | matches x -> ([], x:back) + | otherwise -> ([x], back) + (front, back) -> (x:front, back) +rstrip :: [a] -> (a -> Bool) -> [a] +rstrip l matches = foldr fn [] l + where fn x acc = case acc of + [] | matches x -> [] + | otherwise -> [x] + _ -> x:acc + +lstrip :: [a] -> (a -> Bool) -> [a] +lstrip l matches = case l of + [] -> [] + x:xs | matches x -> lstrip xs matches + | otherwise -> l + +lrsplitWhenNot :: Show a => [a] -> (a -> Bool) -> ([a], [a], [a]) +lrsplitWhenNot x matches = + let (l, x') = lsplitWhenNot x matches + (m, r) = rsplitWhenNot x' matches + in (l, m, r)
+ lib/Data/BAByNF/Util/Stream.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE LambdaCase #-} +module Data.BAByNF.Util.Stream where +import Data.Bifunctor qualified as Bifunctor +import Data.Maybe (isJust, isNothing) +import Control.Applicative (liftA2) +import Control.Monad (when) +import Prelude hiding (take, drop, takeWhile, dropWhile) +import Data.Kind (Type) + +newtype Stream e a = Stream + { runStream :: [e] -> ([e], a) + } + +runStream_ :: Stream e a -> [e] -> a +runStream_ stream = snd . runStream stream +instance Functor (Stream e) where + fmap func stream = Stream { runStream = Bifunctor.second func . runStream stream} +instance Applicative (Stream e) where + pure a = Stream { runStream = (, a) } + liftA2 func s1 s2 = Stream { runStream = (\(es1, a) -> Bifunctor.second (func a) . runStream s2 $ es1) . runStream s1 } +instance Monad (Stream e) where + (>>=) s sf = Stream { runStream = (\(es, a) -> runStream (sf a) es ) . runStream s } + + +hasNext :: Stream e Bool +hasNext = Stream { runStream = \es -> case es of [] -> (es, False); _ -> (es, True) } +take :: Stream e (Maybe e) +take = Stream { runStream = \es -> case es of [] -> (es, Nothing); x:xs -> (xs, Just x)} +drop :: Stream e () +drop = Stream { runStream = \es -> case es of [] -> (es, ()); _:xs -> (xs, ())} +peek :: Stream e (Maybe e) +peek = Stream { runStream = \es -> case es of [] -> (es, Nothing); x:_ -> (es, Just x)} +takeIf :: (e -> Bool) -> Stream e (Maybe e) +takeIf cond = do + opt <- peek + case opt of + Nothing -> return Nothing + Just x -> if cond x then drop >> return (Just x) else return Nothing +dropIf :: (e -> Bool) -> Stream e () +dropIf cond = do + opt <- peek + case opt of + Nothing -> return () + Just x -> when (cond x) drop +takeWhile :: (e -> Bool) -> Stream e [e] +takeWhile cond = do + opt <- takeIf cond + case opt of + Nothing -> return [] + Just x -> do + xs <- takeWhile cond + return (x:xs) +dropWhile :: (e -> Bool) -> Stream e () +dropWhile cond = do + opt <- peek + case opt of + Nothing -> return () + Just x -> when (cond x) $ drop >> dropWhile cond + +find :: (e -> Bool) -> Stream e (Maybe e) +find cond = dropWhile (not . cond) >> takeIf cond + +findSeq :: (e -> Bool) -> Stream e [e] +findSeq cond = dropWhile (not . cond) >> takeWhile cond + +takeIfMap :: (e -> Maybe a) -> Stream e (Maybe a) +takeIfMap func = do + opt <- peek >>= (\maybeE -> return $ maybeE >>= func) + when (isJust opt) drop >> return opt + +takeWhileMap :: (e -> Maybe a) -> Stream e [a] +takeWhileMap func = do + opt <- takeIfMap func + case opt of + Nothing -> return [] + Just e -> takeWhileMap func >>= (\es -> return $ e : es) + +findMap :: (e -> Maybe a) -> Stream e (Maybe a) +findMap func = dropWhile (isNothing . func) >> takeIfMap func + +findSeqMap :: (e -> Maybe a) -> Stream e [a] +findSeqMap func = dropWhile (isNothing . func) >> takeWhileMap func + +either :: Stream e (Either l a) -> (a -> Stream e b) -> Stream e (Either l b) +either stream action = stream >>= \case Left l -> return (Left l); Right a -> fmap Right (action a) + + +either' :: Stream e (Either l a) -> (a -> Stream e (Either l b)) -> Stream e (Either l b) +either' stream action = stream >>= \case Left l -> return (Left l); Right a -> action a + + +class Propagate (p :: Type -> Type) where + propagate :: (Monad m) => m (p a) -> (a -> m (p b)) -> m (p b) + +instance Propagate Maybe where + propagate m1 m2 = m1 >>= \case Nothing -> return Nothing; Just a -> m2 a + +instance Propagate (Either a) where + propagate m1 m2 = m1 >>= \case Left e -> return (Left e); Right a -> m2 a + +propagate' :: (Propagate p, Monad m) => m (p a) -> m (p b) -> m (p b) +propagate' m1 m2 = propagate m1 (const m2)
+ test/Data/BAByNF/ABNF/Parse/Test.hs view
@@ -0,0 +1,78 @@+module Data.BAByNF.ABNF.Parse.Test + ( testModule + ) where + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Core.Tree (Tree (..)) +import Data.BAByNF.Core.Ref qualified as Ref +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.Util.Ascii qualified as Ascii +import Data.BAByNF.ABNF.Parse (parseRulelist, parse) +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Core qualified as Core + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Parse" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testParseRulelist ] + +testParseRulelist :: Tasty.TestTree +testParseRulelist = HUnit.testCase "parseRulelist" $ + case ( + parseRulelist rules + >>= + (\rulelist -> parse (withCore rulelist) (Model.Rulename (Ascii.stringAsBytesUnsafe "ehlo-ok-rsp")) ehloResponse) + ) of + Left err -> HUnit.assertFailure $ "Expected fragment to be successfully parsed but failed with error message " ++ err + Right tree -> + expectRefTreeThat (ref "ehlo-ok-rsp") tree $ \nodes -> + return nodes >>= + expectString "250" >>= + expectRefNodeLike Core.spRef " " >>= + expectRefNodeLike (ref "Domain") "mail.server.org" >>= + expectRefNodeLike Core.spRef " " >>= + expectRefNodeLike (ref "ehlo-greet") "greetings fellow traveller!" >>= + expectRefNodeLike Core.crlfRef "\r\n" >>= + expectEnd + -- todo: node list assert (monoid?) + where ehloResponse = Ascii.stringAsBytesUnsafe "250 mail.server.org greetings fellow traveller!\r\n" + rules = Ascii.stringAsBytesUnsafe + "ehlo-ok-rsp = ( \"250\" SP Domain [ SP ehlo-greet ] CRLF )\r\n\ + \ / ( \"250-\" Domain [ SP ehlo-greet ] CRLF\r\n\ + \ *( \"250-\" ehlo-line CRLF )\r\n\ + \ \"250\" SP ehlo-line CRLF )\r\n\ + \Domain = \"mail.server.org\"\r\n\ + \ehlo-greet = 1*(%d0-9 / %d11-12 / %d14-127)\r\n\ + \ehlo-line = ehlo-keyword *( SP ehlo-param )\r\n\ + \ehlo-keyword = (ALPHA / DIGIT) *(ALPHA / DIGIT / \"-\")\r\n\ + \ehlo-param = 1*(%d33-126)\r\n" + withCore (Model.Rulelist r) = Model.Rulelist (r ++ Core.rules) + expectString s l = + let expected = stringNode s + in case l of + [] -> HUnit.assertFailure $ "Expected " ++ show expected ++ " but no more elements found" + x:xs -> (x @?= expected) >> return xs + expectRefNodeLike r s l = + let expected = refNodeWithString r s + in case l of + [] -> HUnit.assertFailure $ "Expected node like " ++ show expected ++ " but no more elements found" + x:xs -> case x of + Tree.RefNode r' t -> (Tree.RefNode r' (Tree [Tree.StringNode $ Tree.stringify t]) @?= expected) >> return xs + t@(Tree.StringNode _) -> HUnit.assertFailure $ "Expected node like " ++ show expected ++ " but found " ++ show t + expectEnd l = + case l of + [] -> return () + _ -> HUnit.assertFailure $ "Expected end of node list but " ++ show (length l) ++ " more elements found" + stringNode s = Tree.StringNode (Ascii.stringAsBytesUnsafe s) :: Tree.Node Model.Rulename + refNodeWithString r s = Tree.RefNode r (Tree [stringNode s]) + ref = Model.Rulename . Ascii.stringAsBytesUnsafe + expectRefTreeThat r t a = case Tree.nodes t of + [Tree.RefNode r' t'] | Ref.eq r r' -> a (Tree.nodes t') + | otherwise -> HUnit.assertFailure $ "Expected tree of ref " ++ show r ++ " but found " ++ show r' + x -> HUnit.assertFailure $ "Expected tree of ref " ++ show r ++ " but found " ++ show (length x) ++ " elements" +
+ test/Data/BAByNF/ABNF/Rules/Alternation/Test.hs view
@@ -0,0 +1,74 @@+module Data.BAByNF.ABNF.Rules.Alternation.Test where + +import Data.Functor ((<&>)) +import Data.List qualified as List + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.Alternation qualified as Alternation + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.Alternation" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint Alternation.rule @?= "alternation = concatenation *(*c-wsp \"/\" *c-wsp concatenation)" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "rule / \"string\"" + , "rule" + , "\"string\"" + , "rule1 / rule2" + , "rule1/rule2" + , "rule1 / rule2 / rule3" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules Alternation.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("someRule", Model.Alternation . List.singleton . Model.Concatenation . List.singleton $ Model.Repetition Model.NoRepeat (Model.RulenameElement . Model.Rulename $ stringAsBytesUnsafe "someRule")) + , ("thisRule / thatRule / anotherRule andAfterThatToo", + Model.Alternation + [ Model.Concatenation . List.singleton $ Model.Repetition Model.NoRepeat (Model.RulenameElement . Model.Rulename $ stringAsBytesUnsafe "thisRule") + , Model.Concatenation . List.singleton $ Model.Repetition Model.NoRepeat (Model.RulenameElement . Model.Rulename $ stringAsBytesUnsafe "thatRule") + , Model.Concatenation + [ Model.Repetition Model.NoRepeat (Model.RulenameElement . Model.Rulename $ stringAsBytesUnsafe "anotherRule") + , Model.Repetition Model.NoRepeat (Model.RulenameElement . Model.Rulename $ stringAsBytesUnsafe "andAfterThatToo") + ] + ] + ) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules Alternation.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef Alternation.ref of + Nothing -> HUnit.assertFailure $ "expected Alternation ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string into model with error: [" ++ msg ++ "]") + return + (Alternation.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/BinVal/Test.hs view
@@ -0,0 +1,75 @@+module Data.BAByNF.ABNF.Rules.BinVal.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) +import Data.BAByNF.Util.Binary (Seq (..), Digit (..)) + +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.BinVal qualified as BinVal + + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.BinVal" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint BinVal.rule @?= "bin-val = \"b\" 1*BIT [1*(\".\" 1*BIT) / (\"-\" 1*BIT)]" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "b0" + , "b1" + , "b01010101" + , "b00001111-11110000" + , "b00000001.00000010.00000100" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules BinVal.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("b00001111", Model.SeqBinVal [Seq [B0, B0, B0, B0, B1, B1, B1, B1]]) + , ("b00001111.00010000.00010100", + Model.SeqBinVal [ Seq [B0, B0, B0, B0, B1, B1, B1, B1] + , Seq [B0, B0, B0, B1, B0, B0, B0, B0] + , Seq [B0, B0, B0, B1, B0, B1, B0, B0] + ] + ) + , ("b00000100-00000111", + Model.RangeBinVal + (Seq [B0, B0, B0, B0, B0, B1, B0, B0]) + (Seq [B0, B0, B0, B0, B0, B1, B1, B1]) + ) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules BinVal.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef BinVal.ref of + Nothing -> HUnit.assertFailure $ "expected BinVal ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string into model with error: [" ++ msg ++ "]") + return + (BinVal.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/CNl/Test.hs view
@@ -0,0 +1,38 @@+module Data.BAByNF.ABNF.Rules.CNl.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.CNl qualified as CNl + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.CNl" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint CNl.rule @?= "c-nl = comment / CRLF" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "\r\n" + , ";\r\n" + , "; this is a comment!\r\n" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules CNl.ref (stringAsBytesUnsafe s))
+ test/Data/BAByNF/ABNF/Rules/CWsp/Test.hs view
@@ -0,0 +1,39 @@+module Data.BAByNF.ABNF.Rules.CWsp.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.CWsp qualified as CWsp + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.CWsp" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint CWsp.rule @?= "c-wsp = WSP / (c-nl WSP)" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ " " + , "\t" + , "; some comment \r\n " + , "; some comment \r\n\t" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules CWsp.ref (stringAsBytesUnsafe s))
+ test/Data/BAByNF/ABNF/Rules/CaseInsensitiveString/Test.hs view
@@ -0,0 +1,61 @@+module Data.BAByNF.ABNF.Rules.CaseInsensitiveString.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.CaseInsensitiveString qualified as CaseInsensitiveString + + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.CaseInsensitiveString" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint CaseInsensitiveString.rule @?= "case-insensitive-string = [\"%i\"] quoted-string" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "\"some string is here\"" + , "%i\"some other string!\"" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules CaseInsensitiveString.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("\"some string\"", Model.CaseInsensitiveString (Model.QuotedString (stringAsBytesUnsafe "some string"))) + , ("%i\"some other string\"", Model.CaseInsensitiveString (Model.QuotedString (stringAsBytesUnsafe "some other string"))) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules CaseInsensitiveString.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef CaseInsensitiveString.ref of + Nothing -> HUnit.assertFailure $ "expected CaseInsensitiveString ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string into model with error: [" ++ msg ++ "]") + return + (CaseInsensitiveString.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/CaseSensitiveString/Test.hs view
@@ -0,0 +1,58 @@+module Data.BAByNF.ABNF.Rules.CaseSensitiveString.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.CaseSensitiveString qualified as CaseSensitiveString + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.CaseSensitiveString" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint CaseSensitiveString.rule @?= "case-sensitive-string = \"%s\" quoted-string" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "%s\"some string!!!\"" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules CaseSensitiveString.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("%s\"some string\"", Model.CaseSensitiveString (Model.QuotedString (stringAsBytesUnsafe "some string"))) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules CaseSensitiveString.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef CaseSensitiveString.ref of + Nothing -> HUnit.assertFailure $ "expected CaseSensitiveString ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string into model with error: [" ++ msg ++ "]") + return + (CaseSensitiveString.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/CharVal/Test.hs view
@@ -0,0 +1,62 @@+module Data.BAByNF.ABNF.Rules.CharVal.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.CharVal qualified as CharVal + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.CharVal" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint CharVal.rule @?= "char-val = case-insensitive-string / case-sensitive-string" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "\"this is a case insensitive string!\"" + , "%i\"this is a case insensitive string!\"" + , "%s\"this is a case sensitive string!\"" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules CharVal.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("\"some string\"", Model.CaseInsensitiveCharVal $ Model.CaseInsensitiveString (Model.QuotedString (stringAsBytesUnsafe "some string"))) + , ("%i\"some other string\"", Model.CaseInsensitiveCharVal $ Model.CaseInsensitiveString (Model.QuotedString (stringAsBytesUnsafe "some other string"))) + , ("%s\"some string\"", Model.CaseSensitiveCharVal $ Model.CaseSensitiveString (Model.QuotedString (stringAsBytesUnsafe "some string"))) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules CharVal.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef CharVal.ref of + Nothing -> HUnit.assertFailure $ "expected CharVal ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string into model with error: [" ++ msg ++ "]") + return + (CharVal.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/Comment/Test.hs view
@@ -0,0 +1,37 @@+module Data.BAByNF.ABNF.Rules.Comment.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.Comment qualified as Comment + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.Comment" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint Comment.rule @?= "comment = \";\" *(WSP / VCHAR) CRLF" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ ";\r\n" + , "; this is a comment!\r\n" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules Comment.ref (stringAsBytesUnsafe s))
+ test/Data/BAByNF/ABNF/Rules/Concatenation/Test.hs view
@@ -0,0 +1,63 @@+module Data.BAByNF.ABNF.Rules.Concatenation.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.Concatenation qualified as Concatenation + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.Concatenation" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint Concatenation.rule @?= "concatenation = repetition *(1*c-wsp repetition)" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "rule1 rule2" + , "just-this-role" + , "1*these-rules" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules Concatenation.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("rule1 rule2", Model.Concatenation + [ Model.Repetition Model.NoRepeat (Model.RulenameElement . Model.Rulename $ stringAsBytesUnsafe "rule1") + , Model.Repetition Model.NoRepeat (Model.RulenameElement . Model.Rulename $ stringAsBytesUnsafe "rule2") + ]) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules Concatenation.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef Concatenation.ref of + Nothing -> HUnit.assertFailure $ "expected Concatenation ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string into model with error: [" ++ msg ++ "]") + return + (Concatenation.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/DecVal/Test.hs view
@@ -0,0 +1,74 @@+module Data.BAByNF.ABNF.Rules.DecVal.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) +import Data.BAByNF.Util.Decimal (Seq(..), Digit(..)) + +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.DecVal qualified as DecVal + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.DecVal" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint DecVal.rule @?= "dec-val = \"d\" 1*DIGIT [1*(\".\" 1*DIGIT) / (\"-\" 1*DIGIT)]" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "d0" + , "d9" + , "d255" + , "d001-255" + , "d001.002.090.128" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules DecVal.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("d128", Model.SeqDecVal [Seq [D1, D2, D8]]) + , ("d098.128.240", + Model.SeqDecVal [ Seq [D0, D9, D8] + , Seq [D1, D2, D8] + , Seq [D2, D4, D0] + ] + ) + , ("d001-255", + Model.RangeDecVal + (Seq [D0, D0, D1]) + (Seq [D2, D5, D5]) + ) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules DecVal.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef DecVal.ref of + Nothing -> HUnit.assertFailure $ "expected DecVal ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string into model with error: [" ++ msg ++ "]") + return + (DecVal.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/DefinedAs/Test.hs view
@@ -0,0 +1,68 @@+module Data.BAByNF.ABNF.Rules.DefinedAs.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.DefinedAs qualified as DefinedAs + +moduleUnderTest :: String +moduleUnderTest = "Test-Data.BAByNF.ABNF.Rules.DefinedAs" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint DefinedAs.rule @?= "defined-as = *c-wsp (\"=\" / \"=/\") *c-wsp" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "=" + , "=/" + , " = " + , " =/ " + , "; comment\r\n = " + , "; comment\r\n =/ " + , "; comment\r\n = ; comment \r\n " + , "; comment\r\n =/ ; comment \r\n " + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules DefinedAs.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("=", Model.BasicDefinition) + , ("=/", Model.IncrementalAlternative) + , (" = ", Model.BasicDefinition) + , (" =/ ", Model.IncrementalAlternative) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules DefinedAs.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef DefinedAs.ref of + Nothing -> HUnit.assertFailure $ "expected DefinedAs ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string into model with error: [" ++ msg ++ "]") + return + (DefinedAs.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/Element/Test.hs view
@@ -0,0 +1,86 @@+module Data.BAByNF.ABNF.Rules.Element.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + +import Data.BAByNF.Util.Hex qualified as Hex + +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.Element qualified as Element +import Data.BAByNF.ABNF.Model qualified as Model + + +moduleUnderTest :: String +moduleUnderTest = "Test-Data.BAByNF.ABNF.Rules.Element" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint Element.rule @?= "element = rulename / group / option / char-val / num-val / prose-val" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "some-rule" + , "\"some char value\"" + , "%i\"some other char value\"" + , "%s\"yet another char value\"" + , "[ something-optional ]" + , "( alt1 / alt2-1 alt2-2 )" + , "%xFF" + , "%x00-FF" + , "%x01.0A.0A.02.B1" + , "%d255" + , "%d000-255" + , "%d001.010.010.002.177" + , "%b11111111" + , "%b00000000-11111111" + , "%b00000001.00001010.10110001" + , "<this is prose>" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules Element.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("some-ref", Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "some-ref"))) + , ("(one / other)", Model.GroupElement (Model.Group (Model.Alternation + [ Model.Concatenation [ Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "one")))] + , Model.Concatenation [Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "other")))] + ]))) + , ("[one / other]", Model.OptionElement (Model.Option (Model.Alternation + [ Model.Concatenation [ Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "one")))] + , Model.Concatenation [Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "other")))] + ]))) + , ("\"some text\"", Model.CharValElement (Model.CaseInsensitiveCharVal (Model.CaseInsensitiveString (Model.QuotedString (stringAsBytesUnsafe "some text"))))) + , ("%xA0-FF", Model.NumValElement (Model.HexNumVal (Model.RangeHexVal (Hex.Seq [Hex.XA, Hex.X0]) (Hex.Seq [Hex.XF, Hex.XF])))) + , ("<this is prose>", Model.ProseValElement (Model.ProseVal (stringAsBytesUnsafe "this is prose"))) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules Element.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef Element.ref of + Nothing -> HUnit.assertFailure $ "expected Element ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string into model with error: [" ++ msg ++ "]") + return + (Element.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/Elements/Test.hs view
@@ -0,0 +1,66 @@+module Data.BAByNF.ABNF.Rules.Elements.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.Elements qualified as Elements +import Data.BAByNF.ABNF.Model qualified as Model + +moduleUnderTest :: String +moduleUnderTest = "Test-Data.BAByNF.ABNF.Rules.Elements" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint Elements.rule @?= "elements = alternation *c-wsp" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "opt1 / opt2-1 opt2-1" + , "opt1 / opt2-1 opt2-1 ; comment\r\n " + , "some-stuff ; comment\r\n " + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules Elements.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("one / other", Model.Elements (Model.Alternation + [ Model.Concatenation [Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "one")))] + , Model.Concatenation [Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "other")))] + ])) + , ("one / other ; this is a comment\r\n ", Model.Elements (Model.Alternation + [ Model.Concatenation [Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "one")))] + , Model.Concatenation [Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "other")))] + ])) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules Elements.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef Elements.ref of + Nothing -> HUnit.assertFailure $ "expected Elements ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string into model with error: [" ++ msg ++ "]") + return + (Elements.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/Group/Test.hs view
@@ -0,0 +1,61 @@+module Data.BAByNF.ABNF.Rules.Group.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.Group qualified as Group +import Data.BAByNF.ABNF.Model qualified as Model + +moduleUnderTest :: String +moduleUnderTest = "Test-Data.BAByNF.ABNF.Rules.Group" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint Group.rule @?= "group = \"(\" *c-wsp alternation *c-wsp \")\"" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "( opt1 / opt2 / opt3 )" + , "( opt1 ; comment1\r\n opt2 ; comment2\r\n opt3)" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules Group.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("(one / other)", Model.Group (Model.Alternation + [ Model.Concatenation [ Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "one")))] + , Model.Concatenation [Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "other")))] + ])) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules Group.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef Group.ref of + Nothing -> HUnit.assertFailure $ "expected Group ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string into model with error: [" ++ msg ++ "]") + return + (Group.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/HexVal/Test.hs view
@@ -0,0 +1,74 @@+module Data.BAByNF.ABNF.Rules.HexVal.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) +import Data.BAByNF.Util.Hex (Seq (..), Digit (..)) + +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.HexVal qualified as HexVal + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.HexVal" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint HexVal.rule @?= "hex-val = \"x\" 1*HEXDIG [1*(\".\" 1*HEXDIG) / (\"-\" 1*HEXDIG)]" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "x0" + , "xF" + , "xFF" + , "x01-FF" + , "x01.02.B1.F0" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules HexVal.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("xBF", Model.SeqHexVal [Seq [XB, XF]]) + , ("x01.C2.F0", + Model.SeqHexVal [ Seq [X0, X1] + , Seq [XC, X2] + , Seq [XF, X0] + ] + ) + , ("x01-FF", + Model.RangeHexVal + (Seq [X0, X1]) + (Seq [XF, XF]) + ) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules HexVal.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef HexVal.ref of + Nothing -> HUnit.assertFailure $ "expected HexVal ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string into model with error: [" ++ msg ++ "]") + return + (HexVal.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/NumVal/Test.hs view
@@ -0,0 +1,71 @@+module Data.BAByNF.ABNF.Rules.NumVal.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) +import Data.BAByNF.Util.Binary qualified as Binary +import Data.BAByNF.Util.Decimal qualified as Decimal +import Data.BAByNF.Util.Hex qualified as Hex + +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.NumVal qualified as NumVal + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.NumVal" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint NumVal.rule @?= "num-val = \"%\" (bin-val / dec-val / hex-val)" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "%xFF" + , "%x01-FF" + , "%x01.02.B1.F0" + , "%d255" + , "%d000-255" + , "%d001.002.090.128" + , "%b01010101" + , "%b00001111-11110000" + , "%b00000001.00000010.00000100" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules NumVal.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("%b01010101", Model.BinNumVal (Model.SeqBinVal [Binary.Seq [Binary.B0, Binary.B1, Binary.B0, Binary.B1, Binary.B0, Binary.B1, Binary.B0, Binary.B1]])) + , ("%d255", Model.DecNumVal (Model.SeqDecVal [Decimal.Seq [Decimal.D2, Decimal.D5, Decimal.D5]])) + , ("%xFF", Model.HexNumVal (Model.SeqHexVal [Hex.Seq [Hex.XF, Hex.XF]])) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules NumVal.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef NumVal.ref of + Nothing -> HUnit.assertFailure $ "expected NumVal ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string into model with error: [" ++ msg ++ "]") + return + (NumVal.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/Option/Test.hs view
@@ -0,0 +1,64 @@+module Data.BAByNF.ABNF.Rules.Option.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.Option qualified as Option + + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.Option" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint Option.rule @?= "option = \"[\" *c-wsp alternation *c-wsp \"]\"" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "[ref]" + , "[alt1 / alt2-1 alt2-2]" + , "[this that]" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules Option.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("[one / other]", Model.Option (Model.Alternation + [ Model.Concatenation [ Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "one")))] + , Model.Concatenation [Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "other")))] + ])) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules Option.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef Option.ref of + Nothing -> HUnit.assertFailure $ "expected Option ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string into model with error: [" ++ msg ++ "]") + return + (Option.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/ProseVal/Test.hs view
@@ -0,0 +1,59 @@+module Data.BAByNF.ABNF.Rules.ProseVal.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.ProseVal qualified as ProseVal + + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.ProseVal" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint ProseVal.rule @?= "prose-val = \"<\" *(%x20-3D / %x3F-7E) \">\"" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "<this is prose!>" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules ProseVal.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("<this is prose!>", Model.ProseVal (stringAsBytesUnsafe "this is prose!")) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules ProseVal.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef ProseVal.ref of + Nothing -> HUnit.assertFailure $ "expected ProseVal ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string into model with error: [" ++ msg ++ "]") + return + (ProseVal.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/QuotedString/Test.hs view
@@ -0,0 +1,62 @@+module Data.BAByNF.ABNF.Rules.QuotedString.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.QuotedString qualified as QuotedString + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.QuotedString" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint QuotedString.rule @?= "quoted-string = DQUOTE *(%x20-21 / %x23-7E) DQUOTE" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "\"\"" + , "\" \"" + , "\" \"" + , "\"this is a quoted string!\"" + , "\"123456789\"" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules QuotedString.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("\"this is a quoted string!\"", Model.QuotedString (stringAsBytesUnsafe "this is a quoted string!")) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules QuotedString.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef QuotedString.ref of + Nothing -> HUnit.assertFailure $ "expected QuotedString ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string into model with error: [" ++ msg ++ "]") + return + (QuotedString.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/Repeat/Test.hs view
@@ -0,0 +1,68 @@+module Data.BAByNF.ABNF.Rules.Repeat.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.Repeat qualified as Repeat + + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.Repeat" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint Repeat.rule @?= "repeat = 1*DIGIT / (*DIGIT \"*\" *DIGIT)" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "2" + , "15" + , "*" + , "15*" + , "*8" + , "1*4" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules Repeat.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("2", Model.FixedRepeat 2) + , ("15*", Model.RangedRepeat (Model.FixedBound 15) Model.UnBound) + , ("*8", Model.RangedRepeat Model.UnBound (Model.FixedBound 8)) + , ("1*4", Model.RangedRepeat (Model.FixedBound 1) (Model.FixedBound 4)) + , ("*", Model.RangedRepeat Model.UnBound Model.UnBound) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules Repeat.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef Repeat.ref of + Nothing -> HUnit.assertFailure $ "expected Repeat ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string into model with error: [" ++ msg ++ "]") + return + (Repeat.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/Repetition/Test.hs view
@@ -0,0 +1,67 @@+module Data.BAByNF.ABNF.Rules.Repetition.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.Repetition qualified as Repetition + + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.Repetition" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint Repetition.rule @?= "repetition = [repeat] element" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "ground-hog" + , "2ground-hog" + , "1*ground-hog" + , "*ground-hog" + , "*2ground-hog" + , "*%xFF" + , "*(some group)" + , "*\"some text\"" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules Repetition.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("ground-hog", Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "ground-hog")))) + , ("2ground-hog", Model.Repetition (Model.FixedRepeat 2) (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "ground-hog")))) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules Repetition.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef Repetition.ref of + Nothing -> HUnit.assertFailure $ "expected Repetition ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string into model with error: [" ++ msg ++ "]") + return + (Repetition.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/Rule/Test.hs view
@@ -0,0 +1,71 @@+module Data.BAByNF.ABNF.Rules.Rule.Test where + +import Data.Functor ((<&>)) +import Data.List qualified as List + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.Rule qualified as Rule +import Data.BAByNF.ABNF.Model qualified as Model + + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.Rule" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint Rule.rule @?= "rule = rulename defined-as elements c-nl" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "rule = rulename defined-as elements c-nl\r\n" + , "rule = rulename defined-as elements c-nl; continues if next line starts\r\n" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules Rule.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("rule = rulename defined-as elements c-nl\r\n", Model.Rule + (Model.Rulename (stringAsBytesUnsafe "rule")) Model.BasicDefinition + ( Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + $ [ Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "rulename"))) + , Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "defined-as"))) + , Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "elements"))) + , Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "c-nl"))) + ]) + ) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules Rule.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef Rule.ref of + Nothing -> HUnit.assertFailure $ "expected Rule ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string into model with error: [" ++ msg ++ "]") + return + (Rule.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/Rulelist/Test.hs view
@@ -0,0 +1,88 @@+module Data.BAByNF.ABNF.Rules.Rulelist.Test where + +import Data.Functor ((<&>)) +import Data.List qualified as List + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Core.Tree qualified as Tree +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.Rulelist qualified as Rulelist +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.Rulelist" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint Rulelist.rule @?= "rulelist = 1*(rule / (*c-wsp c-nl))" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "rule = rulename defined-as elements c-nl\r\n" + , "rule1 = %x02-0F\r\nrule2 = \"something else\"\r\n" + , "\r\n" + , "ruleX = <this> / <that>; some comment\r\nruleY = \"impossible\"\r\n" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules Rulelist.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("rule = rulename defined-as elements c-nl\r\n", Model.Rulelist [ + Model.Rule (Model.Rulename (stringAsBytesUnsafe "rule")) Model.BasicDefinition + ( Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + $ [ Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "rulename"))) + , Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "defined-as"))) + , Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "elements"))) + , Model.Repetition Model.NoRepeat (Model.RulenameElement (Model.Rulename (stringAsBytesUnsafe "c-nl"))) + ]) + ]) + , ("ruleX = <this> / <that>; some comment\r\nruleY = \"impossible\"\r\n", Model.Rulelist [ + Model.Rule (Model.Rulename (stringAsBytesUnsafe "ruleX")) Model.BasicDefinition + ( Model.Elements + . Model.Alternation + $ [ Model.Concatenation . List.singleton $ Model.Repetition Model.NoRepeat (Model.ProseValElement (Model.ProseVal (stringAsBytesUnsafe "this"))) + , Model.Concatenation . List.singleton $ Model.Repetition Model.NoRepeat (Model.ProseValElement (Model.ProseVal (stringAsBytesUnsafe "that"))) + ]) + , Model.Rule (Model.Rulename (stringAsBytesUnsafe "ruleY")) Model.BasicDefinition + ( Model.Elements + . Model.Alternation + . List.singleton + . Model.Concatenation + . List.singleton + $ Model.Repetition Model.NoRepeat (Model.CharValElement (Model.CaseInsensitiveCharVal (Model.CaseInsensitiveString (Model.QuotedString (stringAsBytesUnsafe "impossible"))))) + ) + ]) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules Rulelist.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef Rulelist.ref of + Nothing -> HUnit.assertFailure $ "expected Rulelist ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + model <- either + (\msgs -> HUnit.assertFailure $ "failed to parse provided string into model with errors: [\n" ++ List.intercalate "\n" msgs ++ "\n]") + return + (Rulelist.fromTree subTree) + model @?= o
+ test/Data/BAByNF/ABNF/Rules/Rulename/Test.hs view
@@ -0,0 +1,58 @@+module Data.BAByNF.ABNF.Rules.Rulename.Test where + +import Data.Functor ((<&>)) + +import Test.Tasty qualified as Tasty +import Test.Tasty.HUnit ((@?=)) +import Test.Tasty.HUnit qualified as HUnit + +import Data.BAByNF.Util.Ascii (stringAsBytesUnsafe) + +import Data.BAByNF.Core.Tree qualified as Tree + +import Data.BAByNF.ABNF.Model qualified as Model +import Data.BAByNF.ABNF.Parse (parse) +import Data.BAByNF.ABNF.Rules (rules) +import Data.BAByNF.ABNF.PrettyPrint +import Data.BAByNF.ABNF.Rules.Rulename qualified as Rulename + + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.ABNF.Rules.Rulename" + +testModule :: Tasty.TestTree +testModule = Tasty.testGroup moduleUnderTest + [ testPrettyPrint + , testParse + , testParseIntoModel + ] + +testPrettyPrint :: Tasty.TestTree +testPrettyPrint = HUnit.testCase "prettyPrint" $ + prettyPrint Rulename.rule @?= "rulename = ALPHA *(ALPHA / DIGIT / \"-\")" + +testParse :: Tasty.TestTree +testParse = Tasty.testGroup "parse" $ + [ "something" + , "some20word" + , "simple-lobster" + ] <&> \s -> HUnit.testCase (show s) $ + either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + (const $ return ()) + (parse rules Rulename.ref (stringAsBytesUnsafe s)) + +testParseIntoModel :: Tasty.TestTree +testParseIntoModel = Tasty.testGroup "parseIntoModel" $ + [ ("this-thing-here", Model.Rulename (stringAsBytesUnsafe "this-thing-here")) + ] <&> \(s, o) -> HUnit.testCase (show s) $ + do + tree <- either + (\msg -> HUnit.assertFailure $ "failed to parse provided string with error: [" ++ msg ++ "]") + return + (parse rules Rulename.ref (stringAsBytesUnsafe s)) + subTree <- case Tree.asSingleton tree >>= Tree.getSubtreeIfRef Rulename.ref of + Nothing -> HUnit.assertFailure $ "expected Rulename ref node but result is tree with [" ++ show (length (Tree.nodes tree)) ++ "] children." + Just subTree -> return subTree + let model = Rulename.fromTree subTree + model @?= o
+ test/Data/BAByNF/Util/Ascii/Test.hs view
@@ -0,0 +1,91 @@+module Data.BAByNF.Util.Ascii.Test where + +import Data.Word (Word8) +import Data.Char (chr, ord) + +import qualified Test.Tasty as T +import qualified Test.Tasty.HUnit as TH + +import qualified Data.ByteString as BS + +import qualified Data.BAByNF.Util.Ascii as A + +moduleUnderTest :: String +moduleUnderTest = "Data.BAByNF.Util.Ascii" + +testModule :: T.TestTree +testModule = moduleUnderTest `T.testGroup` + [ rangedCompareTest + , lowerToUpperTest + , eqNoCaseTest + , eqNoCaseSeqTest + , eqNoCaseBSTest + ] + +rangedCompareTest :: T.TestTree +rangedCompareTest = "rangedCompare test" `T.testGroup` + [ "rangedCompare given value below lower bound" `TH.testCase` + ( TH.assertEqual "should be less than" LT (funcUnderTest 1) ) + , "rangedCompare given value equal to lower bound" `TH.testCase` + ( TH.assertEqual "should be equal" EQ (funcUnderTest 2) ) + , "rangedCompare given value between lower and upper bound" `TH.testCase` + ( TH.assertEqual "should be equal" EQ (funcUnderTest 3) ) + , "rangedCompare given value equal to upper bound" `TH.testCase` + ( TH.assertEqual "should be equal" EQ (funcUnderTest 4) ) + , "rangedCompare given value above bound" `TH.testCase` + ( TH.assertEqual "should be greater than" GT (funcUnderTest 5) ) + ] + where funcUnderTest = A.rangedCompare 2 4 :: Word8 -> Ordering + +lowerToUpperTest :: T.TestTree +lowerToUpperTest = "lowerToUpper test" `TH.testCase` ( + mapM_ (uncurry doAssert) $ + [ (input, Just expected) | (input, expected) <- zip ['a'..'z'] ['A'..'Z'] ] ++ + [ (input, Nothing) | input <- ['\0'..'`'] ++ ['{'..'~'] ] + ) + where funcUnderTest input= fromW8 <$> (A.lowerToUpper.toW8) input + msg input expected = "lowerToUpper given " ++ (show input) ++ " should return " ++ (show expected) + doAssert input expected = TH.assertEqual (msg input expected) expected (funcUnderTest input) + +eqNoCaseTest :: T.TestTree +eqNoCaseTest = "eqNoCase test" `TH.testCase` ( + mapM_ (\(a, b, expected) -> doAssert a b expected) $ + [ (a, b, True) | (a, b) <- zip lc uc ++ zip lc lc ++ zip uc lc ++ zip uc uc ] ++ + [ (a, b, False) | a <- ['A'..'Z'] ++ ['a'..'z'], b <- ['\0'..'@'] ++ ['['..'`'] ++ ['{'..'~'] ] + ) + where funcUnderTest a b = A.eqNoCase (toW8 a) (toW8 b) + msg a b expected = "eqNoCase given " ++ show a ++ " and " ++ show b ++ " should return " ++ show expected + lc = ['a'..'z'] + uc = ['A'..'Z'] + doAssert a b expected = TH.assertEqual (msg a b expected) expected (funcUnderTest a b) + +eqNoCaseSeqTest :: T.TestTree +eqNoCaseSeqTest = "eqNoCaseSeq tests" `T.testGroup` + [ "eqNoCaseSeq test - empty" `TH.testCase` ( doAssert "" "" True ) + , "eqNoCaseSeq test - one empty" `TH.testCase` ( doAssert "" "ab;" False) + , "eqNoCaseSeq test - exact same" `TH.testCase` ( doAssert "a! nGr\n." "a! nGr\n." True) + , "eqNoCaseSeq test - case mirror" `TH.testCase` ( doAssert "A! NgR\n." "a! nGr\n." True) + , "eqNoCaseSeq test - different" `TH.testCase` ( doAssert "A1\rnG\\." "Pangolin! Webbed feet..." False) + ] + where funcUnderTest a b = A.eqNoCaseSeq (map toW8 a) (map toW8 b) + msg a b expected = "eqNoCaseSeq given " ++ show a ++ " and " ++ show b ++ " should return " ++ show expected + doAssert a b expected = TH.assertEqual (msg a b expected) expected (funcUnderTest a b) + +eqNoCaseBSTest :: T.TestTree +eqNoCaseBSTest = "eqNoCaseBS test" `T.testGroup` + [ "eqNoCaseBS test - empty" `TH.testCase` ( doAssert "" "" True ) + , "eqNoCaseBS test - one empty" `TH.testCase` ( doAssert "" "ab;" False) + , "eqNoCaseBS test - exact same" `TH.testCase` ( doAssert "a! nGr\n." "a! nGr\n." True) + , "eqNoCaseBS test - case mirror" `TH.testCase` ( doAssert "A! NgR\n." "a! nGr\n." True) + , "eqNoCaseBS test - different" `TH.testCase` ( doAssert "A1\rnG\\." "Pangolin! Webbed feet..." False) + ] + where funcUnderTest a b = A.eqNoCaseBS (BS.pack $ map toW8 a) (BS.pack $ map toW8 b) + msg a b expected = "eqNoCaseBS given " ++ show a ++ " and " ++ show b ++ " should return " ++ show expected + doAssert a b expected = TH.assertEqual (msg a b expected) expected (funcUnderTest a b) + +toW8 :: Char -> Word8 +toW8 = fromIntegral.ord + +fromW8 :: Word8 -> Char +fromW8 = chr.fromIntegral +
+ test/Main.hs view
@@ -0,0 +1,63 @@+module Main (main) where + +import Test.Tasty qualified as Tasty + +import Data.BAByNF.ABNF.Rules.Alternation.Test qualified as ABNF.Rules.Alternation +import Data.BAByNF.ABNF.Rules.BinVal.Test qualified as ABNF.Rules.BinVal +import Data.BAByNF.ABNF.Rules.CaseInsensitiveString.Test qualified as ABNF.Rules.CaseInsensitiveString +import Data.BAByNF.ABNF.Rules.CaseSensitiveString.Test qualified as ABNF.Rules.CaseSensitiveString +import Data.BAByNF.ABNF.Rules.CharVal.Test qualified as ABNF.Rules.CharVal +import Data.BAByNF.ABNF.Rules.CNl.Test qualified as ABNF.Rules.CNl +import Data.BAByNF.ABNF.Rules.Comment.Test qualified as ABNF.Rules.Comment +import Data.BAByNF.ABNF.Rules.Concatenation.Test qualified as ABNF.Rules.Concatenation +import Data.BAByNF.ABNF.Rules.CWsp.Test qualified as ABNF.Rules.CWsp +import Data.BAByNF.ABNF.Rules.DecVal.Test qualified as ABNF.Rules.DecVal +import Data.BAByNF.ABNF.Rules.DefinedAs.Test qualified as ABNF.Rules.DefinedAs +import Data.BAByNF.ABNF.Rules.Element.Test qualified as ABNF.Rules.Element +import Data.BAByNF.ABNF.Rules.Elements.Test qualified as ABNF.Rules.Elements +import Data.BAByNF.ABNF.Rules.Group.Test qualified as ABNF.Rules.Group +import Data.BAByNF.ABNF.Rules.HexVal.Test qualified as ABNF.Rules.HexVal +import Data.BAByNF.ABNF.Rules.NumVal.Test qualified as ABNF.Rules.NumVal +import Data.BAByNF.ABNF.Rules.Option.Test qualified as ABNF.Rules.Option +import Data.BAByNF.ABNF.Rules.ProseVal.Test qualified as ABNF.Rules.ProseVal +import Data.BAByNF.ABNF.Rules.QuotedString.Test qualified as ABNF.Rules.QuotedString +import Data.BAByNF.ABNF.Rules.Repeat.Test qualified as ABNF.Rules.Repeat +import Data.BAByNF.ABNF.Rules.Repetition.Test qualified as ABNF.Rules.Repetition +import Data.BAByNF.ABNF.Rules.Rule.Test qualified as ABNF.Rules.Rule +import Data.BAByNF.ABNF.Rules.Rulelist.Test qualified as ABNF.Rules.Rulelist +import Data.BAByNF.ABNF.Rules.Rulename.Test qualified as ABNF.Rules.Rulename +import Data.BAByNF.ABNF.Parse.Test qualified as ABNF.Parse +import Data.BAByNF.Util.Ascii.Test qualified as Util.Ascii + +main :: IO () +main = Tasty.defaultMain $ + Tasty.testGroup "babynf-test" + [ Tasty.testGroup "module-tests" + [ ABNF.Rules.Alternation.testModule + , ABNF.Rules.BinVal.testModule + , ABNF.Rules.CaseInsensitiveString.testModule + , ABNF.Rules.CaseSensitiveString.testModule + , ABNF.Rules.CharVal.testModule + , ABNF.Rules.CNl.testModule + , ABNF.Rules.Comment.testModule + , ABNF.Rules.Concatenation.testModule + , ABNF.Rules.CWsp.testModule + , ABNF.Rules.DecVal.testModule + , ABNF.Rules.DefinedAs.testModule + , ABNF.Rules.Element.testModule + , ABNF.Rules.Elements.testModule + , ABNF.Rules.Group.testModule + , ABNF.Rules.HexVal.testModule + , ABNF.Rules.NumVal.testModule + , ABNF.Rules.Option.testModule + , ABNF.Rules.ProseVal.testModule + , ABNF.Rules.QuotedString.testModule + , ABNF.Rules.Repeat.testModule + , ABNF.Rules.Repetition.testModule + , ABNF.Rules.Rule.testModule + , ABNF.Rules.Rulelist.testModule + , ABNF.Rules.Rulename.testModule + , ABNF.Parse.testModule + , Util.Ascii.testModule + ] + ]