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

" ++ 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 $ TL.replace "
" "
"
                 $ 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"