diff --git a/abnf.cabal b/abnf.cabal --- a/abnf.cabal +++ b/abnf.cabal @@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: abnf -version: 0.3.2.0 +version: 0.4.0.0 synopsis: Parse ABNF and generate parsers for the specified document description: You can use this library to parse an ABNF document and generate a parser from that ABNF to read a document @@ -52,7 +52,7 @@ Document, Util hs-source-dirs: test - build-depends: base >= 4.8 && <4.9, + build-depends: base >= 4.8 && <4.10, text, containers, test-framework, diff --git a/src/Text/ABNF/Document.hs b/src/Text/ABNF/Document.hs --- a/src/Text/ABNF/Document.hs +++ b/src/Text/ABNF/Document.hs @@ -13,7 +13,6 @@ -- * Document types -- | Re-exported from "Text.ABNF.Document.Types" Document(..) - , Content(..) -- * Reducing documents -- | Re-exported from "Text.ABNF.Document.Operations" -- @@ -26,7 +25,6 @@ , filterDocument , squashDocument , squashDocumentOn - , squashContent , lookupDocument -- * Parsing documents -- | Re-exported from "Text.ABNF.Document.Parser" @@ -35,13 +33,11 @@ ) where import Text.ABNF.Document.Types ( Document(..) - , Content(..) ) import Text.ABNF.Document.Operations ( filterDocument , squashDocument , squashDocumentOn - , squashContent , lookupDocument ) diff --git a/src/Text/ABNF/Document/Operations.hs b/src/Text/ABNF/Document/Operations.hs --- a/src/Text/ABNF/Document/Operations.hs +++ b/src/Text/ABNF/Document/Operations.hs @@ -13,7 +13,6 @@ import Control.Monad (join) import Data.Maybe (catMaybes) -import Data.Monoid ((<>)) import qualified Data.Text as Text import Text.ABNF.Document.Types @@ -25,44 +24,36 @@ -> Maybe (Document a) -- ^ Returns 'Nothing' if the -- predicate fails, cascades -- otherwise -filterDocument pred doc@(Document ident conts) | pred doc = Just . Document ident $ (catMaybes . fmap filterNT $ conts) - | otherwise = Nothing - where - filterNT :: Content a -> Maybe (Content a) - filterNT a@(Terminal _) = Just a - filterNT (NonTerminal doc) | pred doc = NonTerminal <$> filterDocument pred doc - | otherwise = Nothing +filterDocument pred term@(Terminal _) | pred term = Just term + | otherwise = Nothing +filterDocument pred doc@(Document ident conts) + | pred doc = Just . Document ident $ (catMaybes . fmap (filterDocument pred) $ conts) + | otherwise = Nothing + -- | Squash all contents of a 'Document' into a single 'Terminal' squashDocument :: Monoid a => Document a -> Document a -squashDocument (Document ident conts) = Document ident [Terminal $ squashContent conts] +squashDocument term@(Terminal _) = term +squashDocument doc@(Document ident _) = Document ident [Terminal $ getContent doc] +getContent :: Monoid a => Document a -> a +getContent (Terminal a) = a +getContent (Document _ conts) = mconcat (fmap getContent conts) + -- | Squash all contents of a 'Document' which matches the predicate -- See also 'squashDocument' squashDocumentOn :: forall a. Monoid a => (Document a -> Bool) -> Document a -> Document a -squashDocumentOn pred doc@(Document ident conts) | pred doc = squashDocument doc - | otherwise = Document ident (squashNT <$> conts) - where - squashNT :: Content a -> Content a - squashNT (Terminal a) = Terminal a - squashNT (NonTerminal doc) = NonTerminal $ squashDocumentOn pred doc - --- | Squash all contents using the 'Monoid' instance of @a@, cascading into --- 'NonTerminal's. -squashContent :: Monoid a => [Content a] -> a -squashContent [] = mempty -squashContent ((Terminal a):xs) = a <> squashContent xs -squashContent ((NonTerminal (Document _ conts)):xs) = squashContent conts <> squashContent xs +squashDocumentOn pred doc@(Document ident conts) + | pred doc = squashDocument doc + | otherwise = Document ident (squashDocumentOn pred <$> conts) +squashDocumentOn _ term@(Terminal _) = term -- | Looks up nested 'Document's with a particular identifier. -- NB: Will not recurse into matching documents. lookupDocument :: forall a. Text.Text -- ^ Identifier to search for -> Document a -- ^ 'Document' to search in -> [Document a] -lookupDocument ident doc@(Document ident2 conts) | ident2 == ident = [doc] - | otherwise = join $ lookupNT <$> conts - where - lookupNT :: Content a -> [Document a] - lookupNT (Terminal _) = [] - lookupNT (NonTerminal d) = lookupDocument ident d - +lookupDocument _ (Terminal _) = [] +lookupDocument ident doc@(Document ident2 conts) + | ident2 == ident = [doc] + | otherwise = join $ lookupDocument ident <$> conts diff --git a/src/Text/ABNF/Document/Parser.hs b/src/Text/ABNF/Document/Parser.hs --- a/src/Text/ABNF/Document/Parser.hs +++ b/src/Text/ABNF/Document/Parser.hs @@ -46,14 +46,14 @@ parseRule :: Rule -> Parser (Document T.Text) parseRule (Rule ident _ spec) = Document ident <$> parseSumSpec spec "Rule" -parseSumSpec :: SumSpec -> Parser [Content T.Text] +parseSumSpec :: SumSpec -> Parser [Document T.Text] parseSumSpec (SumSpec prodspecs) = asum (map parseProdSpec prodspecs) "Sum" -parseProdSpec :: ProductSpec -> Parser [Content T.Text] +parseProdSpec :: ProductSpec -> Parser [Document T.Text] parseProdSpec (ProductSpec reps) = join <$> (sequence $ map parseRepetition reps) "Product" -parseRepetition :: Repetition -> Parser [Content T.Text] +parseRepetition :: Repetition -> Parser [Document T.Text] -- any number of times parseRepetition (Repetition (Repeat 0 Nothing) elem) = join <$> (many $ parseElem elem) @@ -75,14 +75,14 @@ liftA2 (++) (parseElem elem) (parseRepetition (Repetition (Repeat (n-1) x) elem)) -parseElem :: Element -> Parser [Content T.Text] -parseElem (RuleElement rule) = toList . NonTerminal <$> parseRule rule "Rule element" +parseElem :: Element -> Parser [Document T.Text] +parseElem (RuleElement rule) = toList <$> parseRule rule "Rule element" parseElem (RuleElement' ruleName) = fail . T.unpack $ "Unknown rule: " <> ruleName parseElem (GroupElement (Group spec)) = parseSumSpec spec "Group element" parseElem (OptionElement (Group spec)) = parseSumSpec spec <|> pure [] "Optional element" parseElem (LiteralElement lit) = parseLiteral lit "Literal element" -parseLiteral :: Literal -> Parser [Content T.Text] +parseLiteral :: Literal -> Parser [Document T.Text] parseLiteral (CharLit lit) = toList . Terminal <$> asciiCI lit "String literal" parseLiteral (NumLit lit) = toList . Terminal <$> parseNumLit lit diff --git a/src/Text/ABNF/Document/Types.hs b/src/Text/ABNF/Document/Types.hs --- a/src/Text/ABNF/Document/Types.hs +++ b/src/Text/ABNF/Document/Types.hs @@ -17,23 +17,10 @@ -- You can use 'Text.ABNF.Document.filterDocument' and -- 'Text.ABNF.Document.squashDocumentOn' to reduce the tree into a more -- managable shape. -data Document a = Document Text.Text [Content a] - deriving (Show, Eq) - -data Content a = Terminal a - | NonTerminal (Document a) - deriving (Show, Eq) +data Document a = Document Text.Text [Document a] + | Terminal a + deriving (Show, Eq) instance Functor Document where fmap f (Document ident conts) = Document ident $ fmap (fmap f) conts - -instance Functor Content where fmap f (Terminal a) = Terminal $ f a - fmap f (NonTerminal doc) = NonTerminal $ fmap f doc - -instance Applicative Content - -instance Monad Content where - return = Terminal - Terminal a >>= f = f a - NonTerminal (Document ident cs) >>= f = NonTerminal (Document ident (map (>>= f) cs)) diff --git a/test/Document.hs b/test/Document.hs --- a/test/Document.hs +++ b/test/Document.hs @@ -38,7 +38,7 @@ in testGroup "element" $ [ testCase "RuleElement" $ testElem (RuleElement $ simpleRule "x" wsElement) " " - [NonTerminal (Document "x" [Terminal " "])] + [Document "x" [Terminal " "]] , testCase "GroupElement" $ testElem (GroupElement (Group (simpleSum wsElement))) " " [Terminal " "]