{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Text.XML.Stream.Parse
(
parseBytes
, parseBytesPos
, parseText
, parseTextPos
, detectUtf
, parseFile
, parseLBS
, ParseSettings
, def
, DecodeEntities
, DecodeIllegalCharacters
, psDecodeEntities
, psDecodeIllegalCharacters
, psRetainNamespaces
, psEntityExpansionSizeLimit
, psIgnoreInternalEntityDeclarations
, decodeXmlEntities
, decodeHtmlEntities
, tag
, tag'
, tagNoAttr
, tagIgnoreAttrs
, content
, contentMaybe
, ignoreEmptyTag
, ignoreTree
, ignoreContent
, ignoreTreeContent
, ignoreAnyTreeContent
, takeContent
, takeTree
, takeTreeContent
, takeAnyTreeContent
, NameMatcher(..)
, matching
, anyOf
, anyName
, AttrParser
, attr
, requireAttr
, optionalAttr
, requireAttrRaw
, optionalAttrRaw
, ignoreAttrs
, orE
, choose
, many
, many_
, manyIgnore
, many'
, force
, manyYield
, manyYield'
, manyIgnoreYield
, XmlException (..)
, PositionRange
, EventPos
) where
import Conduit
import Control.Applicative (Alternative (empty, (<|>)),
Applicative (..), (<$>))
import qualified Control.Applicative as A
import Control.Arrow ((***))
import Control.Exception (Exception (..), SomeException)
import Control.Monad (ap, liftM, void)
import Control.Monad.Fix (fix)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe (MaybeT (..))
import Control.Monad.Trans.Resource (MonadResource, MonadThrow (..),
throwM)
import Data.Attoparsec.Internal (concatReverse)
import Data.Attoparsec.Text (Parser, anyChar, char, manyTill,
skipWhile, string, takeWhile,
takeWhile1, (<?>),
notInClass, skipMany, skipMany1,
satisfy, peekChar)
import qualified Data.Attoparsec.Text as AT
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Builder as Builder
import Data.Char (isSpace)
import Data.Conduit.Attoparsec (PositionRange, conduitParser)
import qualified Data.Conduit.Text as CT
import Data.Default.Class (Default (..))
import Data.List (foldl', intercalate)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe, isNothing, mapMaybe)
import Data.String (IsString (..))
import Data.Text (Text, pack)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import Data.Typeable (Typeable)
import Data.XML.Types (Content (..), Event (..),
ExternalID (..),
Instruction (..), Name (..))
import Prelude hiding (takeWhile)
import Text.XML.Stream.Token
type EntityTable = [(Text, Text)]
tokenToEvent :: ParseSettings -> EntityTable -> [NSLevel] -> Token -> (EntityTable, [NSLevel], [Event])
tokenToEvent :: ParseSettings
-> EntityTable
-> [NSLevel]
-> Token
-> (EntityTable, [NSLevel], [Event])
tokenToEvent ParseSettings
_ EntityTable
es [NSLevel]
n (TokenXMLDeclaration [TAttribute]
_) = (EntityTable
es, [NSLevel]
n, [])
tokenToEvent ParseSettings
_ EntityTable
es [NSLevel]
n (TokenInstruction Instruction
i) = (EntityTable
es, [NSLevel]
n, [Instruction -> Event
EventInstruction Instruction
i])
tokenToEvent ParseSettings
ps EntityTable
es [NSLevel]
n (TokenBeginElement TName
name [TAttribute]
as Bool
isClosed Int
_) =
(EntityTable
es, [NSLevel]
n', if Bool
isClosed then [Event
begin, Event
end] else [Event
begin])
where
l0 :: NSLevel
l0 = case [NSLevel]
n of
[] -> Maybe Text -> Map Text Text -> NSLevel
NSLevel forall a. Maybe a
Nothing forall k a. Map k a
Map.empty
NSLevel
x:[NSLevel]
_ -> NSLevel
x
([TAttribute] -> [TAttribute]
as', NSLevel
l') = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([TAttribute] -> [TAttribute], NSLevel)
-> TAttribute -> ([TAttribute] -> [TAttribute], NSLevel)
go (forall a. a -> a
id, NSLevel
l0) [TAttribute]
as
go :: ([TAttribute] -> [TAttribute], NSLevel)
-> TAttribute -> ([TAttribute] -> [TAttribute], NSLevel)
go ([TAttribute] -> [TAttribute]
front, NSLevel
l) (TName Maybe Text
kpref Text
kname, [Content]
val) =
(([TAttribute] -> [TAttribute]) -> [TAttribute] -> [TAttribute]
addNS [TAttribute] -> [TAttribute]
front, NSLevel
l'')
where
isPrefixed :: Bool
isPrefixed = Maybe Text
kpref forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
"xmlns"
isUnprefixed :: Bool
isUnprefixed = forall a. Maybe a -> Bool
isNothing Maybe Text
kpref Bool -> Bool -> Bool
&& Text
kname forall a. Eq a => a -> a -> Bool
== Text
"xmlns"
addNS :: ([TAttribute] -> [TAttribute]) -> [TAttribute] -> [TAttribute]
addNS
| Bool -> Bool
not (ParseSettings -> Bool
psRetainNamespaces ParseSettings
ps) Bool -> Bool -> Bool
&& (Bool
isPrefixed Bool -> Bool -> Bool
|| Bool
isUnprefixed) = forall a. a -> a
id
| Bool
otherwise = (forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TName
tname, ParseSettings -> EntityTable -> [Content] -> [Content]
resolveEntities' ParseSettings
ps EntityTable
es [Content]
val)forall a. a -> [a] -> [a]
:))
where
resolveEntities' :: ParseSettings -> EntityTable -> [Content] -> [Content]
resolveEntities' ParseSettings
ps' EntityTable
es' [Content]
xs =
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Token -> Maybe Content
extractTokenContent
(ParseSettings -> EntityTable -> [Token] -> [Token]
resolveEntities ParseSettings
ps' EntityTable
es'
(forall a b. (a -> b) -> [a] -> [b]
map Content -> Token
TokenContent [Content]
xs))
extractTokenContent :: Token -> Maybe Content
extractTokenContent (TokenContent Content
c) = forall a. a -> Maybe a
Just Content
c
extractTokenContent Token
_ = forall a. Maybe a
Nothing
tname :: TName
tname
| Bool
isPrefixed = Maybe Text -> Text -> TName
TName forall a. Maybe a
Nothing (Text
"xmlns:" Text -> Text -> Text
`T.append` Text
kname)
| Bool
otherwise = Maybe Text -> Text -> TName
TName Maybe Text
kpref Text
kname
l'' :: NSLevel
l''
| Bool
isPrefixed =
NSLevel
l { prefixes :: Map Text Text
prefixes = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
kname ([Content] -> Text
contentsToText [Content]
val)
forall a b. (a -> b) -> a -> b
$ NSLevel -> Map Text Text
prefixes NSLevel
l }
| Bool
isUnprefixed =
NSLevel
l { defaultNS :: Maybe Text
defaultNS = if Text -> Bool
T.null forall a b. (a -> b) -> a -> b
$ [Content] -> Text
contentsToText [Content]
val
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Content] -> Text
contentsToText [Content]
val }
| Bool
otherwise = NSLevel
l
n' :: [NSLevel]
n' = if Bool
isClosed then [NSLevel]
n else NSLevel
l' forall a. a -> [a] -> [a]
: [NSLevel]
n
fixAttName :: TAttribute -> (Name, [Content])
fixAttName (TName
name', [Content]
val) = (Bool -> NSLevel -> TName -> Name
tnameToName Bool
True NSLevel
l' TName
name', [Content]
val)
elementName :: Name
elementName = Bool -> NSLevel -> TName -> Name
tnameToName Bool
False NSLevel
l' TName
name
begin :: Event
begin = Name -> [(Name, [Content])] -> Event
EventBeginElement Name
elementName forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map TAttribute -> (Name, [Content])
fixAttName forall a b. (a -> b) -> a -> b
$ [TAttribute] -> [TAttribute]
as' []
end :: Event
end = Name -> Event
EventEndElement Name
elementName
tokenToEvent ParseSettings
_ EntityTable
es [NSLevel]
n (TokenEndElement TName
name) =
(EntityTable
es, [NSLevel]
n', [Name -> Event
EventEndElement forall a b. (a -> b) -> a -> b
$ Bool -> NSLevel -> TName -> Name
tnameToName Bool
False NSLevel
l TName
name])
where
(NSLevel
l, [NSLevel]
n') =
case [NSLevel]
n of
[] -> (Maybe Text -> Map Text Text -> NSLevel
NSLevel forall a. Maybe a
Nothing forall k a. Map k a
Map.empty, [])
NSLevel
x:[NSLevel]
xs -> (NSLevel
x, [NSLevel]
xs)
tokenToEvent ParseSettings
ps EntityTable
es [NSLevel]
n tok :: Token
tok@(TokenContent c :: Content
c@(ContentEntity Text
e))
= case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
e EntityTable
es of
Just Text
_ -> (EntityTable
es, [NSLevel]
n, forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [Event]
toEvents [Token]
newtoks)
Maybe Text
Nothing -> (EntityTable
es, [NSLevel]
n, [Content -> Event
EventContent Content
c])
where
toEvents :: Token -> [Event]
toEvents Token
t =
let (EntityTable
_, [NSLevel]
_, [Event]
events) = ParseSettings
-> EntityTable
-> [NSLevel]
-> Token
-> (EntityTable, [NSLevel], [Event])
tokenToEvent ParseSettings
ps [] [NSLevel]
n Token
t
in [Event]
events
newtoks :: [Token]
newtoks = ParseSettings -> EntityTable -> [Token] -> [Token]
resolveEntities ParseSettings
ps EntityTable
es [Token
tok]
tokenToEvent ParseSettings
_ EntityTable
es [NSLevel]
n (TokenContent Content
c) = (EntityTable
es, [NSLevel]
n, [Content -> Event
EventContent Content
c])
tokenToEvent ParseSettings
_ EntityTable
es [NSLevel]
n (TokenComment Text
c) = (EntityTable
es, [NSLevel]
n, [Text -> Event
EventComment Text
c])
tokenToEvent ParseSettings
_ EntityTable
es [NSLevel]
n (TokenDoctype Text
t Maybe ExternalID
eid EntityTable
es') = (EntityTable
es forall a. [a] -> [a] -> [a]
++ EntityTable
es', [NSLevel]
n, [Text -> Maybe ExternalID -> Event
EventBeginDoctype Text
t Maybe ExternalID
eid, Event
EventEndDoctype])
tokenToEvent ParseSettings
_ EntityTable
es [NSLevel]
n (TokenCDATA Text
t) = (EntityTable
es, [NSLevel]
n, [Text -> Event
EventCDATA Text
t])
resolveEntities :: ParseSettings
-> EntityTable
-> [Token]
-> [Token]
resolveEntities :: ParseSettings -> EntityTable -> [Token] -> [Token]
resolveEntities ParseSettings
ps EntityTable
entities = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Token -> [Token] -> [Token]
go []
where
go :: Token -> [Token] -> [Token]
go tok :: Token
tok@(TokenContent (ContentEntity Text
e)) [Token]
toks
= case EntityTable -> Text -> Maybe [Token]
expandEntity EntityTable
entities Text
e of
Just [Token]
xs -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Token -> [Token] -> [Token]
go [Token]
toks [Token]
xs
Maybe [Token]
Nothing -> Token
tok forall a. a -> [a] -> [a]
: [Token]
toks
go Token
tok [Token]
toks = Token
tok forall a. a -> [a] -> [a]
: [Token]
toks
expandEntity :: EntityTable -> Text -> Maybe [Token]
expandEntity EntityTable
es Text
e
| Just Text
t <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
e EntityTable
es =
case forall a. Parser a -> Text -> Either String a
AT.parseOnly (forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill
(ParseSettings -> Parser Token
parseToken ParseSettings
ps :: Parser Token)
forall t. Chunk t => Parser t ()
AT.endOfInput) Text
t of
Left String
_ -> forall a. Maybe a
Nothing
Right [Token]
xs ->
let es' :: EntityTable
es' = forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
x,Text
_) -> Text
x forall a. Eq a => a -> a -> Bool
/= Text
e) EntityTable
es
in forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (EntityTable
-> Token -> Maybe ([Token], Int) -> Maybe ([Token], Int)
goent EntityTable
es') (forall a. a -> Maybe a
Just ([], Int
0)) [Token]
xs
| Bool
otherwise = forall a. Maybe a
Nothing
goent :: EntityTable
-> Token -> Maybe ([Token], Int) -> Maybe ([Token], Int)
goent EntityTable
_ Token
_ Maybe ([Token], Int)
Nothing = forall a. Maybe a
Nothing
goent EntityTable
es (TokenContent (ContentEntity Text
e)) (Just ([Token]
cs, Int
size))
= EntityTable -> Text -> Maybe [Token]
expandEntity EntityTable
es Text
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (EntityTable
-> Token -> Maybe ([Token], Int) -> Maybe ([Token], Int)
goent EntityTable
es) (forall a. a -> Maybe a
Just ([Token]
cs, Int
size))
goent EntityTable
_ Token
tok (Just ([Token]
toks, Int
size)) =
let toksize :: Int
toksize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$
ByteString -> Int64
L.length (Builder -> ByteString
Builder.toLazyByteString (Token -> Builder
tokenToBuilder Token
tok))
in case Int
size forall a. Num a => a -> a -> a
+ Int
toksize of
Int
n | Int
n forall a. Ord a => a -> a -> Bool
> ParseSettings -> Int
psEntityExpansionSizeLimit ParseSettings
ps -> forall a. Maybe a
Nothing
| Bool
otherwise -> forall a. a -> Maybe a
Just (Token
tokforall a. a -> [a] -> [a]
:[Token]
toks, Int
n)
tnameToName :: Bool -> NSLevel -> TName -> Name
tnameToName :: Bool -> NSLevel -> TName -> Name
tnameToName Bool
_ NSLevel
_ (TName (Just Text
"xml") Text
name) =
Text -> Maybe Text -> Maybe Text -> Name
Name Text
name (forall a. a -> Maybe a
Just Text
"http://www.w3.org/XML/1998/namespace") (forall a. a -> Maybe a
Just Text
"xml")
tnameToName Bool
isAttr (NSLevel Maybe Text
def' Map Text Text
_) (TName Maybe Text
Nothing Text
name) =
Text -> Maybe Text -> Maybe Text -> Name
Name Text
name (if Bool
isAttr then forall a. Maybe a
Nothing else Maybe Text
def') forall a. Maybe a
Nothing
tnameToName Bool
_ (NSLevel Maybe Text
_ Map Text Text
m) (TName (Just Text
pref) Text
name) =
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
pref Map Text Text
m of
Just Text
ns -> Text -> Maybe Text -> Maybe Text -> Name
Name Text
name (forall a. a -> Maybe a
Just Text
ns) (forall a. a -> Maybe a
Just Text
pref)
Maybe Text
Nothing -> Text -> Maybe Text -> Maybe Text -> Name
Name Text
name forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Text
pref)
detectUtf :: MonadThrow m => ConduitT S.ByteString T.Text m ()
detectUtf :: forall (m :: * -> *). MonadThrow m => ConduitT ByteString Text m ()
detectUtf =
forall {m :: * -> *}.
MonadThrow m =>
(ByteString -> ByteString) -> ConduitT ByteString Text m ()
conduit forall a. a -> a
id
where
conduit :: (ByteString -> ByteString) -> ConduitT ByteString Text m ()
conduit ByteString -> ByteString
front = forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) ((ByteString -> ByteString)
-> ByteString -> ConduitT ByteString Text m ()
push ByteString -> ByteString
front)
push :: (ByteString -> ByteString)
-> ByteString -> ConduitT ByteString Text m ()
push ByteString -> ByteString
front ByteString
bss =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> ByteString) -> ConduitT ByteString Text m ()
conduit
(forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *).
MonadThrow m =>
ByteString -> Maybe Codec -> ConduitT ByteString Text m ()
checkXMLDecl)
(forall {t}.
(t -> ByteString)
-> t -> Either (ByteString -> ByteString) (ByteString, Maybe Codec)
getEncoding ByteString -> ByteString
front ByteString
bss)
getEncoding :: (t -> ByteString)
-> t -> Either (ByteString -> ByteString) (ByteString, Maybe Codec)
getEncoding t -> ByteString
front t
bs'
| ByteString -> Int
S.length ByteString
bs forall a. Ord a => a -> a -> Bool
< Int
4 =
forall a b. a -> Either a b
Left (ByteString
bs ByteString -> ByteString -> ByteString
`S.append`)
| Bool
otherwise =
forall a b. b -> Either a b
Right (ByteString
bsOut, Maybe Codec
mcodec)
where
bs :: ByteString
bs = t -> ByteString
front t
bs'
bsOut :: ByteString
bsOut = ByteString -> ByteString -> ByteString
S.append (Int -> ByteString -> ByteString
S.drop Int
toDrop ByteString
x) ByteString
y
(ByteString
x, ByteString
y) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt Int
4 ByteString
bs
(Int
toDrop, Maybe Codec
mcodec) =
case ByteString -> [Word8]
S.unpack ByteString
x of
[Word8
0x00, Word8
0x00, Word8
0xFE, Word8
0xFF] -> (Int
4, forall a. a -> Maybe a
Just Codec
CT.utf32_be)
[Word8
0xFF, Word8
0xFE, Word8
0x00, Word8
0x00] -> (Int
4, forall a. a -> Maybe a
Just Codec
CT.utf32_le)
Word8
0xFE : Word8
0xFF: [Word8]
_ -> (Int
2, forall a. a -> Maybe a
Just Codec
CT.utf16_be)
Word8
0xFF : Word8
0xFE: [Word8]
_ -> (Int
2, forall a. a -> Maybe a
Just Codec
CT.utf16_le)
Word8
0xEF : Word8
0xBB: Word8
0xBF : [Word8]
_ -> (Int
3, forall a. a -> Maybe a
Just Codec
CT.utf8)
[Word8
0x00, Word8
0x00, Word8
0x00, Word8
0x3C] -> (Int
0, forall a. a -> Maybe a
Just Codec
CT.utf32_be)
[Word8
0x3C, Word8
0x00, Word8
0x00, Word8
0x00] -> (Int
0, forall a. a -> Maybe a
Just Codec
CT.utf32_le)
[Word8
0x00, Word8
0x3C, Word8
0x00, Word8
0x3F] -> (Int
0, forall a. a -> Maybe a
Just Codec
CT.utf16_be)
[Word8
0x3C, Word8
0x00, Word8
0x3F, Word8
0x00] -> (Int
0, forall a. a -> Maybe a
Just Codec
CT.utf16_le)
[Word8]
_ -> (Int
0, forall a. Maybe a
Nothing)
checkXMLDecl :: MonadThrow m
=> S.ByteString
-> Maybe CT.Codec
-> ConduitT S.ByteString T.Text m ()
checkXMLDecl :: forall (m :: * -> *).
MonadThrow m =>
ByteString -> Maybe Codec -> ConduitT ByteString Text m ()
checkXMLDecl ByteString
bs (Just Codec
codec) = forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
bs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *).
MonadThrow m =>
Codec -> ConduitT ByteString Text m ()
CT.decode Codec
codec
checkXMLDecl ByteString
bs0 Maybe Codec
Nothing =
forall {m :: * -> *}.
MonadThrow m =>
[ByteString]
-> (Text -> IResult Text Token)
-> ByteString
-> ConduitT ByteString Text m ()
loop [] (forall a. Parser a -> Text -> Result a
AT.parse (ParseSettings -> Parser Token
parseToken forall a. Default a => a
def)) ByteString
bs0
where
loop :: [ByteString]
-> (Text -> IResult Text Token)
-> ByteString
-> ConduitT ByteString Text m ()
loop [ByteString]
chunks0 Text -> IResult Text Token
parser ByteString
nextChunk =
case Text -> IResult Text Token
parser forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
nextChunk of
AT.Fail{} -> ConduitT ByteString Text m ()
fallback
AT.Partial Text -> IResult Text Token
f -> forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe ConduitT ByteString Text m ()
fallback ([ByteString]
-> (Text -> IResult Text Token)
-> ByteString
-> ConduitT ByteString Text m ()
loop [ByteString]
chunks Text -> IResult Text Token
f)
AT.Done Text
_ (TokenXMLDeclaration [TAttribute]
attrs) -> [TAttribute] -> ConduitT ByteString Text m ()
findEncoding [TAttribute]
attrs
AT.Done{} -> ConduitT ByteString Text m ()
fallback
where
chunks :: [ByteString]
chunks = ByteString
nextChunk forall a. a -> [a] -> [a]
: [ByteString]
chunks0
fallback :: ConduitT ByteString Text m ()
fallback = Codec -> ConduitT ByteString Text m ()
complete Codec
CT.utf8
complete :: Codec -> ConduitT ByteString Text m ()
complete Codec
codec = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover [ByteString]
chunks forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *).
MonadThrow m =>
Codec -> ConduitT ByteString Text m ()
CT.decode Codec
codec
findEncoding :: [TAttribute] -> ConduitT ByteString Text m ()
findEncoding [] = ConduitT ByteString Text m ()
fallback
findEncoding ((TName Maybe Text
_ Text
"encoding", [ContentText Text
enc]):[TAttribute]
_) =
case Text -> Text
T.toLower Text
enc of
Text
"iso-8859-1" -> Codec -> ConduitT ByteString Text m ()
complete Codec
CT.iso8859_1
Text
"utf-8" -> Codec -> ConduitT ByteString Text m ()
complete Codec
CT.utf8
Text
_ -> Codec -> ConduitT ByteString Text m ()
complete Codec
CT.utf8
findEncoding (TAttribute
_:[TAttribute]
xs) = [TAttribute] -> ConduitT ByteString Text m ()
findEncoding [TAttribute]
xs
type EventPos = (Maybe PositionRange, Event)
parseBytes :: MonadThrow m
=> ParseSettings
-> ConduitT S.ByteString Event m ()
parseBytes :: forall (m :: * -> *).
MonadThrow m =>
ParseSettings -> ConduitT ByteString Event m ()
parseBytes = forall (m :: * -> *) o1 o2 i r.
Monad m =>
(o1 -> o2) -> ConduitT i o1 m r -> ConduitT i o2 m r
mapOutput forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadThrow m =>
ParseSettings -> ConduitT ByteString EventPos m ()
parseBytesPos
parseBytesPos :: MonadThrow m
=> ParseSettings
-> ConduitT S.ByteString EventPos m ()
parseBytesPos :: forall (m :: * -> *).
MonadThrow m =>
ParseSettings -> ConduitT ByteString EventPos m ()
parseBytesPos ParseSettings
ps = forall (m :: * -> *). MonadThrow m => ConduitT ByteString Text m ()
detectUtf forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *).
MonadThrow m =>
ParseSettings -> ConduitT Text EventPos m ()
parseTextPos ParseSettings
ps
dropBOM :: Monad m => ConduitT T.Text T.Text m ()
dropBOM :: forall (m :: * -> *). Monad m => ConduitT Text Text m ()
dropBOM =
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) Text -> ConduitT Text Text m ()
push
where
push :: Text -> ConduitT Text Text m ()
push Text
t =
case Text -> Maybe (Char, Text)
T.uncons Text
t of
Maybe (Char, Text)
Nothing -> forall (m :: * -> *). Monad m => ConduitT Text Text m ()
dropBOM
Just (Char
c, Text
cs) ->
let output :: Text
output
| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\xfeef' = Text
cs
| Bool
otherwise = Text
t
in forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Text
output forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {o}. ConduitT o o m ()
idConduit
idConduit :: ConduitT o o m ()
idConduit = forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\o
x -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield o
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT o o m ()
idConduit)
parseText :: MonadThrow m => ParseSettings -> ConduitT T.Text Event m ()
parseText :: forall (m :: * -> *).
MonadThrow m =>
ParseSettings -> ConduitT Text Event m ()
parseText = forall (m :: * -> *) o1 o2 i r.
Monad m =>
(o1 -> o2) -> ConduitT i o1 m r -> ConduitT i o2 m r
mapOutput forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadThrow m =>
ParseSettings -> ConduitT Text EventPos m ()
parseTextPos
parseTextPos :: MonadThrow m
=> ParseSettings
-> ConduitT T.Text EventPos m ()
parseTextPos :: forall (m :: * -> *).
MonadThrow m =>
ParseSettings -> ConduitT Text EventPos m ()
parseTextPos ParseSettings
de =
forall (m :: * -> *). Monad m => ConduitT Text Text m ()
dropBOM
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT Text (PositionRange, Token) m ()
tokenize
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 =>
ParseSettings -> ConduitT (PositionRange, Token) EventPos m ()
toEventC ParseSettings
de
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT EventPos EventPos m ()
addBeginEnd
where
tokenize :: ConduitT Text (PositionRange, Token) m ()
tokenize = forall (m :: * -> *).
MonadThrow m =>
ParseSettings -> ConduitT Text (PositionRange, Token) m ()
conduitToken ParseSettings
de
addBeginEnd :: ConduitT EventPos EventPos m ()
addBeginEnd = forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (forall a. Maybe a
Nothing, Event
EventBeginDocument) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {a}. ConduitT (Maybe a, Event) (Maybe a, Event) m ()
addEnd
addEnd :: ConduitT (Maybe a, Event) (Maybe a, Event) m ()
addEnd = forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (forall a. Maybe a
Nothing, Event
EventEndDocument))
(\(Maybe a, Event)
e -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Maybe a, Event)
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT (Maybe a, Event) (Maybe a, Event) m ()
addEnd)
toEventC :: Monad m => ParseSettings -> ConduitT (PositionRange, Token) EventPos m ()
toEventC :: forall (m :: * -> *).
Monad m =>
ParseSettings -> ConduitT (PositionRange, Token) EventPos m ()
toEventC ParseSettings
ps =
EntityTable
-> [NSLevel] -> ConduitT (PositionRange, Token) EventPos m ()
go [] []
where
go :: EntityTable
-> [NSLevel] -> ConduitT (PositionRange, Token) EventPos m ()
go !EntityTable
es ![NSLevel]
levels =
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (PositionRange, Token)
-> ConduitT (PositionRange, Token) EventPos m ()
push
where
push :: (PositionRange, Token)
-> ConduitT (PositionRange, Token) EventPos m ()
push (PositionRange
position, Token
token) =
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) (forall a. a -> Maybe a
Just PositionRange
position)) [Event]
events forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EntityTable
-> [NSLevel] -> ConduitT (PositionRange, Token) EventPos m ()
go EntityTable
es' [NSLevel]
levels'
where
(EntityTable
es', [NSLevel]
levels', [Event]
events) = ParseSettings
-> EntityTable
-> [NSLevel]
-> Token
-> (EntityTable, [NSLevel], [Event])
tokenToEvent ParseSettings
ps EntityTable
es [NSLevel]
levels Token
token
type DecodeEntities = Text -> Content
type DecodeIllegalCharacters = Int -> Maybe Char
data ParseSettings = ParseSettings
{ ParseSettings -> DecodeEntities
psDecodeEntities :: DecodeEntities
, ParseSettings -> Bool
psRetainNamespaces :: Bool
, ParseSettings -> DecodeIllegalCharacters
psDecodeIllegalCharacters :: DecodeIllegalCharacters
, ParseSettings -> Int
psEntityExpansionSizeLimit :: Int
, ParseSettings -> Bool
psIgnoreInternalEntityDeclarations :: Bool
}
instance Default ParseSettings where
def :: ParseSettings
def = ParseSettings
{ psDecodeEntities :: DecodeEntities
psDecodeEntities = DecodeEntities
decodeXmlEntities
, psRetainNamespaces :: Bool
psRetainNamespaces = Bool
False
, psDecodeIllegalCharacters :: DecodeIllegalCharacters
psDecodeIllegalCharacters = forall a b. a -> b -> a
const forall a. Maybe a
Nothing
, psEntityExpansionSizeLimit :: Int
psEntityExpansionSizeLimit = Int
8192
, psIgnoreInternalEntityDeclarations :: Bool
psIgnoreInternalEntityDeclarations = Bool
False
}
conduitToken :: MonadThrow m => ParseSettings -> ConduitT T.Text (PositionRange, Token) m ()
conduitToken :: forall (m :: * -> *).
MonadThrow m =>
ParseSettings -> ConduitT Text (PositionRange, Token) m ()
conduitToken = forall a (m :: * -> *) b.
(AttoparsecInput a, MonadThrow m) =>
Parser a b -> ConduitT a (PositionRange, b) m ()
conduitParser forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseSettings -> Parser Token
parseToken
parseToken :: ParseSettings -> Parser Token
parseToken :: ParseSettings -> Parser Token
parseToken ParseSettings
settings = do
Maybe Char
mbc <- Parser (Maybe Char)
peekChar
case Maybe Char
mbc of
Just Char
'<' -> Char -> Parser Char
char Char
'<' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Token
parseLt
Maybe Char
_ -> Content -> Token
TokenContent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseSettings -> Bool -> Bool -> Parser Content
parseContent ParseSettings
settings Bool
False Bool
False
where
parseLt :: Parser Token
parseLt = do
Maybe Char
mbc <- Parser (Maybe Char)
peekChar
case Maybe Char
mbc of
Just Char
'?' -> Char -> Parser ()
char' Char
'?' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Token
parseInstr
Just Char
'!' -> Char -> Parser ()
char' Char
'!' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
(Parser Token
parseComment forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseCdata forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseDoctype)
Just Char
'/' -> Char -> Parser ()
char' Char
'/' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Token
parseEnd
Maybe Char
_ -> Parser Token
parseBegin
parseInstr :: Parser Token
parseInstr = (do
Text
name <- Parser Text
parseIdent
if Text
name forall a. Eq a => a -> a -> Bool
== Text
"xml"
then do
[TAttribute]
as <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many forall a b. (a -> b) -> a -> b
$ ParseSettings -> Parser TAttribute
parseAttribute ParseSettings
settings
Parser ()
skipSpace
Char -> Parser ()
char' Char
'?'
Char -> Parser ()
char' Char
'>'
Parser ()
newline forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [TAttribute] -> Token
TokenXMLDeclaration [TAttribute]
as
else do
Parser ()
skipSpace
Text
x <- String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Char
anyChar (Text -> Parser Text
string Text
"?>")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Instruction -> Token
TokenInstruction forall a b. (a -> b) -> a -> b
$ Text -> Text -> Instruction
Instruction Text
name Text
x)
forall i a. Parser i a -> String -> Parser i a
<?> String
"instruction"
parseComment :: Parser Token
parseComment = (do
Char -> Parser ()
char' Char
'-'
Char -> Parser ()
char' Char
'-'
Text
c <- String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Char
anyChar (Text -> Parser Text
string Text
"-->")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Token
TokenComment Text
c) forall i a. Parser i a -> String -> Parser i a
<?> String
"comment"
parseCdata :: Parser Token
parseCdata = (do
Text
_ <- Text -> Parser Text
string Text
"[CDATA["
Text
t <- String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Char
anyChar (Text -> Parser Text
string Text
"]]>")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Token
TokenCDATA Text
t) forall i a. Parser i a -> String -> Parser i a
<?> String
"CDATA"
parseDoctype :: Parser Token
parseDoctype = (do
Text
_ <- Text -> Parser Text
string Text
"DOCTYPE"
Parser ()
skipSpace
TName
name <- Parser TName
parseName
let i :: Text
i =
case TName
name of
TName Maybe Text
Nothing Text
x -> Text
x
TName (Just Text
x) Text
y -> [Text] -> Text
T.concat [Text
x, Text
":", Text
y]
Parser ()
skipSpace
Maybe ExternalID
eid <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just Parser Text ExternalID
parsePublicID forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just Parser Text ExternalID
parseSystemID forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Parser ()
skipSpace
Maybe Char
mbc <- Parser (Maybe Char)
peekChar
EntityTable
ents <- case Maybe Char
mbc of
Just Char
'[' ->
do Char -> Parser ()
char' Char
'['
EntityTable
ents <- forall {c}. (EntityTable -> c) -> Parser Text c
parseDeclarations forall a. a -> a
id
Parser ()
skipSpace
if ParseSettings -> Bool
psIgnoreInternalEntityDeclarations ParseSettings
settings then
forall (m :: * -> *) a. Monad m => a -> m a
return []
else
forall (m :: * -> *) a. Monad m => a -> m a
return EntityTable
ents
Maybe Char
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Char -> Parser ()
char' Char
'>'
Parser ()
newline forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Maybe ExternalID -> EntityTable -> Token
TokenDoctype Text
i Maybe ExternalID
eid EntityTable
ents) forall i a. Parser i a -> String -> Parser i a
<?> String
"DOCTYPE"
parseDeclarations :: (EntityTable -> c) -> Parser Text c
parseDeclarations EntityTable -> c
front =
(Char -> Parser ()
char' Char
']' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (EntityTable -> c
front [])) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Parser Text (EntityTable -> EntityTable)
parseEntity forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \EntityTable -> EntityTable
f -> (EntityTable -> c) -> Parser Text c
parseDeclarations (EntityTable -> c
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityTable -> EntityTable
f)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Text -> Parser Text
string Text
"<!--" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Char
anyChar (Text -> Parser Text
string Text
"-->") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
(EntityTable -> c) -> Parser Text c
parseDeclarations EntityTable -> c
front) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(do Char -> Parser ()
char' Char
'<'
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany
(forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Char -> Bool) -> Parser Text
takeWhile1 (String -> Char -> Bool
notInClass String
"]<>'\"")) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Text
quotedText)
Char -> Parser ()
char' Char
'>'
(EntityTable -> c) -> Parser Text c
parseDeclarations EntityTable -> c
front) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany1 ((Char -> Bool) -> Parser Char
satisfy (String -> Char -> Bool
notInClass String
"]<>")) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
(EntityTable -> c) -> Parser Text c
parseDeclarations EntityTable -> c
front)
parseEntity :: Parser Text (EntityTable -> EntityTable)
parseEntity = (do
Text
_ <- Text -> Parser Text
string Text
"<!ENTITY"
Parser ()
skipSpace
Bool
isParameterEntity <- forall (f :: * -> *) a. Alternative f => a -> f a -> f a
AT.option Bool
False (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> Parser ()
char' Char
'%' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace))
Text
i <- Parser Text
parseIdent
Text
t <- Parser Text
quotedText
Parser ()
skipSpace
Char -> Parser ()
char' Char
'>'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
if Bool
isParameterEntity
then forall a. a -> a
id
else ((Text
i, Text
t)forall a. a -> [a] -> [a]
:)) forall i a. Parser i a -> String -> Parser i a
<?> String
"entity"
parsePublicID :: Parser Text ExternalID
parsePublicID = Text -> Text -> ExternalID
PublicID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
string Text
"PUBLIC" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
quotedText) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text
quotedText
parseSystemID :: Parser Text ExternalID
parseSystemID = Text -> ExternalID
SystemID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
string Text
"SYSTEM" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
quotedText)
quotedText :: Parser Text
quotedText = (do
Parser ()
skipSpace
Char -> Parser Text
between Char
'"' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Text
between Char
'\'') forall i a. Parser i a -> String -> Parser i a
<?> String
"quoted text"
between :: Char -> Parser Text
between Char
c = do
Char -> Parser ()
char' Char
c
Text
x <- (Char -> Bool) -> Parser Text
takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
c)
Char -> Parser ()
char' Char
c
forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
parseEnd :: Parser Token
parseEnd = (do
Parser ()
skipSpace
TName
n <- Parser TName
parseName
Parser ()
skipSpace
Char -> Parser ()
char' Char
'>'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TName -> Token
TokenEndElement TName
n) forall i a. Parser i a -> String -> Parser i a
<?> String
"close tag"
parseBegin :: Parser Token
parseBegin = (do
Parser ()
skipSpace
TName
n <- Parser TName
parseName
[TAttribute]
as <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many forall a b. (a -> b) -> a -> b
$ ParseSettings -> Parser TAttribute
parseAttribute ParseSettings
settings
Parser ()
skipSpace
Bool
isClose <- (Char -> Parser Char
char Char
'/' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
skipSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Char -> Parser ()
char' Char
'>'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TName -> [TAttribute] -> Bool -> Int -> Token
TokenBeginElement TName
n [TAttribute]
as Bool
isClose Int
0) forall i a. Parser i a -> String -> Parser i a
<?> String
"open tag"
parseAttribute :: ParseSettings -> Parser TAttribute
parseAttribute :: ParseSettings -> Parser TAttribute
parseAttribute ParseSettings
settings = (do
Parser ()
skipSpace
TName
key <- Parser TName
parseName
Parser ()
skipSpace
Char -> Parser ()
char' Char
'='
Parser ()
skipSpace
[Content]
val <- Parser Text [Content]
squoted forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text [Content]
dquoted
forall (m :: * -> *) a. Monad m => a -> m a
return (TName
key, [Content]
val)) forall i a. Parser i a -> String -> Parser i a
<?> String
"attribute"
where
squoted :: Parser Text [Content]
squoted = Char -> Parser Char
char Char
'\'' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill (ParseSettings -> Bool -> Bool -> Parser Content
parseContent ParseSettings
settings Bool
False Bool
True) (Char -> Parser Char
char Char
'\'')
dquoted :: Parser Text [Content]
dquoted = Char -> Parser Char
char Char
'"' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill (ParseSettings -> Bool -> Bool -> Parser Content
parseContent ParseSettings
settings Bool
True Bool
False) (Char -> Parser Char
char Char
'"')
parseName :: Parser TName
parseName :: Parser TName
parseName =
(Text -> Maybe Text -> TName
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
parseIdent forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
A.optional (Char -> Parser Char
char Char
':' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text
parseIdent)) forall i a. Parser i a -> String -> Parser i a
<?> String
"name"
where
name :: Text -> Maybe Text -> TName
name Text
i1 Maybe Text
Nothing = Maybe Text -> Text -> TName
TName forall a. Maybe a
Nothing Text
i1
name Text
i1 (Just Text
i2) = Maybe Text -> Text -> TName
TName (forall a. a -> Maybe a
Just Text
i1) Text
i2
parseIdent :: Parser Text
parseIdent :: Parser Text
parseIdent = (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
valid forall i a. Parser i a -> String -> Parser i a
<?> String
"identifier"
where
valid :: Char -> Bool
valid Char
'&' = Bool
False
valid Char
'<' = Bool
False
valid Char
'>' = Bool
False
valid Char
':' = Bool
False
valid Char
'?' = Bool
False
valid Char
'=' = Bool
False
valid Char
'"' = Bool
False
valid Char
'\'' = Bool
False
valid Char
'/' = Bool
False
valid Char
';' = Bool
False
valid Char
'#' = Bool
False
valid Char
'[' = Bool
False
valid Char
']' = Bool
False
valid Char
c = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Char -> Bool
isXMLSpace Char
c
parseContent :: ParseSettings
-> Bool
-> Bool
-> Parser Content
parseContent :: ParseSettings -> Bool -> Bool -> Parser Content
parseContent (ParseSettings DecodeEntities
decodeEntities Bool
_ DecodeIllegalCharacters
decodeIllegalCharacters Int
_ Bool
_) Bool
breakDouble Bool
breakSingle = Parser Content
parseReference forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Content
parseTextContent forall i a. Parser i a -> String -> Parser i a
<?> String
"text content") where
parseReference :: Parser Content
parseReference = do
Char -> Parser ()
char' Char
'&'
Content
t <- Parser Content
parseEntityRef forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Content
parseHexCharRef forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Content
parseDecCharRef
Char -> Parser ()
char' Char
';'
forall (m :: * -> *) a. Monad m => a -> m a
return Content
t
parseEntityRef :: Parser Content
parseEntityRef = do
TName Maybe Text
ma Text
b <- Parser TName
parseName
let name :: Text
name = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
`T.append` Text
":") Maybe Text
ma Text -> Text -> Text
`T.append` Text
b
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Text
name of
Text
"lt" -> DecodeEntities
ContentText Text
"<"
Text
"gt" -> DecodeEntities
ContentText Text
">"
Text
"amp" -> DecodeEntities
ContentText Text
"&"
Text
"quot" -> DecodeEntities
ContentText Text
"\""
Text
"apos" -> DecodeEntities
ContentText Text
"'"
Text
_ -> DecodeEntities
decodeEntities Text
name
parseHexCharRef :: Parser Content
parseHexCharRef = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
string Text
"#x"
Int
n <- forall a. (Integral a, Bits a) => Parser a
AT.hexadecimal
case DecodeIllegalCharacters
toValidXmlChar Int
n forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DecodeIllegalCharacters
decodeIllegalCharacters Int
n of
Maybe Char
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid character from hexadecimal character reference."
Just Char
c -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DecodeEntities
ContentText forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c
parseDecCharRef :: Parser Content
parseDecCharRef = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
string Text
"#"
Int
n <- forall a. Integral a => Parser a
AT.decimal
case DecodeIllegalCharacters
toValidXmlChar Int
n forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DecodeIllegalCharacters
decodeIllegalCharacters Int
n of
Maybe Char
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid character from decimal character reference."
Just Char
c -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DecodeEntities
ContentText forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c
parseTextContent :: Parser Content
parseTextContent = do
Text
firstChunk <- (Char -> Bool) -> Parser Text
takeWhile Char -> Bool
valid
Maybe Char
mbC <- Parser (Maybe Char)
peekChar
case Maybe Char
mbC of
Just Char
'\r' ->
[Text] -> Parser Content
handleCR [Text
firstChunk]
Maybe Char
_ ->
forall {m :: * -> *}. MonadFail m => Text -> m Content
exit Text
firstChunk
handleCRPeek :: [Text] -> Parser Content
handleCRPeek [Text]
chunks = do
Maybe Char
mbC <- Parser (Maybe Char)
peekChar
case Maybe Char
mbC of
Just Char
'\r' ->
[Text] -> Parser Content
handleCR [Text]
chunks
Maybe Char
_ ->
forall {m :: * -> *}. MonadFail m => [Text] -> m Content
exit' [Text]
chunks
handleCR :: [Text] -> Parser Content
handleCR [Text]
chunks = do
Char
_ <- Parser Char
anyChar
Text
chunk <- (Char -> Bool) -> Parser Text
takeWhile Char -> Bool
valid
case Text -> Maybe (Char, Text)
T.uncons Text
chunk of
Just (Char
'\n', Text
_) ->
[Text] -> Parser Content
handleCRPeek forall a b. (a -> b) -> a -> b
$ Text
chunk forall a. a -> [a] -> [a]
: [Text]
chunks
Just (Char, Text)
_ ->
[Text] -> Parser Content
handleCRPeek forall a b. (a -> b) -> a -> b
$ Text
chunk forall a. a -> [a] -> [a]
: Text
"\n" forall a. a -> [a] -> [a]
: [Text]
chunks
Maybe (Char, Text)
Nothing ->
[Text] -> Parser Content
handleCRPeek forall a b. (a -> b) -> a -> b
$ Text
"\n" forall a. a -> [a] -> [a]
: [Text]
chunks
exit :: Text -> m Content
exit Text
c
| Text -> Bool
T.null Text
c = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parseTextContent"
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DecodeEntities
ContentText Text
c
exit' :: [Text] -> m Content
exit' [Text]
cs = forall {m :: * -> *}. MonadFail m => Text -> m Content
exit forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Text]
cs
valid :: Char -> Bool
valid Char
'"' = Bool -> Bool
not Bool
breakDouble
valid Char
'\'' = Bool -> Bool
not Bool
breakSingle
valid Char
'&' = Bool
False
valid Char
'<' = Bool
False
valid Char
'\r' = Bool
False
valid Char
_ = Bool
True
toValidXmlChar :: Int -> Maybe Char
toValidXmlChar :: DecodeIllegalCharacters
toValidXmlChar Int
n
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int, Int) -> Bool
checkRange [(Int, Int)]
ranges = forall a. a -> Maybe a
Just (forall a. Enum a => Int -> a
toEnum Int
n)
| Bool
otherwise = forall a. Maybe a
Nothing
where
ranges :: [(Int, Int)]
ranges :: [(Int, Int)]
ranges =
[ (Int
0x9, Int
0xA)
, (Int
0xD, Int
0xD)
, (Int
0x20, Int
0xD7FF)
, (Int
0xE000, Int
0xFFFD)
, (Int
0x10000, Int
0x10FFFF)
]
checkRange :: (Int, Int) -> Bool
checkRange (Int
lb, Int
ub) = Int
lb forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
ub
skipSpace :: Parser ()
skipSpace :: Parser ()
skipSpace = (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isXMLSpace
isXMLSpace :: Char -> Bool
isXMLSpace :: Char -> Bool
isXMLSpace Char
' ' = Bool
True
isXMLSpace Char
'\t' = Bool
True
isXMLSpace Char
'\r' = Bool
True
isXMLSpace Char
'\n' = Bool
True
isXMLSpace Char
_ = Bool
False
newline :: Parser ()
newline :: Parser ()
newline = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ (Char -> Parser Char
char Char
'\r' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser Char
char Char
'\n') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Char
char Char
'\n'
char' :: Char -> Parser ()
char' :: Char -> Parser ()
char' = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Parser Char
char
data ContentType = Ignore | IsContent Text | IsError String | NotContent
contentMaybe :: MonadThrow m => ConduitT Event o m (Maybe Text)
contentMaybe :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitT Event o m (Maybe Text)
contentMaybe = do
Maybe Event
x <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
peekC
case Maybe Event -> ContentType
pc' Maybe Event
x of
ContentType
Ignore -> forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
dropC Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) o.
MonadThrow m =>
ConduitT Event o m (Maybe Text)
contentMaybe
IsContent Text
t -> forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
dropC Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (forall {m :: * -> *} {o}.
MonadThrow m =>
([Text] -> [Text]) -> ConduitT Event o m Text
takeContents (Text
tforall a. a -> [a] -> [a]
:))
IsError String
e -> 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
$ String -> Maybe Event -> XmlException
InvalidEntity String
e Maybe Event
x
ContentType
NotContent -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
where
pc' :: Maybe Event -> ContentType
pc' Maybe Event
Nothing = ContentType
NotContent
pc' (Just Event
x) = Event -> ContentType
pc Event
x
pc :: Event -> ContentType
pc (EventContent (ContentText Text
t)) = Text -> ContentType
IsContent Text
t
pc (EventContent (ContentEntity Text
e)) = String -> ContentType
IsError forall a b. (a -> b) -> a -> b
$ String
"Unknown entity: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
e
pc (EventCDATA Text
t) = Text -> ContentType
IsContent Text
t
pc EventBeginElement{} = ContentType
NotContent
pc EventEndElement{} = ContentType
NotContent
pc EventBeginDocument{} = ContentType
Ignore
pc Event
EventEndDocument = ContentType
Ignore
pc EventBeginDoctype{} = ContentType
Ignore
pc Event
EventEndDoctype = ContentType
Ignore
pc EventInstruction{} = ContentType
Ignore
pc EventComment{} = ContentType
Ignore
takeContents :: ([Text] -> [Text]) -> ConduitT Event o m Text
takeContents [Text] -> [Text]
front = do
Maybe Event
x <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
peekC
case Maybe Event -> ContentType
pc' Maybe Event
x of
ContentType
Ignore -> forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
dropC Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Text] -> [Text]) -> ConduitT Event o m Text
takeContents [Text] -> [Text]
front
IsContent Text
t -> forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
dropC Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Text] -> [Text]) -> ConduitT Event o m Text
takeContents ([Text] -> [Text]
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Text
t)
IsError String
e -> 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
$ String -> Maybe Event -> XmlException
InvalidEntity String
e Maybe Event
x
ContentType
NotContent -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
front []
content :: MonadThrow m => ConduitT Event o m Text
content :: forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content = forall a. a -> Maybe a -> a
fromMaybe Text
T.empty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) o.
MonadThrow m =>
ConduitT Event o m (Maybe Text)
contentMaybe
isWhitespace :: Event -> Bool
isWhitespace :: Event -> Bool
isWhitespace Event
EventBeginDocument = Bool
True
isWhitespace Event
EventEndDocument = Bool
True
isWhitespace EventBeginDoctype{} = Bool
True
isWhitespace Event
EventEndDoctype = Bool
True
isWhitespace EventInstruction{} = Bool
True
isWhitespace (EventContent (ContentText Text
t)) = (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
t
isWhitespace EventComment{} = Bool
True
isWhitespace (EventCDATA Text
t) = (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
t
isWhitespace Event
_ = Bool
False
tag :: MonadThrow m
=> NameMatcher a
-> (a -> AttrParser b)
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag :: forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> (a -> AttrParser b)
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag NameMatcher a
nameMatcher a -> AttrParser b
attrParser b -> ConduitT Event o m c
f = do
(Maybe Event
x, [Event]
leftovers) <- forall {m :: * -> *} {o}.
Monad m =>
[Event] -> ConduitT Event o m (Maybe Event, [Event])
dropWS []
Maybe c
res <- case Maybe Event
x of
Just (EventBeginElement Name
name [(Name, [Content])]
as) -> case forall a. NameMatcher a -> Name -> Maybe a
runNameMatcher NameMatcher a
nameMatcher Name
name of
Just a
y -> case forall {b}.
AttrParser b -> [(Name, [Content])] -> Either SomeException b
runAttrParser' (a -> AttrParser b
attrParser a
y) [(Name, [Content])]
as of
Left SomeException
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Right b
z -> do
c
z' <- b -> ConduitT Event o m c
f b
z
(Maybe Event
a, [Event]
_leftovers') <- forall {m :: * -> *} {o}.
Monad m =>
[Event] -> ConduitT Event o m (Maybe Event, [Event])
dropWS []
case Maybe Event
a of
Just (EventEndElement Name
name')
| Name
name forall a. Eq a => a -> a -> Bool
== Name
name' -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just c
z')
Maybe Event
_ -> 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 Event -> XmlException
InvalidEndElement Name
name Maybe Event
a
Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Maybe Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
case Maybe c
res of
Maybe c
Nothing -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover [Event]
leftovers
Maybe c
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe c
res
where
dropWS :: [Event] -> ConduitT Event o m (Maybe Event, [Event])
dropWS [Event]
leftovers = do
Maybe Event
x <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
let leftovers' :: [Event]
leftovers' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:) Maybe Event
x [Event]
leftovers
case Event -> Bool
isWhitespace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Event
x of
Just Bool
True -> [Event] -> ConduitT Event o m (Maybe Event, [Event])
dropWS [Event]
leftovers'
Maybe Bool
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Event
x, [Event]
leftovers')
runAttrParser' :: AttrParser b -> [(Name, [Content])] -> Either SomeException b
runAttrParser' AttrParser b
p [(Name, [Content])]
as =
case forall a.
AttrParser a
-> [(Name, [Content])]
-> Either SomeException ([(Name, [Content])], a)
runAttrParser AttrParser b
p [(Name, [Content])]
as of
Left SomeException
e -> forall a b. a -> Either a b
Left SomeException
e
Right ([], b
x) -> forall a b. b -> Either a b
Right b
x
Right ([(Name, [Content])]
attr', b
_) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall e. Exception e => e -> SomeException
toException forall a b. (a -> b) -> a -> b
$ [(Name, [Content])] -> XmlException
UnparsedAttributes [(Name, [Content])]
attr'
tag' :: MonadThrow m
=> NameMatcher a -> AttrParser b -> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag' :: forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag' NameMatcher a
a AttrParser b
b = forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> (a -> AttrParser b)
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag NameMatcher a
a (forall a b. a -> b -> a
const AttrParser b
b)
tagNoAttr :: MonadThrow m
=> NameMatcher a
-> ConduitT Event o m b
-> ConduitT Event o m (Maybe b)
tagNoAttr :: forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher a
name ConduitT Event o m b
f = forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag' NameMatcher a
name (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const ConduitT Event o m b
f
tagIgnoreAttrs :: MonadThrow m
=> NameMatcher a
-> ConduitT Event o m b
-> ConduitT Event o m (Maybe b)
tagIgnoreAttrs :: forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagIgnoreAttrs NameMatcher a
name ConduitT Event o m b
f = forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag' NameMatcher a
name AttrParser ()
ignoreAttrs forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const ConduitT Event o m b
f
ignoreEmptyTag :: MonadThrow m
=> NameMatcher a
-> ConduitT Event o m (Maybe ())
ignoreEmptyTag :: forall (m :: * -> *) a o.
MonadThrow m =>
NameMatcher a -> ConduitT Event o m (Maybe ())
ignoreEmptyTag NameMatcher a
nameMatcher = forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagIgnoreAttrs NameMatcher a
nameMatcher (forall (m :: * -> *) a. Monad m => a -> m a
return ())
ignored :: Monad m => ConduitT i o m ()
ignored :: forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
ignored = forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \ConduitT i o m ()
recurse -> do
Maybe i
event <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
case Maybe i
event of
Just i
_ -> ConduitT i o m ()
recurse
Maybe i
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
ignoreTree :: MonadThrow m => NameMatcher a -> AttrParser b -> ConduitT Event o m (Maybe ())
ignoreTree :: forall (m :: * -> *) a b o.
MonadThrow m =>
NameMatcher a -> AttrParser b -> ConduitT Event o m (Maybe ())
ignoreTree NameMatcher a
nameMatcher AttrParser b
attrParser = forall (m :: * -> *) a b r c.
Monad m =>
ConduitT a b m r -> ConduitT b c m () -> ConduitT a c m r
fuseUpstream (forall (m :: * -> *) a b.
MonadThrow m =>
NameMatcher a -> AttrParser b -> ConduitT Event Event m (Maybe ())
takeTree NameMatcher a
nameMatcher AttrParser b
attrParser) forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
ignored
ignoreContent :: MonadThrow m => ConduitT Event o m (Maybe ())
ignoreContent :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitT Event o m (Maybe ())
ignoreContent = forall (m :: * -> *) a b r c.
Monad m =>
ConduitT a b m r -> ConduitT b c m () -> ConduitT a c m r
fuseUpstream forall (m :: * -> *).
MonadThrow m =>
ConduitT Event Event m (Maybe ())
takeContent forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
ignored
ignoreTreeContent :: MonadThrow m => NameMatcher a -> AttrParser b -> ConduitT Event o m (Maybe ())
ignoreTreeContent :: forall (m :: * -> *) a b o.
MonadThrow m =>
NameMatcher a -> AttrParser b -> ConduitT Event o m (Maybe ())
ignoreTreeContent NameMatcher a
namePred AttrParser b
attrParser = forall (m :: * -> *) a b r c.
Monad m =>
ConduitT a b m r -> ConduitT b c m () -> ConduitT a c m r
fuseUpstream (forall (m :: * -> *) a b.
MonadThrow m =>
NameMatcher a -> AttrParser b -> ConduitT Event Event m (Maybe ())
takeTreeContent NameMatcher a
namePred AttrParser b
attrParser) forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
ignored
ignoreAnyTreeContent :: MonadThrow m => ConduitT Event o m (Maybe ())
ignoreAnyTreeContent :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitT Event o m (Maybe ())
ignoreAnyTreeContent = forall (m :: * -> *) a b r c.
Monad m =>
ConduitT a b m r -> ConduitT b c m () -> ConduitT a c m r
fuseUpstream forall (m :: * -> *).
MonadThrow m =>
ConduitT Event Event m (Maybe ())
takeAnyTreeContent forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
ignored
orE :: Monad m
=> ConduitT Event o m (Maybe a)
-> ConduitT Event o m (Maybe a)
-> ConduitT Event o m (Maybe a)
orE :: forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a)
-> ConduitT Event o m (Maybe a) -> ConduitT Event o m (Maybe a)
orE ConduitT Event o m (Maybe a)
a ConduitT Event o m (Maybe a)
b = ConduitT Event o m (Maybe a)
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe a
x -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe ConduitT Event o m (Maybe a)
b (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
x) Maybe a
x
choose :: Monad m
=> [ConduitT Event o m (Maybe a)]
-> ConduitT Event o m (Maybe a)
choose :: forall (m :: * -> *) o a.
Monad m =>
[ConduitT Event o m (Maybe a)] -> ConduitT Event o m (Maybe a)
choose [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
choose (ConduitT Event o m (Maybe a)
i:[ConduitT Event o m (Maybe a)]
is) = ConduitT Event o m (Maybe a)
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) o a.
Monad m =>
[ConduitT Event o m (Maybe a)] -> ConduitT Event o m (Maybe a)
choose [ConduitT Event o m (Maybe a)]
is) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
force :: MonadThrow m
=> String
-> m (Maybe a)
-> m a
force :: forall (m :: * -> *) a.
MonadThrow m =>
String -> m (Maybe a) -> m a
force String
msg m (Maybe a)
i = m (Maybe a)
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> Maybe Event -> XmlException
XmlException String
msg forall a. Maybe a
Nothing) forall (m :: * -> *) a. Monad m => a -> m a
return
parseFile :: MonadResource m
=> ParseSettings
-> FilePath
-> ConduitT i Event m ()
parseFile :: forall (m :: * -> *) i.
MonadResource m =>
ParseSettings -> String -> ConduitT i Event m ()
parseFile ParseSettings
ps String
fp = forall (m :: * -> *) i.
MonadResource m =>
String -> ConduitT i ByteString m ()
sourceFile String
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 :: * -> *) (n :: * -> *) i o r.
Monad m =>
(forall a. m a -> n a) -> ConduitT i o m r -> ConduitT i o n r
transPipe forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *).
MonadThrow m =>
ParseSettings -> ConduitT ByteString Event m ()
parseBytes ParseSettings
ps)
parseLBS :: MonadThrow m
=> ParseSettings
-> L.ByteString
-> ConduitT i Event m ()
parseLBS :: forall (m :: * -> *) i.
MonadThrow m =>
ParseSettings -> ByteString -> ConduitT i Event m ()
parseLBS ParseSettings
ps ByteString
lbs = forall (m :: * -> *) lazy strict i.
(Monad m, LazySequence lazy strict) =>
lazy -> ConduitT i strict m ()
sourceLazy 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 :: * -> *).
MonadThrow m =>
ParseSettings -> ConduitT ByteString Event m ()
parseBytes ParseSettings
ps
data XmlException = XmlException
{ XmlException -> String
xmlErrorMessage :: String
, XmlException -> Maybe Event
xmlBadInput :: Maybe Event
}
| InvalidEndElement Name (Maybe Event)
| InvalidEntity String (Maybe Event)
| MissingAttribute String
| UnparsedAttributes [(Name, [Content])]
deriving (Int -> XmlException -> ShowS
[XmlException] -> ShowS
XmlException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XmlException] -> ShowS
$cshowList :: [XmlException] -> ShowS
show :: XmlException -> String
$cshow :: XmlException -> String
showsPrec :: Int -> XmlException -> ShowS
$cshowsPrec :: Int -> XmlException -> ShowS
Show, Typeable)
instance Exception XmlException where
#if MIN_VERSION_base(4, 8, 0)
displayException :: XmlException -> String
displayException (XmlException String
msg (Just Event
event)) = String
"Error while parsing XML event " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Event
event forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
msg
displayException (XmlException String
msg Maybe Event
_) = String
"Error while parsing XML: " forall a. [a] -> [a] -> [a]
++ String
msg
displayException (InvalidEndElement Name
name (Just Event
event)) = String
"Error while parsing XML event: expected </" forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (Name -> Text
nameLocalName Name
name) forall a. [a] -> [a] -> [a]
++ String
">, got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Event
event
displayException (InvalidEndElement Name
name Maybe Event
_) = String
"Error while parsing XML event: expected </" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Name
name forall a. [a] -> [a] -> [a]
++ String
">, got nothing"
displayException (InvalidEntity String
msg (Just Event
event)) = String
"Error while parsing XML entity " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Event
event forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
msg
displayException (InvalidEntity String
msg Maybe Event
_) = String
"Error while parsing XML entity: " forall a. [a] -> [a] -> [a]
++ String
msg
displayException (MissingAttribute String
msg) = String
"Missing required attribute: " forall a. [a] -> [a] -> [a]
++ String
msg
displayException (UnparsedAttributes [(Name, [Content])]
attrs) = forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Name, [Content])]
attrs) forall a. [a] -> [a] -> [a]
++ String
" remaining unparsed attributes: \n" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" (forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Name, [Content])]
attrs)
#endif
newtype NameMatcher a = NameMatcher { forall a. NameMatcher a -> Name -> Maybe a
runNameMatcher :: Name -> Maybe a }
deriving instance Functor NameMatcher
instance Applicative NameMatcher where
pure :: forall a. a -> NameMatcher a
pure a
a = forall a. (Name -> Maybe a) -> NameMatcher a
NameMatcher forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
NameMatcher Name -> Maybe (a -> b)
f <*> :: forall a b. NameMatcher (a -> b) -> NameMatcher a -> NameMatcher b
<*> NameMatcher Name -> Maybe a
a = forall a. (Name -> Maybe a) -> NameMatcher a
NameMatcher forall a b. (a -> b) -> a -> b
$ \Name
name -> Name -> Maybe (a -> b)
f Name
name forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Maybe a
a Name
name
instance Alternative NameMatcher where
empty :: forall a. NameMatcher a
empty = forall a. (Name -> Maybe a) -> NameMatcher a
NameMatcher forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a. Maybe a
Nothing
NameMatcher Name -> Maybe a
f <|> :: forall a. NameMatcher a -> NameMatcher a -> NameMatcher a
<|> NameMatcher Name -> Maybe a
g = forall a. (Name -> Maybe a) -> NameMatcher a
NameMatcher (\Name
a -> Name -> Maybe a
f Name
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Name -> Maybe a
g Name
a)
instance (a ~ Name) => IsString (NameMatcher a) where
fromString :: String -> NameMatcher a
fromString String
s = (Name -> Bool) -> NameMatcher Name
matching (forall a. Eq a => a -> a -> Bool
== forall a. IsString a => String -> a
fromString String
s)
matching :: (Name -> Bool) -> NameMatcher Name
matching :: (Name -> Bool) -> NameMatcher Name
matching Name -> Bool
f = forall a. (Name -> Maybe a) -> NameMatcher a
NameMatcher forall a b. (a -> b) -> a -> b
$ \Name
name -> if Name -> Bool
f Name
name then forall a. a -> Maybe a
Just Name
name else forall a. Maybe a
Nothing
anyName :: NameMatcher Name
anyName :: NameMatcher Name
anyName = (Name -> Bool) -> NameMatcher Name
matching (forall a b. a -> b -> a
const Bool
True)
anyOf :: [Name] -> NameMatcher Name
anyOf :: [Name] -> NameMatcher Name
anyOf [Name]
values = (Name -> Bool) -> NameMatcher Name
matching (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
values)
newtype AttrParser a = AttrParser { forall a.
AttrParser a
-> [(Name, [Content])]
-> Either SomeException ([(Name, [Content])], a)
runAttrParser :: [(Name, [Content])] -> Either SomeException ([(Name, [Content])], a) }
instance Monad AttrParser where
return :: forall a. a -> AttrParser a
return a
a = forall a.
([(Name, [Content])]
-> Either SomeException ([(Name, [Content])], a))
-> AttrParser a
AttrParser forall a b. (a -> b) -> a -> b
$ \[(Name, [Content])]
as -> forall a b. b -> Either a b
Right ([(Name, [Content])]
as, a
a)
(AttrParser [(Name, [Content])]
-> Either SomeException ([(Name, [Content])], a)
f) >>= :: forall a b. AttrParser a -> (a -> AttrParser b) -> AttrParser b
>>= a -> AttrParser b
g = forall a.
([(Name, [Content])]
-> Either SomeException ([(Name, [Content])], a))
-> AttrParser a
AttrParser forall a b. (a -> b) -> a -> b
$ \[(Name, [Content])]
as ->
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (\([(Name, [Content])]
as', a
f') -> forall a.
AttrParser a
-> [(Name, [Content])]
-> Either SomeException ([(Name, [Content])], a)
runAttrParser (a -> AttrParser b
g a
f') [(Name, [Content])]
as') ([(Name, [Content])]
-> Either SomeException ([(Name, [Content])], a)
f [(Name, [Content])]
as)
instance Functor AttrParser where
fmap :: forall a b. (a -> b) -> AttrParser a -> AttrParser b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative AttrParser where
pure :: forall a. a -> AttrParser a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b. AttrParser (a -> b) -> AttrParser a -> AttrParser b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Alternative AttrParser where
empty :: forall a. AttrParser a
empty = forall a.
([(Name, [Content])]
-> Either SomeException ([(Name, [Content])], a))
-> AttrParser a
AttrParser forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall e. Exception e => e -> SomeException
toException forall a b. (a -> b) -> a -> b
$ String -> Maybe Event -> XmlException
XmlException String
"AttrParser.empty" forall a. Maybe a
Nothing
AttrParser [(Name, [Content])]
-> Either SomeException ([(Name, [Content])], a)
f <|> :: forall a. AttrParser a -> AttrParser a -> AttrParser a
<|> AttrParser [(Name, [Content])]
-> Either SomeException ([(Name, [Content])], a)
g = forall a.
([(Name, [Content])]
-> Either SomeException ([(Name, [Content])], a))
-> AttrParser a
AttrParser forall a b. (a -> b) -> a -> b
$ \[(Name, [Content])]
x ->
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ [(Name, [Content])]
-> Either SomeException ([(Name, [Content])], a)
g [(Name, [Content])]
x) forall a b. b -> Either a b
Right ([(Name, [Content])]
-> Either SomeException ([(Name, [Content])], a)
f [(Name, [Content])]
x)
instance MonadThrow AttrParser where
throwM :: forall e a. Exception e => e -> AttrParser a
throwM = forall a.
([(Name, [Content])]
-> Either SomeException ([(Name, [Content])], a))
-> AttrParser a
AttrParser forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
optionalAttrRaw :: ((Name, [Content]) -> Maybe b) -> AttrParser (Maybe b)
optionalAttrRaw :: forall b. ((Name, [Content]) -> Maybe b) -> AttrParser (Maybe b)
optionalAttrRaw (Name, [Content]) -> Maybe b
f =
forall a.
([(Name, [Content])]
-> Either SomeException ([(Name, [Content])], a))
-> AttrParser a
AttrParser forall a b. (a -> b) -> a -> b
$ ([(Name, [Content])] -> [(Name, [Content])])
-> [(Name, [Content])]
-> Either SomeException ([(Name, [Content])], Maybe b)
go forall a. a -> a
id
where
go :: ([(Name, [Content])] -> [(Name, [Content])])
-> [(Name, [Content])]
-> Either SomeException ([(Name, [Content])], Maybe b)
go [(Name, [Content])] -> [(Name, [Content])]
front [] = forall a b. b -> Either a b
Right ([(Name, [Content])] -> [(Name, [Content])]
front [], forall a. Maybe a
Nothing)
go [(Name, [Content])] -> [(Name, [Content])]
front ((Name, [Content])
a:[(Name, [Content])]
as) =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (([(Name, [Content])] -> [(Name, [Content])])
-> [(Name, [Content])]
-> Either SomeException ([(Name, [Content])], Maybe b)
go ([(Name, [Content])] -> [(Name, [Content])]
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) (Name, [Content])
a) [(Name, [Content])]
as)
(\b
b -> forall a b. b -> Either a b
Right ([(Name, [Content])] -> [(Name, [Content])]
front [(Name, [Content])]
as, forall a. a -> Maybe a
Just b
b))
((Name, [Content]) -> Maybe b
f (Name, [Content])
a)
requireAttrRaw :: String -> ((Name, [Content]) -> Maybe b) -> AttrParser b
requireAttrRaw :: forall b. String -> ((Name, [Content]) -> Maybe b) -> AttrParser b
requireAttrRaw String
msg (Name, [Content]) -> Maybe b
f = forall b. ((Name, [Content]) -> Maybe b) -> AttrParser (Maybe b)
optionalAttrRaw (Name, [Content]) -> Maybe b
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a.
([(Name, [Content])]
-> Either SomeException ([(Name, [Content])], a))
-> AttrParser a
AttrParser forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall e. Exception e => e -> SomeException
toException forall a b. (a -> b) -> a -> b
$ String -> XmlException
MissingAttribute String
msg)
forall (m :: * -> *) a. Monad m => a -> m a
return
attr :: Name -> AttrParser (Maybe Text)
attr :: Name -> AttrParser (Maybe Text)
attr Name
n = forall b. ((Name, [Content]) -> Maybe b) -> AttrParser (Maybe b)
optionalAttrRaw
(\(Name
x, [Content]
y) -> if Name
x forall a. Eq a => a -> a -> Bool
== Name
n then forall a. a -> Maybe a
Just ([Content] -> Text
contentsToText [Content]
y) else forall a. Maybe a
Nothing)
requireAttr :: Name -> AttrParser Text
requireAttr :: Name -> AttrParser Text
requireAttr Name
n = forall (m :: * -> *) a.
MonadThrow m =>
String -> m (Maybe a) -> m a
force (String
"Missing attribute: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Name
n) forall a b. (a -> b) -> a -> b
$ Name -> AttrParser (Maybe Text)
attr Name
n
{-# DEPRECATED optionalAttr "Please use 'attr'." #-}
optionalAttr :: Name -> AttrParser (Maybe Text)
optionalAttr :: Name -> AttrParser (Maybe Text)
optionalAttr = Name -> AttrParser (Maybe Text)
attr
contentsToText :: [Content] -> Text
contentsToText :: [Content] -> Text
contentsToText = [Text] -> Text
T.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Content -> Text
toText where
toText :: Content -> Text
toText (ContentText Text
t) = Text
t
toText (ContentEntity Text
e) = [Text] -> Text
T.concat [Text
"&", Text
e, Text
";"]
ignoreAttrs :: AttrParser ()
ignoreAttrs :: AttrParser ()
ignoreAttrs = forall a.
([(Name, [Content])]
-> Either SomeException ([(Name, [Content])], a))
-> AttrParser a
AttrParser forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ([], ())
many :: Monad m
=> ConduitT Event o m (Maybe a)
-> ConduitT Event o m [a]
many :: forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ConduitT Event o m (Maybe a)
i = forall (m :: * -> *) o a b.
Monad m =>
ConduitT Event o m (Maybe a)
-> ConduitT Event o m (Maybe b) -> ConduitT Event o m [a]
manyIgnore ConduitT Event o m (Maybe a)
i forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
many_ :: MonadThrow m
=> ConduitT Event o m (Maybe a)
-> ConduitT Event o m ()
many_ :: forall (m :: * -> *) o a.
MonadThrow m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m ()
many_ ConduitT Event o m (Maybe a)
consumer = forall (m :: * -> *) b.
MonadThrow m =>
ConduitT Event b m (Maybe b)
-> ConduitT Event b m (Maybe ()) -> ConduitT Event b m ()
manyIgnoreYield (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT Event o m (Maybe a)
consumer)
manyIgnore :: Monad m
=> ConduitT Event o m (Maybe a)
-> ConduitT Event o m (Maybe b)
-> ConduitT Event o m [a]
manyIgnore :: forall (m :: * -> *) o a b.
Monad m =>
ConduitT Event o m (Maybe a)
-> ConduitT Event o m (Maybe b) -> ConduitT Event o m [a]
manyIgnore ConduitT Event o m (Maybe a)
i ConduitT Event o m (Maybe b)
ignored' = ([a] -> [a]) -> ConduitT Event o m [a]
go forall a. a -> a
id where
go :: ([a] -> [a]) -> ConduitT Event o m [a]
go [a] -> [a]
front = ConduitT Event o m (Maybe a)
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (([a] -> [a]) -> ConduitT Event o m [a]
onFail [a] -> [a]
front) (\a
y -> ([a] -> [a]) -> ConduitT Event o m [a]
go forall a b. (a -> b) -> a -> b
$ [a] -> [a]
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) a
y)
onFail :: ([a] -> [a]) -> ConduitT Event o m [a]
onFail [a] -> [a]
front = ConduitT Event o m (Maybe b)
ignored' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [a] -> [a]
front []) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ ([a] -> [a]) -> ConduitT Event o m [a]
go [a] -> [a]
front)
many' :: MonadThrow m
=> ConduitT Event o m (Maybe a)
-> ConduitT Event o m [a]
many' :: forall (m :: * -> *) o a.
MonadThrow m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many' ConduitT Event o m (Maybe a)
consumer = forall (m :: * -> *) o a b.
Monad m =>
ConduitT Event o m (Maybe a)
-> ConduitT Event o m (Maybe b) -> ConduitT Event o m [a]
manyIgnore ConduitT Event o m (Maybe a)
consumer forall (m :: * -> *) o.
MonadThrow m =>
ConduitT Event o m (Maybe ())
ignoreAnyTreeContent
manyYield :: Monad m
=> ConduitT a b m (Maybe b)
-> ConduitT a b m ()
manyYield :: forall (m :: * -> *) a b.
Monad m =>
ConduitT a b m (Maybe b) -> ConduitT a b m ()
manyYield ConduitT a b m (Maybe b)
consumer = forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \ConduitT a b m ()
loop ->
ConduitT a b m (Maybe b)
consumer forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\b
x -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield b
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT a b m ()
loop)
manyIgnoreYield :: MonadThrow m
=> ConduitT Event b m (Maybe b)
-> ConduitT Event b m (Maybe ())
-> ConduitT Event b m ()
manyIgnoreYield :: forall (m :: * -> *) b.
MonadThrow m =>
ConduitT Event b m (Maybe b)
-> ConduitT Event b m (Maybe ()) -> ConduitT Event b m ()
manyIgnoreYield ConduitT Event b m (Maybe b)
consumer ConduitT Event b m (Maybe ())
ignoreParser = forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \ConduitT Event b m ()
loop ->
ConduitT Event b m (Maybe b)
consumer forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ConduitT Event b m () -> ConduitT Event b m ()
onFail ConduitT Event b m ()
loop) (\b
x -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield b
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT Event b m ()
loop)
where onFail :: ConduitT Event b m () -> ConduitT Event b m ()
onFail ConduitT Event b m ()
loop = ConduitT Event b m (Maybe ())
ignoreParser forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall a b. a -> b -> a
const ConduitT Event b m ()
loop)
manyYield' :: MonadThrow m
=> ConduitT Event b m (Maybe b)
-> ConduitT Event b m ()
manyYield' :: forall (m :: * -> *) b.
MonadThrow m =>
ConduitT Event b m (Maybe b) -> ConduitT Event b m ()
manyYield' ConduitT Event b m (Maybe b)
consumer = forall (m :: * -> *) b.
MonadThrow m =>
ConduitT Event b m (Maybe b)
-> ConduitT Event b m (Maybe ()) -> ConduitT Event b m ()
manyIgnoreYield ConduitT Event b m (Maybe b)
consumer forall (m :: * -> *) o.
MonadThrow m =>
ConduitT Event o m (Maybe ())
ignoreAnyTreeContent
takeContent :: MonadThrow m => ConduitT Event Event m (Maybe ())
takeContent :: forall (m :: * -> *).
MonadThrow m =>
ConduitT Event Event m (Maybe ())
takeContent = do
Maybe Event
event <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
case Maybe Event
event of
Just e :: Event
e@EventContent{} -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Event
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just ())
Just e :: Event
e@EventCDATA{} -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Event
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just ())
Just Event
e -> if Event -> Bool
isWhitespace Event
e then forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Event
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *).
MonadThrow m =>
ConduitT Event Event m (Maybe ())
takeContent else forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Event
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Maybe Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
takeTree :: MonadThrow m => NameMatcher a -> AttrParser b -> ConduitT Event Event m (Maybe ())
takeTree :: forall (m :: * -> *) a b.
MonadThrow m =>
NameMatcher a -> AttrParser b -> ConduitT Event Event m (Maybe ())
takeTree NameMatcher a
nameMatcher AttrParser b
attrParser = do
Maybe Event
event <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
case Maybe Event
event of
Just e :: Event
e@(EventBeginElement Name
name [(Name, [Content])]
as) -> case forall a. NameMatcher a -> Name -> Maybe a
runNameMatcher NameMatcher a
nameMatcher Name
name of
Just a
_ -> case forall a.
AttrParser a
-> [(Name, [Content])]
-> Either SomeException ([(Name, [Content])], a)
runAttrParser AttrParser b
attrParser [(Name, [Content])]
as of
Right ([(Name, [Content])], b)
_ -> do
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Event
e
forall {m :: * -> *} {a}. Monad m => m (Maybe a) -> m ()
whileJust forall (m :: * -> *).
MonadThrow m =>
ConduitT Event Event m (Maybe ())
takeAnyTreeContent
Maybe Event
endEvent <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
case Maybe Event
endEvent of
Just e' :: Event
e'@(EventEndElement Name
name') | Name
name forall a. Eq a => a -> a -> Bool
== Name
name' -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Event
e' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just ())
Maybe Event
_ -> 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 Event -> XmlException
InvalidEndElement Name
name Maybe Event
endEvent
Either SomeException ([(Name, [Content])], b)
_ -> forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Event
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Maybe a
_ -> forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Event
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just Event
e -> if Event -> Bool
isWhitespace Event
e then forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Event
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a b.
MonadThrow m =>
NameMatcher a -> AttrParser b -> ConduitT Event Event m (Maybe ())
takeTree NameMatcher a
nameMatcher AttrParser b
attrParser else forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Event
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Maybe Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
where
whileJust :: m (Maybe a) -> m ()
whileJust m (Maybe a)
f = forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \m ()
loop -> m (Maybe a)
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall a b. a -> b -> a
const m ()
loop)
takeTreeContent :: MonadThrow m => NameMatcher a -> AttrParser b -> ConduitT Event Event m (Maybe ())
takeTreeContent :: forall (m :: * -> *) a b.
MonadThrow m =>
NameMatcher a -> AttrParser b -> ConduitT Event Event m (Maybe ())
takeTreeContent NameMatcher a
nameMatcher AttrParser b
attrParser = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (forall (m :: * -> *) a b.
MonadThrow m =>
NameMatcher a -> AttrParser b -> ConduitT Event Event m (Maybe ())
takeTree NameMatcher a
nameMatcher AttrParser b
attrParser) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall (m :: * -> *).
MonadThrow m =>
ConduitT Event Event m (Maybe ())
takeContent
takeAnyTreeContent :: MonadThrow m
=> ConduitT Event Event m (Maybe ())
takeAnyTreeContent :: forall (m :: * -> *).
MonadThrow m =>
ConduitT Event Event m (Maybe ())
takeAnyTreeContent = forall (m :: * -> *) a b.
MonadThrow m =>
NameMatcher a -> AttrParser b -> ConduitT Event Event m (Maybe ())
takeTreeContent NameMatcher Name
anyName AttrParser ()
ignoreAttrs
decodeXmlEntities :: DecodeEntities
decodeXmlEntities :: DecodeEntities
decodeXmlEntities = DecodeEntities
ContentEntity
decodeHtmlEntities :: DecodeEntities
decodeHtmlEntities :: DecodeEntities
decodeHtmlEntities Text
t =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DecodeEntities
ContentEntity Text
t) DecodeEntities
ContentText forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
t Map Text Text
htmlEntities
htmlEntities :: Map.Map T.Text T.Text
htmlEntities :: Map Text Text
htmlEntities = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
pack forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> Text
pack)
[ (String
"nbsp", String
"\160")
, (String
"iexcl", String
"\161")
, (String
"cent", String
"\162")
, (String
"pound", String
"\163")
, (String
"curren", String
"\164")
, (String
"yen", String
"\165")
, (String
"brvbar", String
"\166")
, (String
"sect", String
"\167")
, (String
"uml", String
"\168")
, (String
"copy", String
"\169")
, (String
"ordf", String
"\170")
, (String
"laquo", String
"\171")
, (String
"not", String
"\172")
, (String
"shy", String
"\173")
, (String
"reg", String
"\174")
, (String
"macr", String
"\175")
, (String
"deg", String
"\176")
, (String
"plusmn", String
"\177")
, (String
"sup2", String
"\178")
, (String
"sup3", String
"\179")
, (String
"acute", String
"\180")
, (String
"micro", String
"\181")
, (String
"para", String
"\182")
, (String
"middot", String
"\183")
, (String
"cedil", String
"\184")
, (String
"sup1", String
"\185")
, (String
"ordm", String
"\186")
, (String
"raquo", String
"\187")
, (String
"frac14", String
"\188")
, (String
"frac12", String
"\189")
, (String
"frac34", String
"\190")
, (String
"iquest", String
"\191")
, (String
"Agrave", String
"\192")
, (String
"Aacute", String
"\193")
, (String
"Acirc", String
"\194")
, (String
"Atilde", String
"\195")
, (String
"Auml", String
"\196")
, (String
"Aring", String
"\197")
, (String
"AElig", String
"\198")
, (String
"Ccedil", String
"\199")
, (String
"Egrave", String
"\200")
, (String
"Eacute", String
"\201")
, (String
"Ecirc", String
"\202")
, (String
"Euml", String
"\203")
, (String
"Igrave", String
"\204")
, (String
"Iacute", String
"\205")
, (String
"Icirc", String
"\206")
, (String
"Iuml", String
"\207")
, (String
"ETH", String
"\208")
, (String
"Ntilde", String
"\209")
, (String
"Ograve", String
"\210")
, (String
"Oacute", String
"\211")
, (String
"Ocirc", String
"\212")
, (String
"Otilde", String
"\213")
, (String
"Ouml", String
"\214")
, (String
"times", String
"\215")
, (String
"Oslash", String
"\216")
, (String
"Ugrave", String
"\217")
, (String
"Uacute", String
"\218")
, (String
"Ucirc", String
"\219")
, (String
"Uuml", String
"\220")
, (String
"Yacute", String
"\221")
, (String
"THORN", String
"\222")
, (String
"szlig", String
"\223")
, (String
"agrave", String
"\224")
, (String
"aacute", String
"\225")
, (String
"acirc", String
"\226")
, (String
"atilde", String
"\227")
, (String
"auml", String
"\228")
, (String
"aring", String
"\229")
, (String
"aelig", String
"\230")
, (String
"ccedil", String
"\231")
, (String
"egrave", String
"\232")
, (String
"eacute", String
"\233")
, (String
"ecirc", String
"\234")
, (String
"euml", String
"\235")
, (String
"igrave", String
"\236")
, (String
"iacute", String
"\237")
, (String
"icirc", String
"\238")
, (String
"iuml", String
"\239")
, (String
"eth", String
"\240")
, (String
"ntilde", String
"\241")
, (String
"ograve", String
"\242")
, (String
"oacute", String
"\243")
, (String
"ocirc", String
"\244")
, (String
"otilde", String
"\245")
, (String
"ouml", String
"\246")
, (String
"divide", String
"\247")
, (String
"oslash", String
"\248")
, (String
"ugrave", String
"\249")
, (String
"uacute", String
"\250")
, (String
"ucirc", String
"\251")
, (String
"uuml", String
"\252")
, (String
"yacute", String
"\253")
, (String
"thorn", String
"\254")
, (String
"yuml", String
"\255")
, (String
"OElig", String
"\338")
, (String
"oelig", String
"\339")
, (String
"Scaron", String
"\352")
, (String
"scaron", String
"\353")
, (String
"Yuml", String
"\376")
, (String
"fnof", String
"\402")
, (String
"circ", String
"\710")
, (String
"tilde", String
"\732")
, (String
"Alpha", String
"\913")
, (String
"Beta", String
"\914")
, (String
"Gamma", String
"\915")
, (String
"Delta", String
"\916")
, (String
"Epsilon", String
"\917")
, (String
"Zeta", String
"\918")
, (String
"Eta", String
"\919")
, (String
"Theta", String
"\920")
, (String
"Iota", String
"\921")
, (String
"Kappa", String
"\922")
, (String
"Lambda", String
"\923")
, (String
"Mu", String
"\924")
, (String
"Nu", String
"\925")
, (String
"Xi", String
"\926")
, (String
"Omicron", String
"\927")
, (String
"Pi", String
"\928")
, (String
"Rho", String
"\929")
, (String
"Sigma", String
"\931")
, (String
"Tau", String
"\932")
, (String
"Upsilon", String
"\933")
, (String
"Phi", String
"\934")
, (String
"Chi", String
"\935")
, (String
"Psi", String
"\936")
, (String
"Omega", String
"\937")
, (String
"alpha", String
"\945")
, (String
"beta", String
"\946")
, (String
"gamma", String
"\947")
, (String
"delta", String
"\948")
, (String
"epsilon", String
"\949")
, (String
"zeta", String
"\950")
, (String
"eta", String
"\951")
, (String
"theta", String
"\952")
, (String
"iota", String
"\953")
, (String
"kappa", String
"\954")
, (String
"lambda", String
"\955")
, (String
"mu", String
"\956")
, (String
"nu", String
"\957")
, (String
"xi", String
"\958")
, (String
"omicron", String
"\959")
, (String
"pi", String
"\960")
, (String
"rho", String
"\961")
, (String
"sigmaf", String
"\962")
, (String
"sigma", String
"\963")
, (String
"tau", String
"\964")
, (String
"upsilon", String
"\965")
, (String
"phi", String
"\966")
, (String
"chi", String
"\967")
, (String
"psi", String
"\968")
, (String
"omega", String
"\969")
, (String
"thetasym", String
"\977")
, (String
"upsih", String
"\978")
, (String
"piv", String
"\982")
, (String
"ensp", String
"\8194")
, (String
"emsp", String
"\8195")
, (String
"thinsp", String
"\8201")
, (String
"zwnj", String
"\8204")
, (String
"zwj", String
"\8205")
, (String
"lrm", String
"\8206")
, (String
"rlm", String
"\8207")
, (String
"ndash", String
"\8211")
, (String
"mdash", String
"\8212")
, (String
"lsquo", String
"\8216")
, (String
"rsquo", String
"\8217")
, (String
"sbquo", String
"\8218")
, (String
"ldquo", String
"\8220")
, (String
"rdquo", String
"\8221")
, (String
"bdquo", String
"\8222")
, (String
"dagger", String
"\8224")
, (String
"Dagger", String
"\8225")
, (String
"bull", String
"\8226")
, (String
"hellip", String
"\8230")
, (String
"permil", String
"\8240")
, (String
"prime", String
"\8242")
, (String
"Prime", String
"\8243")
, (String
"lsaquo", String
"\8249")
, (String
"rsaquo", String
"\8250")
, (String
"oline", String
"\8254")
, (String
"frasl", String
"\8260")
, (String
"euro", String
"\8364")
, (String
"image", String
"\8465")
, (String
"weierp", String
"\8472")
, (String
"real", String
"\8476")
, (String
"trade", String
"\8482")
, (String
"alefsym", String
"\8501")
, (String
"larr", String
"\8592")
, (String
"uarr", String
"\8593")
, (String
"rarr", String
"\8594")
, (String
"darr", String
"\8595")
, (String
"harr", String
"\8596")
, (String
"crarr", String
"\8629")
, (String
"lArr", String
"\8656")
, (String
"uArr", String
"\8657")
, (String
"rArr", String
"\8658")
, (String
"dArr", String
"\8659")
, (String
"hArr", String
"\8660")
, (String
"forall", String
"\8704")
, (String
"part", String
"\8706")
, (String
"exist", String
"\8707")
, (String
"empty", String
"\8709")
, (String
"nabla", String
"\8711")
, (String
"isin", String
"\8712")
, (String
"notin", String
"\8713")
, (String
"ni", String
"\8715")
, (String
"prod", String
"\8719")
, (String
"sum", String
"\8721")
, (String
"minus", String
"\8722")
, (String
"lowast", String
"\8727")
, (String
"radic", String
"\8730")
, (String
"prop", String
"\8733")
, (String
"infin", String
"\8734")
, (String
"ang", String
"\8736")
, (String
"and", String
"\8743")
, (String
"or", String
"\8744")
, (String
"cap", String
"\8745")
, (String
"cup", String
"\8746")
, (String
"int", String
"\8747")
, (String
"there4", String
"\8756")
, (String
"sim", String
"\8764")
, (String
"cong", String
"\8773")
, (String
"asymp", String
"\8776")
, (String
"ne", String
"\8800")
, (String
"equiv", String
"\8801")
, (String
"le", String
"\8804")
, (String
"ge", String
"\8805")
, (String
"sub", String
"\8834")
, (String
"sup", String
"\8835")
, (String
"nsub", String
"\8836")
, (String
"sube", String
"\8838")
, (String
"supe", String
"\8839")
, (String
"oplus", String
"\8853")
, (String
"otimes", String
"\8855")
, (String
"perp", String
"\8869")
, (String
"sdot", String
"\8901")
, (String
"lceil", String
"\8968")
, (String
"rceil", String
"\8969")
, (String
"lfloor", String
"\8970")
, (String
"rfloor", String
"\8971")
, (String
"lang", String
"\9001")
, (String
"rang", String
"\9002")
, (String
"loz", String
"\9674")
, (String
"spades", String
"\9824")
, (String
"clubs", String
"\9827")
, (String
"hearts", String
"\9829")
, (String
"diams", String
"\9830")
]