module Text.Roundtrip.Xml.ParserInternal (
PxState, PxParser, GenXmlParser(..)
, AttrMap, RtEvent(..)
, WithPos(..), RtEventWithPos
, EventWithPos, eventWithPos, eventWithoutPos
) where
import Data.XML.Types
import qualified Data.Text as T
import Text.PrettyPrint.HughesPJ
import Text.Roundtrip.Parser
import Text.Roundtrip.Xml.Pretty
type PxState = Maybe AttrMap
type PxParser s m a = PParser s PxState m a
newtype GenXmlParser s m a = GenXmlParser (PxParser s m a)
type AttrMap = [(Name, T.Text)]
data RtEvent
= RtBeginDocument
| RtEndDocument
| RtBeginElement Name AttrMap
| RtText T.Text
| RtEndElement Name
| RtInvalidEntity T.Text
deriving (Eq)
instance Pretty RtEvent where
pp RtBeginDocument = text "begin-document"
pp RtEndDocument = text "end-document"
pp (RtBeginElement n m) = text "<" <> pp n <>
(if null m
then empty
else Prelude.foldl (\d (n, t) -> d <+> pp n <> text "=" <>
doubleQuotes (text (T.unpack t)))
(text "") m)
<> text ">"
pp (RtText t) = text "text" <> parens (shorten 32 t)
where shorten n t | T.length t <= n = text (T.unpack t)
| otherwise = text (T.unpack (T.take n t)) <+> text "..."
pp (RtEndElement n) = text "</" <> pp n <> text ">"
instance Show RtEvent where
showsPrec _ ev = showString (render (pp ev))
data WithPos a = WithPos {
wp_data :: a
, wp_pos :: SourcePos
}
eventWithPos :: a -> SourceName -> Line -> Column -> WithPos a
eventWithPos x s l c = WithPos x (newPos s l c)
eventWithoutPos :: a -> WithPos a
eventWithoutPos x = WithPos x (newPos "" (1) (1))
type EventWithPos = WithPos Event
type RtEventWithPos = WithPos RtEvent
instance Pretty a => Pretty (WithPos a) where
pp (WithPos a p) = pp a <+> text " at " <+> text (show p)
instance Pretty a => Show (WithPos a) where
showsPrec _ p = showString (render (pp p))