{-# LANGUAGE OverloadedStrings #-}

import Data.UUID.V4
import System.Directory
import Control.Monad.Extra
import Data.UUID
import Data.Char
import Data.Generics
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import Text.Feed.Import
import Text.Feed.Query
import Text.Feed.Types
import Text.RSS.Syntax hiding (RSSItem)
import Data.XML.Types
import Data.Time
import System.Posix.Process
import System.Posix.Files
import Network.HostName
import System.Random
import System.FilePath

data FeedMetadata = FeedMetadata
  { title :: Text,
    author :: Maybe Text,
    home :: Maybe Text
  }
  deriving (Show)

data Message = Message
  { from :: Text,
    subject :: Text,
    date :: Text,
    messageId :: Text,
    body :: Text
--    newsGroup :: Text
  }
  deriving (Show)

formatMessage :: Message -> Text
formatMessage (Message from subject date messageId body) =
  "MIME-Version: 1.0\n" <> "Date: " <> date <> "\nSubject: " <> subject <>
  "\nFrom: " <> from <> "\nMessage-ID: " <> messageId <>
  "\nContent-Type: text/html" <> "\n\n" <> body

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

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

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 -> FeedMetadata
toFeedMetadata feed =
  FeedMetadata (getFeedTitle feed) (getFeedAuthor feed) (getFeedHome feed)

genFilename :: FilePath -> IO String
genFilename root = do
  epoch <- formatTime defaultTimeLocale "%s" <$> getCurrentTime
  pid <- getProcessID
  host <- getHostName
  rand <- randomRIO (10000, 99999) :: IO Int
  return $ root </> "new" </> epoch <> "." <> show pid <> "." <>
    host <> "." <> show rand

genUniqFilename :: FilePath -> IO String
genUniqFilename root = do
  filename <- genFilename root
  exists <- fileExist filename
  if exists then genUniqFilename root else return filename

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

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" <> ">"

writeMessage :: FilePath -> Message -> IO ()
writeMessage root msg =
  genUniqFilename root >>=
  \filename -> writeFile filename $ T.unpack (formatMessage msg)

main :: IO ()
main = do
  feed <- parseFeedFromFile "./stallman.xml"
  let root = "./maildir"
  mapM_ (createDirectoryIfMissing True)
    [root </> "new", root </> "cur", root </> "tmp"]
  whenJust feed $
    \feed' ->
      mapM_ (\msg -> 
               writeMessage root =<< toMessage (toFeedMetadata feed') msg)
      (getFeedItems feed')