{-# LANGUAGE OverloadedStrings #-}

module F2Md.Import (toMessagesFromFile, toMessagesFromUrl) where

import Control.Monad
import Data.Time
import System.Process
import Data.UUID
import Data.UUID.V4
import Data.Char
import Data.Text (Text)
import Text.Feed.Types
import qualified Data.Text as T
import Data.Maybe
import Text.Feed.Query
import Data.Generics
import Text.RSS.Syntax hiding (RSSItem)
import Data.XML.Types
import Text.Feed.Import
import Text.Feed.Types
import F2Md.Types

toMessagesFromFile :: Text -> FilePath -> IO [Message]
toMessagesFromFile url file = do
  feed <- parseFeedFromFile file
  case feed of
    Nothing -> return []
    Just feed' ->
      mapM (\msg -> toMessage (toFeedMetadata feed' url) msg) (getFeedItems feed')

toMessagesFromUrl :: Text -> Maybe ZonedTime -> IO [Message]
toMessagesFromUrl url after = do
  feed <- parseFeedString <$> (fetchFeed $ T.unpack url)
  case feed of
    Nothing -> return []
    Just feed' -> catMaybes <$>
      mapM (\msg -> toMessage' after (toFeedMetadata feed' url) msg) (getFeedItems feed')

wgetCommand :: String
wgetCommand = "wget -O- 2>/dev/null"

fetchFeed :: String -> IO String
fetchFeed url = readCreateProcess (shell $ wgetCommand ++ " " ++ url) ""

toMessage' :: Maybe ZonedTime -> FeedMetadata -> Item -> IO (Maybe Message)
toMessage' after feed item
  | isNothing date = return Nothing
  | isNothing after = toMessage feed item >>= return . Just
  | zonedTimeToUTC (fromJust after) >= fromJust date = return Nothing
  | otherwise = toMessage feed item >>= return . Just
  where date = join $ getItemPublishDate item

toMessage :: FeedMetadata -> Item -> IO Message
toMessage (FeedMetadata title author home url) item = do
  messageId <- genMessageId (fromMaybe "" home) (snd <$> getItemId item)
  return $ Message
    (fromMaybe title $ orElse (getItemAuthor' item) author)
    (fromMaybe "Untitled" $ getItemTitle item)
    (fromJust $ join $ getItemPublishDate item) -- default should be current date
    messageId
    (formatBody (getItemLink item) $
     (getItemContent item) `orElse` (getItemContent' item) `orElse`
     (getItemDescription item))
    url

getItemAuthor' :: Item -> Maybe Text
getItemAuthor' item = case getItemAuthor item of
  Just "" -> Nothing
  Just author -> Just author
  Nothing -> Nothing

getItemContent' :: Item -> Maybe Text
getItemContent' (RSSItem item) =
  (fmap (T.concat . elementText) . listToMaybe .
   filter (\e -> namePrefix (elementName e) == Just "content"))
  $ rssItemOther item
getItemContent' _ = Nothing

formatBody :: Maybe Text -> Maybe Text -> Text
formatBody link desc =
  let linkText = case link of
        Nothing -> ""
        Just link' -> "Link: " <> link' <> "\n\n" in
    linkText <> (fromMaybe "" desc)

toFeedMetadata :: Feed -> Text -> FeedMetadata
toFeedMetadata feed url =
  FeedMetadata (getFeedTitle feed) (getFeedAuthor feed) (getFeedHome feed) url

genMessageId :: Text -> Maybe Text -> IO Text
genMessageId feedLink guid = do
  id <- case guid of
          Just guid' -> return $ T.map hyphenateNonAlNum guid'
          Nothing -> toText <$> nextRandom
  return $
    "<" <> id <> "@" <> (T.map hyphenateNonAlNum feedLink) <> ".gnu" <> ">"

hyphenateNonAlNum :: Char -> Char
hyphenateNonAlNum c
  | isAlphaNum c = c
  | otherwise = '-'