module Web.Geek.Post where
import Air.Env
import Air.Spec
import Air.TH
import Data.Aeson.Generic (encode, decode)
import Data.Char
import Data.Maybe
import Data.Text (Text, pack, strip, stripStart)
import Data.Time
import GHC.Exts( IsString(..) )
import System.FilePath
import System.Locale
import Test.Hspec
import Web.Geek.Config
import Web.Geek.Type
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
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
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 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