{-# LANGUAGE OverloadedStrings #-}{-# LANGUAGE DeriveDataTypeable #-}{-# LANGUAGE FlexibleContexts #-}-- | Used for loading a catalog file, caching DTDs and applying DTDs to-- documents.moduleText.XML.Catalog(-- * CatalogsCatalog,PubSys(..),loadCatalog-- * Resolving,resolveURI)whereimportPreludehiding(FilePath)importqualifiedData.MapasMapimportData.Text(Text)importqualifiedText.XMLasXimportControl.Monad(foldM)importNetwork.URI.ConduitimportqualifiedData.TextasTimportqualifiedData.ConduitasCimportControl.Monad.IO.Class(MonadIO,liftIO)-- | Either a public or system identifier.dataPubSys=PublicText|SystemTextderiving(Eq,Show,Ord)-- | An XML catalog, mapping public and system identifiers to filepaths.typeCatalog=Map.MapPubSysURI-- | Load a 'Catalog' from the given path.loadCatalog::MonadIOm=>SchemeMap->URI->mCatalogloadCatalogsmuri=doX.Document_(X.Element__ns)_<-liftIO$C.runResourceT$readURIsmuriC.$$X.sinkDocX.deffoldM(addNodeNothing)Map.emptynswhereaddNodembase0c(X.NodeElement(X.Elementnameasns))=doc''<-c'foldM(addNodembase)c''nswherembase=maybembase0Just$lookup"{http://www.w3.org/XML/1998/namespace}base"aswithBase=maybeidT.appendmbasec'=casenameof"{urn:oasis:names:tc:entity:xmlns:xml:catalog}public"->case(lookup"publicId"as,lookup"uri"as)of(Justpid,Justref)->caseparseURIReference(withBaseref)>>=fliprelativeTouriofJusturi'->return$Map.insert(Publicpid)uri'cNothing->returnc_->returnc"{urn:oasis:names:tc:entity:xmlns:xml:catalog}system"->case(lookup"systemId"as,lookup"uri"as)of(Justsid,Justref)->caseparseURIReference(withBaseref)>>=fliprelativeTouriofJusturi'->return$Map.insert(Systemsid)uri'cNothing->returnc_->returnc"{urn:oasis:names:tc:entity:xmlns:xml:catalog}nextCatalog"->caselookup"catalog"asofJustcatalog->caseparseURIReference(withBasecatalog)>>=fliprelativeTouriofJusturi'->doc''<-loadCatalogsmuri'return$c''`Map.union`cNothing->returncNothing->returnc_->returncaddNode_c_=returncresolveURI::Catalog->MaybeURI-- ^ base URI for relative system identifiers->X.ExternalID->MaybeURIresolveURIcatalogmbase(X.PublicIDpublicsystem)=caseMap.lookup(Publicpublic)catalogofNothing->resolveURIcatalogmbase(X.SystemIDsystem)Justx->JustxresolveURIcatalogmbase(X.SystemIDsystem)=caseMap.lookup(Systemsystem)catalogofNothing->caseparseURIsystemofJusturi->JusturiNothing->dobase<-mbaseref<-parseURIReferencesystemref`relativeTo`baseJustx->Justx