module XmlParser.XmlConduitWrapper
( parseByteString,
parseLazyByteString,
parseFile,
)
where
import qualified Data.ByteString.Lazy as LazyByteString
import qualified Data.Text as Text
import qualified Text.XML as XmlConduit
import qualified Text.XML.Unresolved as XmlConduit (InvalidEventStream (..))
import XmlParser.Prelude
parseByteString :: ByteString -> Either Text XmlConduit.Document
parseByteString :: ByteString -> Either Text Document
parseByteString =
ByteString -> Either Text Document
parseLazyByteString (ByteString -> Either Text Document)
-> (ByteString -> ByteString) -> ByteString -> Either Text Document
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
LazyByteString.fromStrict
parseLazyByteString :: LazyByteString.ByteString -> Either Text XmlConduit.Document
parseLazyByteString :: ByteString -> Either Text Document
parseLazyByteString ByteString
input =
(SomeException -> Text)
-> Either SomeException Document -> Either Text Document
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SomeException -> Text
renderError (ParseSettings -> ByteString -> Either SomeException Document
XmlConduit.parseLBS ParseSettings
settings ByteString
input)
parseFile :: FilePath -> IO (Either Text XmlConduit.Document)
parseFile :: FilePath -> IO (Either Text Document)
parseFile FilePath
path =
(SomeException -> Text) -> IO Document -> IO (Either Text Document)
forall e e' a. Exception e => (e -> e') -> IO a -> IO (Either e' a)
tryMapping SomeException -> Text
renderError (ParseSettings -> FilePath -> IO Document
XmlConduit.readFile ParseSettings
settings FilePath
path)
settings :: XmlConduit.ParseSettings
settings :: ParseSettings
settings =
ParseSettings
forall a. Default a => a
XmlConduit.def
{ psRetainNamespaces :: Bool
XmlConduit.psRetainNamespaces = Bool
True
}
renderError :: SomeException -> Text
renderError :: SomeException -> Text
renderError SomeException
e
| Just XMLException
e <- SomeException -> Maybe XMLException
forall e. Exception e => SomeException -> Maybe e
fromException @XmlConduit.XMLException SomeException
e =
FilePath -> Text
forall a. IsString a => FilePath -> a
fromString (XMLException -> FilePath
forall a. Show a => a -> FilePath
show XMLException
e)
| Just InvalidEventStream
e <- SomeException -> Maybe InvalidEventStream
forall e. Exception e => SomeException -> Maybe e
fromException @XmlConduit.InvalidEventStream SomeException
e =
FilePath -> Text
forall a. IsString a => FilePath -> a
fromString (InvalidEventStream -> FilePath
forall a. Show a => a -> FilePath
show InvalidEventStream
e)
| Just (XmlConduit.UnresolvedEntityException Set Text
e) <- SomeException -> Maybe UnresolvedEntityException
forall e. Exception e => SomeException -> Maybe e
fromException @XmlConduit.UnresolvedEntityException SomeException
e =
Text
"Unresolved entities: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"," (Set Text -> [Item (Set Text)]
forall l. IsList l => l -> [Item l]
toList Set Text
e)
| Bool
otherwise =
FilePath -> Text
forall a. IsString a => FilePath -> a
fromString (SomeException -> FilePath
forall a. Show a => a -> FilePath
show SomeException
e)