module Text.Roundtrip.Xml.ParserInternal (

    PState, PParser, GenXmlParser(..)
  , AttrMap, RtEvent(..)
  , WithPos(..), RtEventWithPos
  , EventWithPos, eventWithPos, eventWithoutPos

) where

import Data.XML.Types
import qualified Data.Text as T

import Text.PrettyPrint.HughesPJ

import qualified Text.Parsec as P
import qualified Text.Parsec.Pos as P

import Text.Roundtrip.Xml.Pretty

type PState = Maybe AttrMap
type PParser s m a = P.ParsecT s PState m a
newtype GenXmlParser s m a = GenXmlParser (PParser 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  :: P.SourcePos
                 }

eventWithPos :: a -> P.SourceName -> P.Line -> P.Column -> WithPos a
eventWithPos x s l c = WithPos x (P.newPos s l c)

eventWithoutPos :: a -> WithPos a
eventWithoutPos x = WithPos x (P.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))