{-# LANGUAGE TupleSections #-}
module Text.Atom.Feed.Validate
( VTree(..)
, ValidatorResult
, advice
, demand
, valid
, mkTree
, flattenT
, validateEntry
, checkEntryAuthor
, checkCats
, checkContents
, checkContributor
, checkContentLink
, checkLinks
, checkId
, checkPublished
, checkRights
, checkSource
, checkSummary
, checkTitle
, checkUpdated
, checkCat
, checkContent
, checkTerm
, checkAuthor
, checkPerson
, checkName
, checkEmail
, checkUri
) where
import Prelude.Compat
import Data.XML.Types
import Text.Atom.Feed.Import
import Data.List.Compat
import Data.Maybe
data VTree a
= VNode [a]
[VTree a]
| VLeaf [a]
deriving (VTree a -> VTree a -> Bool
(VTree a -> VTree a -> Bool)
-> (VTree a -> VTree a -> Bool) -> Eq (VTree a)
forall a. Eq a => VTree a -> VTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VTree a -> VTree a -> Bool
$c/= :: forall a. Eq a => VTree a -> VTree a -> Bool
== :: VTree a -> VTree a -> Bool
$c== :: forall a. Eq a => VTree a -> VTree a -> Bool
Eq, Int -> VTree a -> ShowS
[VTree a] -> ShowS
VTree a -> String
(Int -> VTree a -> ShowS)
-> (VTree a -> String) -> ([VTree a] -> ShowS) -> Show (VTree a)
forall a. Show a => Int -> VTree a -> ShowS
forall a. Show a => [VTree a] -> ShowS
forall a. Show a => VTree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VTree a] -> ShowS
$cshowList :: forall a. Show a => [VTree a] -> ShowS
show :: VTree a -> String
$cshow :: forall a. Show a => VTree a -> String
showsPrec :: Int -> VTree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> VTree a -> ShowS
Show)
type ValidatorResult = VTree (Bool, String)
advice :: String -> ValidatorResult
advice :: String -> ValidatorResult
advice s :: String
s = [(Bool, String)] -> ValidatorResult
forall a. [a] -> VTree a
VLeaf [(Bool
False, String
s)]
demand :: String -> ValidatorResult
demand :: String -> ValidatorResult
demand s :: String
s = [(Bool, String)] -> ValidatorResult
forall a. [a] -> VTree a
VLeaf [(Bool
True, String
s)]
valid :: ValidatorResult
valid :: ValidatorResult
valid = [(Bool, String)] -> ValidatorResult
forall a. [a] -> VTree a
VLeaf []
mkTree :: [(Bool, String)] -> [ValidatorResult] -> ValidatorResult
mkTree :: [(Bool, String)] -> [ValidatorResult] -> ValidatorResult
mkTree = [(Bool, String)] -> [ValidatorResult] -> ValidatorResult
forall a. [a] -> [VTree a] -> VTree a
VNode
flattenT :: VTree a -> [a]
flattenT :: VTree a -> [a]
flattenT (VLeaf xs :: [a]
xs) = [a]
xs
flattenT (VNode as :: [a]
as bs :: [VTree a]
bs) = [a]
as [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (VTree a -> [a]) -> [VTree a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap VTree a -> [a]
forall a. VTree a -> [a]
flattenT [VTree a]
bs
validateEntry :: Element -> ValidatorResult
validateEntry :: Element -> ValidatorResult
validateEntry e :: Element
e =
[(Bool, String)] -> [ValidatorResult] -> ValidatorResult
mkTree
[]
[ Element -> ValidatorResult
checkEntryAuthor Element
e
, Element -> ValidatorResult
checkCats Element
e
, Element -> ValidatorResult
checkContents Element
e
, Element -> ValidatorResult
checkContributor Element
e
, Element -> ValidatorResult
checkId Element
e
, Element -> ValidatorResult
checkContentLink Element
e
, Element -> ValidatorResult
checkLinks Element
e
, Element -> ValidatorResult
checkPublished Element
e
, Element -> ValidatorResult
checkRights Element
e
, Element -> ValidatorResult
checkSource Element
e
, Element -> ValidatorResult
checkSummary Element
e
, Element -> ValidatorResult
checkTitle Element
e
, Element -> ValidatorResult
checkUpdated Element
e
]
checkEntryAuthor :: Element -> ValidatorResult
checkEntryAuthor :: Element -> ValidatorResult
checkEntryAuthor e :: Element
e =
case Text -> [Element] -> [Element]
pNodes "author" (Element -> [Element]
elementChildren Element
e) of
[]
->
case Text -> [Element] -> Maybe Element
pNode "summary" (Element -> [Element]
elementChildren Element
e) of
Nothing -> String -> ValidatorResult
demand "Required 'author' element missing (no 'summary' either)"
Just e1 :: Element
e1 ->
case Text -> [Element] -> Maybe Element
pNode "author" (Element -> [Element]
elementChildren Element
e1) of
Just a :: Element
a -> Element -> ValidatorResult
checkAuthor Element
a
_ -> String -> ValidatorResult
demand "Required 'author' element missing"
xs :: [Element]
xs -> [(Bool, String)] -> [ValidatorResult] -> ValidatorResult
mkTree [] ([ValidatorResult] -> ValidatorResult)
-> [ValidatorResult] -> ValidatorResult
forall a b. (a -> b) -> a -> b
$ (Element -> ValidatorResult) -> [Element] -> [ValidatorResult]
forall a b. (a -> b) -> [a] -> [b]
map Element -> ValidatorResult
checkAuthor [Element]
xs
checkCats :: Element -> ValidatorResult
checkCats :: Element -> ValidatorResult
checkCats e :: Element
e = [(Bool, String)] -> [ValidatorResult] -> ValidatorResult
mkTree [] ([ValidatorResult] -> ValidatorResult)
-> [ValidatorResult] -> ValidatorResult
forall a b. (a -> b) -> a -> b
$ (Element -> ValidatorResult) -> [Element] -> [ValidatorResult]
forall a b. (a -> b) -> [a] -> [b]
map Element -> ValidatorResult
checkCat (Text -> [Element] -> [Element]
pNodes "category" (Element -> [Element]
elementChildren Element
e))
checkContents :: Element -> ValidatorResult
checkContents :: Element -> ValidatorResult
checkContents e :: Element
e =
case Text -> [Element] -> [Element]
pNodes "content" (Element -> [Element]
elementChildren Element
e) of
[] -> ValidatorResult
valid
[c :: Element
c] -> [(Bool, String)] -> [ValidatorResult] -> ValidatorResult
mkTree [] [Element -> ValidatorResult
checkContent Element
c]
cs :: [Element]
cs ->
[(Bool, String)] -> [ValidatorResult] -> ValidatorResult
mkTree
(ValidatorResult -> [(Bool, String)]
forall a. VTree a -> [a]
flattenT
(String -> ValidatorResult
demand
("at most one 'content' element expected inside 'entry', found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Element] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Element]
cs))))
((Element -> ValidatorResult) -> [Element] -> [ValidatorResult]
forall a b. (a -> b) -> [a] -> [b]
map Element -> ValidatorResult
checkContent [Element]
cs)
checkContributor :: Element -> ValidatorResult
checkContributor :: Element -> ValidatorResult
checkContributor _e :: Element
_e = ValidatorResult
valid
checkContentLink :: Element -> ValidatorResult
checkContentLink :: Element -> ValidatorResult
checkContentLink e :: Element
e =
case Text -> [Element] -> [Element]
pNodes "content" (Element -> [Element]
elementChildren Element
e) of
[] ->
case Text -> [Element] -> [Element]
pNodes "link" (Element -> [Element]
elementChildren Element
e) of
[] ->
String -> ValidatorResult
demand
"An 'entry' element with no 'content' element must have at least one 'link-rel' element"
xs :: [Element]
xs ->
case (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "alternate") ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Element -> Maybe Text) -> [Element] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Element -> Maybe Text
pAttr "rel") [Element]
xs of
[] ->
String -> ValidatorResult
demand
"An 'entry' element with no 'content' element must have at least one 'link-rel' element"
_ -> ValidatorResult
valid
_ -> ValidatorResult
valid
checkLinks :: Element -> ValidatorResult
checkLinks :: Element -> ValidatorResult
checkLinks e :: Element
e =
case Text -> [Element] -> [Element]
pNodes "link" (Element -> [Element]
elementChildren Element
e) of
xs :: [Element]
xs ->
case ((Element, Text) -> Element) -> [(Element, Text)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Element, Text) -> Element
forall a b. (a, b) -> a
fst ([(Element, Text)] -> [Element]) -> [(Element, Text)] -> [Element]
forall a b. (a -> b) -> a -> b
$
((Element, Text) -> Bool) -> [(Element, Text)] -> [(Element, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(_, n :: Text
n) -> Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "alternate") ([(Element, Text)] -> [(Element, Text)])
-> [(Element, Text)] -> [(Element, Text)]
forall a b. (a -> b) -> a -> b
$
(Element -> Maybe (Element, Text))
-> [Element] -> [(Element, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\ex :: Element
ex -> (Element
ex,) (Text -> (Element, Text)) -> Maybe Text -> Maybe (Element, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Element -> Maybe Text
pAttr "rel" Element
ex) [Element]
xs of
xs1 :: [Element]
xs1 ->
let jmb :: Maybe a -> Maybe b -> Maybe (a, b)
jmb (Just x :: a
x) (Just y :: b
y) = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
x, b
y)
jmb _ _ = Maybe (a, b)
forall a. Maybe a
Nothing
in case (Element -> Maybe (Text, Text)) -> [Element] -> [(Text, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\ex :: Element
ex -> Text -> Element -> Maybe Text
pAttr "type" Element
ex Maybe Text -> Maybe Text -> Maybe (Text, Text)
forall a b. Maybe a -> Maybe b -> Maybe (a, b)
`jmb` Text -> Element -> Maybe Text
pAttr "hreflang" Element
ex) [Element]
xs1 of
xs2 :: [(Text, Text)]
xs2 ->
if ([(Text, Text)] -> Bool) -> [[(Text, Text)]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\x :: [(Text, Text)]
x -> [(Text, Text)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Text)]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1) ([(Text, Text)] -> [[(Text, Text)]]
forall a. Eq a => [a] -> [[a]]
group [(Text, Text)]
xs2)
then String -> ValidatorResult
demand
"An 'entry' element cannot have duplicate 'link-rel-alternate-type-hreflang' elements"
else ValidatorResult
valid
checkId :: Element -> ValidatorResult
checkId :: Element -> ValidatorResult
checkId e :: Element
e =
case Text -> [Element] -> [Element]
pNodes "id" (Element -> [Element]
elementChildren Element
e) of
[] -> String -> ValidatorResult
demand "required field 'id' missing from 'entry' element"
[_] -> ValidatorResult
valid
xs :: [Element]
xs -> String -> ValidatorResult
demand ("only one 'id' field expected in 'entry' element, found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Element] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Element]
xs))
checkPublished :: Element -> ValidatorResult
checkPublished :: Element -> ValidatorResult
checkPublished e :: Element
e =
case Text -> [Element] -> [Element]
pNodes "published" (Element -> [Element]
elementChildren Element
e) of
[] -> ValidatorResult
valid
[_] -> ValidatorResult
valid
xs :: [Element]
xs ->
String -> ValidatorResult
demand
("expected at most one 'published' field in 'entry' element, found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Element] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Element]
xs))
checkRights :: Element -> ValidatorResult
checkRights :: Element -> ValidatorResult
checkRights e :: Element
e =
case Text -> [Element] -> [Element]
pNodes "rights" (Element -> [Element]
elementChildren Element
e) of
[] -> ValidatorResult
valid
[_] -> ValidatorResult
valid
xs :: [Element]
xs ->
String -> ValidatorResult
demand ("expected at most one 'rights' field in 'entry' element, found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Element] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Element]
xs))
checkSource :: Element -> ValidatorResult
checkSource :: Element -> ValidatorResult
checkSource e :: Element
e =
case Text -> [Element] -> [Element]
pNodes "source" (Element -> [Element]
elementChildren Element
e) of
[] -> ValidatorResult
valid
[_] -> ValidatorResult
valid
xs :: [Element]
xs ->
String -> ValidatorResult
demand ("expected at most one 'source' field in 'entry' element, found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Element] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Element]
xs))
checkSummary :: Element -> ValidatorResult
checkSummary :: Element -> ValidatorResult
checkSummary e :: Element
e =
case Text -> [Element] -> [Element]
pNodes "summary" (Element -> [Element]
elementChildren Element
e) of
[] -> ValidatorResult
valid
[_] -> ValidatorResult
valid
xs :: [Element]
xs ->
String -> ValidatorResult
demand
("expected at most one 'summary' field in 'entry' element, found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Element] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Element]
xs))
checkTitle :: Element -> ValidatorResult
checkTitle :: Element -> ValidatorResult
checkTitle e :: Element
e =
case Text -> [Element] -> [Element]
pNodes "title" (Element -> [Element]
elementChildren Element
e) of
[] -> String -> ValidatorResult
demand "required field 'title' missing from 'entry' element"
[_] -> ValidatorResult
valid
xs :: [Element]
xs -> String -> ValidatorResult
demand ("only one 'title' field expected in 'entry' element, found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Element] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Element]
xs))
checkUpdated :: Element -> ValidatorResult
checkUpdated :: Element -> ValidatorResult
checkUpdated e :: Element
e =
case Text -> [Element] -> [Element]
pNodes "updated" (Element -> [Element]
elementChildren Element
e) of
[] -> String -> ValidatorResult
demand "required field 'updated' missing from 'entry' element"
[_] -> ValidatorResult
valid
xs :: [Element]
xs ->
String -> ValidatorResult
demand ("only one 'updated' field expected in 'entry' element, found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Element] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Element]
xs))
checkCat :: Element -> ValidatorResult
checkCat :: Element -> ValidatorResult
checkCat e :: Element
e = [(Bool, String)] -> [ValidatorResult] -> ValidatorResult
mkTree [] [Element -> ValidatorResult
checkTerm Element
e, Element -> ValidatorResult
checkScheme Element
e, Element -> ValidatorResult
checkLabel Element
e]
where
checkScheme :: Element -> ValidatorResult
checkScheme e' :: Element
e' =
case Text -> Element -> [Text]
pAttrs "scheme" Element
e' of
[] -> ValidatorResult
valid
(_:xs :: [Text]
xs)
| [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
xs -> ValidatorResult
valid
| Bool
otherwise ->
String -> ValidatorResult
demand ("Expected at most one 'scheme' attribute, found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
xs))
checkLabel :: Element -> ValidatorResult
checkLabel e' :: Element
e' =
case Text -> Element -> [Text]
pAttrs "label" Element
e' of
[] -> ValidatorResult
valid
(_:xs :: [Text]
xs)
| [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
xs -> ValidatorResult
valid
| Bool
otherwise ->
String -> ValidatorResult
demand ("Expected at most one 'label' attribute, found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
xs))
checkContent :: Element -> ValidatorResult
checkContent :: Element -> ValidatorResult
checkContent e :: Element
e =
[(Bool, String)] -> [ValidatorResult] -> ValidatorResult
mkTree
(ValidatorResult -> [(Bool, String)]
forall a. VTree a -> [a]
flattenT ([(Bool, String)] -> [ValidatorResult] -> ValidatorResult
mkTree [] [ValidatorResult
type_valid, ValidatorResult
src_valid]))
[ case Text
ty of
"text" ->
case Element -> [Element]
elementChildren Element
e of
[] -> ValidatorResult
valid
_ -> String -> ValidatorResult
demand "content with type 'text' cannot have child elements, text only."
"html" ->
case Element -> [Element]
elementChildren Element
e of
[] -> ValidatorResult
valid
_ -> String -> ValidatorResult
demand "content with type 'html' cannot have child elements, text only."
"xhtml" ->
case Element -> [Element]
elementChildren Element
e of
[] -> ValidatorResult
valid
[_] -> ValidatorResult
valid
_ds :: [Element]
_ds -> String -> ValidatorResult
demand "content with type 'xhtml' should only contain one 'div' child."
_ -> ValidatorResult
valid
]
where
types :: [Text]
types = Text -> Element -> [Text]
pAttrs "type" Element
e
(ty :: Text
ty, type_valid :: ValidatorResult
type_valid) =
case [Text]
types of
[] -> ("text", ValidatorResult
valid)
[t :: Text
t] -> Text -> (Text, ValidatorResult)
forall a. (Eq a, IsString a) => a -> (a, ValidatorResult)
checkTypeA Text
t
(t :: Text
t:ts :: [Text]
ts) ->
(Text
t, String -> ValidatorResult
demand ("Expected at most one 'type' attribute, found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ts)))
src_valid :: ValidatorResult
src_valid =
case Text -> Element -> [Text]
pAttrs "src" Element
e of
[] -> ValidatorResult
valid
[_] ->
case [Text]
types of
[] -> String -> ValidatorResult
advice "It is advisable to provide a 'type' along with a 'src' attribute"
(_:_) -> ValidatorResult
valid
ss :: [Text]
ss -> String -> ValidatorResult
demand ("Expected at most one 'src' attribute, found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ss))
checkTypeA :: a -> (a, ValidatorResult)
checkTypeA v :: a
v
| a
v a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
std_types = (a
v, ValidatorResult
valid)
| Bool
otherwise = (a
v, ValidatorResult
valid)
where
std_types :: [a]
std_types = ["text", "xhtml", "html"]
checkTerm :: Element -> ValidatorResult
checkTerm :: Element -> ValidatorResult
checkTerm e :: Element
e =
case Text -> [Element] -> [Element]
pNodes "term" (Element -> [Element]
elementChildren Element
e) of
[] -> String -> ValidatorResult
demand "required field 'term' missing from 'category' element"
[_] -> ValidatorResult
valid
xs :: [Element]
xs ->
String -> ValidatorResult
demand ("only one 'term' field expected in 'category' element, found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Element] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Element]
xs))
checkAuthor :: Element -> ValidatorResult
checkAuthor :: Element -> ValidatorResult
checkAuthor = Element -> ValidatorResult
checkPerson
checkPerson :: Element -> ValidatorResult
checkPerson :: Element -> ValidatorResult
checkPerson e :: Element
e = [(Bool, String)] -> [ValidatorResult] -> ValidatorResult
mkTree (ValidatorResult -> [(Bool, String)]
forall a. VTree a -> [a]
flattenT (ValidatorResult -> [(Bool, String)])
-> ValidatorResult -> [(Bool, String)]
forall a b. (a -> b) -> a -> b
$ Element -> ValidatorResult
checkName Element
e) [Element -> ValidatorResult
checkEmail Element
e, Element -> ValidatorResult
checkUri Element
e]
checkName :: Element -> ValidatorResult
checkName :: Element -> ValidatorResult
checkName e :: Element
e =
case Text -> [Element] -> [Element]
pNodes "name" (Element -> [Element]
elementChildren Element
e) of
[] -> String -> ValidatorResult
demand "required field 'name' missing from 'author' element"
[_] -> ValidatorResult
valid
xs :: [Element]
xs -> String -> ValidatorResult
demand ("only one 'name' expected in 'author' element, found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Element] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Element]
xs))
checkEmail :: Element -> ValidatorResult
checkEmail :: Element -> ValidatorResult
checkEmail e :: Element
e =
case Text -> [Element] -> [Element]
pNodes "email" (Element -> [Element]
elementChildren Element
e) of
[] -> ValidatorResult
valid
(_:xs :: [Element]
xs)
| [Element] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Element]
xs -> ValidatorResult
valid
| Bool
otherwise ->
String -> ValidatorResult
demand ("at most one 'email' expected in 'author' element, found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Element] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Element]
xs))
checkUri :: Element -> ValidatorResult
checkUri :: Element -> ValidatorResult
checkUri e :: Element
e =
case Text -> [Element] -> [Element]
pNodes "email" (Element -> [Element]
elementChildren Element
e) of
[] -> ValidatorResult
valid
(_:xs :: [Element]
xs)
| [Element] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Element]
xs -> ValidatorResult
valid
| Bool
otherwise ->
String -> ValidatorResult
demand ("at most one 'uri' expected in 'author' element, found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Element] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Element]
xs))