--------------------------------------------------------------------
-- |
-- Module    : Text.RSS1.Utils
-- Copyright : (c) Galois, Inc. 2008,
--             (c) Sigbjorn Finne 2009-
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
-- Stability : provisional
-- Portability: portable
--
--------------------------------------------------------------------
module Text.RSS1.Utils
  ( pQNodes
  , pNode
  , pQNode
  , pLeaf
  , pQLeaf
  , pQLeaf'
  , pAttr
  , pAttr'
  , pMany
  , children
  , qualName
  , qualName'
  , rss10NS
  , rdfPrefix
  , rdfNS
  , synPrefix
  , synNS
  , taxPrefix
  , taxNS
  , conPrefix
  , conNS
  , dcPrefix
  , dcNS
  , rdfName
  , rssName
  , synName
  , known_rss_elts
  , known_syn_elts
  , known_dc_elts
  , known_tax_elts
  , known_con_elts
  , removeKnownElts
  , removeKnownAttrs
  ) where

import Prelude.Compat

import Data.XML.Compat
import Data.XML.Types as XML
import Text.DublinCore.Types

import Data.Maybe (listToMaybe, mapMaybe)
import Data.Text (Text)

pQNodes :: Name -> XML.Element -> [XML.Element]
pQNodes :: Name -> Element -> [Element]
pQNodes = Name -> Element -> [Element]
findChildren

pNode :: Text -> XML.Element -> Maybe XML.Element
pNode :: Text -> Element -> Maybe Element
pNode Text
x Element
e = [Element] -> Maybe Element
forall a. [a] -> Maybe a
listToMaybe (Name -> Element -> [Element]
pQNodes ((Maybe Text, Maybe Text) -> Text -> Name
qualName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
rss10NS, Maybe Text
forall a. Maybe a
Nothing) Text
x) Element
e)

pQNode :: Name -> XML.Element -> Maybe XML.Element
pQNode :: Name -> Element -> Maybe Element
pQNode Name
x Element
e = [Element] -> Maybe Element
forall a. [a] -> Maybe a
listToMaybe (Name -> Element -> [Element]
pQNodes Name
x Element
e)

pLeaf :: Text -> XML.Element -> Maybe Text
pLeaf :: Text -> Element -> Maybe Text
pLeaf Text
x Element
e = Element -> Text
strContent (Element -> Text) -> Maybe Element -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Name -> Element -> Maybe Element
pQNode ((Maybe Text, Maybe Text) -> Text -> Name
qualName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
rss10NS, Maybe Text
forall a. Maybe a
Nothing) Text
x) Element
e

pQLeaf' :: (Text, Text) -> Text -> XML.Element -> Maybe Text
pQLeaf' :: (Text, Text) -> Text -> Element -> Maybe Text
pQLeaf' (Text
ns, Text
pre) = (Text, Maybe Text) -> Text -> Element -> Maybe Text
pQLeaf (Text
ns, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
pre)

pQLeaf :: (Text, Maybe Text) -> Text -> XML.Element -> Maybe Text
pQLeaf :: (Text, Maybe Text) -> Text -> Element -> Maybe Text
pQLeaf (Text
ns, Maybe Text
pre) Text
x Element
e = Element -> Text
strContent (Element -> Text) -> Maybe Element -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Name -> Element -> Maybe Element
pQNode ((Maybe Text, Maybe Text) -> Text -> Name
qualName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ns, Maybe Text
pre) Text
x) Element
e

pAttr :: (Maybe Text, Maybe Text) -> Text -> XML.Element -> Maybe Text
pAttr :: (Maybe Text, Maybe Text) -> Text -> Element -> Maybe Text
pAttr (Maybe Text, Maybe Text)
ns Text
x = Name -> Element -> Maybe Text
attributeText ((Maybe Text, Maybe Text) -> Text -> Name
qualName (Maybe Text, Maybe Text)
ns Text
x)

pAttr' :: (Text, Text) -> Text -> XML.Element -> Maybe Text
pAttr' :: (Text, Text) -> Text -> Element -> Maybe Text
pAttr' (Text
ns, Text
pre) = (Maybe Text, Maybe Text) -> Text -> Element -> Maybe Text
pAttr (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ns, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
pre)

pMany :: (Maybe Text, Maybe Text) -> Text -> (XML.Element -> Maybe a) -> XML.Element -> [a]
pMany :: (Maybe Text, Maybe Text)
-> Text -> (Element -> Maybe a) -> Element -> [a]
pMany (Maybe Text, Maybe Text)
ns Text
p Element -> Maybe a
f Element
e = (Element -> Maybe a) -> [Element] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Element -> Maybe a
f (Name -> Element -> [Element]
pQNodes ((Maybe Text, Maybe Text) -> Text -> Name
qualName (Maybe Text, Maybe Text)
ns Text
p) Element
e)

children :: XML.Element -> [XML.Element]
children :: Element -> [Element]
children = Element -> [Element]
elementChildren

qualName :: (Maybe Text, Maybe Text) -> Text -> Name
qualName :: (Maybe Text, Maybe Text) -> Text -> Name
qualName (Maybe Text
ns, Maybe Text
pre) Text
x = Text -> Maybe Text -> Maybe Text -> Name
Name Text
x Maybe Text
ns Maybe Text
pre

qualName' :: (Text, Text) -> Text -> Name
qualName' :: (Text, Text) -> Text -> Name
qualName' (Text
ns, Text
pre) Text
x = Text -> Maybe Text -> Maybe Text -> Name
Name Text
x (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ns) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
pre)

rss10NS :: Text
rss10NS :: Text
rss10NS = Text
"http://purl.org/rss/1.0/"

rdfPrefix, rdfNS :: Text
rdfNS :: Text
rdfNS = Text
"http://www.w3.org/1999/02/22-rdf-syntax-ns#"

rdfPrefix :: Text
rdfPrefix = Text
"rdf"

synPrefix, synNS :: Text
synNS :: Text
synNS = Text
"http://purl.org/rss/1.0/modules/syndication/"

synPrefix :: Text
synPrefix = Text
"sy"

taxPrefix, taxNS :: Text
taxNS :: Text
taxNS = Text
"http://purl.org/rss/1.0/modules/taxonomy/"

taxPrefix :: Text
taxPrefix = Text
"taxo"

conPrefix, conNS :: Text
conNS :: Text
conNS = Text
"http://purl.org/rss/1.0/modules/content/"

conPrefix :: Text
conPrefix = Text
"content"

dcPrefix, dcNS :: Text
dcNS :: Text
dcNS = Text
"http://purl.org/dc/elements/1.1/"

dcPrefix :: Text
dcPrefix = Text
"dc"

rdfName :: Text -> Name
rdfName :: Text -> Name
rdfName Text
x = Text -> Maybe Text -> Maybe Text -> Name
Name Text
x (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
rdfNS) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
rdfPrefix)

rssName :: Text -> Name
rssName :: Text -> Name
rssName Text
x = Text -> Maybe Text -> Maybe Text -> Name
Name Text
x (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
rss10NS) Maybe Text
forall a. Maybe a
Nothing

synName :: Text -> Name
synName :: Text -> Name
synName Text
x = Text -> Maybe Text -> Maybe Text -> Name
Name Text
x (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
synNS) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
synPrefix)

known_rss_elts :: [Name]
known_rss_elts :: [Name]
known_rss_elts = (Text -> Name) -> [Text] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Name
rssName [Text
"channel", Text
"item", Text
"image", Text
"textinput"]

known_syn_elts :: [Name]
known_syn_elts :: [Name]
known_syn_elts = (Text -> Name) -> [Text] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Name
synName [Text
"updateBase", Text
"updateFrequency", Text
"updatePeriod"]

known_dc_elts :: [Name]
known_dc_elts :: [Name]
known_dc_elts = (Text -> Name) -> [Text] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map ((Text, Text) -> Text -> Name
qualName' (Text
dcNS, Text
dcPrefix)) [Text]
dc_element_names

known_tax_elts :: [Name]
known_tax_elts :: [Name]
known_tax_elts = (Text -> Name) -> [Text] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map ((Text, Text) -> Text -> Name
qualName' (Text
taxNS, Text
taxPrefix)) [Text
"topic", Text
"topics"]

known_con_elts :: [Name]
known_con_elts :: [Name]
known_con_elts = (Text -> Name) -> [Text] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map ((Text, Text) -> Text -> Name
qualName' (Text
conNS, Text
conPrefix)) [Text
"items", Text
"item", Text
"format", Text
"encoding"]

removeKnownElts :: XML.Element -> [XML.Element]
removeKnownElts :: Element -> [Element]
removeKnownElts Element
e = (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Element
e1 -> Element -> Name
elementName Element
e1 Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
known_elts) (Element -> [Element]
elementChildren Element
e)
  where
    known_elts :: [Name]
known_elts =
      [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Name]
known_rss_elts, [Name]
known_syn_elts, [Name]
known_dc_elts, [Name]
known_con_elts, [Name]
known_tax_elts]

removeKnownAttrs :: XML.Element -> [Attr]
removeKnownAttrs :: Element -> [Attr]
removeKnownAttrs Element
e = (Attr -> Bool) -> [Attr] -> [Attr]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
known_attrs) (Name -> Bool) -> (Attr -> Name) -> Attr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Name
forall a b. (a, b) -> a
fst) (Element -> [Attr]
elementAttributes Element
e)
  where
    known_attrs :: [Name]
known_attrs = (Text -> Name) -> [Text] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Name
rdfName [Text
"about"]