{-# 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.Pretty import Data.ByteString (getContents) import Data.ByteString.Builder import Data.ByteString.Streaming (toStreamingByteString) import qualified Data.MessagePack as MsgPack import qualified Data.Text as Text (null, replace) import Data.Time import Options.Applicative import Streaming.With import System.Directory (createDirectoryIfMissing) import System.FilePath import Text.Atom.Types 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 Text.RSS.Types import URI.ByteString -- }}} 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 message <- getContents <&> fromStrict <&> MsgPack.unpack case message of Just (Message feed element) -> do let content = defaultFileContent feed element filePath = defaultFilePath directory feed element putStrLn filePath unless dryRun $ do createDirectoryIfMissing True $ takeDirectory filePath writeBinaryFile filePath $ toStreamingByteString content _ -> putStrLn "Invalid input" >> exitFailure return () -- * Default behavior -- | Generate a path @//-.html@, where @@ is the first argument defaultFilePath :: FilePath -> Feed -> FeedElement -> FilePath defaultFilePath root feed element = makeValid $ root toString title fileName <.> "html" where date = maybe "" (formatTime defaultTimeLocale "%F-") $ getDate element fileName = date <> toString (sanitize $ getTitle element) title = sanitize $ getFeedTitle feed 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 :: Feed -> FeedElement -> Builder defaultFileContent feed element = renderHtmlBuilder $ docTypeHtml $ do H.head $ do H.meta ! H.charset "utf-8" H.title $ convertText $ getFeedTitle feed <> " | " <> getTitle element H.body $ do H.h1 $ convertText $ getFeedTitle feed H.article $ do H.header $ do defaultArticleTitle feed element defaultArticleAuthor feed element defaultArticleDate feed element defaultBody feed element -- * Low-level helpers defaultArticleTitle :: Feed -> FeedElement -> Html defaultArticleTitle _ element@(RssElement item) = H.h2 $ maybe id (\uri -> H.a ! H.href uri) link $ convertText $ getTitle element where link = withRssURI (convertDoc . prettyURI) <$> itemLink item defaultArticleTitle _ element@(AtomElement _) = H.h2 $ convertText $ getTitle element defaultArticleAuthor :: Feed -> FeedElement -> Html defaultArticleAuthor _ (RssElement item) = unless (Text.null author) $ H.address $ "Published by " >> convertText author where author = itemAuthor item defaultArticleAuthor _ (AtomElement entry) = H.address $ do "Published by " forM_ (entryAuthors entry) $ \author -> do convertDoc $ prettyPerson author ", " defaultArticleDate :: Feed -> FeedElement -> Html defaultArticleDate _ element = forM_ (getDate element) $ \date -> H.p $ " on " >> H.time (convertDoc $ prettyTime date) -- | Generate the HTML content for a given feed element defaultBody :: Feed -> FeedElement -> Html defaultBody _ element@(RssElement _) = H.p $ preEscapedToHtml $ getContent element defaultBody _ element@(AtomElement entry) = do unless (null links) $ H.p $ do "Related links:" H.ul $ forM_ links $ \uri -> H.li (H.a ! withAtomURI href uri $ convertAtomURI uri) H.p $ preEscapedToHtml $ getContent element where links = map linkHref $ entryLinks entry href :: URIRef a -> H.Attribute href = H.href . convertURI convertAtomURI :: (IsString t) => AtomURI -> t convertAtomURI = withAtomURI convertURI convertURI :: (IsString t) => URIRef a -> t convertURI = convertText . decodeUtf8 . serializeURIRef' convertText :: (IsString t) => Text -> t convertText = fromString . toString convertDoc :: (IsString t) => Doc a -> t convertDoc = show