{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE CPP #-}

--------------------------------------------------------------------
-- |
-- Module    : Text.Feed.Import
-- Copyright : (c) Galois, Inc. 2008,
--             (c) Sigbjorn Finne 2009-
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
-- Stability : provisional
--
-- Convert from XML to Feeds.
--
--------------------------------------------------------------------
module Text.Feed.Import
  ( parseFeedFromFile -- :: FilePath -> IO Feed
  , parseFeedString -- :: String -> Maybe Feed
  , parseFeedSource -- :: FeedSource s => s -> Maybe Feed
  , FeedSource
          -- if you know your format, use these directly:
  , readRSS2 -- :: XML.Element -> Maybe Feed
  , readRSS1 -- :: XML.Element -> Maybe Feed
  , readAtom -- :: XML.Element -> Maybe Feed
  ) where

import Prelude.Compat

import Control.Exception
import Data.ByteString.Lazy (ByteString)
import Data.Text.Lazy (Text, pack)
import Data.XML.Types as XML

import Text.Atom.Feed.Import as Atom

import Text.Feed.Types
import Text.RSS.Import as RSS
import Text.RSS1.Import as RSS1

import Control.Monad.Compat

import qualified Text.XML as C
#if MIN_VERSION_utf8_string(1,0,0)
import Codec.Binary.UTF8.String (decodeString)
import System.IO (IOMode(..), hGetContents, openBinaryFile)

utf8readFile :: FilePath -> IO String
utf8readFile :: FilePath -> IO FilePath
utf8readFile FilePath
fp = (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
decodeString (Handle -> IO FilePath
hGetContents (Handle -> IO FilePath) -> IO Handle -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IOMode -> IO Handle
openBinaryFile FilePath
fp IOMode
ReadMode)
#else
import System.IO.UTF8 as UTF8 (readFile)

utf8readFile :: FilePath -> IO String
utf8readFile = UTF8.readFile
#endif
class FeedSource s where
  parseFeedSourceXML :: s -> Either SomeException C.Document

instance FeedSource ByteString where
  parseFeedSourceXML :: ByteString -> Either SomeException Document
parseFeedSourceXML = ParseSettings -> ByteString -> Either SomeException Document
C.parseLBS ParseSettings
forall a. Default a => a
C.def

instance FeedSource Text where
  parseFeedSourceXML :: Text -> Either SomeException Document
parseFeedSourceXML = ParseSettings -> Text -> Either SomeException Document
C.parseText ParseSettings
forall a. Default a => a
C.def

instance FeedSource String where
  parseFeedSourceXML :: FilePath -> Either SomeException Document
parseFeedSourceXML = Text -> Either SomeException Document
forall s. FeedSource s => s -> Either SomeException Document
parseFeedSourceXML (Text -> Either SomeException Document)
-> (FilePath -> Text) -> FilePath -> Either SomeException Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack

-- | 'parseFeedFromFile fp' reads in the contents of the file at @fp@;
-- the assumed encoding is UTF-8.
parseFeedFromFile :: FilePath -> IO (Maybe Feed)
parseFeedFromFile :: FilePath -> IO (Maybe Feed)
parseFeedFromFile FilePath
fp = FilePath -> Maybe Feed
parseFeedString (FilePath -> Maybe Feed) -> IO FilePath -> IO (Maybe Feed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
utf8readFile FilePath
fp

-- | 'parseFeedWithParser tries to parse the string @str@
-- as one of the feed formats. First as Atom, then RSS2 before
-- giving RSS1 a try. @Nothing@ is, rather unhelpfully, returned
-- as an indication of error.
parseFeedWithParser :: FeedSource s => (s -> Either e C.Document) -> s -> Maybe Feed
parseFeedWithParser :: (s -> Either e Document) -> s -> Maybe Feed
parseFeedWithParser s -> Either e Document
parser s
str =
  case s -> Either e Document
parser s
str of
    Left e
_ -> Maybe Feed
forall a. Maybe a
Nothing
    Right Document
d -> Element -> Maybe Feed
readAtom Element
e Maybe Feed -> Maybe Feed -> Maybe Feed
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Element -> Maybe Feed
readRSS2 Element
e Maybe Feed -> Maybe Feed -> Maybe Feed
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Element -> Maybe Feed
readRSS1 Element
e Maybe Feed -> Maybe Feed -> Maybe Feed
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Feed -> Maybe Feed
forall a. a -> Maybe a
Just (Element -> Feed
XMLFeed Element
e)
      where e :: Element
e = Element -> Element
C.toXMLElement (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Document -> Element
C.documentRoot Document
d

parseFeedString :: String -> Maybe Feed
parseFeedString :: FilePath -> Maybe Feed
parseFeedString = FilePath -> Maybe Feed
forall s. FeedSource s => s -> Maybe Feed
parseFeedSource

-- | 'parseFeedSource s' tries to parse the source @s@ as
-- one of the feed formats. First as Atom, then RSS2 before giving
-- RSS1 a try. @Nothing@ is, rather unhelpfully, returned as an
-- indication of error.
parseFeedSource :: FeedSource s => s -> Maybe Feed
parseFeedSource :: s -> Maybe Feed
parseFeedSource = (s -> Either SomeException Document) -> s -> Maybe Feed
forall s e.
FeedSource s =>
(s -> Either e Document) -> s -> Maybe Feed
parseFeedWithParser s -> Either SomeException Document
forall s. FeedSource s => s -> Either SomeException Document
parseFeedSourceXML

-- | 'readRSS2 elt' tries to derive an RSS2.x, RSS-0.9x feed document
-- from the XML element @e@.
readRSS2 :: XML.Element -> Maybe Feed
readRSS2 :: Element -> Maybe Feed
readRSS2 Element
e = RSS -> Feed
RSSFeed (RSS -> Feed) -> Maybe RSS -> Maybe Feed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> Maybe RSS
RSS.elementToRSS Element
e

-- | 'readRSS1 elt' tries to derive an RSS1.0 feed document
-- from the XML element @e@.
readRSS1 :: XML.Element -> Maybe Feed
readRSS1 :: Element -> Maybe Feed
readRSS1 Element
e = Feed -> Feed
RSS1Feed (Feed -> Feed) -> Maybe Feed -> Maybe Feed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> Maybe Feed
RSS1.elementToFeed Element
e

-- | 'readAtom elt' tries to derive an Atom feed document
-- from the XML element @e@.
readAtom :: XML.Element -> Maybe Feed
readAtom :: Element -> Maybe Feed
readAtom Element
e = Feed -> Feed
AtomFeed (Feed -> Feed) -> Maybe Feed -> Maybe Feed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> Maybe Feed
Atom.elementFeed Element
e