X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FXml.hs;h=780a64e6473815ecd0ec88d4257e4d1ce231373c;hb=refs%2Ftags%2F0.0.5;hp=bbb72be0348d1864ddf3094fda6173769ef247f1;hpb=7815ba497d075c63c76418fc2c2b914ebe56b712;p=dead%2Fhtsn-import.git diff --git a/src/Xml.hs b/src/Xml.hs index bbb72be..780a64e 100644 --- a/src/Xml.hs +++ b/src/Xml.hs @@ -10,7 +10,8 @@ module Xml ( ToDb(..), parse_opts, pickle_unpickle, - unpickleable ) + unpickleable, + unsafe_unpickle ) where -- System imports. @@ -26,8 +27,10 @@ import Text.XML.HXT.Core ( readDocument, runX, withRemoveWS, + withSubstDTDEntities, withValidate, xpickleVal, + xunpickleDocument, xunpickleVal, yes ) @@ -80,7 +83,9 @@ newtype DtdName = DtdName String -- would have to parse whitespace in each (un)pickler. -- parse_opts :: SysConfigList -parse_opts = [ withRemoveWS yes, withValidate no ] +parse_opts = [ withRemoveWS yes, + withSubstDTDEntities no, + withValidate no ] -- | Given an @unpickler@ and a @filepath@, attempt to unpickle the @@ -140,3 +145,11 @@ unpickleable filepath unpickler = do try_unpickle = runX $ readDocument parse_opts filepath >>> xunpickleVal unpickler + + +-- | Unpickle from a 'FilePath' using the given pickler. Explode if it +-- doesn't work. +-- +unsafe_unpickle :: FilePath -> PU a -> IO a +unsafe_unpickle filepath unpickler = + fmap head $ runX $ xunpickleDocument unpickler parse_opts filepath