{-# LANGUAGE OverloadedStrings #-}
module Network.XMPP.XML
( strAttr
, getVals
, isVal
, getText
, getText_
, txtpat
, xtractp
, matchPatterns
, mread
, mattr
, mattr'
, literal
, noelem
, lookupAttr
, FromXML(..)
, ToXML(..)
) where
import Text.XML (Node)
import Text.XML.HaXml hiding (tag)
import Text.XML.HaXml.Posn
import qualified Text.XML.HaXml.Pretty as P
import Text.XML.HaXml.Xtract.Parse (xtract)
import Text.PrettyPrint.HughesPJ (hcat)
import Data.Text (Text, pack, unpack)
import Text.Read
import Control.Applicative ((<|>))
class FromXML a where
decodeXml :: Content Posn -> Maybe a
class ToXML a where
encodeXml :: a -> [Node]
instance FromXML () where
decodeXml :: Content Posn -> Maybe ()
decodeXml Content Posn
_ = () -> Maybe ()
forall a. a -> Maybe a
Just ()
instance (FromXML a, FromXML b) => FromXML (Either a b) where
decodeXml :: Content Posn -> Maybe (Either a b)
decodeXml Content Posn
m = (a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> Maybe a -> Maybe (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Content Posn -> Maybe a
forall a. FromXML a => Content Posn -> Maybe a
decodeXml Content Posn
m) Maybe (Either a b) -> Maybe (Either a b) -> Maybe (Either a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Maybe b -> Maybe (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Content Posn -> Maybe b
forall a. FromXML a => Content Posn -> Maybe a
decodeXml Content Posn
m)
strAttr :: a -> String -> (a, CFilter i)
strAttr :: a -> String -> (a, CFilter i)
strAttr a
s String
d = (a
s, String -> CFilter i
forall i. String -> CFilter i
literal String
d)
getVals :: Text -> [Content Posn] -> [Text]
getVals :: Text -> [Content Posn] -> [Text]
getVals Text
q = (Content Posn -> Text) -> [Content Posn] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Content Posn] -> Text
forall i. [Content i] -> Text
getText_ ([Content Posn] -> Text)
-> (Content Posn -> [Content Posn]) -> Content Posn -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> String -> Content Posn -> [Content Posn]
forall i. (String -> String) -> String -> CFilter i
xtract String -> String
forall a. a -> a
id (Text -> String
unpack Text
q))
isVal :: Text -> Text -> [Content Posn] -> Bool
isVal :: Text -> Text -> [Content Posn] -> Bool
isVal Text
str Text
cont = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
str) ([Text] -> Bool)
-> ([Content Posn] -> [Text]) -> [Content Posn] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Content Posn] -> [Text]
getVals Text
cont
getText :: Content i -> Text
getText :: Content i -> Text
getText cs :: Content i
cs@CString{} = String -> Text
pack (String -> Text) -> (Content i -> String) -> Content i -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
render (Doc -> String) -> (Content i -> Doc) -> Content i -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content i -> Doc
forall i. Content i -> Doc
P.content (Content i -> Text) -> Content i -> Text
forall a b. (a -> b) -> a -> b
$ Content i
cs
getText cs :: Content i
cs@CRef{} = String -> Text
pack (String -> Text) -> (Content i -> String) -> Content i -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
render (Doc -> String) -> (Content i -> Doc) -> Content i -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content i -> Doc
forall i. Content i -> Doc
P.content (Content i -> Text) -> Content i -> Text
forall a b. (a -> b) -> a -> b
$ Content i
cs
getText Content i
x =
String -> Text
forall a. HasCallStack => String -> a
error
(String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Attempt to extract text from content that is not a string: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
render (Content i -> Doc
forall i. Content i -> Doc
P.content Content i
x)
getText_ :: [Content i] -> Text
getText_ :: [Content i] -> Text
getText_ = String -> Text
pack (String -> Text) -> ([Content i] -> String) -> [Content i] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
render (Doc -> String) -> ([Content i] -> Doc) -> [Content i] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hcat ([Doc] -> Doc) -> ([Content i] -> [Doc]) -> [Content i] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content i -> Doc) -> [Content i] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Content i -> Doc
forall i. Content i -> Doc
P.content
txtpat :: Text
-> Content Posn
-> Text
txtpat :: Text -> Content Posn -> Text
txtpat Text
p Content Posn
m = [Content Posn] -> Text
forall i. [Content i] -> Text
getText_ ([Content Posn] -> Text) -> [Content Posn] -> Text
forall a b. (a -> b) -> a -> b
$ (String -> String) -> String -> Content Posn -> [Content Posn]
forall i. (String -> String) -> String -> CFilter i
xtract String -> String
forall a. a -> a
id (Text -> String
unpack Text
p) Content Posn
m
xtractp :: (Text -> Text) -> Text -> Content i -> Bool
xtractp :: (Text -> Text) -> Text -> Content i -> Bool
xtractp Text -> Text
f Text
p Content i
m = Bool -> Bool
not (Bool -> Bool) -> ([Content i] -> Bool) -> [Content i] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Content i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Content i] -> Bool) -> [Content i] -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> String) -> String -> CFilter i
forall i. (String -> String) -> String -> CFilter i
xtract (Text -> String
unpack (Text -> String) -> (String -> Text) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
f (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) (Text -> String
unpack Text
p) Content i
m
matchPatterns :: Content i -> [Text] -> Bool
matchPatterns :: Content i -> [Text] -> Bool
matchPatterns Content i
m = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Text -> Bool) -> [Text] -> Bool)
-> (Text -> Bool) -> [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ (Text -> Content i -> Bool) -> Content i -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Text -> Text) -> Text -> Content i -> Bool
forall i. (Text -> Text) -> Text -> Content i -> Bool
xtractp Text -> Text
forall a. a -> a
id) Content i
m
mread :: Read a => Text -> Maybe a
mread :: Text -> Maybe a
mread Text
"" = Maybe a
forall a. Maybe a
Nothing
mread Text
a = String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe a) -> String -> Maybe a
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
a
mattr :: (Show a) => b -> Maybe a -> [(b, CFilter i)]
mattr :: b -> Maybe a -> [(b, CFilter i)]
mattr b
s (Just a
a) = [ b -> String -> (b, CFilter i)
forall a i. a -> String -> (a, CFilter i)
strAttr b
s (a -> String
forall a. Show a => a -> String
show a
a) ]
mattr b
_ Maybe a
Nothing = []
mattr' :: a -> Maybe String -> [(a, CFilter i)]
mattr' :: a -> Maybe String -> [(a, CFilter i)]
mattr' a
s (Just String
a) = [ a -> String -> (a, CFilter i)
forall a i. a -> String -> (a, CFilter i)
strAttr a
s String
a ]
mattr' a
_ Maybe String
Nothing = []
noelem :: Content Posn
noelem :: Content Posn
noelem = Element Posn -> Posn -> Content Posn
forall i. Element i -> i -> Content i
CElem (QName -> [Attribute] -> [Content Posn] -> Element Posn
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem (String -> QName
N String
"root") [] []) Posn
noPos
lookupAttr :: String -> [Attribute] -> Maybe String
lookupAttr :: String -> [Attribute] -> Maybe String
lookupAttr String
k [Attribute]
lst = do
AttValue
x <- QName -> [Attribute] -> Maybe AttValue
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> QName
N String
k) [Attribute]
lst
case AttValue
x of
AttValue [Left String
str] -> String -> Maybe String
forall a. a -> Maybe a
Just String
str
AttValue [Either String Reference]
_ -> Maybe String
forall a. Maybe a
Nothing