--------------------------------------------------------------------
-- |
-- Module    : Text.Atom.Feed.Import
  Copyright : ( c ) Galois , Inc. 2007 - 2008 ,
              ( c ) Sigbjorn Finne 2009-
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <>
-- Stability : provisional
-- Portability:: portable
  Description : Convert from XML to Atom
--
  Convert from XML to Atom
--
--------------------------------------------------------------------

module Text.Atom.Feed.Import where

import Data.Maybe (listToMaybe, mapMaybe, isJust)
import Data.List  (find)
import Control.Monad (guard,mplus)

import Text.Atom.Feed
import Text.Atom.Feed.Export (atomName, atomThreadName)
import Text.XML.Light as XML

pNodes       :: String -> [XML.Element] -> [XML.Element]
pNodes x es   = filter ((atomName x ==) . elName) es

pQNodes      :: QName -> [XML.Element] -> [XML.Element]
pQNodes x es  = filter ((x==) . elName) es

pNode        :: String -> [XML.Element] -> Maybe XML.Element
pNode x es    = listToMaybe (pNodes x es)

pQNode       :: QName -> [XML.Element] -> Maybe XML.Element
pQNode x es   = listToMaybe (pQNodes x es)

pLeaf        :: String -> [XML.Element] -> Maybe String
pLeaf x es    = strContent `fmap` pNode x es

pQLeaf        :: QName -> [XML.Element] -> Maybe String
pQLeaf x es    = strContent `fmap` pQNode x es

pAttr        :: String -> XML.Element -> Maybe String
pAttr x e     = fmap snd $ find sameAttr [ (k,v) | Attr k v <- elAttribs e ]
  where
    ax = atomName x
    sameAttr (k,_) = k == ax ||  (not (isJust (qURI k)) && qName k == x)

pAttrs       :: String -> XML.Element -> [String]
pAttrs x e    = [ v | Attr k v <- elAttribs e, k == atomName x ]

pQAttr       :: QName -> XML.Element -> Maybe String
pQAttr x e    = lookup x [ (k,v) | Attr k v <- elAttribs e ]

pMany        :: String -> (XML.Element -> Maybe a) -> [XML.Element] -> [a]
pMany p f es  = mapMaybe f (pNodes p es)

children     :: XML.Element -> [XML.Element]
children e    = onlyElems (elContent e)

elementFeed  :: XML.Element -> Maybe Feed
elementFeed e =
  do guard (elName e == atomName "feed")
     let es = children e
     i <- pLeaf "id" es
     t <- pTextContent "title" es `mplus` return (TextString "<no-title>")
     u <- pLeaf "updated" es
     return Feed
       { feedId           = i
       , feedTitle        = t
       , feedSubtitle     = pTextContent "subtitle" es
       , feedUpdated      = u
       , feedAuthors      = pMany "author" pPerson es
       , feedContributors = pMany "contributor" pPerson es
       , feedCategories   = pMany "category" pCategory es
       , feedGenerator    = pGenerator `fmap` pNode "generator" es
       , feedIcon         = pLeaf "icon" es
       , feedLogo         = pLeaf "logo" es
       , feedRights       = pTextContent "rights" es
       , feedLinks        = pMany "link" pLink es
       , feedEntries      = pMany "entry" pEntry es
       , feedOther        = other_es es
       , feedAttrs        = other_as (elAttribs e)
       }
  where
   other_es es = filter (\ el -> not (elName el `elem` known_elts))
   	                es

   other_as as = filter (\ a -> not (attrKey a `elem` known_attrs))
   	                as

    -- let's have them all (including xml:base and xml:lang + xmlns: stuff)
   known_attrs = []
   known_elts = map atomName
     [ "author"
     , "category"
     , "contributor"
     , "generator"
     , "icon"
     , "id"
     , "link"
     , "logo"
     , "rights"
     , "subtitle"
     , "title"
     , "updated"
     , "entry"
     ]

pTextContent :: String -> [XML.Element] -> Maybe TextContent
pTextContent tag es =
  do e <- pNode tag es
     case pAttr "type" e of
       Nothing       -> return (TextString (strContent e))
       Just "text"   -> return (TextString (strContent e))
       Just "html"   -> return (HTMLString (strContent e))
       Just "xhtml"  -> case children e of   -- hmm...
                          [c] -> return (XHTMLString c)
                          _   -> Nothing -- Multiple XHTML children.
       _             -> Nothing          -- Unknown text content type.

pPerson :: XML.Element -> Maybe Person
pPerson e =
  do let es = children e
     name <- pLeaf "name" es   -- or missing "name"
     return Person
       { personName  = name
       , personURI   = pLeaf "uri" es
       , personEmail = pLeaf "email" es
       , personOther = []  -- XXX?
       }

pCategory :: XML.Element -> Maybe Category
pCategory e =
  do term <- pAttr "term" e      -- or missing "term" attribute
     return Category
       { catTerm   = term
       , catScheme = pAttr "scheme" e
       , catLabel  = pAttr "label"  e
       , catOther  = [] -- XXX?
       }

pGenerator :: XML.Element -> Generator
pGenerator e = Generator
   { genURI      = pAttr "href" e
   , genVersion  = pAttr "version" e
   , genText     = strContent e
   }

pSource :: XML.Element -> Source
pSource e =
  let es = children e
  in Source
      { sourceAuthors     = pMany "author" pPerson es
      , sourceCategories  = pMany "category" pCategory es
      , sourceGenerator   = pGenerator `fmap` pNode "generator" es
      , sourceIcon        = pLeaf "icon" es
      , sourceId          = pLeaf "id" es
      , sourceLinks       = pMany "link" pLink es
      , sourceLogo        = pLeaf "logo" es
      , sourceRights      = pTextContent "rights" es
      , sourceSubtitle    = pTextContent "subtitle" es
      , sourceTitle       = pTextContent "title" es
      , sourceUpdated     = pLeaf "updated" es
      , sourceOther       = [] -- XXX ?
      }

pLink :: XML.Element -> Maybe Link
pLink e =
  do uri <- pAttr "href" e
     return Link
       { linkHref     = uri
       , linkRel      = Right `fmap` pAttr "rel" e
       , linkType     = pAttr "type" e
       , linkHrefLang = pAttr "hreflang" e
       , linkTitle    = pAttr "title" e
       , linkLength   = pAttr "length" e
       , linkAttrs    = other_as (elAttribs e)
       , linkOther    = []
       }
 where
   other_as as = filter (\ a -> not (attrKey a `elem` known_attrs))
   	                as

   known_attrs = map atomName
      [ "href", "rel", "type", "hreflang", "title", "length"]


pEntry :: XML.Element -> Maybe Entry
pEntry e =
  do let es = children e
     i <- pLeaf "id" es
     t <- pTextContent "title" es
     u <- pLeaf "updated" es `mplus` pLeaf "published" es
     return Entry
       { entryId           = i
       , entryTitle        = t
       , entryUpdated      = u
       , entryAuthors      = pMany "author" pPerson es
       , entryContributor  = pMany "contributor" pPerson es
       , entryCategories   = pMany "category" pCategory es
       , entryContent      = pContent =<< pNode "content" es
       , entryLinks        = pMany "link" pLink es
       , entryPublished    = pLeaf "published" es
       , entryRights       = pTextContent "rights" es
       , entrySource       = pSource `fmap` pNode "source" es
       , entrySummary      = pTextContent "summary" es
       , entryInReplyTo    = pInReplyTo es
       , entryInReplyTotal = pInReplyTotal es
       , entryAttrs        = other_as (elAttribs e)
       , entryOther        = [] -- ?
       }
 where
   other_as as = filter (\ a -> not (attrKey a `elem` known_attrs))
   	                as

    -- let's have them all (including xml:base and xml:lang + xmlns: stuff)
   known_attrs = []

pContent :: XML.Element -> Maybe EntryContent
pContent e =
  case pAttr "type" e of
    Nothing      -> return (TextContent (strContent e))
    Just "text"  -> return (TextContent (strContent e))
    Just "html"  -> return (HTMLContent (strContent e))
    Just "xhtml" ->
      case children e of
        []  -> return (TextContent "")
        [c] -> return (XHTMLContent c)
        _   -> Nothing
    Just ty      ->
      case pAttr "src" e of
        Nothing  -> return (MixedContent (Just ty) (elContent e))
        Just uri -> return (ExternalContent (Just ty) uri)

pInReplyTotal :: [XML.Element] -> Maybe InReplyTotal
pInReplyTotal es = do
 t <- pQLeaf (atomThreadName "total") es
 case reads t of
   ((x,_):_) -> do
     n <- pQNode (atomThreadName "total") es
     return InReplyTotal
       { replyToTotal      = x
       , replyToTotalOther = elAttribs n
       }
   _ -> fail "no parse"

pInReplyTo :: [XML.Element] -> Maybe InReplyTo
pInReplyTo es = do
 t <- pQNode (atomThreadName "reply-to") es
 case pQAttr (atomThreadName "ref") t of
   Just ref ->
     return InReplyTo
       { replyToRef     = ref
       , replyToHRef    = pQAttr (atomThreadName "href") t
       , replyToType    = pQAttr (atomThreadName "type") t
       , replyToSource  = pQAttr (atomThreadName "source") t
  ToDo : snip out matched ones .
       , replyToContent = elContent t
       }
   _ -> fail "no parse"

------------------------------------------------------------------
 |
 Module    : Text.Atom.Feed.Import
 License   : BSD3

 Maintainer: Sigbjorn Finne <>
 Stability : provisional
 Portability:: portable


------------------------------------------------------------------
 let's have them all (including xml:base and xml:lang + xmlns: stuff)
 hmm...
 Multiple XHTML children.
 Unknown text content type.
 or missing "name"
 XXX?
 or missing "term" attribute
 XXX?
 XXX ?
 ?
 let's have them all (including xml:base and xml:lang + xmlns: stuff)
  Copyright : ( c ) Galois , Inc. 2007 - 2008 ,
              ( c ) Sigbjorn Finne 2009-
  Description : Convert from XML to Atom
  Convert from XML to Atom

module Text.Atom.Feed.Import where

import Data.Maybe (listToMaybe, mapMaybe, isJust)
import Data.List  (find)
import Control.Monad (guard,mplus)

import Text.Atom.Feed
import Text.Atom.Feed.Export (atomName, atomThreadName)
import Text.XML.Light as XML

pNodes       :: String -> [XML.Element] -> [XML.Element]
pNodes x es   = filter ((atomName x ==) . elName) es

pQNodes      :: QName -> [XML.Element] -> [XML.Element]
pQNodes x es  = filter ((x==) . elName) es

pNode        :: String -> [XML.Element] -> Maybe XML.Element
pNode x es    = listToMaybe (pNodes x es)

pQNode       :: QName -> [XML.Element] -> Maybe XML.Element
pQNode x es   = listToMaybe (pQNodes x es)

pLeaf        :: String -> [XML.Element] -> Maybe String
pLeaf x es    = strContent `fmap` pNode x es

pQLeaf        :: QName -> [XML.Element] -> Maybe String
pQLeaf x es    = strContent `fmap` pQNode x es

pAttr        :: String -> XML.Element -> Maybe String
pAttr x e     = fmap snd $ find sameAttr [ (k,v) | Attr k v <- elAttribs e ]
  where
    ax = atomName x
    sameAttr (k,_) = k == ax ||  (not (isJust (qURI k)) && qName k == x)

pAttrs       :: String -> XML.Element -> [String]
pAttrs x e    = [ v | Attr k v <- elAttribs e, k == atomName x ]

pQAttr       :: QName -> XML.Element -> Maybe String
pQAttr x e    = lookup x [ (k,v) | Attr k v <- elAttribs e ]

pMany        :: String -> (XML.Element -> Maybe a) -> [XML.Element] -> [a]
pMany p f es  = mapMaybe f (pNodes p es)

children     :: XML.Element -> [XML.Element]
children e    = onlyElems (elContent e)

elementFeed  :: XML.Element -> Maybe Feed
elementFeed e =
  do guard (elName e == atomName "feed")
     let es = children e
     i <- pLeaf "id" es
     t <- pTextContent "title" es `mplus` return (TextString "<no-title>")
     u <- pLeaf "updated" es
     return Feed
       { feedId           = i
       , feedTitle        = t
       , feedSubtitle     = pTextContent "subtitle" es
       , feedUpdated      = u
       , feedAuthors      = pMany "author" pPerson es
       , feedContributors = pMany "contributor" pPerson es
       , feedCategories   = pMany "category" pCategory es
       , feedGenerator    = pGenerator `fmap` pNode "generator" es
       , feedIcon         = pLeaf "icon" es
       , feedLogo         = pLeaf "logo" es
       , feedRights       = pTextContent "rights" es
       , feedLinks        = pMany "link" pLink es
       , feedEntries      = pMany "entry" pEntry es
       , feedOther        = other_es es
       , feedAttrs        = other_as (elAttribs e)
       }
  where
   other_es es = filter (\ el -> not (elName el `elem` known_elts))
   	                es

   other_as as = filter (\ a -> not (attrKey a `elem` known_attrs))
   	                as

   known_attrs = []
   known_elts = map atomName
     [ "author"
     , "category"
     , "contributor"
     , "generator"
     , "icon"
     , "id"
     , "link"
     , "logo"
     , "rights"
     , "subtitle"
     , "title"
     , "updated"
     , "entry"
     ]

pTextContent :: String -> [XML.Element] -> Maybe TextContent
pTextContent tag es =
  do e <- pNode tag es
     case pAttr "type" e of
       Nothing       -> return (TextString (strContent e))
       Just "text"   -> return (TextString (strContent e))
       Just "html"   -> return (HTMLString (strContent e))
                          [c] -> return (XHTMLString c)

pPerson :: XML.Element -> Maybe Person
pPerson e =
  do let es = children e
     return Person
       { personName  = name
       , personURI   = pLeaf "uri" es
       , personEmail = pLeaf "email" es
       }

pCategory :: XML.Element -> Maybe Category
pCategory e =
     return Category
       { catTerm   = term
       , catScheme = pAttr "scheme" e
       , catLabel  = pAttr "label"  e
       }

pGenerator :: XML.Element -> Generator
pGenerator e = Generator
   { genURI      = pAttr "href" e
   , genVersion  = pAttr "version" e
   , genText     = strContent e
   }

pSource :: XML.Element -> Source
pSource e =
  let es = children e
  in Source
      { sourceAuthors     = pMany "author" pPerson es
      , sourceCategories  = pMany "category" pCategory es
      , sourceGenerator   = pGenerator `fmap` pNode "generator" es
      , sourceIcon        = pLeaf "icon" es
      , sourceId          = pLeaf "id" es
      , sourceLinks       = pMany "link" pLink es
      , sourceLogo        = pLeaf "logo" es
      , sourceRights      = pTextContent "rights" es
      , sourceSubtitle    = pTextContent "subtitle" es
      , sourceTitle       = pTextContent "title" es
      , sourceUpdated     = pLeaf "updated" es
      }

pLink :: XML.Element -> Maybe Link
pLink e =
  do uri <- pAttr "href" e
     return Link
       { linkHref     = uri
       , linkRel      = Right `fmap` pAttr "rel" e
       , linkType     = pAttr "type" e
       , linkHrefLang = pAttr "hreflang" e
       , linkTitle    = pAttr "title" e
       , linkLength   = pAttr "length" e
       , linkAttrs    = other_as (elAttribs e)
       , linkOther    = []
       }
 where
   other_as as = filter (\ a -> not (attrKey a `elem` known_attrs))
   	                as

   known_attrs = map atomName
      [ "href", "rel", "type", "hreflang", "title", "length"]


pEntry :: XML.Element -> Maybe Entry
pEntry e =
  do let es = children e
     i <- pLeaf "id" es
     t <- pTextContent "title" es
     u <- pLeaf "updated" es `mplus` pLeaf "published" es
     return Entry
       { entryId           = i
       , entryTitle        = t
       , entryUpdated      = u
       , entryAuthors      = pMany "author" pPerson es
       , entryContributor  = pMany "contributor" pPerson es
       , entryCategories   = pMany "category" pCategory es
       , entryContent      = pContent =<< pNode "content" es
       , entryLinks        = pMany "link" pLink es
       , entryPublished    = pLeaf "published" es
       , entryRights       = pTextContent "rights" es
       , entrySource       = pSource `fmap` pNode "source" es
       , entrySummary      = pTextContent "summary" es
       , entryInReplyTo    = pInReplyTo es
       , entryInReplyTotal = pInReplyTotal es
       , entryAttrs        = other_as (elAttribs e)
       }
 where
   other_as as = filter (\ a -> not (attrKey a `elem` known_attrs))
   	                as

   known_attrs = []

pContent :: XML.Element -> Maybe EntryContent
pContent e =
  case pAttr "type" e of
    Nothing      -> return (TextContent (strContent e))
    Just "text"  -> return (TextContent (strContent e))
    Just "html"  -> return (HTMLContent (strContent e))
    Just "xhtml" ->
      case children e of
        []  -> return (TextContent "")
        [c] -> return (XHTMLContent c)
        _   -> Nothing
    Just ty      ->
      case pAttr "src" e of
        Nothing  -> return (MixedContent (Just ty) (elContent e))
        Just uri -> return (ExternalContent (Just ty) uri)

pInReplyTotal :: [XML.Element] -> Maybe InReplyTotal
pInReplyTotal es = do
 t <- pQLeaf (atomThreadName "total") es
 case reads t of
   ((x,_):_) -> do
     n <- pQNode (atomThreadName "total") es
     return InReplyTotal
       { replyToTotal      = x
       , replyToTotalOther = elAttribs n
       }
   _ -> fail "no parse"

pInReplyTo :: [XML.Element] -> Maybe InReplyTo
pInReplyTo es = do
 t <- pQNode (atomThreadName "reply-to") es
 case pQAttr (atomThreadName "ref") t of
   Just ref ->
     return InReplyTo
       { replyToRef     = ref
       , replyToHRef    = pQAttr (atomThreadName "href") t
       , replyToType    = pQAttr (atomThreadName "type") t
       , replyToSource  = pQAttr (atomThreadName "source") t
  ToDo : snip out matched ones .
       , replyToContent = elContent t
       }
   _ -> fail "no parse"
