{-# 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 $ "
" "" $ 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"