Converter.hs

{-# LANGUAGE OverloadedStrings #-}
{- |
Module      : Web.RBB.Converter
Description :  Converter functions
Copyright   :  (c) Sebastian Witte
License     :  BSD3

Maintainer  :  woozletoff@gmail.com
Stability   :  experimental


-}
module Web.RBB.Converter
    ( convertToHTML
    , fileContentToHtml
    , renderEntries
    ) where

import           Control.Applicative
import           Control.Concurrent.STM
import           Control.Lens
import           Control.Monad.IO.Class
import           Control.Monad.Reader
import           Data.Default
import qualified Data.Map                     as Map
import qualified Data.Set                     as Set
import           Text.Pandoc.Options
import           Text.Pandoc.Readers.Markdown
import           Text.Pandoc.Writers.HTML
import           Web.RBB.Config
import           Web.RBB.Types                as E
import           Web.RBB.Types.Blog
import           Web.RBB.Types.CachedEntry    as E
import           Web.RBB.Util

-- | Given a bunch of entries and a 'Blog'
renderEntries :: (Functor io, MonadIO io, Monad m)
              => Blog m -> [Entry] -> io (m Html)
renderEntries blog is = do
    cachedEntries <- foldM manageCache [] $ select is
    let bcfg = blog^.blogConfig
    return . entryRenderer bcfg bcfg $ reverse cachedEntries
  where
    select :: [Entry] -> [(Maybe CachedEntry, Maybe Entry)]
    select =
        let c = blog^.blogEntryCache
        in map (\e -> (Map.lookup (e^.entryId) c, Just e))

    manageCache :: (Functor io, MonadIO io)
                => [(Entry, Html)]
                -> (Maybe CachedEntry, Maybe Entry)
                -> io [(Entry, Html)]
    manageCache acc ie =
        case ie of
            (_,Nothing) -> return acc
            (Just ce, Just e) | ((==) `on` updateTime) (ce^.cacheEntryData) e
                        -> return $ (ce^.cacheEntryData, ce^.entry) : acc
            (_, Just e) -> do
                en <- convertToHTML e <$> liftIO (readFile (e^.fullPath))
                let h = CachedEntry en (e^.lastUpdate) e
                liftIO . atomically $
                    writeTChan (blog^.blogCacheChannel) (e^.entryId, h)
                return $ (e, en) : acc
      where
        updateTime e = entryUpdateTime (e^.lastUpdate)

-- | Converter function that choses an appropriate pandoc configuration for the
-- given 'FileType' and converts the given 'String' to 'Html'.
fileContentToHtml :: FileType -> String -> Html
fileContentToHtml ft = writeHtml defaultWriter . case ft of
    PandocMarkdown ->
        readMarkdown (def
        { readerExtensions = pandocExtensions })
    LiterateHaskell ->
        readMarkdown (def
        { readerExtensions = Ext_literate_haskell `Set.insert` pandocExtensions })

-- | Convert the given file contents given as a 'String' to an 'Html' element
-- and add some meta data from the 'EntryData' argument'.
convertToHTML :: Entry -> String -> Html
convertToHTML ed = fileContentToHtml (ed^.fileType)

-- | Default 'WriterOptions' for the converters.
defaultWriter :: WriterOptions
defaultWriter = def
    { writerHtml5 = True
    , writerEmailObfuscation = ReferenceObfuscation
    , writerHighlight = True
    }