    {-# LANGUAGE TupleSections #-}

    --------------------------------------------------------------------
    -- |
    -- Module    : Text.Atom.Feed.Validate
    -- Copyright : (c) Galois, Inc. 2008,
    --             (c) Sigbjorn Finne 2009-
    -- License   : BSD3
    --
    -- Maintainer: Sigbjorn Finne <sof@forkIO.com>
    -- Stability : provisional
    -- Portability: portable
    --
    --------------------------------------------------------------------
    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
    $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
    /= :: VTree a -> VTree a -> Bool
    Eq, Int -> VTree a -> ShowS
    [VTree a] -> ShowS
    VTree a -> [Char]
    (Int -> VTree a -> ShowS)
    -> (VTree a -> [Char]) -> ([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 -> [Char]
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> VTree a -> ShowS
    showsPrec :: Int -> VTree a -> ShowS
    $cshow :: forall a. Show a => VTree a -> [Char]
    show :: VTree a -> [Char]
    $cshowList :: forall a. Show a => [VTree a] -> ShowS
    showList :: [VTree a] -> ShowS
    Show)

    type ValidatorResult = VTree (Bool, String)

    advice :: String -> ValidatorResult
    advice :: [Char] -> ValidatorResult
    advice [Char]
    s = [(Bool, [Char])] -> ValidatorResult
    forall a. [a] -> VTree a
    VLeaf [(Bool
    False, [Char]
    s)]

    demand :: String -> ValidatorResult
    demand :: [Char] -> ValidatorResult
    demand [Char]
    s = [(Bool, [Char])] -> ValidatorResult
    forall a. [a] -> VTree a
    VLeaf [(Bool
    True, [Char]
    s)]

    valid :: ValidatorResult
    valid :: ValidatorResult
    valid = [(Bool, [Char])] -> ValidatorResult
    forall a. [a] -> VTree a
    VLeaf []

    mkTree :: [(Bool, String)] -> [ValidatorResult] -> ValidatorResult
    mkTree :: [(Bool, [Char])] -> [ValidatorResult] -> ValidatorResult
    mkTree = [(Bool, [Char])] -> [ValidatorResult] -> ValidatorResult
    forall a. [a] -> [VTree a] -> VTree a
    VNode

    flattenT :: VTree a -> [a]
    flattenT :: forall a. VTree a -> [a]
    flattenT (VLeaf [a]
    xs) = [a]
    xs
    flattenT (VNode [a]
    as [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 Element
    e =
      [(Bool, [Char])] -> [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
        ]

    -- Sec 4.1.2, check #1
    checkEntryAuthor :: Element -> ValidatorResult
    checkEntryAuthor :: Element -> ValidatorResult
    checkEntryAuthor Element
    e =
      case Text -> [Element] -> [Element]
    pNodes Text
    "author" (Element -> [Element]
    elementChildren Element
    e) of
        [] -- required
         ->
          case Text -> [Element] -> Maybe Element
    pNode Text
    "summary" (Element -> [Element]
    elementChildren Element
    e) of
            Maybe Element
    Nothing -> [Char] -> ValidatorResult
    demand [Char]
    "Required 'author' element missing (no 'summary' either)"
            Just Element
    e1 ->
              case Text -> [Element] -> Maybe Element
    pNode Text
    "author" (Element -> [Element]
    elementChildren Element
    e1) of
                Just Element
    a -> Element -> ValidatorResult
    checkAuthor Element
    a
                Maybe Element
    _ -> [Char] -> ValidatorResult
    demand [Char]
    "Required 'author' element missing"
        [Element]
    xs -> [(Bool, [Char])] -> [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

    -- Sec 4.1.2, check #2
    checkCats :: Element -> ValidatorResult
    checkCats :: Element -> ValidatorResult
    checkCats Element
    e = [(Bool, [Char])] -> [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 Text
    "category" (Element -> [Element]
    elementChildren Element
    e))

    checkContents :: Element -> ValidatorResult
    checkContents :: Element -> ValidatorResult
    checkContents Element
    e =
      case Text -> [Element] -> [Element]
    pNodes Text
    "content" (Element -> [Element]
    elementChildren Element
    e) of
        [] -> ValidatorResult
    valid
        [Element
    c] -> [(Bool, [Char])] -> [ValidatorResult] -> ValidatorResult
    mkTree [] [Element -> ValidatorResult
    checkContent Element
    c]
        [Element]
    cs ->
          [(Bool, [Char])] -> [ValidatorResult] -> ValidatorResult
    mkTree
            (ValidatorResult -> [(Bool, [Char])]
    forall a. VTree a -> [a]
    flattenT
               ([Char] -> ValidatorResult
    demand
                  ([Char]
    "at most one 'content' element expected inside 'entry', found: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show ([Element] -> Int
    forall a. [a] -> 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 Element
    _e = ValidatorResult
    valid

    checkContentLink :: Element -> ValidatorResult
    checkContentLink :: Element -> ValidatorResult
    checkContentLink Element
    e =
      case Text -> [Element] -> [Element]
    pNodes Text
    "content" (Element -> [Element]
    elementChildren Element
    e) of
        [] ->
          case Text -> [Element] -> [Element]
    pNodes Text
    "link" (Element -> [Element]
    elementChildren Element
    e) of
            [] ->
              [Char] -> ValidatorResult
    demand
                [Char]
    "An 'entry' element with no 'content' element must have at least one 'link-rel' element"
            [Element]
    xs ->
              case (Text -> Bool) -> [Text] -> [Text]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "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 Text
    "rel") [Element]
    xs of
                [] ->
                  [Char] -> ValidatorResult
    demand
                    [Char]
    "An 'entry' element with no 'content' element must have at least one 'link-rel' element"
                [Text]
    _ -> ValidatorResult
    valid
        [Element]
    _ -> ValidatorResult
    valid

    checkLinks :: Element -> ValidatorResult
    checkLinks :: Element -> ValidatorResult
    checkLinks Element
    e =
      case Text -> [Element] -> [Element]
    pNodes Text
    "link" (Element -> [Element]
    elementChildren Element
    e) of
        [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 (\(Element
    _, Text
    n) -> Text
    n Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "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 (\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 Text
    "rel" Element
    ex) [Element]
    xs of
            [Element]
    xs1 ->
              let jmb :: Maybe a -> Maybe b -> Maybe (a, b)
    jmb (Just a
    x) (Just b
    y) = (a, b) -> Maybe (a, b)
    forall a. a -> Maybe a
    Just (a
    x, b
    y)
                  jmb Maybe a
    _ Maybe b
    _ = 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 (\Element
    ex -> Text -> Element -> Maybe Text
    pAttr Text
    "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 Text
    "hreflang" Element
    ex) [Element]
    xs1 of
                    [(Text, Text)]
    xs2 ->
                      if ([(Text, Text)] -> Bool) -> [[(Text, Text)]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (\[(Text, Text)]
    x -> [(Text, Text)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Text, Text)]
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1) ([(Text, Text)] -> [[(Text, Text)]]
    forall a. Eq a => [a] -> [[a]]
    group [(Text, Text)]
    xs2)
                        then [Char] -> ValidatorResult
    demand
                               [Char]
    "An 'entry' element cannot have duplicate 'link-rel-alternate-type-hreflang' elements"
                        else ValidatorResult
    valid

    checkId :: Element -> ValidatorResult
    checkId :: Element -> ValidatorResult
    checkId Element
    e =
      case Text -> [Element] -> [Element]
    pNodes Text
    "id" (Element -> [Element]
    elementChildren Element
    e) of
        [] -> [Char] -> ValidatorResult
    demand [Char]
    "required field 'id' missing from 'entry' element"
        [Element
    _] -> ValidatorResult
    valid
        [Element]
    xs -> [Char] -> ValidatorResult
    demand ([Char]
    "only one 'id' field expected in 'entry' element, found: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show ([Element] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Element]
    xs))

    checkPublished :: Element -> ValidatorResult
    checkPublished :: Element -> ValidatorResult
    checkPublished Element
    e =
      case Text -> [Element] -> [Element]
    pNodes Text
    "published" (Element -> [Element]
    elementChildren Element
    e) of
        [] -> ValidatorResult
    valid
        [Element
    _] -> ValidatorResult
    valid
        [Element]
    xs ->
          [Char] -> ValidatorResult
    demand
            ([Char]
    "expected at most one 'published' field in 'entry' element, found: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show ([Element] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Element]
    xs))

    checkRights :: Element -> ValidatorResult
    checkRights :: Element -> ValidatorResult
    checkRights Element
    e =
      case Text -> [Element] -> [Element]
    pNodes Text
    "rights" (Element -> [Element]
    elementChildren Element
    e) of
        [] -> ValidatorResult
    valid
        [Element
    _] -> ValidatorResult
    valid
        [Element]
    xs ->
          [Char] -> ValidatorResult
    demand ([Char]
    "expected at most one 'rights' field in 'entry' element, found: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show ([Element] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Element]
    xs))

    checkSource :: Element -> ValidatorResult
    checkSource :: Element -> ValidatorResult
    checkSource Element
    e =
      case Text -> [Element] -> [Element]
    pNodes Text
    "source" (Element -> [Element]
    elementChildren Element
    e) of
        [] -> ValidatorResult
    valid
        [Element
    _] -> ValidatorResult
    valid
        [Element]
    xs ->
          [Char] -> ValidatorResult
    demand ([Char]
    "expected at most one 'source' field in 'entry' element, found: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show ([Element] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Element]
    xs))

    checkSummary :: Element -> ValidatorResult
    checkSummary :: Element -> ValidatorResult
    checkSummary Element
    e =
      case Text -> [Element] -> [Element]
    pNodes Text
    "summary" (Element -> [Element]
    elementChildren Element
    e) of
        [] -> ValidatorResult
    valid
        [Element
    _] -> ValidatorResult
    valid
        [Element]
    xs ->
          [Char] -> ValidatorResult
    demand
            ([Char]
    "expected at most one 'summary' field in 'entry' element, found: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show ([Element] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Element]
    xs))

    checkTitle :: Element -> ValidatorResult
    checkTitle :: Element -> ValidatorResult
    checkTitle Element
    e =
      case Text -> [Element] -> [Element]
    pNodes Text
    "title" (Element -> [Element]
    elementChildren Element
    e) of
        [] -> [Char] -> ValidatorResult
    demand [Char]
    "required field 'title' missing from 'entry' element"
        [Element
    _] -> ValidatorResult
    valid
        [Element]
    xs -> [Char] -> ValidatorResult
    demand ([Char]
    "only one 'title' field expected in 'entry' element, found: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show ([Element] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Element]
    xs))

    checkUpdated :: Element -> ValidatorResult
    checkUpdated :: Element -> ValidatorResult
    checkUpdated Element
    e =
      case Text -> [Element] -> [Element]
    pNodes Text
    "updated" (Element -> [Element]
    elementChildren Element
    e) of
        [] -> [Char] -> ValidatorResult
    demand [Char]
    "required field 'updated' missing from 'entry' element"
        [Element
    _] -> ValidatorResult
    valid
        [Element]
    xs ->
          [Char] -> ValidatorResult
    demand ([Char]
    "only one 'updated' field expected in 'entry' element, found: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show ([Element] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Element]
    xs))

    checkCat :: Element -> ValidatorResult
    checkCat :: Element -> ValidatorResult
    checkCat Element
    e = [(Bool, [Char])] -> [ValidatorResult] -> ValidatorResult
    mkTree [] [Element -> ValidatorResult
    checkTerm Element
    e, Element -> ValidatorResult
    checkScheme Element
    e, Element -> ValidatorResult
    checkLabel Element
    e]
      where
        checkScheme :: Element -> ValidatorResult
    checkScheme Element
    e' =
          case Text -> Element -> [Text]
    pAttrs Text
    "scheme" Element
    e' of
            [] -> ValidatorResult
    valid
            (Text
    _:[Text]
    xs)
              | [Text] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Text]
    xs -> ValidatorResult
    valid
              | Bool
    otherwise ->
                [Char] -> ValidatorResult
    demand ([Char]
    "Expected at most one 'scheme' attribute, found: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show (Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Text] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Text]
    xs))
        checkLabel :: Element -> ValidatorResult
    checkLabel Element
    e' =
          case Text -> Element -> [Text]
    pAttrs Text
    "label" Element
    e' of
            [] -> ValidatorResult
    valid
            (Text
    _:[Text]
    xs)
              | [Text] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Text]
    xs -> ValidatorResult
    valid
              | Bool
    otherwise ->
                [Char] -> ValidatorResult
    demand ([Char]
    "Expected at most one 'label' attribute, found: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show (Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Text] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Text]
    xs))

    checkContent :: Element -> ValidatorResult
    checkContent :: Element -> ValidatorResult
    checkContent Element
    e =
      [(Bool, [Char])] -> [ValidatorResult] -> ValidatorResult
    mkTree
        (ValidatorResult -> [(Bool, [Char])]
    forall a. VTree a -> [a]
    flattenT ([(Bool, [Char])] -> [ValidatorResult] -> ValidatorResult
    mkTree [] [ValidatorResult
    type_valid, ValidatorResult
    src_valid]))
        [ case Text
    ty of
            Text
    "text" ->
              case Element -> [Element]
    elementChildren Element
    e of
                [] -> ValidatorResult
    valid
                [Element]
    _ -> [Char] -> ValidatorResult
    demand [Char]
    "content with type 'text' cannot have child elements, text only."
            Text
    "html" ->
              case Element -> [Element]
    elementChildren Element
    e of
                [] -> ValidatorResult
    valid
                [Element]
    _ -> [Char] -> ValidatorResult
    demand [Char]
    "content with type 'html' cannot have child elements, text only."
            Text
    "xhtml" ->
              case Element -> [Element]
    elementChildren Element
    e of
                [] -> ValidatorResult
    valid
                [Element
    _] -> ValidatorResult
    valid -- ToDo: check that it is a 'div'.
                [Element]
    _ds -> [Char] -> ValidatorResult
    demand [Char]
    "content with type 'xhtml' should only contain one 'div' child."
            Text
    _ -> ValidatorResult
    valid
        ]
      where
        types :: [Text]
    types = Text -> Element -> [Text]
    pAttrs Text
    "type" Element
    e
        (Text
    ty, ValidatorResult
    type_valid) =
          case [Text]
    types of
            [] -> (Text
    "text", ValidatorResult
    valid)
            [Text
    t] -> Text -> (Text, ValidatorResult)
    forall {a}. (Eq a, IsString a) => a -> (a, ValidatorResult)
    checkTypeA Text
    t
            (Text
    t:[Text]
    ts) ->
              (Text
    t, [Char] -> ValidatorResult
    demand ([Char]
    "Expected at most one 'type' attribute, found: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show (Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Text] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Text]
    ts)))
        src_valid :: ValidatorResult
    src_valid =
          case Text -> Element -> [Text]
    pAttrs Text
    "src" Element
    e of
            [] -> ValidatorResult
    valid
            [Text
    _] ->
              case [Text]
    types of
                [] -> [Char] -> ValidatorResult
    advice [Char]
    "It is advisable to provide a 'type' along with a 'src' attribute"
                (Text
    _:[Text]
    _) -> ValidatorResult
    valid
            [Text]
    ss -> [Char] -> ValidatorResult
    demand ([Char]
    "Expected at most one 'src' attribute, found: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show ([Text] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Text]
    ss))
        checkTypeA :: a -> (a, ValidatorResult)
    checkTypeA a
    v
          | a
    v a -> [a] -> Bool
    forall a. Eq a => 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 = [a
    "text", a
    "xhtml", a
    "html"]

    {-
          case parseMIMEType ty of
            Nothing -> valid
            Just mt
              | isXmlType mt -> valid
              | otherwise ->
                case onlyElems (elContent e) of
                  [] -> valid -- check
                  _  -> demand ("content with MIME type '" ++ ty ++ "' must only contain base64 data")]
    -}
    {-
                case parseMIMEType t of
                  Just{} -> valid
                  _      -> demand "The 'type' attribute must be a valid MIME type"
    -}
    {-
            case parseMIMEType v of
              Nothing -> ("text", demand ("Invalid/unknown type value " ++ v))
              Just mt ->
                case mimeType mt of
                  Multipart{} -> ("text", demand "Multipart MIME types not a legal 'type'")
                  _ -> (v, valid)
    -}
    checkTerm :: Element -> ValidatorResult
    checkTerm :: Element -> ValidatorResult
    checkTerm Element
    e =
      case Text -> [Element] -> [Element]
    pNodes Text
    "term" (Element -> [Element]
    elementChildren Element
    e) of
        [] -> [Char] -> ValidatorResult
    demand [Char]
    "required field 'term' missing from 'category' element"
        [Element
    _] -> ValidatorResult
    valid
        [Element]
    xs ->
          [Char] -> ValidatorResult
    demand ([Char]
    "only one 'term' field expected in 'category' element, found: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show ([Element] -> Int
    forall a. [a] -> 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 Element
    e = [(Bool, [Char])] -> [ValidatorResult] -> ValidatorResult
    mkTree (ValidatorResult -> [(Bool, [Char])]
    forall a. VTree a -> [a]
    flattenT (ValidatorResult -> [(Bool, [Char])])
    -> ValidatorResult -> [(Bool, [Char])]
    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 Element
    e =
      case Text -> [Element] -> [Element]
    pNodes Text
    "name" (Element -> [Element]
    elementChildren Element
    e) of
        [] -> [Char] -> ValidatorResult
    demand [Char]
    "required field 'name' missing from 'author' element"
        [Element
    _] -> ValidatorResult
    valid
        [Element]
    xs -> [Char] -> ValidatorResult
    demand ([Char]
    "only one 'name' expected in 'author' element, found: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show ([Element] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Element]
    xs))

    checkEmail :: Element -> ValidatorResult
    checkEmail :: Element -> ValidatorResult
    checkEmail Element
    e =
      case Text -> [Element] -> [Element]
    pNodes Text
    "email" (Element -> [Element]
    elementChildren Element
    e) of
        [] -> ValidatorResult
    valid
        (Element
    _:[Element]
    xs)
          | [Element] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Element]
    xs -> ValidatorResult
    valid
          | Bool
    otherwise ->
            [Char] -> ValidatorResult
    demand ([Char]
    "at most one 'email' expected in 'author' element, found: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show (Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Element] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Element]
    xs))

    checkUri :: Element -> ValidatorResult
    checkUri :: Element -> ValidatorResult
    checkUri Element
    e =
      case Text -> [Element] -> [Element]
    pNodes Text
    "email" (Element -> [Element]
    elementChildren Element
    e) of
        [] -> ValidatorResult
    valid
        (Element
    _:[Element]
    xs)
          | [Element] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Element]
    xs -> ValidatorResult
    valid
          | Bool
    otherwise ->
            [Char] -> ValidatorResult
    demand ([Char]
    "at most one 'uri' expected in 'author' element, found: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show (Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Element] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Element]
    xs))