--------------------------------------------------------------------
-- |
-- Module    : Text.RSS1.Import
-- Copyright : (c) Galois, Inc. 2008,
--             (c) Sigbjorn Finne 2009-
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
-- Stability : provisional
-- Portability: portable
--
--------------------------------------------------------------------
module Text.RSS1.Import
  ( elementToFeed
  ) where

import Prelude ()
import Prelude.Compat

import Data.XML.Compat
import Data.XML.Types as XML
import Text.DublinCore.Types
import Text.RSS1.Syntax
import Text.RSS1.Utils

import Control.Monad (guard, mplus)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Text.Util

---
elementToFeed :: XML.Element -> Maybe Feed
elementToFeed e = do
  guard (elementName e == rdfName "RDF")
  ver <- pAttr (Nothing, Nothing) "xmlns" e `mplus` Just rss10NS
  ch <- pNode "channel" e >>= elementToChannel
  let mbImg = pNode "image" e >>= elementToImage
  let is = fromMaybe [] $ fmap elementToItems $ pNode "items" e
  let mbTI = pNode "textinput" e >>= elementToTextInput
  let ch1 = ch {channelItemURIs = is}
  let its = pMany (Just rss10NS, Nothing) "item" elementToItem e
  let es_rest = removeKnownElts e
  let as_rest = removeKnownAttrs e
  return
    Feed
    { feedVersion = ver
    , feedChannel = ch1
    , feedImage = mbImg
    , feedItems = its
    , feedTextInput = mbTI
    , feedTopics =
        mapMaybe elementToTaxonomyTopic $ pQNodes (qualName' (taxNS, taxPrefix) "topic") e
    , feedOther = es_rest
    , feedAttrs = as_rest
    }

elementToItems :: XML.Element -> [URIString]
elementToItems = seqLeaves

elementToTextInput :: XML.Element -> Maybe TextInputInfo
elementToTextInput e = do
  let es = children e
  uri <- pAttr' (rdfNS, rdfPrefix) "about" e
  ti <- pQLeaf (rss10NS, Nothing) "title" e
  desc <- pQLeaf (rss10NS, Nothing) "description" e
  na <- pQLeaf (rss10NS, Nothing) "name" e
  li <- pQLeaf (rss10NS, Nothing) "link" e
  let dcs = mapMaybe elementToDC es
  return
    TextInputInfo
    { textInputURI = uri
    , textInputTitle = ti
    , textInputDesc = desc
    , textInputName = na
    , textInputLink = li
    , textInputDC = dcs
    , textInputOther = es
    , textInputAttrs = elementAttributes e
    }

elementToItem :: XML.Element -> Maybe Item
elementToItem e = do
  guard (elementName e == qualName (Just rss10NS, Nothing) "item")
  let es = children e
  uri <- pAttr' (rdfNS, rdfPrefix) "about" e
  ti <- pQLeaf (rss10NS, Nothing) "title" e
  li <- pQLeaf (rss10NS, Nothing) "link" e
  let desc = pQLeaf (rss10NS, Nothing) "description" e
  let dcs = mapMaybe elementToDC es
  let tos = fromMaybe [] (fmap bagLeaves $ pQNode (qualName' (taxNS, taxPrefix) "topics") e)
  let cs = mapMaybe elementToContent es
  let es_other = removeKnownElts e
  let as_other = removeKnownAttrs e
  return
    Item
    { itemURI = uri
    , itemTitle = ti
    , itemLink = li
    , itemDesc = desc
    , itemDC = dcs
    , itemTopics = tos
    , itemContent = cs
    , itemOther = es_other
    , itemAttrs = as_other
    }

elementToImage :: XML.Element -> Maybe Image
elementToImage e = do
  let es = children e
  let as = elementAttributes e
  uri <- pAttr' (rdfNS, rdfPrefix) "about" e
  ti <- pLeaf "title" e
  ur <- pLeaf "url" e
  li <- pLeaf "link" e
  let dcs = mapMaybe elementToDC es
  return
    Image
    { imageURI = uri
    , imageTitle = ti
    , imageURL = ur
    , imageLink = li
    , imageDC = dcs
    , imageOther = es
    , imageAttrs = as
    }

elementToChannel :: XML.Element -> Maybe Channel
elementToChannel e = do
  let es = children e
  uri <- pAttr' (rdfNS, rdfPrefix) "about" e
  ti <- pLeaf "title" e
  li <- pLeaf "link" e
  de <- pLeaf "description" e
  let mbImg = pLeaf "image" e
  let is = fromMaybe [] (fmap seqLeaves $ pNode "items" e)
  let tinp = pLeaf "textinput" e
  let dcs = mapMaybe elementToDC es
  let tos = fromMaybe [] (fmap bagLeaves $ pQNode (qualName' (taxNS, taxPrefix) "topics") e)
  let cs = mapMaybe elementToContent es
  let es_other = removeKnownElts e
  let as_other = removeKnownAttrs e
  let def_chan =
        Channel
        { channelURI = uri
        , channelTitle = ti
        , channelLink = li
        , channelDesc = de
        , channelImageURI = mbImg
        , channelItemURIs = is
        , channelTextInputURI = tinp
        , channelDC = dcs
        , channelUpdatePeriod = Nothing
        , channelUpdateFreq = Nothing
        , channelUpdateBase = Nothing
        , channelContent = cs
        , channelTopics = tos
        , channelOther = es_other
        , channelAttrs = as_other
        }
  return (addSyndication e def_chan)

addSyndication :: XML.Element -> Channel -> Channel
addSyndication e ch =
  ch
  { channelUpdatePeriod = fmap toUpdatePeriod $ pQLeaf' (synNS, synPrefix) "updatePeriod" e
  , channelUpdateFreq = readInt =<< pQLeaf' (synNS, synPrefix) "updateFrequency" e
  , channelUpdateBase = pQLeaf' (synNS, synPrefix) "updateBase" e
  }
  where
    toUpdatePeriod x =
      case x of
        "hourly" -> Update_Hourly
        "daily" -> Update_Daily
        "weekly" -> Update_Weekly
        "monthly" -> Update_Monthly
        "yearly" -> Update_Yearly
        _ -> Update_Hourly -- ToDo: whine

elementToDC :: XML.Element -> Maybe DCItem
elementToDC e = do
  guard (nameNamespace (elementName e) == Just dcNS)
  let dcItem x = DCItem {dcElt = x, dcText = strContent e}
  return $
    dcItem $
    case nameLocalName $ elementName e of
      "title" -> DC_Title
      "creator" -> DC_Creator
      "subject" -> DC_Subject
      "description" -> DC_Description
      "publisher" -> DC_Publisher
      "contributor" -> DC_Contributor
      "date" -> DC_Date
      "type" -> DC_Type
      "format" -> DC_Format
      "identifier" -> DC_Identifier
      "source" -> DC_Source
      "language" -> DC_Language
      "relation" -> DC_Relation
      "coverage" -> DC_Coverage
      "rights" -> DC_Rights
      oth -> DC_Other oth

elementToTaxonomyTopic :: XML.Element -> Maybe TaxonomyTopic
elementToTaxonomyTopic e = do
  guard (elementName e == qualName' (taxNS, taxPrefix) "topic")
  let es = children e
  uri <- pAttr' (rdfNS, rdfPrefix) "about" e
  li <- pQLeaf' (taxNS, taxPrefix) "link" e
  return
    TaxonomyTopic
    { taxonomyURI = uri
    , taxonomyLink = li
    , taxonomyTitle = pLeaf "title" e
    , taxonomyDesc = pLeaf "description" e
    , taxonomyTopics =
        fromMaybe [] (fmap bagLeaves $ pQNode (qualName' (taxNS, taxPrefix) "topics") e)
    , taxonomyDC = mapMaybe elementToDC es
    , taxonomyOther = es
    }

elementToContent :: XML.Element -> Maybe ContentInfo
elementToContent e = do
  guard (elementName e == qualName' (conNS, conPrefix) "items")
  return
    ContentInfo
    { contentURI = pAttr' (rdfNS, rdfPrefix) "about" e
    , contentFormat = pQLeaf' (conNS, conPrefix) "format" e
    , contentEncoding = pQLeaf' (conNS, conPrefix) "encoding" e
    , contentValue = pQLeaf' (rdfNS, rdfPrefix) "value" e
    }

bagLeaves :: XML.Element -> [URIString]
bagLeaves be =
  mapMaybe
    (\e -> do
       guard (elementName e == qualName' (rdfNS, rdfPrefix) "li")
       pAttr' (rdfNS, rdfPrefix) "resource" e `mplus`
         fmap strContent (pQNode (qualName' (rdfNS, rdfPrefix) "li") e))
    (fromMaybe [] $ fmap children $ pQNode (qualName' (rdfNS, rdfPrefix) "Bag") be)

{-
bagElements :: XML.Element -> [XML.Element]
bagElements be =
  mapMaybe
    (\ e -> do
      guard (elementName e == rdfName "li")
      return e)
    (fromMaybe [] $ fmap children $ pQNode (rdfName "Bag") be)
-}
seqLeaves :: XML.Element -> [URIString]
seqLeaves se =
  mapMaybe
    (\e -> do
       guard (elementName e == rdfName "li")
       return (strContent e))
    (fromMaybe [] $ fmap children $ pQNode (rdfName "Seq") se)