xml-catalog 0.2.0 → 0.3.0.1
raw patch · 4 files changed
+147/−151 lines, 4 filesdep ~uri-enumeratorsetup-changed
Dependency ranges changed: uri-enumerator
Files
- LICENSE +30/−30
- Setup.lhs +7/−7
- Text/XML/Catalog.hs +88/−92
- xml-catalog.cabal +22/−22
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,92 +1,88 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE DeriveDataTypeable #-}--- | 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.Enumerator-import qualified Data.Text as T-import Control.Monad.IO.Class (MonadIO)---- | 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 :: MonadIO m => SchemeMap m -> URI -> m Catalog-loadCatalog sm uri = do- X.Document _ (X.Element _ _ ns) _ <- X.parseEnum_ X.def $ readURI sm uri- foldM addNode Map.empty ns- where- addNode c (X.NodeElement (X.Element name as ns)) = do- c'' <- c'- foldM addNode c'' ns- where- -- FIXME handle hierarchies- base =- case lookup "{http://www.w3.org/XML/1998/namespace}base" as of- Nothing -> ""- Just x -> x- withBase = T.append base-- 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 #-} +-- | 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.Enumerator +import qualified Data.Text as T +import Control.Monad.IO.Class (MonadIO) + +-- | 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 :: MonadIO m => SchemeMap m -> URI -> m Catalog +loadCatalog sm uri = do + X.Document _ (X.Element _ _ ns) _ <- X.parseEnum_ X.def $ readURI sm uri + 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,22 +1,22 @@-Name: xml-catalog-Version: 0.2.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-enumerator >= 0.4 && < 0.5- , uri-enumerator >= 0.0 && < 0.1- , transformers >= 0.2 && < 0.3- Ghc-options: -Wall+Name: xml-catalog +Version: 0.3.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-enumerator >= 0.4 && < 0.5 + , uri-enumerator >= 0.1 && < 0.2 + , transformers >= 0.2 && < 0.3 + Ghc-options: -Wall