dtd-text 0.1.1.0 → 0.1.1.1
raw patch · 2 files changed
+52/−41 lines, 2 files
Files
- Data/XML/DTD/Parse.hs +51/−39
- dtd-text.cabal +1/−2
Data/XML/DTD/Parse.hs view
@@ -71,7 +71,7 @@ import Data.Attoparsec.Combinator (many, manyTill, choice, sepBy1) import Data.Functor ((<$>)) import Control.Applicative (pure, optional, (<*>), (<*), (*>), (<|>))-import Control.Monad (guard)+import Control.Monad (guard, join) import Data.Text (Text) import Data.Char (isSpace) import qualified Data.Text as T@@ -80,16 +80,16 @@ import Data.Maybe (fromMaybe, catMaybes) import Data.List (groupBy) --- | Parse a DTD while fully resolving the values of all parameter--- entities whose values are provided internally in the DTD. If the--- syntax of the DTD is invalid, all declarations up to the first--- invalid one are returned.+-- | Parse a DTD from lazy 'L.Text' while fully resolving the values+-- of all parameter entities whose values are provided internally in+-- the DTD. If the syntax of the DTD is invalid, all declarations up+-- to the first invalid one are returned. parseDTD :: L.Text -> DTD parseDTD = parseDTDWithExtern M.empty --- | Parse a DTD while fully resolving the values of parameter--- entities. The given table of values is used to resolve external--- parameter entities.+-- | Parse a DTD from lazy 'L.Text' while fully resolving the values+-- of parameter entities. The given table of values is used to resolve+-- external parameter entities. -- -- If you need information from the DTD itself to look up the external -- entities, such as system and public IDs, you might be able to get@@ -111,18 +111,18 @@ | PMarkup [MarkupText] deriving (Eq, Show) --- | Markup text is interspersed quoted 'Text, unquoted 'Text', and+-- | Markup text is interspersed quoted 'Text', unquoted 'Text', and -- parameter entity references. data MarkupText = MTUnquoted Text | MTQuoted Text | MTPERef PERef deriving (Eq, Show) --- | A symbol table for internal parameter entity resolution. A symbol--- can be marked as defined without a value. That allows us to attempt--- to produce a useful parse even when some information is missing,--- e.g., when there are undefined external parameter entities.+-- | A symbol table for internal parameter entity resolution. type IntSymTable = M.Map Text (Maybe [EntityValue]) --- | A symbol table for external parameter entity resolution.+-- | A symbol table for external parameter entity resolution. The+-- symbol table maps strict 'Text' names to lazy 'L.Text' values.+-- Typically, the values will have been retrieved from an external+-- resource such as a file or URL. type SymTable = M.Map Text L.Text -- | Parse the components of a DTD, given the current symbol table of@@ -130,14 +130,27 @@ parseCmps :: SymTable -> IntSymTable -> L.Text -> [DTDComponent] parseCmps ext int = handlePre . parse (preparse <* skipWS) where- handlePre (Done c (PPERef r)) = parseCmps ext int . L.concat $- map L.fromStrict (renderPERef int r) ++ [c]+ handlePre (Done c (PPERef r)) = handlePERef ext int c r handlePre (Done c (PComment t)) = DTDComment t : parseCmps ext int c handlePre (Done c (PInstruction i)) = DTDInstruction i : parseCmps ext int c handlePre (Done c (PMarkup m)) = handleMarkup ext int c m handlePre _ = [] +-- | To handle a pre-parsed parameter entity reference, try to resolve+-- it. If it resolves, push the resolved text back into the input+-- stream and rescan. Otherwise, just drop it into the output as is+-- and move on.+handlePERef :: SymTable -> IntSymTable -> L.Text -> Text -> [DTDComponent]+handlePERef ext int cont name = maybe moveOn rescan refVal+ where+ moveOn = DTDPERef name : parseCmps ext int cont+ rescan = (++ parseCmps ext int cont) .+ parseCmps ext intNoRecurse .+ L.concat . map (L.fromStrict . renderValue)+ refVal = join $ M.lookup name int+ intNoRecurse = M.insert name Nothing int+ -- | Pre-parse a single DTD component at the beginning of the current -- input text. Pre-parsing separates components that need parameter -- entity replacement from those that do not.@@ -179,7 +192,10 @@ handleCmp _ = [] -- | Render pre-parsed markup as text, resolving parameter entities as--- needed.+-- needed. Note that parameter entities inside quoted strings are not+-- resolved here; if later we recognize that the string is the value+-- being asigned to an entity in an entity declaration, we will+-- resolve the parameter then. renderMarkup :: IntSymTable -> [MarkupText] -> Text renderMarkup syms = T.concat . concatMap render where@@ -191,7 +207,8 @@ -- entity references in its value if it is internal, and updating the -- internal symbol table if it is a parameter entity declaration. We -- allow re-declaration of parameter entities, although that is--- forbidded by the XML spec, but we ignore the new declaration.+-- forbidden by the XML spec, but we ignore the new declaration when+-- resolving parameter entities. handleEntity :: SymTable -> IntSymTable -> L.Text -> EntityDecl -> [DTDComponent] handleEntity ext int cont e = DTDEntityDecl e' : parseCmps ext int' cont@@ -201,45 +218,40 @@ InternalParameterEntityDecl n val -> ipe n val ExternalParameterEntityDecl n _ -> epe n other -> (other, int)- ige n v = (InternalGeneralEntityDecl n $ resolveValue int n v, int)- ipe n v = let v' = resolveValue int n v- in (InternalParameterEntityDecl n v',- M.insertWith (const id) n (Just v') int)- epe n = (e, M.insertWith (const id) n (resolveEPE n <$> M.lookup n ext) int)- resolveEPE n =- resolveValue int n . fromMaybe [] . maybeResult . parse parseEPE+ ige n v = (InternalGeneralEntityDecl n $ resolveValue int v, int)+ ipe n v = let v' = resolveValue int v+ in (InternalParameterEntityDecl n v', insertPE n v')+ epe n = (e, maybe int (insertPE n) $ resolveEPE n)+ 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 $ EntityPERef <$> try pERef <|> EntityText <$> takeTill (== '%') -- | Resolve nested parameter entity references in the value string--- for a parameter entity declaration. Make sure that the name of--- entity being declared does not appear recursively in its--- definition.-resolveValue :: IntSymTable -> Text -> [EntityValue] -> [EntityValue]-resolveValue syms name = coalesce . map noRecursion . concatMap resolve+-- for an entity declaration.+resolveValue :: IntSymTable -> [EntityValue] -> [EntityValue]+resolveValue syms = concatMap combine . groupBy bothText . concatMap resolve where- resolve e@(EntityPERef r) = fromMaybe [e] . fromMaybe Nothing $- M.lookup r syms+ resolve e@(EntityPERef r) = fromMaybe [e] . join $ M.lookup r syms resolve e = [e] - noRecursion (EntityPERef r) | r == name = EntityText $ T.append "ERR" name- noRecursion e = e-- coalesce = concatMap combine . groupBy bothText bothText (EntityText {}) (EntityText {}) = True bothText _ _ = False+ combine es@(EntityText {}:_) = [EntityText . T.concat . catMaybes $ map justText es] combine es = es+ justText (EntityText t) = Just t- justText e = Nothing+ justText _ = Nothing -- | Render a parameter entity reference (which is not inside a quoted -- value string in an entity declaration) as 'Text'. Render nested PEs -- whose value is not known as textual PE refs. Insert a space before -- and after the replacement text, as per the XML specification. renderPERef :: IntSymTable -> PERef -> [Text]-renderPERef syms ref = maybe [pERefText ref] render . fromMaybe Nothing $+renderPERef syms ref = maybe [pERefText ref] render . join $ M.lookup ref syms where render = (" " :) . (++ [" "]) . map renderValue@@ -491,6 +503,6 @@ manyTillS :: Parser a -> Parser Text -> Parser [a] manyTillS = manyTill - -- | Create a two-element list.+-- | Create a two-element list. list2 :: a -> a -> [a] list2 x y = [x, y]
dtd-text.cabal view
@@ -1,5 +1,5 @@ name: dtd-text-version: 0.1.1.0+version: 0.1.1.1 synopsis: Parse and render XML DTDs description: This library provides an attoparsec-text parser and blaze-builder for@@ -8,7 +8,6 @@ license-file: license.txt author: Yitzchak Gale maintainer: gale@sefer.org-category: Data, Text, XML build-type: Simple cabal-version: >=1.6 category: Data, Text, XML, Parsing