dtd 0.5.1.1 → 0.6.0
raw patch · 5 files changed
+71/−125 lines, 5 filesdep ~attoparsec-conduitdep ~conduitdep ~uri-conduitPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: attoparsec-conduit, conduit, uri-conduit, xml-catalog, xml-conduit
API changes (from Hackage documentation)
- Data.DTD.Parse: enumFile :: (MonadBaseControl IO m, MonadResource m) => FilePath -> Source m DTDComponent
+ Data.DTD.Parse: enumFile :: (MonadBaseControl IO m, MonadResource m) => FilePath -> Pipe l i DTDComponent u m ()
- Data.DTD.Parse: readEID :: (MonadResource m, MonadBaseControl IO m) => Catalog -> ExternalID -> SchemeMap -> Source m DTDComponent
+ Data.DTD.Parse: readEID :: (MonadResource m, MonadBaseControl IO m) => Catalog -> ExternalID -> SchemeMap -> Pipe l i DTDComponent u m ()
Files
- Data/DTD/Cache.hs +4/−4
- Data/DTD/Parse.hs +43/−48
- Data/DTD/Render.hs +1/−2
- Data/DTD/Types/Unresolved.hs +17/−65
- dtd.cabal +6/−6
Data/DTD/Cache.hs view
@@ -27,7 +27,7 @@ import Network.URI.Conduit.File import qualified Data.DTD.Types as D import Data.DTD.Parse (readEID, uriToEID)-import qualified Data.Conduit as C+import Data.Conduit hiding (Source, Sink, Conduit) import qualified Data.Conduit.List as CL import Control.Monad.IO.Class (MonadIO (liftIO)) import qualified Data.IORef as I@@ -90,7 +90,7 @@ case resolveURI catalog Nothing (X.PublicID uri uri) of Nothing -> throwIO $ UnknownSchemaURI uri Just uri' -> do- doc <- C.runResourceT $ readURI sm uri' C.$$ X.sinkDoc X.def+ doc <- runResourceT $ readURI sm uri' $$ X.sinkDoc X.def let c = fromDocument doc let includes = (c $// element "{http://www.w3.org/2001/XMLSchema}include" >=> attribute "schemaLocation") ++@@ -119,7 +119,7 @@ case Map.lookup pubsys catalog of Nothing -> liftIO $ throwIO $ UnknownExternalID ext Just uri -> do- ecomps <- liftIO $ try $ C.runResourceT $ readEID catalog (uriToEID uri) sm C.$$ CL.consume+ ecomps <- liftIO $ try $ runResourceT $ readEID catalog (uriToEID uri) sm $$ CL.consume comps <- either (liftIO . throwIO . CannotLoadDTD (toNetworkURI uri)) return ecomps let maps = toMaps comps liftIO $ I.atomicModifyIORef icache $ \m ->@@ -166,7 +166,7 @@ go (ents, attrs) (XU.Element name as ns) = do as' <- mapM (resolveAttr ents) as ns' <- mapM gon ns- Right $ X.Element name (as'' as') ns'+ Right $ X.Element name (Map.fromList $ as'' as') ns' where as'' as' = case Map.lookup name attrs of
Data/DTD/Parse.hs view
@@ -25,11 +25,11 @@ import Text.XML.Catalog (resolveURI, Catalog) import Network.URI.Conduit (URI, SchemeMap, readURI, toNetworkURI, toSchemeMap) import Network.URI.Conduit.File (decodeString, fileScheme)-import qualified Data.Conduit as C+import Data.Conduit hiding (Source, Sink, Conduit) import qualified Data.Conduit.Internal as CI import Text.XML.Stream.Parse (detectUtf) import Data.Conduit.Attoparsec (sinkParser)-import Control.Applicative ((*>), (<*), (<|>), (<$>), many)+import Control.Applicative ((*>), (<*), (<|>), many) import qualified Data.IORef as I import Control.Monad.Trans.Control (MonadBaseControl) import qualified Data.Attoparsec.Text as A@@ -38,58 +38,53 @@ type ResolveMonad m = ReaderT ResolveReader m -readEID :: (C.MonadResource m, MonadBaseControl IO m)+readEID :: (MonadResource m, MonadBaseControl IO m) => Catalog -> ExternalID -> SchemeMap- -> C.Source m DTDComponent+ -> Pipe l i DTDComponent u m () readEID catalog eid sm =- C.PipeM pull (return ())- where- pull =- case resolveURI catalog Nothing eid of- Nothing -> liftIO $ throwIO $ CannotResolveExternalID eid- Just uri -> do- istate <- liftIO $ I.newIORef initState- let rr = ResolveReader catalog uri istate sm- return $ readerToEnum rr+ case resolveURI catalog Nothing eid of+ Nothing -> liftIO $ throwIO $ CannotResolveExternalID eid+ Just uri -> do+ istate <- liftIO $ I.newIORef initState+ let rr = ResolveReader catalog uri istate sm+ readerToEnum rr -readerToEnum :: (MonadBaseControl IO m, C.MonadThrow m, MonadIO m, C.MonadResource m)- => ResolveReader -> C.Source m DTDComponent+readerToEnum :: (MonadBaseControl IO m, MonadThrow m, MonadIO m, MonadResource m)+ => ResolveReader -> Pipe l i DTDComponent u m () readerToEnum rr = addCatch src0 where src0 = readURI (rrSchemeMap rr) (rrBase rr)- C.$= detectUtf- C.$= streamUnresolved- C.$= CL.concatMap id- C.$= resolveEnum rr+ >+> detectUtf+ >+> streamUnresolved+ >+> CL.concatMap id+ >+> resolveEnum rr - addCatch (C.HaveOutput src close x) = C.HaveOutput (addCatch src) (addCatch'' close) x- addCatch (C.NeedInput _ src) = addCatch src- addCatch (C.Done l ()) = C.Done l ()- addCatch (C.PipeM msrc close) = C.PipeM (addCatch' $ liftM addCatch msrc) (addCatch'' close)+ addCatch :: (MonadThrow m, MonadBaseControl IO m)+ => Pipe l i o u m r+ -> Pipe l i o u m r+ addCatch (CI.HaveOutput src close x) = CI.HaveOutput (addCatch src) (addCatch' close) x+ addCatch (CI.NeedInput p c) = CI.NeedInput (addCatch . p) (addCatch . c)+ addCatch (CI.Done r) = CI.Done r+ addCatch (CI.PipeM msrc) = CI.PipeM (addCatch' $ liftM addCatch msrc)+ addCatch (CI.Leftover p i) = CI.Leftover (addCatch p) i addCatch' m = m `Lifted.catch` throw rr - addCatch'' (CI.FinalizeM m) = CI.FinalizeM $ m `Lifted.catch` throw rr- addCatch'' (CI.FinalizePure x) = CI.FinalizePure x--throw :: C.MonadThrow m => ResolveReader -> SomeException -> m a+throw :: MonadThrow m => ResolveReader -> SomeException -> m a throw rr e =- C.monadThrow $ OccuredAt (show $ toNetworkURI $ rrBase rr) (ResolveOther e)+ monadThrow $ OccuredAt (show $ toNetworkURI $ rrBase rr) (ResolveOther e) readFile_ :: FilePath -> IO [DTDComponent]-readFile_ fp = C.runResourceT $ enumFile fp C.$$ CL.consume+readFile_ fp = runResourceT $ enumFile fp $$ CL.consume -enumFile :: (MonadBaseControl IO m, C.MonadResource m) => FilePath -> C.Source m DTDComponent-enumFile fp =- C.PipeM pull (return ())- where- pull = do- eid <- filePathToEID fp- return $ readEID Map.empty eid $ toSchemeMap [fileScheme]+enumFile :: (MonadBaseControl IO m, MonadResource m) => FilePath -> Pipe l i DTDComponent u m ()+enumFile fp = do+ eid <- lift $ filePathToEID fp+ readEID Map.empty eid $ toSchemeMap [fileScheme] filePathToEID :: MonadIO m => FilePath -> m ExternalID filePathToEID = liftM uriToEID . liftIO . decodeString@@ -97,20 +92,20 @@ uriToEID :: URI -> ExternalID uriToEID = SystemID . T.pack . show . toNetworkURI -streamUnresolved :: C.MonadThrow m => C.Conduit T.Text m [U.DTDComponent]+streamUnresolved :: MonadThrow m => Pipe l T.Text [U.DTDComponent] r m r streamUnresolved =- C.sequenceSink () $ const $ C.Emit () . return <$> sinkParser p+ injectLeftovers $ CL.sequence $ sinkParser p where p = (UP.ws >> UP.skipWS >> return []) <|> (UP.textDecl >> return []) <|> (UP.dtdComponent >>= return . return) <|> (A.endOfInput >> return []) -resolveEnum :: (MonadBaseControl IO m, C.MonadThrow m, MonadIO m, C.MonadUnsafeIO m)+resolveEnum :: (MonadBaseControl IO m, MonadThrow m, MonadIO m, MonadUnsafeIO m) => ResolveReader- -> C.Conduit U.DTDComponent m DTDComponent+ -> Pipe l U.DTDComponent DTDComponent r m r resolveEnum rr =- C.transPipe (evalStateT' rr)+ transPipe (evalStateT' rr) $ CL.concatMapM resolvef evalStateT' :: Monad m@@ -150,7 +145,7 @@ initState :: ResolveState initState = ResolveState Map.empty Map.empty -resolvef :: (MonadBaseControl IO m, C.MonadThrow m, MonadIO m, C.MonadUnsafeIO m)+resolvef :: (MonadBaseControl IO m, MonadThrow m, MonadIO m, MonadUnsafeIO m) => U.DTDComponent -> ResolveMonad m [DTDComponent] @@ -191,7 +186,7 @@ Nothing -> throwError' $ CannotResolveExternalID eid Just uri -> do let rr' = rr { rrBase = uri }- C.runResourceT $ readerToEnum rr' C.$$ CL.consume+ runResourceT $ readerToEnum rr' $$ CL.consume -- element declarations resolvef (U.DTDElementDecl (U.ElementDecl name' c)) = do@@ -221,7 +216,7 @@ ys <- mapM resolveAttDeclPERef xs return [DTDAttList $ AttList name $ concat ys] -resolveAttDeclPERef :: (MonadIO m, C.MonadThrow m) => U.AttDeclPERef -> ResolveMonad m [AttDecl]+resolveAttDeclPERef :: (MonadIO m, MonadThrow m) => U.AttDeclPERef -> ResolveMonad m [AttDecl] resolveAttDeclPERef (U.ADPDecl (U.AttDecl name typ def)) = do typ' <- case typ of@@ -238,16 +233,16 @@ A.Done "" x -> liftM concat $ mapM (resolveAttDeclPERef . U.ADPDecl) x x -> throwError' $ InvalidAttDecl p t x -throwError' :: C.MonadThrow m => ResolveException' -> ResolveMonad m a+throwError' :: MonadThrow m => ResolveException' -> ResolveMonad m a throwError' e = do uri <- liftM rrBase ask- lift $ C.monadThrow $ OccuredAt (show $ toNetworkURI uri) e+ lift $ monadThrow $ OccuredAt (show $ toNetworkURI uri) e runPartial :: A.Result t -> A.Result t runPartial (A.Partial f) = f "" runPartial r = r -resolvePERefText :: (MonadIO m, C.MonadThrow m) => U.PERef -> ResolveMonad m T.Text+resolvePERefText :: (MonadIO m, MonadThrow m) => U.PERef -> ResolveMonad m T.Text resolvePERefText p = do rs <- get maybe (throwError' $ UnknownPERefText p) return $ Map.lookup p $ rsRefText rs@@ -262,7 +257,7 @@ Nothing -> Left $ UnknownPERefValue p Just t -> Right t -resolveContentModel :: (MonadIO m, C.MonadThrow m) => [U.EntityValue] -> ResolveMonad m ContentDecl+resolveContentModel :: (MonadIO m, MonadThrow m) => [U.EntityValue] -> ResolveMonad m ContentDecl resolveContentModel ev = do rs <- get text <- either throwError' return $ resolveEntityValue rs ev
Data/DTD/Render.hs view
@@ -135,9 +135,8 @@ where name = fromText (entityDeclName d) <> space (pct, val) = case d of- InternalGeneralEntityDecl _ val -> (mempty, quote $ fromText val)+ InternalGeneralEntityDecl _ val' -> (mempty, quote $ fromText val') ExternalGeneralEntityDecl _ eid nt -> (mempty, ege eid nt)- pctBld = fromText "% " ege eid nt = buildExternalID eid <> buildMaybe ((fromText " NDATA " <>) . quote . fromText) nt
Data/DTD/Types/Unresolved.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveDataTypeable #-} ------------------------------------------------------------------------------ -- | -- Module : Data.XML.DTD.Types@@ -70,8 +71,7 @@ where import Data.Text (Text)-import Data.Typeable ( Typeable, TypeRep, typeOf- , mkTyConApp, mkTyCon)+import Data.Typeable (Typeable) import Data.XML.Types (ExternalID, Instruction) -- | A 'DTD' is a sequence components in any order.@@ -79,10 +79,7 @@ { dtdTextDecl :: Maybe DTDTextDecl , dtdComponents :: [DTDComponent] }- deriving (Show, Eq)--instance Typeable DTD where- typeOf = typeString "DTD"+ deriving (Show, Eq, Typeable) -- | The @?xml@ text declaration at the beginning of a DTD. data DTDTextDecl =@@ -90,10 +87,7 @@ { dtdXMLVersion :: Maybe Text , dtdEncoding :: Text }- deriving (Show, Eq)--instance Typeable DTDTextDecl where- typeOf = typeString "DTDTextDecl"+ deriving (Show, Eq, Typeable) -- | The kinds of components that can appear in a 'DTD'. data DTDComponent =@@ -106,10 +100,7 @@ -- the top-level flow of the DTD | DTDInstruction Instruction -- ^ A processing instruction | DTDComment Text -- ^ A comment- deriving (Show, Eq)--instance Typeable DTDComponent where- typeOf = typeString "DTDComponent"+ deriving (Show, Eq, Typeable) -- | A declaration of an entity. An entity is a textual substitution -- variable. General entities can be referenced in an XML document@@ -137,10 +128,7 @@ { entityDeclName :: Text , entityDeclID :: ExternalID }- deriving (Show, Eq)--instance Typeable EntityDecl where- typeOf = typeString "EntityDecl"+ deriving (Show, Eq, Typeable) -- | The value of an internal entity may contain references to -- parameter entities; these references need to be resolved to obtain@@ -149,10 +137,7 @@ data EntityValue = EntityText Text | EntityPERef PERef- deriving (Show, Eq)--instance Typeable EntityValue where- typeOf = typeString "EntityValue"+ deriving (Show, Eq, Typeable) -- | A parameter entity reference. It contains the name of the -- parameter entity that is being referenced.@@ -164,10 +149,7 @@ { eltDeclName :: Either PERef Text , eltDeclContent :: ContentDecl }- deriving (Show, Eq)--instance Typeable ElementDecl where- typeOf = typeString "ElementDecl"+ deriving (Show, Eq, Typeable) -- | The content that can occur in an element. data ContentDecl =@@ -176,28 +158,19 @@ | ContentElement [EntityValue] -- ^ Structured element content | ContentMixed [Text] -- ^ A mixture of text and elements | ContentPERef PERef- deriving (Show, Eq)--instance Typeable ContentDecl where- typeOf = typeString "ContentDecl"+ deriving (Show, Eq, Typeable) -- | A model of structured content for an element. data ContentModel = CMName Text Repeat -- ^ Element name | CMChoice [ContentModel] Repeat -- ^ Choice, delimited by @\"|\"@ | CMSeq [ContentModel] Repeat -- ^ Sequence, delimited by @\",\"@- deriving (Show, Eq)--instance Typeable ContentModel where- typeOf = typeString "ContentModel"+ deriving (Show, Eq, Typeable) -- | The number of times a production of content model syntax can -- repeat. data Repeat = One | ZeroOrOne | ZeroOrMore | OneOrMore- deriving (Show, Eq)--instance Typeable Repeat where- typeOf = typeString "Repeat"+ deriving (Show, Eq, Typeable) -- | A list of attribute declarations for an element. data AttList =@@ -207,10 +180,7 @@ -- declarations apply , attListDecls :: [AttDeclPERef] }- deriving (Show, Eq)--instance Typeable AttList where- typeOf = typeString "AttList"+ deriving (Show, Eq, Typeable) data AttDeclPERef = ADPDecl AttDecl | ADPPERef PERef deriving (Show, Eq)@@ -222,10 +192,7 @@ , attDeclType :: AttTypePERef -- ^ The type of the attribute , attDeclDefault :: AttDefault -- ^ The default value specification }- deriving (Show, Eq)--instance Typeable AttDecl where- typeOf = typeString "AttDecl"+ deriving (Show, Eq, Typeable) data AttTypePERef = ATPType AttType | ATPPERef PERef deriving (Show, Eq)@@ -243,10 +210,7 @@ | AttEnumType [Text] -- ^ One of the given values | AttNotationType [Text] -- ^ Specified by external syntax -- declared as a notation- deriving (Show, Eq)--instance Typeable AttType where- typeOf = typeString "AttType"+ deriving (Show, Eq, Typeable) -- | A default value specification for an attribute. data AttDefault =@@ -257,10 +221,7 @@ -- given value | AttDefaultValue Text -- ^ The attribute has the given default value -- when not supplied- deriving (Show, Eq)--instance Typeable AttDefault where- typeOf = typeString "AttDefault"+ deriving (Show, Eq, Typeable) -- | A declaration of a notation. data Notation =@@ -268,10 +229,7 @@ { notationName :: Text, notationSource :: NotationSource }- deriving (Show, Eq)--instance Typeable Notation where- typeOf = typeString "Notation"+ deriving (Show, Eq, Typeable) -- | A source for a notation. We do not use the usual 'ExternalID' -- type here, because for notations it is only optional, not required,@@ -280,10 +238,4 @@ NotationSysID Text -- ^ A system ID | NotationPubID Text -- ^ A public ID | NotationPubSysID Text Text -- ^ A public ID with a system ID- deriving (Show, Eq)--instance Typeable NotationSource where- typeOf = typeString "NotationSource"--typeString :: String -> a -> TypeRep-typeString str _ = mkTyConApp (mkTyCon ("Data.XML.DTD.Types." ++ str)) []+ deriving (Show, Eq, Typeable)
dtd.cabal view
@@ -1,5 +1,5 @@ Name: dtd-Version: 0.5.1.1+Version: 0.6.0 Synopsis: Parse and render DTD files Homepage: http://github.com/snoyberg/xml License: BSD3@@ -21,17 +21,17 @@ Build-depends: base >= 4 && < 5 , text >= 0.11 && < 1.0 , containers >= 0.2- , xml-conduit >= 0.7 && < 0.8- , uri-conduit >= 0.4 && < 0.5+ , xml-conduit >= 1.0 && < 1.1+ , uri-conduit >= 0.5 && < 0.6 , transformers >= 0.2 && < 0.4 , xml-types >= 0.3 && < 0.4 , attoparsec >= 0.10 && < 0.11 , monad-control >= 0.3 && < 0.4- , xml-catalog >= 0.7 && < 0.8+ , xml-catalog >= 0.8 && < 0.9 , blaze-builder >= 0.3 && < 0.4 , network >= 2.2 && < 2.4 , resourcet >= 0.3 && < 0.4- , conduit >= 0.4.1.1 && < 0.5- , attoparsec-conduit >= 0.4 && < 0.5+ , conduit >= 0.5 && < 0.6+ , attoparsec-conduit >= 0.5 && < 0.6 , lifted-base >= 0.1 && < 0.2 Ghc-options: -Wall