{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE NoImplicitPrelude #-} module Web.Geek.Post where import Air.Env import Air.Extra (u2b) import Air.Spec import Air.TH import Data.Aeson.Generic (encode, decode) import Data.Char import Data.List.Split import Data.Maybe import Data.Text (Text, pack, unpack, strip, stripStart) import Data.Time import Data.Time.Clock (UTCTime(..)) import GHC.Exts( IsString(..) ) import System.FilePath import System.Locale import Test.Hspec import Web.Geek.Config import Web.Geek.MarkupEngine.Markdown import Web.Geek.Type import qualified Data.ByteString.Char8 as B import qualified Data.Text as T import qualified Data.Text as T post_tags :: Text -> Post -> [Text] post_tags meta_tag_keyword post = case post.meta.lookup meta_tag_keyword of Nothing -> [] Just s -> s.T.splitOn ",".map T.strip post_link :: Post -> URIEscapedText post_link post = let text_link = case post.date of Just _date -> let link_format = "%Y/%m/%d" prefix = T.pack - formatTime defaultTimeLocale link_format - _date.utctDay in prefix + "/" + post.title Nothing -> "post/" + post.title in text_link.T.unpack.fromString.URIEscapedText parse_title_and_date_from_path :: String -> FilePath -> (T.Text, Maybe UTCTime) parse_title_and_date_from_path post_date_format path = let base_name = path.takeBaseName _post_date_length = post_date_length - post_date_format title = base_name.drop _post_date_length date = base_name.take _post_date_length.parseTime defaultTimeLocale post_date_format in (title.T.pack, date) markup :: [MarkupEngine] -> FilePath -> Text -> HTMLText markup markups path body = let ext = path.takeExtension.dropWhile (is '.').pack in case markups.select (extensions > has ext) of [] -> transformer def body markup:_ -> transformer markup body parse_meta :: Text -> (Meta, Text) parse_meta str = let no_meta = ([], str) in case str.T.stripStart.T.splitOn "---\n" of (x:y:zs) -> if x.T.all isSpace then let parse_line line = case line.T.splitOn ":" of w1:w2:[] -> Just (w1.strip, w2.strip) _ -> Nothing in let meta = y.T.lines.reject (T.all isSpace).map parse_line.catMaybes in (meta, zs.T.unlines.stripStart) else no_meta _ -> no_meta -- Spec test_meta :: T.Text test_meta = T.pack [here| --- layout: post categories: 日常 --- some thing |] spec :: Spec spec = do describe "Post" - do it "should parse meta data" - do parse_meta test_meta === ([("layout", "post"), ("categories", "日常")], "some thing\n\n\n") it "should parse title" - do let path = "blog/posts/2010-10-30-dummy title.md" title_and_date = ("dummy title", parseTime defaultTimeLocale "%Y-%m-%d" "2010-10-30") parse_title_and_date_from_path "%Y-%m-%d-" path === title_and_date it "should markup" - do let path = "blog/posts/2010-10-30-dummy title.md" body = "### abc" markup [markdown] path body === "

abc

" it "should have tags" - do let _post = def {meta = [("tags", "haskell, blog")]} :: Post post_tags "tags" _post === ["haskell", "blog"] it "should encode json" - do let _post = def {meta = [("tags", "haskell, blog")]} :: Post _post.encode.decode === Just _post