{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module Text.XML.Stream.Token
    ( tokenToBuilder
    , TName (..)
    , Token (..)
    , TAttribute
    , NSLevel (..)
    ) where

import Data.XML.Types (Instruction (..), Content (..), ExternalID (..))
import qualified Data.Text as T
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8Builder, encodeUtf8BuilderEscaped)
import Data.String (IsString (fromString))
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder.Prim as E
import Data.ByteString.Builder.Prim ((>*<), (>$<), condB)
import Data.Monoid (mconcat, mempty, (<>))
import Data.Map (Map)
import qualified Data.Set as Set
import Data.List (foldl')
import Control.Arrow (first)
import Data.Word (Word8)

oneSpace :: Builder
oneSpace :: Builder
oneSpace = Builder
" "

data Token = TokenXMLDeclaration [TAttribute]
           | TokenInstruction Instruction
           | TokenBeginElement TName [TAttribute] Bool Int -- ^ indent
           | TokenEndElement TName
           | TokenContent Content
           | TokenComment Text
           | TokenDoctype Text (Maybe ExternalID) [(Text, Text)]
           | TokenCDATA Text
    deriving Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show
tokenToBuilder :: Token -> Builder
tokenToBuilder :: Token -> Builder
tokenToBuilder (TokenXMLDeclaration [TAttribute]
attrs) =
    Builder
"<?xml" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Builder -> [TAttribute] -> Builder
foldAttrs Builder
oneSpace [TAttribute]
attrs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Builder
"?>"
tokenToBuilder (TokenInstruction (Instruction Text
target Text
data_)) =
    Builder
"<?" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Text -> Builder
encodeUtf8Builder Text
target Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Text -> Builder
encodeUtf8Builder Text
data_ Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Builder
"?>"
tokenToBuilder (TokenBeginElement TName
name [TAttribute]
attrs' Bool
isEmpty Int
indent) =
    Builder
"<" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    TName -> Builder
tnameToText TName
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Builder -> [TAttribute] -> Builder
foldAttrs
        (if Int
indent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| [TAttribute] -> Bool
forall a. [a] -> Bool
lessThan3 [TAttribute]
attrs
            then Builder
oneSpace
            else [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ (Builder
"\n" Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Int -> Builder -> [Builder]
forall a. Int -> a -> [a]
replicate Int
indent Builder
" "))
        [TAttribute]
attrs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    (if Bool
isEmpty then Builder
"/>" else Builder
">")
  where
    attrs :: [TAttribute]
attrs = [TAttribute] -> [TAttribute]
nubAttrs ([TAttribute] -> [TAttribute]) -> [TAttribute] -> [TAttribute]
forall a b. (a -> b) -> a -> b
$ (TAttribute -> TAttribute) -> [TAttribute] -> [TAttribute]
forall a b. (a -> b) -> [a] -> [b]
map ((TName -> TName) -> TAttribute -> TAttribute
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first TName -> TName
splitTName) [TAttribute]
attrs'
    lessThan3 :: [a] -> Bool
lessThan3 [] = Bool
True
    lessThan3 [a
_] = Bool
True
    lessThan3 [a
_, a
_] = Bool
True
    lessThan3 [a]
_ = Bool
False
tokenToBuilder (TokenEndElement TName
name) = Builder
"</" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TName -> Builder
tnameToText TName
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
">"
tokenToBuilder (TokenContent Content
c) = Content -> Builder
contentToText Content
c
tokenToBuilder (TokenCDATA Text
t) = Builder
"<![CDATA[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
escCDATA Text
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]]>"
tokenToBuilder (TokenComment Text
t) = Builder
"<!--" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
encodeUtf8Builder Text
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"-->"
tokenToBuilder (TokenDoctype Text
name Maybe ExternalID
eid [(Text, Text)]
_) =
    Builder
"<!DOCTYPE " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Text -> Builder
encodeUtf8Builder Text
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Maybe ExternalID -> Builder
go Maybe ExternalID
eid Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Builder
">"
  where
    go :: Maybe ExternalID -> Builder
go Maybe ExternalID
Nothing = Builder
forall a. Monoid a => a
mempty
    go (Just (SystemID Text
uri)) = Builder
" SYSTEM \"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
encodeUtf8Builder Text
uri Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\""
    go (Just (PublicID Text
pid Text
uri)) =
        Builder
" PUBLIC \"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Text -> Builder
encodeUtf8Builder Text
pid Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Builder
"\" \"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Text -> Builder
encodeUtf8Builder Text
uri Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Builder
"\""

data TName = TName (Maybe Text) Text
    deriving (Int -> TName -> ShowS
[TName] -> ShowS
TName -> String
(Int -> TName -> ShowS)
-> (TName -> String) -> ([TName] -> ShowS) -> Show TName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TName] -> ShowS
$cshowList :: [TName] -> ShowS
show :: TName -> String
$cshow :: TName -> String
showsPrec :: Int -> TName -> ShowS
$cshowsPrec :: Int -> TName -> ShowS
Show, TName -> TName -> Bool
(TName -> TName -> Bool) -> (TName -> TName -> Bool) -> Eq TName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TName -> TName -> Bool
$c/= :: TName -> TName -> Bool
== :: TName -> TName -> Bool
$c== :: TName -> TName -> Bool
Eq, Eq TName
Eq TName
-> (TName -> TName -> Ordering)
-> (TName -> TName -> Bool)
-> (TName -> TName -> Bool)
-> (TName -> TName -> Bool)
-> (TName -> TName -> Bool)
-> (TName -> TName -> TName)
-> (TName -> TName -> TName)
-> Ord TName
TName -> TName -> Bool
TName -> TName -> Ordering
TName -> TName -> TName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TName -> TName -> TName
$cmin :: TName -> TName -> TName
max :: TName -> TName -> TName
$cmax :: TName -> TName -> TName
>= :: TName -> TName -> Bool
$c>= :: TName -> TName -> Bool
> :: TName -> TName -> Bool
$c> :: TName -> TName -> Bool
<= :: TName -> TName -> Bool
$c<= :: TName -> TName -> Bool
< :: TName -> TName -> Bool
$c< :: TName -> TName -> Bool
compare :: TName -> TName -> Ordering
$ccompare :: TName -> TName -> Ordering
$cp1Ord :: Eq TName
Ord)

tnameToText :: TName -> Builder
tnameToText :: TName -> Builder
tnameToText (TName Maybe Text
Nothing Text
name) = Text -> Builder
encodeUtf8Builder Text
name
tnameToText (TName (Just Text
prefix) Text
name) =
  Text -> Builder
encodeUtf8Builder Text
prefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
encodeUtf8Builder Text
name

contentToText :: Content -> Builder
contentToText :: Content -> Builder
contentToText (ContentText Text
t) = BoundedPrim Word8 -> Text -> Builder
encodeUtf8BuilderEscaped BoundedPrim Word8
charUtf8XmlEscaped Text
t
contentToText (ContentEntity Text
e) = Builder
"&" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
encodeUtf8Builder Text
e Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";"

{-# INLINE charUtf8XmlEscaped #-}
charUtf8XmlEscaped :: E.BoundedPrim Word8
charUtf8XmlEscaped :: BoundedPrim Word8
charUtf8XmlEscaped =
    (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>  Word8
_gt) (FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
E.liftFixedToBounded FixedPrim Word8
E.word8) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$
    (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_lt) ((Word8, (Word8, (Word8, Word8))) -> BoundedPrim Word8
forall a. (Word8, (Word8, (Word8, Word8))) -> BoundedPrim a
fixed4 (Word8
_am,(Word8
_l,(Word8
_t,Word8
_sc)))) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$       -- &lt;
    (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_gt) ((Word8, (Word8, (Word8, Word8))) -> BoundedPrim Word8
forall a. (Word8, (Word8, (Word8, Word8))) -> BoundedPrim a
fixed4 (Word8
_am,(Word8
_g,(Word8
_t,Word8
_sc)))) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$       -- &gt;
    (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_am) ((Word8, (Word8, (Word8, (Word8, Word8)))) -> BoundedPrim Word8
forall a.
(Word8, (Word8, (Word8, (Word8, Word8)))) -> BoundedPrim a
fixed5 (Word8
_am,(Word8
_a,(Word8
_m,(Word8
_p,Word8
_sc))))) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$  -- &amp;
    (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_dq) ((Word8, (Word8, (Word8, (Word8, Word8)))) -> BoundedPrim Word8
forall a.
(Word8, (Word8, (Word8, (Word8, Word8)))) -> BoundedPrim a
fixed5 (Word8
_am,(Word8
_ha,(Word8
_3,(Word8
_4,Word8
_sc))))) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ -- &#34;
    (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_sq) ((Word8, (Word8, (Word8, (Word8, Word8)))) -> BoundedPrim Word8
forall a.
(Word8, (Word8, (Word8, (Word8, Word8)))) -> BoundedPrim a
fixed5 (Word8
_am,(Word8
_ha,(Word8
_3,(Word8
_9,Word8
_sc))))) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ -- &#39;
    (FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
E.liftFixedToBounded FixedPrim Word8
E.word8)         -- fallback for Chars smaller than '>'
  where
    _gt :: Word8
_gt = Word8
62 -- >
    _lt :: Word8
_lt = Word8
60 -- <
    _am :: Word8
_am = Word8
38 -- &
    _dq :: Word8
_dq = Word8
34 -- "
    _sq :: Word8
_sq = Word8
39 -- '
    _l :: Word8
_l  = Word8
108 -- l
    _t :: Word8
_t  = Word8
116 -- t
    _g :: Word8
_g  = Word8
103 -- g
    _a :: Word8
_a  = Word8
97  -- a
    _m :: Word8
_m  = Word8
109 -- m
    _p :: Word8
_p  = Word8
112 -- p
    _3 :: Word8
_3  = Word8
51  -- 3
    _4 :: Word8
_4  = Word8
52  -- 4
    _ha :: Word8
_ha = Word8
35  -- #, hash
    _9 :: Word8
_9  = Word8
57  -- 9
    _sc :: Word8
_sc = Word8
59  -- ;
    {-# INLINE fixed4 #-}
    fixed4 :: (Word8, (Word8, (Word8, Word8))) -> BoundedPrim a
fixed4 (Word8, (Word8, (Word8, Word8)))
x = FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
E.liftFixedToBounded (FixedPrim a -> BoundedPrim a) -> FixedPrim a -> BoundedPrim a
forall a b. (a -> b) -> a -> b
$ (Word8, (Word8, (Word8, Word8)))
-> a -> (Word8, (Word8, (Word8, Word8)))
forall a b. a -> b -> a
const (Word8, (Word8, (Word8, Word8)))
x (a -> (Word8, (Word8, (Word8, Word8))))
-> FixedPrim (Word8, (Word8, (Word8, Word8))) -> FixedPrim a
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
      FixedPrim Word8
E.word8 FixedPrim Word8
-> FixedPrim (Word8, (Word8, Word8))
-> FixedPrim (Word8, (Word8, (Word8, Word8)))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Word8
E.word8 FixedPrim Word8
-> FixedPrim (Word8, Word8) -> FixedPrim (Word8, (Word8, Word8))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Word8
E.word8 FixedPrim Word8 -> FixedPrim Word8 -> FixedPrim (Word8, Word8)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Word8
E.word8

    {-# INLINE fixed5 #-}
    fixed5 :: (Word8, (Word8, (Word8, (Word8, Word8)))) -> BoundedPrim a
fixed5 (Word8, (Word8, (Word8, (Word8, Word8))))
x = FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
E.liftFixedToBounded (FixedPrim a -> BoundedPrim a) -> FixedPrim a -> BoundedPrim a
forall a b. (a -> b) -> a -> b
$ (Word8, (Word8, (Word8, (Word8, Word8))))
-> a -> (Word8, (Word8, (Word8, (Word8, Word8))))
forall a b. a -> b -> a
const (Word8, (Word8, (Word8, (Word8, Word8))))
x (a -> (Word8, (Word8, (Word8, (Word8, Word8)))))
-> FixedPrim (Word8, (Word8, (Word8, (Word8, Word8))))
-> FixedPrim a
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
      FixedPrim Word8
E.word8 FixedPrim Word8
-> FixedPrim (Word8, (Word8, (Word8, Word8)))
-> FixedPrim (Word8, (Word8, (Word8, (Word8, Word8))))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Word8
E.word8 FixedPrim Word8
-> FixedPrim (Word8, (Word8, Word8))
-> FixedPrim (Word8, (Word8, (Word8, Word8)))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Word8
E.word8 FixedPrim Word8
-> FixedPrim (Word8, Word8) -> FixedPrim (Word8, (Word8, Word8))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Word8
E.word8 FixedPrim Word8 -> FixedPrim Word8 -> FixedPrim (Word8, Word8)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Word8
E.word8

type TAttribute = (TName, [Content])

foldAttrs :: Builder -- ^ before
          -> [TAttribute]
          -> Builder
foldAttrs :: Builder -> [TAttribute] -> Builder
foldAttrs Builder
before =
    (TAttribute -> Builder) -> [TAttribute] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TAttribute -> Builder
forall (t :: * -> *). Foldable t => (TName, t Content) -> Builder
go
  where
    go :: (TName, t Content) -> Builder
go (TName
key, t Content
val) =
      Builder
before Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      TName -> Builder
tnameToText TName
key Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Builder
"=\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      (Content -> Builder) -> t Content -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Content -> Builder
go' t Content
val Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Builder
"\""
    go' :: Content -> Builder
go' (ContentText Text
t) =
      BoundedPrim Word8 -> Text -> Builder
encodeUtf8BuilderEscaped BoundedPrim Word8
charUtf8XmlEscaped Text
t
    go' (ContentEntity Text
t) = Builder
"&" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
encodeUtf8Builder Text
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";"

instance IsString TName where
    fromString :: String -> TName
fromString = Maybe Text -> Text -> TName
TName Maybe Text
forall a. Maybe a
Nothing (Text -> TName) -> (String -> Text) -> String -> TName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

data NSLevel = NSLevel
    { NSLevel -> Maybe Text
defaultNS :: Maybe Text
    , NSLevel -> Map Text Text
prefixes :: Map Text Text
    }
    deriving Int -> NSLevel -> ShowS
[NSLevel] -> ShowS
NSLevel -> String
(Int -> NSLevel -> ShowS)
-> (NSLevel -> String) -> ([NSLevel] -> ShowS) -> Show NSLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NSLevel] -> ShowS
$cshowList :: [NSLevel] -> ShowS
show :: NSLevel -> String
$cshow :: NSLevel -> String
showsPrec :: Int -> NSLevel -> ShowS
$cshowsPrec :: Int -> NSLevel -> ShowS
Show

nubAttrs :: [TAttribute] -> [TAttribute]
nubAttrs :: [TAttribute] -> [TAttribute]
nubAttrs [TAttribute]
orig =
    [TAttribute] -> [TAttribute]
front []
  where
    ([TAttribute] -> [TAttribute]
front, Set TName
_) = (([TAttribute] -> [TAttribute], Set TName)
 -> TAttribute -> ([TAttribute] -> [TAttribute], Set TName))
-> ([TAttribute] -> [TAttribute], Set TName)
-> [TAttribute]
-> ([TAttribute] -> [TAttribute], Set TName)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([TAttribute] -> [TAttribute], Set TName)
-> TAttribute -> ([TAttribute] -> [TAttribute], Set TName)
forall a b c.
Ord a =>
([(a, b)] -> c, Set a) -> (a, b) -> ([(a, b)] -> c, Set a)
go ([TAttribute] -> [TAttribute]
forall a. a -> a
id, Set TName
forall a. Set a
Set.empty) [TAttribute]
orig
    go :: ([(a, b)] -> c, Set a) -> (a, b) -> ([(a, b)] -> c, Set a)
go ([(a, b)] -> c
dlist, Set a
used) (a
k, b
v)
        | a
k a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
used = ([(a, b)] -> c
dlist, Set a
used)
        | Bool
otherwise = ([(a, b)] -> c
dlist ([(a, b)] -> c) -> ([(a, b)] -> [(a, b)]) -> [(a, b)] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a
k, b
v)(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:), a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
k Set a
used)

splitTName :: TName -> TName
splitTName :: TName -> TName
splitTName x :: TName
x@(TName Just{} Text
_) = TName
x
splitTName x :: TName
x@(TName Maybe Text
Nothing Text
t)
    | Text -> Bool
T.null Text
b = TName
x
    | Bool
otherwise = Maybe Text -> Text -> TName
TName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
a) (Text -> TName) -> Text -> TName
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 Text
b
  where
    (Text
a, Text
b) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
t

escCDATA :: Text -> Builder
escCDATA :: Text -> Builder
escCDATA Text
s = Text -> Builder
encodeUtf8Builder (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"]]>" Text
"]]]]><![CDATA[>" Text
s)