xml-catalog 0.5.0 → 0.5.0.1
raw patch · 4 files changed
+152/−152 lines, 4 filesdep ~conduitsetup-changed
Dependency ranges changed: conduit
Files
- LICENSE +30/−30
- Setup.lhs +7/−7
- Text/XML/Catalog.hs +91/−91
- xml-catalog.cabal +24/−24
LICENSE view
@@ -1,30 +1,30 @@-Copyright (c)2011, Michael Snoyman - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Michael Snoyman nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +Copyright (c)2011, Michael Snoyman++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Michael Snoyman nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Setup.lhs view
@@ -1,7 +1,7 @@-#!/usr/bin/env runhaskell - -> module Main where -> import Distribution.Simple - -> main :: IO () -> main = defaultMain +#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain
Text/XML/Catalog.hs view
@@ -1,91 +1,91 @@-{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleContexts #-} --- | Used for loading a catalog file, caching DTDs and applying DTDs to --- documents. -module Text.XML.Catalog - ( -- * Catalogs - Catalog - , PubSys (..) - , loadCatalog - -- * Resolving - , resolveURI - ) where - -import Prelude hiding (FilePath) -import qualified Data.Map as Map -import Data.Text (Text) -import qualified Text.XML as X -import Control.Monad (foldM) -import Network.URI.Conduit -import qualified Data.Text as T -import qualified Data.Conduit as C -import Control.Monad.IO.Class (liftIO) - --- | Either a public or system identifier. -data PubSys = Public Text | System Text - deriving (Eq, Show, Ord) - --- | An XML catalog, mapping public and system identifiers to filepaths. -type Catalog = Map.Map PubSys URI - --- | Load a 'Catalog' from the given path. -loadCatalog :: C.ResourceIO m => SchemeMap -> URI -> m Catalog -loadCatalog sm uri = do - X.Document _ (X.Element _ _ ns) _ <- liftIO $ C.runResourceT $ - readURI sm uri C.$$ X.sinkDoc X.def - foldM (addNode Nothing) Map.empty ns - where - addNode mbase0 c (X.NodeElement (X.Element name as ns)) = do - c'' <- c' - foldM (addNode mbase) c'' ns - where - mbase = maybe mbase0 Just $ lookup "{http://www.w3.org/XML/1998/namespace}base" as - withBase = maybe id T.append mbase - - c' = - case name of - "{urn:oasis:names:tc:entity:xmlns:xml:catalog}public" -> - case (lookup "publicId" as, lookup "uri" as) of - (Just pid, Just ref) -> - case parseURIReference (withBase ref) >>= flip relativeTo uri of - Just uri' -> return $ Map.insert (Public pid) uri' c - Nothing -> return c - _ -> return c - "{urn:oasis:names:tc:entity:xmlns:xml:catalog}system" -> - case (lookup "systemId" as, lookup "uri" as) of - (Just sid, Just ref) -> - case parseURIReference (withBase ref) >>= flip relativeTo uri of - Just uri' -> return $ Map.insert (System sid) uri' c - Nothing -> return c - _ -> return c - "{urn:oasis:names:tc:entity:xmlns:xml:catalog}nextCatalog" -> - case lookup "catalog" as of - Just catalog -> - case parseURIReference catalog >>= flip relativeTo uri of - Just uri' -> do - c'' <- loadCatalog sm uri' - return $ c'' `Map.union` c - Nothing -> return c - Nothing -> return c - _ -> return c - addNode _ c _ = return c - -resolveURI :: Catalog - -> Maybe URI -- ^ base URI for relative system identifiers - -> X.ExternalID - -> Maybe URI -resolveURI catalog mbase (X.PublicID public system) = - case Map.lookup (Public public) catalog of - Nothing -> resolveURI catalog mbase (X.SystemID system) - Just x -> Just x -resolveURI catalog mbase (X.SystemID system) = - case Map.lookup (System system) catalog of - Nothing -> - case parseURI system of - Just uri -> Just uri - Nothing -> do - base <- mbase - ref <- parseURIReference system - ref `relativeTo` base - Just x -> Just x +{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+-- | Used for loading a catalog file, caching DTDs and applying DTDs to+-- documents.+module Text.XML.Catalog+ ( -- * Catalogs+ Catalog+ , PubSys (..)+ , loadCatalog+ -- * Resolving+ , resolveURI+ ) where++import Prelude hiding (FilePath)+import qualified Data.Map as Map+import Data.Text (Text)+import qualified Text.XML as X+import Control.Monad (foldM)+import Network.URI.Conduit+import qualified Data.Text as T+import qualified Data.Conduit as C+import Control.Monad.IO.Class (liftIO)++-- | Either a public or system identifier.+data PubSys = Public Text | System Text+ deriving (Eq, Show, Ord)++-- | An XML catalog, mapping public and system identifiers to filepaths.+type Catalog = Map.Map PubSys URI++-- | Load a 'Catalog' from the given path.+loadCatalog :: C.ResourceIO m => SchemeMap -> URI -> m Catalog+loadCatalog sm uri = do+ X.Document _ (X.Element _ _ ns) _ <- liftIO $ C.runResourceT $+ readURI sm uri C.$$ X.sinkDoc X.def+ foldM (addNode Nothing) Map.empty ns+ where+ addNode mbase0 c (X.NodeElement (X.Element name as ns)) = do+ c'' <- c'+ foldM (addNode mbase) c'' ns+ where+ mbase = maybe mbase0 Just $ lookup "{http://www.w3.org/XML/1998/namespace}base" as+ withBase = maybe id T.append mbase++ c' =+ case name of+ "{urn:oasis:names:tc:entity:xmlns:xml:catalog}public" ->+ case (lookup "publicId" as, lookup "uri" as) of+ (Just pid, Just ref) ->+ case parseURIReference (withBase ref) >>= flip relativeTo uri of+ Just uri' -> return $ Map.insert (Public pid) uri' c+ Nothing -> return c+ _ -> return c+ "{urn:oasis:names:tc:entity:xmlns:xml:catalog}system" ->+ case (lookup "systemId" as, lookup "uri" as) of+ (Just sid, Just ref) ->+ case parseURIReference (withBase ref) >>= flip relativeTo uri of+ Just uri' -> return $ Map.insert (System sid) uri' c+ Nothing -> return c+ _ -> return c+ "{urn:oasis:names:tc:entity:xmlns:xml:catalog}nextCatalog" ->+ case lookup "catalog" as of+ Just catalog ->+ case parseURIReference catalog >>= flip relativeTo uri of+ Just uri' -> do+ c'' <- loadCatalog sm uri'+ return $ c'' `Map.union` c+ Nothing -> return c+ Nothing -> return c+ _ -> return c+ addNode _ c _ = return c++resolveURI :: Catalog+ -> Maybe URI -- ^ base URI for relative system identifiers+ -> X.ExternalID+ -> Maybe URI+resolveURI catalog mbase (X.PublicID public system) =+ case Map.lookup (Public public) catalog of+ Nothing -> resolveURI catalog mbase (X.SystemID system)+ Just x -> Just x+resolveURI catalog mbase (X.SystemID system) =+ case Map.lookup (System system) catalog of+ Nothing ->+ case parseURI system of+ Just uri -> Just uri+ Nothing -> do+ base <- mbase+ ref <- parseURIReference system+ ref `relativeTo` base+ Just x -> Just x
xml-catalog.cabal view
@@ -1,24 +1,24 @@-Name: xml-catalog -Version: 0.5.0 -Synopsis: Parse XML catalog files -Homepage: http://github.com/snoyberg/xml -License: BSD3 -License-file: LICENSE -Author: Michael Snoyman -Maintainer: michaels@suite-sol.com -Category: Text -Build-type: Simple -Cabal-version: >=1.6 -Description: Parse XML catalog files - -Library - Exposed-modules: Text.XML.Catalog - Build-depends: base >= 4 && < 5 - , text >= 0.11 && < 1.0 - , containers >= 0.2 && < 0.5 - , xml-conduit >= 0.5 && < 0.6 - , uri-conduit >= 0.2 && < 0.3 - , conduit >= 0.0 && < 0.1 - , transformers >= 0.2 && < 0.3 - , bytestring - Ghc-options: -Wall +Name: xml-catalog+Version: 0.5.0.1+Synopsis: Parse XML catalog files+Homepage: http://github.com/snoyberg/xml+License: BSD3+License-file: LICENSE+Author: Michael Snoyman+Maintainer: michaels@suite-sol.com+Category: Text+Build-type: Simple+Cabal-version: >=1.6+Description: Parse XML catalog files++Library+ Exposed-modules: Text.XML.Catalog+ Build-depends: base >= 4 && < 5+ , text >= 0.11 && < 1.0+ , containers >= 0.2 && < 0.5+ , xml-conduit >= 0.5 && < 0.6+ , uri-conduit >= 0.2 && < 0.3+ , conduit+ , transformers >= 0.2 && < 0.3+ , bytestring+ Ghc-options: -Wall