{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Text.XML.Unresolved
(
writeFile
, readFile
, renderLBS
, parseLBS
, parseLBS_
, parseText
, parseText_
, sinkTextDoc
, sinkDoc
, toEvents
, elementToEvents
, fromEvents
, elementFromEvents
, renderBuilder
, renderBytes
, renderText
, InvalidEventStream (..)
, P.def
, P.ParseSettings
, P.psDecodeEntities
, P.psRetainNamespaces
, R.RenderSettings
, R.rsPretty
, R.rsNamespaces
) where
import Conduit
import Control.Applicative ((<$>), (<*>))
import Control.Exception (Exception, SomeException, throw)
import Control.Monad (when)
import Control.Monad.Trans.Class (lift)
import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Lazy as L
import Data.Char (isSpace)
import qualified Data.Conduit.Binary as CB
import Data.Conduit.Lazy (lazyConsume)
import qualified Data.Conduit.List as CL
import Data.Maybe (isJust, mapMaybe)
import Data.Monoid (mconcat)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Typeable (Typeable)
import Data.XML.Types
import Prelude hiding (readFile, writeFile)
import System.IO.Unsafe (unsafePerformIO)
import Text.XML.Stream.Parse (ParseSettings)
import qualified Text.XML.Stream.Parse as P
import qualified Text.XML.Stream.Render as R
readFile :: P.ParseSettings -> FilePath -> IO Document
readFile :: ParseSettings -> FilePath -> IO Document
readFile ParseSettings
ps FilePath
fp = forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
CB.sourceFile FilePath
fp forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadThrow m =>
ParseSettings -> ConduitT ByteString o m Document
sinkDoc ParseSettings
ps
sinkDoc :: MonadThrow m
=> P.ParseSettings
-> ConduitT ByteString o m Document
sinkDoc :: forall (m :: * -> *) o.
MonadThrow m =>
ParseSettings -> ConduitT ByteString o m Document
sinkDoc ParseSettings
ps = forall (m :: * -> *).
MonadThrow m =>
ParseSettings -> ConduitT ByteString EventPos m ()
P.parseBytesPos ParseSettings
ps forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadThrow m =>
ConduitT EventPos o m Document
fromEvents
writeFile :: R.RenderSettings -> FilePath -> Document -> IO ()
writeFile :: RenderSettings -> FilePath -> Document -> IO ()
writeFile RenderSettings
rs FilePath
fp Document
doc =
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) i.
PrimMonad m =>
RenderSettings -> Document -> ConduitT i ByteString m ()
renderBytes RenderSettings
rs Document
doc forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadResource m =>
FilePath -> ConduitT ByteString o m ()
CB.sinkFile FilePath
fp
renderLBS :: R.RenderSettings -> Document -> L.ByteString
renderLBS :: RenderSettings -> Document -> ByteString
renderLBS RenderSettings
rs Document
doc =
[ByteString] -> ByteString
L.fromChunks forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadUnliftIO m, MonadActive m) =>
Source m a -> m [a]
lazyConsume
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) i.
PrimMonad m =>
RenderSettings -> Document -> ConduitT i ByteString m ()
renderBytes RenderSettings
rs Document
doc
parseLBS :: P.ParseSettings -> L.ByteString -> Either SomeException Document
parseLBS :: ParseSettings -> ByteString -> Either SomeException Document
parseLBS ParseSettings
ps ByteString
lbs = forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList (ByteString -> [ByteString]
L.toChunks ByteString
lbs) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadThrow m =>
ParseSettings -> ConduitT ByteString o m Document
sinkDoc ParseSettings
ps
parseLBS_ :: P.ParseSettings -> L.ByteString -> Document
parseLBS_ :: ParseSettings -> ByteString -> Document
parseLBS_ ParseSettings
ps ByteString
lbs = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a e. Exception e => e -> a
throw forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ ParseSettings -> ByteString -> Either SomeException Document
parseLBS ParseSettings
ps ByteString
lbs
data InvalidEventStream = ContentAfterRoot P.EventPos
| MissingRootElement
| InvalidInlineDoctype P.EventPos
| MissingEndElement Name (Maybe P.EventPos)
| UnterminatedInlineDoctype
deriving Typeable
instance Exception InvalidEventStream
instance Show InvalidEventStream where
show :: InvalidEventStream -> FilePath
show (ContentAfterRoot (Maybe PositionRange
pos, Event
e)) = Maybe PositionRange -> FilePath
mShowPos Maybe PositionRange
pos forall a. [a] -> [a] -> [a]
++ FilePath
"Found content after root element: " forall a. [a] -> [a] -> [a]
++ Event -> FilePath
prettyShowE Event
e
show InvalidEventStream
MissingRootElement = FilePath
"Missing root element"
show (InvalidInlineDoctype (Maybe PositionRange
pos, Event
e)) = Maybe PositionRange -> FilePath
mShowPos Maybe PositionRange
pos forall a. [a] -> [a] -> [a]
++ FilePath
"Invalid content inside doctype: " forall a. [a] -> [a] -> [a]
++ Event -> FilePath
prettyShowE Event
e
show (MissingEndElement Name
name Maybe EventPos
Nothing) = FilePath
"Documented ended while expected end element for: " forall a. [a] -> [a] -> [a]
++ Name -> FilePath
prettyShowName Name
name
show (MissingEndElement Name
name (Just (Maybe PositionRange
pos, Event
e))) = Maybe PositionRange -> FilePath
mShowPos Maybe PositionRange
pos forall a. [a] -> [a] -> [a]
++ FilePath
"Expected end element for: " forall a. [a] -> [a] -> [a]
++ Name -> FilePath
prettyShowName Name
name forall a. [a] -> [a] -> [a]
++ FilePath
", but received: " forall a. [a] -> [a] -> [a]
++ Event -> FilePath
prettyShowE Event
e
show InvalidEventStream
UnterminatedInlineDoctype = FilePath
"Unterminated doctype declaration"
mShowPos :: Maybe P.PositionRange -> String
mShowPos :: Maybe PositionRange -> FilePath
mShowPos Maybe PositionRange
Nothing = FilePath
""
mShowPos (Just PositionRange
pos) = forall a. Show a => a -> FilePath
show PositionRange
pos forall a. [a] -> [a] -> [a]
++ FilePath
": "
prettyShowE :: Event -> String
prettyShowE :: Event -> FilePath
prettyShowE = forall a. Show a => a -> FilePath
show
prettyShowName :: Name -> String
prettyShowName :: Name -> FilePath
prettyShowName = forall a. Show a => a -> FilePath
show
renderBuilder :: Monad m => R.RenderSettings -> Document -> ConduitT i Builder m ()
renderBuilder :: forall (m :: * -> *) i.
Monad m =>
RenderSettings -> Document -> ConduitT i Builder m ()
renderBuilder RenderSettings
rs Document
doc = forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList (Document -> [Event]
toEvents Document
doc) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *).
Monad m =>
RenderSettings -> ConduitT Event Builder m ()
R.renderBuilder RenderSettings
rs
renderBytes :: PrimMonad m => R.RenderSettings -> Document -> ConduitT i ByteString m ()
renderBytes :: forall (m :: * -> *) i.
PrimMonad m =>
RenderSettings -> Document -> ConduitT i ByteString m ()
renderBytes RenderSettings
rs Document
doc = forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList (Document -> [Event]
toEvents Document
doc) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *).
PrimMonad m =>
RenderSettings -> ConduitT Event ByteString m ()
R.renderBytes RenderSettings
rs
renderText :: (MonadThrow m, PrimMonad m) => R.RenderSettings -> Document -> ConduitT i Text m ()
renderText :: forall (m :: * -> *) i.
(MonadThrow m, PrimMonad m) =>
RenderSettings -> Document -> ConduitT i Text m ()
renderText RenderSettings
rs Document
doc = forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList (Document -> [Event]
toEvents Document
doc) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *).
(PrimMonad m, MonadThrow m) =>
RenderSettings -> ConduitT Event Text m ()
R.renderText RenderSettings
rs
manyTries :: Monad m => m (Maybe a) -> m [a]
manyTries :: forall (m :: * -> *) a. Monad m => m (Maybe a) -> m [a]
manyTries m (Maybe a)
f =
forall {c}. ([a] -> c) -> m c
go forall a. a -> a
id
where
go :: ([a] -> c) -> m c
go [a] -> c
front = do
Maybe a
x <- m (Maybe a)
f
case Maybe a
x of
Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [a] -> c
front []
Just a
y -> ([a] -> c) -> m c
go ([a] -> c
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) a
y)
dropReturn :: Monad m => a -> ConduitM i o m a
dropReturn :: forall (m :: * -> *) a i o. Monad m => a -> ConduitM i o m a
dropReturn a
x = forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
CL.drop Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
fromEvents :: MonadThrow m => ConduitT P.EventPos o m Document
fromEvents :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitT EventPos o m Document
fromEvents = do
forall {m :: * -> *} {b} {a} {o}.
(Monad m, Eq b) =>
b -> ConduitT (a, b) o m ()
skip Event
EventBeginDocument
Document
d <- Prologue -> Element -> [Miscellaneous] -> Document
Document forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {o}. ConduitT EventPos o m Prologue
goP forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {m :: * -> *} {o} {b}.
MonadThrow m =>
ConduitT EventPos o m (Maybe b) -> ConduitT EventPos o m b
require forall (m :: * -> *) o.
MonadThrow m =>
ConduitT EventPos o m (Maybe Element)
elementFromEvents forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {a} {o}. ConduitT (a, Event) o m [Miscellaneous]
goM
forall {m :: * -> *} {b} {a} {o}.
(Monad m, Eq b) =>
b -> ConduitT (a, b) o m ()
skip Event
EventEndDocument
Maybe EventPos
y <- forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.head
case Maybe EventPos
y of
Maybe EventPos
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Document
d
Just (Maybe PositionRange
_, Event
EventEndDocument) -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM InvalidEventStream
MissingRootElement
Just EventPos
z ->
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ EventPos -> InvalidEventStream
ContentAfterRoot EventPos
z
where
skip :: b -> ConduitT (a, b) o m ()
skip b
e = do
Maybe (a, b)
x <- forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.peek
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd Maybe (a, b)
x forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just b
e) (forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
CL.drop Int
1)
require :: ConduitT EventPos o m (Maybe b) -> ConduitT EventPos o m b
require ConduitT EventPos o m (Maybe b)
f = do
Maybe b
x <- ConduitT EventPos o m (Maybe b)
f
case Maybe b
x of
Just b
y -> forall (m :: * -> *) a. Monad m => a -> m a
return b
y
Maybe b
Nothing -> do
Maybe EventPos
my <- forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.head
case Maybe EventPos
my of
Maybe EventPos
Nothing -> forall a. HasCallStack => FilePath -> a
error FilePath
"Text.XML.Unresolved:impossible"
Just (Maybe PositionRange
_, Event
EventEndDocument) -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM InvalidEventStream
MissingRootElement
Just EventPos
y -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ EventPos -> InvalidEventStream
ContentAfterRoot EventPos
y
goP :: ConduitT EventPos o m Prologue
goP = [Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a} {o}. ConduitT (a, Event) o m [Miscellaneous]
goM forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {o}. ConduitT EventPos o m (Maybe Doctype)
goD forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {a} {o}. ConduitT (a, Event) o m [Miscellaneous]
goM
goM :: ConduitT (a, Event) o m [Miscellaneous]
goM = forall (m :: * -> *) a. Monad m => m (Maybe a) -> m [a]
manyTries forall {a} {o}. ConduitT (a, Event) o m (Maybe Miscellaneous)
goM'
goM' :: ConduitT (a, Event) o m (Maybe Miscellaneous)
goM' = do
Maybe (a, Event)
x <- forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.peek
case Maybe (a, Event)
x of
Just (a
_, EventInstruction Instruction
i) -> forall (m :: * -> *) a i o. Monad m => a -> ConduitM i o m a
dropReturn forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Instruction -> Miscellaneous
MiscInstruction Instruction
i
Just (a
_, EventComment Text
t) -> forall (m :: * -> *) a i o. Monad m => a -> ConduitM i o m a
dropReturn forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Miscellaneous
MiscComment Text
t
Just (a
_, EventContent (ContentText Text
t))
| (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
t -> forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
CL.drop Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT (a, Event) o m (Maybe Miscellaneous)
goM'
Maybe (a, Event)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
goD :: ConduitT EventPos o m (Maybe Doctype)
goD = do
Maybe EventPos
x <- forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.peek
case Maybe EventPos
x of
Just (Maybe PositionRange
_, EventBeginDoctype Text
name Maybe ExternalID
meid) -> do
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
CL.drop Int
1
forall {o}. ConduitT EventPos o m ()
dropTillDoctype
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Maybe ExternalID -> Doctype
Doctype Text
name Maybe ExternalID
meid)
Maybe EventPos
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
dropTillDoctype :: ConduitT EventPos o m ()
dropTillDoctype = do
Maybe EventPos
x <- forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.head
case Maybe EventPos
x of
Just (Maybe PositionRange
_, Event
EventEndDoctype) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just EventPos
epos -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ EventPos -> InvalidEventStream
InvalidInlineDoctype EventPos
epos
Maybe EventPos
Nothing -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM InvalidEventStream
UnterminatedInlineDoctype
elementFromEvents :: MonadThrow m => ConduitT P.EventPos o m (Maybe Element)
elementFromEvents :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitT EventPos o m (Maybe Element)
elementFromEvents = forall {o}. ConduitT EventPos o m (Maybe Element)
goE
where
goE :: ConduitT EventPos o m (Maybe Element)
goE = do
Maybe EventPos
x <- forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.peek
case Maybe EventPos
x of
Just (Maybe PositionRange
_, EventBeginElement Name
n [(Name, [Content])]
as) -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {o}.
Name -> [(Name, [Content])] -> ConduitT EventPos o m Element
goE' Name
n [(Name, [Content])]
as
Maybe EventPos
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
goE' :: Name -> [(Name, [Content])] -> ConduitT EventPos o m Element
goE' Name
n [(Name, [Content])]
as = do
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
CL.drop Int
1
[Node]
ns <- forall (m :: * -> *) a. Monad m => m (Maybe a) -> m [a]
manyTries ConduitT EventPos o m (Maybe Node)
goN
Maybe EventPos
y <- forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.head
if forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd Maybe EventPos
y forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (Name -> Event
EventEndElement Name
n)
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Name -> [(Name, [Content])] -> [Node] -> Element
Element Name
n [(Name, [Content])]
as forall a b. (a -> b) -> a -> b
$ [Node] -> [Node]
compressNodes [Node]
ns
else forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Name -> Maybe EventPos -> InvalidEventStream
MissingEndElement Name
n Maybe EventPos
y
goN :: ConduitT EventPos o m (Maybe Node)
goN = do
Maybe EventPos
x <- forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.peek
case Maybe EventPos
x of
Just (Maybe PositionRange
_, EventBeginElement Name
n [(Name, [Content])]
as) -> (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Node
NodeElement) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> [(Name, [Content])] -> ConduitT EventPos o m Element
goE' Name
n [(Name, [Content])]
as
Just (Maybe PositionRange
_, EventInstruction Instruction
i) -> forall (m :: * -> *) a i o. Monad m => a -> ConduitM i o m a
dropReturn forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Instruction -> Node
NodeInstruction Instruction
i
Just (Maybe PositionRange
_, EventContent Content
c) -> forall (m :: * -> *) a i o. Monad m => a -> ConduitM i o m a
dropReturn forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Content -> Node
NodeContent Content
c
Just (Maybe PositionRange
_, EventComment Text
t) -> forall (m :: * -> *) a i o. Monad m => a -> ConduitM i o m a
dropReturn forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Node
NodeComment Text
t
Just (Maybe PositionRange
_, EventCDATA Text
t) -> forall (m :: * -> *) a i o. Monad m => a -> ConduitM i o m a
dropReturn forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Content -> Node
NodeContent forall a b. (a -> b) -> a -> b
$ Text -> Content
ContentText Text
t
Maybe EventPos
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
toEvents :: Document -> [Event]
toEvents :: Document -> [Event]
toEvents (Document Prologue
prol Element
root [Miscellaneous]
epi) =
(Event
EventBeginDocument forall a. a -> [a] -> [a]
:)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prologue -> [Event] -> [Event]
goP Prologue
prol forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Event] -> [Event]
elementToEvents' Element
root forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Miscellaneous] -> [Event] -> [Event]
goM [Miscellaneous]
epi forall a b. (a -> b) -> a -> b
$ [Event
EventEndDocument]
where
goP :: Prologue -> [Event] -> [Event]
goP (Prologue [Miscellaneous]
before Maybe Doctype
doctype [Miscellaneous]
after) =
[Miscellaneous] -> [Event] -> [Event]
goM [Miscellaneous]
before forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id Doctype -> [Event] -> [Event]
goD Maybe Doctype
doctype forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Miscellaneous] -> [Event] -> [Event]
goM [Miscellaneous]
after
goM :: [Miscellaneous] -> [Event] -> [Event]
goM [] = forall a. a -> a
id
goM [Miscellaneous
x] = (Miscellaneous -> Event
goM' Miscellaneous
x forall a. a -> [a] -> [a]
:)
goM (Miscellaneous
x:[Miscellaneous]
xs) = (Miscellaneous -> Event
goM' Miscellaneous
x forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Miscellaneous] -> [Event] -> [Event]
goM [Miscellaneous]
xs
goM' :: Miscellaneous -> Event
goM' (MiscInstruction Instruction
i) = Instruction -> Event
EventInstruction Instruction
i
goM' (MiscComment Text
t) = Text -> Event
EventComment Text
t
goD :: Doctype -> [Event] -> [Event]
goD (Doctype Text
name Maybe ExternalID
meid) =
(:) (Text -> Maybe ExternalID -> Event
EventBeginDoctype Text
name Maybe ExternalID
meid)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Event
EventEndDoctype
elementToEvents :: Element -> [Event]
elementToEvents :: Element -> [Event]
elementToEvents Element
e = Element -> [Event] -> [Event]
elementToEvents' Element
e []
elementToEvents' :: Element -> [Event] -> [Event]
elementToEvents' :: Element -> [Event] -> [Event]
elementToEvents' = Element -> [Event] -> [Event]
goE
where
goE :: Element -> [Event] -> [Event]
goE (Element Name
name [(Name, [Content])]
as [Node]
ns) =
(Name -> [(Name, [Content])] -> Event
EventBeginElement Name
name [(Name, [Content])]
as forall a. a -> [a] -> [a]
:)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> [Event] -> [Event]
goN [Node]
ns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Event
EventEndElement Name
name forall a. a -> [a] -> [a]
:)
goN :: [Node] -> [Event] -> [Event]
goN [] = forall a. a -> a
id
goN [Node
x] = Node -> [Event] -> [Event]
goN' Node
x
goN (Node
x:[Node]
xs) = Node -> [Event] -> [Event]
goN' Node
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> [Event] -> [Event]
goN [Node]
xs
goN' :: Node -> [Event] -> [Event]
goN' (NodeElement Element
e) = Element -> [Event] -> [Event]
goE Element
e
goN' (NodeInstruction Instruction
i) = (Instruction -> Event
EventInstruction Instruction
i forall a. a -> [a] -> [a]
:)
goN' (NodeContent Content
c) = (Content -> Event
EventContent Content
c forall a. a -> [a] -> [a]
:)
goN' (NodeComment Text
t) = (Text -> Event
EventComment Text
t forall a. a -> [a] -> [a]
:)
compressNodes :: [Node] -> [Node]
compressNodes :: [Node] -> [Node]
compressNodes [] = []
compressNodes [Node
x] = [Node
x]
compressNodes (x :: Node
x@(NodeContent (ContentText Text
_)) : y :: Node
y@(NodeContent (ContentText Text
_)) : [Node]
z) =
let ([Node]
textNodes, [Node]
remainder) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Maybe Text
unContent) (Node
xforall a. a -> [a] -> [a]
:Node
yforall a. a -> [a] -> [a]
:[Node]
z)
texts :: [Text]
texts = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node -> Maybe Text
unContent [Node]
textNodes
in
[Node] -> [Node]
compressNodes forall a b. (a -> b) -> a -> b
$ Content -> Node
NodeContent (Text -> Content
ContentText forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Text]
texts) forall a. a -> [a] -> [a]
: [Node]
remainder
where
unContent :: Node -> Maybe Text
unContent (NodeContent (ContentText Text
text)) = forall a. a -> Maybe a
Just Text
text
unContent Node
_ = forall a. Maybe a
Nothing
compressNodes (Node
x:[Node]
xs) = Node
x forall a. a -> [a] -> [a]
: [Node] -> [Node]
compressNodes [Node]
xs
parseText :: ParseSettings -> TL.Text -> Either SomeException Document
parseText :: ParseSettings -> Text -> Either SomeException Document
parseText ParseSettings
ps Text
tl =
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList (Text -> [Text]
TL.toChunks Text
tl)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadThrow m =>
ParseSettings -> ConduitT Text o m Document
sinkTextDoc ParseSettings
ps
parseText_ :: ParseSettings -> TL.Text -> Document
parseText_ :: ParseSettings -> Text -> Document
parseText_ ParseSettings
ps = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a e. Exception e => e -> a
throw forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseSettings -> Text -> Either SomeException Document
parseText ParseSettings
ps
sinkTextDoc :: MonadThrow m
=> ParseSettings
-> ConduitT Text o m Document
sinkTextDoc :: forall (m :: * -> *) o.
MonadThrow m =>
ParseSettings -> ConduitT Text o m Document
sinkTextDoc ParseSettings
ps = forall (m :: * -> *).
MonadThrow m =>
ParseSettings -> ConduitT Text EventPos m ()
P.parseTextPos ParseSettings
ps forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadThrow m =>
ConduitT EventPos o m Document
fromEvents