{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable #-} module Post where import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.String.Utils as S 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 Site import Control.Monad import Constant import Network.HTTP.Base (urlEncode) 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 $ "

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

" ++ "

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

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

" ++ "
Read more..." ++ "


" 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 $ 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 (\x -> isAlphaNum x || x=='-') $ 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"