{-# 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 Site import Control.Monad import Constant postPath = "posts/" :: String 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 :: StringTemplate T.Text -> Post -> T.Text renderPost t p = render $ setAttribute "site" defaultSite $ setAttribute "post" p t renderName :: StringTemplate T.Text -> String -> IO T.Text renderName t n = liftM (renderPost t) (getPost (0, n)) makeExtract :: Post -> T.Text makeExtract p = T.pack $ "

" ++ T.unpack (title p) ++ "

" ++ "

" ++ T.unpack (date p) ++ "

" ++ unlines (take 25 $ lines $ T.unpack $ content p) ++ "

Read more..." ++ "
" makePost :: (Int, [String]) -> Post makePost l = Post { title = T.pack $ head (snd l) , link = T.pack $ "/post/" ++ show (fst l) , date = T.pack $ snd l !! 1 , comment = T.pack $ snd l !! 2 , content = T.pack $ extractContent (snd l) } extractContent :: [String] -> String extractContent l = TL.unpack $ renderHtml $ markdown def $ TL.pack $ unlines $ drop 3 l getPost :: (Int, FilePath) -> IO Post getPost n = do c <- readFile (snd n) return $ makePost (fst n, lines c) getNames :: IO [(Int, FilePath)] getNames = do d <- globDir [compile "*.post"] postPath let l = (sort . head . fst) d return $ zip [1..(length l)] l renderPosts :: IO [T.Text] renderPosts = do templates <- directoryGroup "templates" :: IO (STGroup T.Text) let Just t = getStringTemplate "post" templates ns <- getNames mapM (renderName t . snd) ns writePosts :: [T.Text] -> IO () writePosts ps = mapM_ writePost (zip [1..(length ps)] ps) writePost :: (Int, T.Text) -> IO () writePost p = do mkdir $ sitePath ++ "post" mkdir $ sitePath ++ "post/" ++ show (fst p) writeFile (sitePath ++ "post/" ++ show (fst p) ++ "/index.html") (T.unpack $ T.append "\n" $ snd p) getAllPosts = do ns <- getNames mapM getPost ns getAllExtracts = do ps <- getAllPosts return $ map makeExtract ps generatePosts = renderPosts >>= writePosts >> putStrLn "Generated posts"