diff --git a/Data/XML/DTD/Parse.hs b/Data/XML/DTD/Parse.hs --- a/Data/XML/DTD/Parse.hs +++ b/Data/XML/DTD/Parse.hs @@ -3,8 +3,9 @@ -- | -- Module : Data.XML.DTD.Parse -- Copyright : Suite Solutions Ltd., Israel 2011 +-- (c) 2013 Montez Fitzpatrick -- --- Maintainer : Yitzchak Gale +-- Maintainer : Montez Fitzpatrick -- Portability : portable -- -- This module provides a "Data.Attoparsec.Text" parser for XML @@ -65,12 +66,12 @@ import Data.XML.Types (ExternalID(PublicID, SystemID), Instruction(Instruction)) import Data.Attoparsec.Text (Parser, try, satisfy, takeTill, - anyChar, char, digit, (<*.), (.*>)) + anyChar, char, digit) import qualified Data.Attoparsec.Text as A -- for takeWhile import Data.Attoparsec.Text.Lazy (parse, Result(Done, Fail), maybeResult) -import Data.Attoparsec.Combinator (many, manyTill, choice, sepBy1) +import Data.Attoparsec.Combinator (many', manyTill, choice, sepBy1) import Data.Functor ((<$>)) -import Control.Applicative (pure, optional, (<*>), (<*), (*>), (<|>)) +import Control.Applicative (Applicative, pure, optional, (<*>), (<*), (*>), (<|>)) import Control.Monad (guard, join) import Data.Text (Text) import Data.Char (isSpace) @@ -171,7 +172,7 @@ ("<" .*> unquoted) <*> manyTillS ((:) . MTQuoted <$> try quoted <*> unquoted) ">" where - unquoted = chunk2 <$> unqText <*> many (list2 <$> pct <*> unqText) + unquoted = chunk2 <$> unqText <*> many' (list2 <$> pct <*> unqText) unqText = MTUnquoted <$> takeTill (`elem` "%>'\"") pct = "%" .*> (MTUnquoted <$> (ws *> pure "% ") <|> MTPERef <$> takeTill (== ';') <*. ";") @@ -225,7 +226,7 @@ insertPE n v = M.insertWith (const id) n (Just v) int resolveEPE n = fmap (resolveValue int) $ M.lookup n ext >>= maybeResult . parse parseEPE - parseEPE = many $ + parseEPE = many' $ EntityPERef <$> try pERef <|> EntityText <$> takeTill (== '%') -- | Resolve nested parameter entity references in the value string @@ -272,7 +273,7 @@ -- them. dtd :: Parser DTD dtd = DTD <$> (skipWS *> optional (textDecl <* skipWS)) <*> - many (dtdComponent <* skipWS) + many' (dtdComponent <* skipWS) -- | Parse an @?xml@ text declaration at the beginning of a 'DTD'. textDecl :: Parser DTDTextDecl @@ -382,7 +383,7 @@ where pcdata = "(" .*> skipWS *> "#PCDATA" .*> skipWS *> (try tags <|> noTagsNoStar) - tags = many ("|" .*> skipWS *> nameSS) <*. ")*" + tags = many' ("|" .*> skipWS *> nameSS) <*. ")*" noTagsNoStar = ")" .*> pure [] -- | Parse the model of structured content for an element. @@ -407,7 +408,7 @@ -- | Parse a list of attribute declarations for an element. attList :: Parser AttList attList = AttList <$> (" ws *> skipWS *> nameSS) <*> - many attDecl <*. ">" + many' attDecl <*. ">" -- | Parse the three-part declaration of an attribute. attDecl :: Parser AttDecl @@ -506,3 +507,15 @@ -- | Create a two-element list. list2 :: a -> a -> [a] list2 x y = [x, y] + +-- This is lifted from attoparsec-text library. +-- | Same as @Applicative@'s @\<*@ but specialized to 'Text' +-- on the second argument. +(<*.) :: Applicative f => f a -> f Text -> f a +(<*.) = (<*) + +-- This is lifted from attoparsec-text library. +-- | Same as @Applicative@'s @*\>@ but specialized to 'Text' +-- on the first argument. +(.*>) :: Applicative f => f Text -> f a -> f a +(.*>) = (*>) diff --git a/Data/XML/DTD/Render.hs b/Data/XML/DTD/Render.hs --- a/Data/XML/DTD/Render.hs +++ b/Data/XML/DTD/Render.hs @@ -3,11 +3,12 @@ -- | -- Module : Data.XML.DTD.Render -- Copyright : Suite Solutions Ltd., Israel 2011 +-- (c) 2013 Montez Fitzpatrick -- --- Maintainer : Yitzchak Gale +-- Maintainer : Montez Fitzpatrick -- Portability : portable -- --- A "Blaze.ByteString.Builder" renderer for XML Document Type +-- A "Data.Text.Lazy.Builder" renderer for XML Document Type -- Declaration (DTD) documents. {- @@ -62,16 +63,15 @@ ) where -import Blaze.ByteString.Builder (Builder) -import Blaze.ByteString.Builder.Char.Utf8 (fromText, fromChar) import Data.XML.DTD.Types import Data.XML.Types (ExternalID(..), Instruction(..)) import Data.Text (Text) +import Data.Text.Lazy.Builder (Builder, fromText, singleton) import Data.Monoid (Monoid(..)) import Data.List (intersperse) import System.IO (nativeNewline, Newline(CRLF)) --- No instance Semigroup Builder yet, so <> defined here manually. ---import Data.Semigroup ((<>)) + +-- Inline Builder combinator (<>) = mappend -- | Build an optional item. @@ -86,19 +86,19 @@ -- | Build a space. space :: Builder -space = fromChar ' ' +space = singleton ' ' -- | Build a quoted string. quote :: Builder -> Builder -quote = (fromChar '"' <>) . (<> fromChar '"') +quote = (singleton '"' <>) . (<> singleton '"') -- | Build a string quoted by angle brackets, with an exclamation mark. pbracket :: Builder -> Builder -pbracket = (fromText ") . (<> fromChar '>') +pbracket = (fromText ") . (<> singleton '>') --- | Build a string surround by parantheses. +-- | Build a string surround by parentheses. parens :: Builder -> Builder -parens = (fromChar '(' <>) . (<> fromChar ')') +parens = (singleton '(' <>) . (<> singleton ')') -- | Build a list of items buildList :: Text -> (a -> Builder) -> [a] -> Builder @@ -162,7 +162,7 @@ -- | A builder for a 'PERef'. buildPERef :: PERef -> Builder -buildPERef r = fromChar '%' <> fromText r <> fromChar ';' +buildPERef r = singleton '%' <> fromText r <> singleton ';' -- | A 'Builder' for an 'ElementDecl'. buildElementDecl :: ElementDecl -> Builder @@ -175,7 +175,7 @@ buildContentDecl ContentAny = fromText "ANY" buildContentDecl (ContentElement cm) = buildContentModel cm buildContentDecl (ContentMixed names) = - buildChoice fromText ("#PCDATA" : names) <> fromChar '*' + buildChoice fromText ("#PCDATA" : names) <> singleton '*' -- | A 'Builder' for a 'ContentModel'. buildContentModel :: ContentModel -> Builder @@ -190,9 +190,9 @@ -- | A 'Builder' for a 'Repeat'. buildRepeat :: Repeat -> Builder buildRepeat One = mempty -buildRepeat ZeroOrOne = fromChar '?' -buildRepeat ZeroOrMore = fromChar '*' -buildRepeat OneOrMore = fromChar '+' +buildRepeat ZeroOrOne = singleton '?' +buildRepeat ZeroOrMore = singleton '*' +buildRepeat OneOrMore = singleton '+' -- | A 'Builder' for an 'AttList'. buildAttList :: AttList -> Builder diff --git a/dtd-text.cabal b/dtd-text.cabal --- a/dtd-text.cabal +++ b/dtd-text.cabal @@ -1,35 +1,33 @@ name: dtd-text -version: 0.1.1.2 +version: 0.1.2.0 synopsis: Parse and render XML DTDs description: - This library provides an attoparsec-text parser and blaze-builder for - XML Document Type Declaration (DTD) documents. + This library provides means to parse XML Document Type Declaration (DTD) documents. license: BSD3 license-file: license.txt -author: Yitzchak Gale -maintainer: gale@sefer.org +author: Yitzchak Gale, + Montez Fitzpatrick +maintainer: Montez Fitzpatrick build-type: Simple cabal-version: >=1.6 category: Data, Text, XML, Parsing stability: experimental -bug-reports: mailto:gale@sefer.org -homepage: http://projects.haskell.org/dtd/ - -source-repository head - type: darcs - location: http://code.haskell.org/dtd/dtd-text/ +bug-reports: https://github.com/m15k/hs-dtd-text/issues +homepage: http://github.com/m15k/hs-dtd-text library build-depends: base >=3 && < 5 , containers - , text + , text >= 0.8 , dtd-types >= 0.3.0.1 && < 1 , xml-types ==0.3.* - , attoparsec >=0.8.0 && < 0.10 - , attoparsec-text ==0.8.* - , blaze-builder ==0.3.* + , attoparsec >=0.10.0 exposed-modules: Data.XML.DTD.Parse Data.XML.DTD.Render + +source-repository head + type: git + location: https://github.com/m15k/hs-dtd-text/