muon-0.1.0.4: src/Post.hs

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

import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Text.StringTemplate
import Text.StringTemplate.GenericStandard
import Text.Blaze.Html.Renderer.Text
import Text.Markdown
import System.Directory
import System.FilePath.Glob
import Data.Typeable
import Data.Data
import Data.List
import Data.Char
import qualified Data.String.Utils as S
import Site
import Control.Monad
import Constant

postPath = "posts/" :: String

replace a b c = S.replace a b (T.unpack c)

data Post = Post { title :: T.Text
                 , link :: T.Text
                 , date :: T.Text
                 , comment :: T.Text
                 , content :: T.Text
                 } deriving (Data, Typeable, Show)

postTemplate = do
    templates <- directoryGroup "templates" :: IO (STGroup T.Text)
    let Just t = getStringTemplate "post" templates
    return t

renderPost ::  Site -> StringTemplate T.Text -> Post -> T.Text
renderPost s t p = render
               $ setAttribute "site" s
               $ setAttribute "post" p t

renderPostT ::  Post -> IO T.Text
renderPostT p = do
    t <- postTemplate
    s <- readSite
    return $ renderPost s t p

makeExtract ::  Post -> T.Text
makeExtract p = T.pack
                  $ "<h2>" ++ T.unpack (title p) ++ "</h2>"
                 ++ "<h3>" ++ T.unpack (date p) ++ "</h3>"
                 ++  unlines (take 25 $ lines $ T.unpack $ content p)
                 ++ "</code></pre></li></ul></ol></p>"
                 ++ "<br/><a href=\'" ++ T.unpack (link p) ++ "\'>Read more...</a>"
                 ++ "<br/><br/><hr/>"

makePost ::  [String] -> Post
makePost l = Post { title  = T.pack $ head l
                  , link = T.pack $ "/" ++ S.replace "-" "/" (l !! 1) ++ "/" ++ linkify (head l)
                  , date = T.pack $ l !! 1
                  , comment = T.pack $ l !! 2
                  , content = T.pack $ extractContent l
                  }

extractContent ::  [String] -> String
extractContent l = TL.unpack
                 $ TL.replace "<pre>" "<pre class=\'prettyprint\'>"
                 $ renderHtml
                 $ markdown def
                 $ TL.pack
                 $ unlines
                 $ drop 3 l

getPost ::  FilePath -> IO Post
getPost n = do
    c <- readFile n
    return $ makePost $ lines c

getNames ::  IO [FilePath]
getNames = do
    d <- globDir [compile "*.post"] postPath
    return $ (sort . head . fst) d

linkify ::  [Char] -> [Char]
linkify s = filter isLetter $ map toLower $ S.replace " " "-" s

writePosts ::  [Post] -> IO ()
writePosts ps = mapM_ writePost ps

writePost ::  Post -> IO ()
writePost p = do
    let d = S.replace "-" "/" (T.unpack $ date p) ++ "/" ++ (linkify $ T.unpack $ title p)
    mkdir $ sitePath ++ d
    c <- renderPostT p
    writeFile (sitePath ++ d ++ "/index.html") (T.unpack $ T.append "\n" c)

getAllPosts ::  IO [Post]
getAllPosts = do
    ns <- getNames
    mapM getPost ns

getAllExtracts ::  IO [T.Text]
getAllExtracts = do
    ps <- getAllPosts
    return $ map makeExtract ps

generatePosts = getAllPosts >>= writePosts >> putStrLn "Generated posts"