muon-0.1.0.8: src/Archive.hs

{-# LANGUAGE OverloadedStrings #-}
module Archive where

import System.Directory
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Site
import Text.StringTemplate
import Post
import Constant

archiveTemplate = do
    templates <- directoryGroup "templates" :: IO (STGroup T.Text)
    return $ maybe (newSTMP "generic.st not found")
                   id
                   (getStringTemplate "generic" templates)

makeTableRow :: Post -> T.Text
makeTableRow p = let a = T.append in "<tr>"
              `a` "<td><a href=" `a` (link p)
              `a` ">" `a` (title p) `a` "</a></td>"
              `a` "<td>" `a` (date p) `a` "</td>"
              `a` "<td>" `a` (comment p) `a` "</td>"
              `a` "</tr>"

makeTable :: [Post] -> T.Text
makeTable ps = let a = T.append in "<table>"
            `a` "<tr><td>Title</td><td>Date</td><td>Comment</td></tr>"
            `a` T.unlines (map makeTableRow ps)
            `a` "</table>"

renderGenericArchive site template content = render
                         $ setAttribute "site" site
                         $ setAttribute "content" content template

renderArchive = do
    posts <- getAllPosts
    template <- archiveTemplate
    site <- readSite
    return $ renderGenericArchive site template (makeTable $ reverse posts)

writeArchive :: T.Text -> IO ()
writeArchive html = do
    let a = T.append
    mkdir $ sitePath ++ "archive/"
    T.writeFile (sitePath ++ "archive/index.html") html

generateArchive = renderArchive >>= writeArchive >> putStrLn "Generated archive"