muon-0.1.0.8: src/Page.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Page where

import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy as TL
import Site
import Text.StringTemplate
import Text.StringTemplate.GenericStandard
import System.Directory
import Control.Monad
import Control.Arrow ((>>>))
import Constant
import Text.Blaze.Html.Renderer.Text
import Text.Markdown


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

onlyFiles :: [FilePath] -> IO [FilePath]
onlyFiles fs = filterM doesFileExist fs

pageNames :: IO [String]
pageNames = do
    cs <- getDirectoryContents "pages"
    let fs = map (\x -> "pages/" ++ x) cs
    fmap ( map (drop 6) ) (onlyFiles fs)

renderMarkdown :: T.Text -> T.Text
renderMarkdown = TL.fromStrict >>> markdown def >>> renderHtml >>> TL.toStrict

renderPage :: Site -> StringTemplate T.Text -> T.Text -> T.Text
renderPage s t c = render
               $ setAttribute "site" s
               $ setAttribute "content" (renderMarkdown c) t

renderPageFile :: FilePath -> IO T.Text
renderPageFile p = do
    content <- T.readFile $ "pages/" ++ p
    template <- pageTemplate
    site <- readSite
    return $ renderPage site template content

writePage :: FilePath -> T.Text -> IO ()
writePage p c = do
    mkdir $ sitePath ++ p
    T.writeFile (sitePath ++ p ++ "/index.html") c

generatePage p = renderPageFile p
             >>= writePage p
              >> putStrLn ("Generated " ++ p)
generatePages = pageNames >>= mapM_ generatePage