Main.hs

{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Write a file from the input RSS/Atom item.
--
-- Meant to be use as a callback for imm.
-- {{{ Imports
import           Imm.Callback
import           Imm.Feed
import           Imm.Link
import           Imm.Pretty

import           Data.Aeson
import           Data.ByteString.Builder
import           Data.ByteString.Lazy          (getContents, writeFile)
import qualified Data.Text                     as Text (replace)
import           Data.Time
import           Options.Applicative
import           System.Directory              (createDirectoryIfMissing)
import           System.FilePath
import           Text.Blaze.Html.Renderer.Utf8
import           Text.Blaze.Html5              (Html, docTypeHtml, preEscapedToHtml, (!))
import qualified Text.Blaze.Html5              as H
import qualified Text.Blaze.Html5.Attributes   as H (charset, href)
import           URI.ByteString.Extended
-- }}}

data CliOptions = CliOptions
  { _directory :: FilePath
  , _dryRun    :: Bool
  } deriving (Eq, Ord, Read, Show)

parseOptions :: MonadIO m => m CliOptions
parseOptions = io $ customExecParser defaultPrefs (info cliOptions $ progDesc "Write a file for each new RSS/Atom item. An intermediate folder will be created for each feed.")

cliOptions :: Parser CliOptions
cliOptions = CliOptions
  <$> strOption (long "directory" <> short 'd' <> metavar "PATH" <> help "Root directory where files will be created.")
  <*> switch (long "dry-run" <> help "Disable all I/Os, except for logs.")



main :: IO ()
main = do
  CliOptions directory dryRun <- parseOptions
  input <- getContents <&> eitherDecode

  case input :: Either String CallbackMessage of
    Right (CallbackMessage feedDefinition item) -> do
      let content = defaultFileContent feedDefinition item
          filePath = defaultFilePath directory feedDefinition item
      putStrLn filePath
      unless dryRun $ do
        createDirectoryIfMissing True $ takeDirectory filePath
        writeFile filePath $ toLazyByteString content
    Left e -> putStrLn ("Invalid input: " <> e) >> exitFailure
  return ()

-- * Default behavior

-- | Generate a path @<root>/<feed title>/<element date>-<element title>.html@, where @<root>@ is the first argument
defaultFilePath :: FilePath -> FeedDefinition -> FeedItem -> FilePath
defaultFilePath root feedDefinition element = makeValid $ root </> toString title </> fileName <.> "html" where
  date = maybe "" (formatTime defaultTimeLocale "%F-") $ _itemDate element
  fileName = date <> toString (sanitize $ _itemTitle element)
  title = sanitize $ _feedTitle feedDefinition
  sanitize = appEndo (mconcat [Endo $ Text.replace (toText [s]) "_" | s <- pathSeparators])
    >>> Text.replace "." "_"
    >>> Text.replace "?" "_"
    >>> Text.replace "!" "_"
    >>> Text.replace "#" "_"

-- | Generate an HTML page, with a title, a header and an article that contains the feed element
defaultFileContent :: FeedDefinition -> FeedItem -> Builder
defaultFileContent feedDefinition element = renderHtmlBuilder $ docTypeHtml $ do
  H.head $ do
    H.meta ! H.charset "utf-8"
    H.title $ convertText $ _feedTitle feedDefinition <> " | " <> _itemTitle element
  H.body $ do
    H.h1 $ convertText $ _feedTitle feedDefinition
    H.article $ do
      H.header $ do
        defaultArticleTitle feedDefinition element
        defaultArticleAuthor feedDefinition element
        defaultArticleDate feedDefinition element
      defaultBody feedDefinition element


-- * Low-level helpers

defaultArticleTitle :: FeedDefinition -> FeedItem -> Html
defaultArticleTitle _ item = H.h2
  $ maybe id (\link -> H.a ! href (_linkURI link)) (getMainLink item)
  $ convertText $ _itemTitle item

defaultArticleAuthor :: FeedDefinition -> FeedItem -> Html
defaultArticleAuthor _ item = H.address $ do
  "Published by "
  forM_ (_itemAuthors item) $ \author -> do
    convertDoc $ pretty author
    ", "

defaultArticleDate :: FeedDefinition -> FeedItem -> Html
defaultArticleDate _ element = forM_ (_itemDate element) $ \date -> H.p $ " on " >> H.time (convertDoc $ prettyTime date)


-- | Generate the HTML content for a given feed element
defaultBody :: FeedDefinition -> FeedItem -> Html
defaultBody _ item = do
  unless (null links) $ H.p $ do
    "Related links:"
    H.ul $ forM_ links $ \uri -> H.li (H.a ! href uri $ convertURI uri)
  H.p $ preEscapedToHtml $ _itemContent item
  where links   = _linkURI <$> _itemLinks item

href :: AnyURI -> H.Attribute
href = H.href . convertURI

convertURI :: (IsString t) => AnyURI -> t
convertURI = convertText . decodeUtf8 . withAnyURI serializeURIRef'

convertText :: (IsString t) => Text -> t
convertText = fromString . toString

convertDoc :: (IsString t) => Doc a -> t
convertDoc = show