* added Markdown support
This commit is contained in:
parent
0f98c3f489
commit
8f1b6b5c4e
2 changed files with 31 additions and 7 deletions
|
@ -36,4 +36,5 @@ Executable tazblog
|
||||||
rss,
|
rss,
|
||||||
recaptcha,
|
recaptcha,
|
||||||
hamlet,
|
hamlet,
|
||||||
shakespeare-css
|
shakespeare-css,
|
||||||
|
markdown
|
||||||
|
|
25
src/Blog.hs
25
src/Blog.hs
|
@ -5,14 +5,17 @@ module Blog where
|
||||||
import Control.Monad (when, unless)
|
import Control.Monad (when, unless)
|
||||||
import Data.Data (Data, Typeable)
|
import Data.Data (Data, Typeable)
|
||||||
import Data.List (intersperse)
|
import Data.List (intersperse)
|
||||||
|
import Data.Maybe (fromJust)
|
||||||
import Data.Monoid (mempty)
|
import Data.Monoid (mempty)
|
||||||
import Data.Text (Text, append, pack, empty)
|
import Data.Text (Text, append, pack, empty)
|
||||||
|
import Data.Text.Lazy (fromStrict)
|
||||||
import Data.Time
|
import Data.Time
|
||||||
import Network.Captcha.ReCaptcha
|
import Network.Captcha.ReCaptcha
|
||||||
import System.Locale (defaultTimeLocale)
|
import System.Locale (defaultTimeLocale)
|
||||||
import Text.Blaze.Html (preEscapedToHtml)
|
import Text.Blaze.Html (preEscapedToHtml)
|
||||||
import Text.Hamlet
|
import Text.Hamlet
|
||||||
import Text.Lucius
|
import Text.Lucius
|
||||||
|
import Text.Markdown
|
||||||
import Locales
|
import Locales
|
||||||
import BlogDB
|
import BlogDB
|
||||||
|
|
||||||
|
@ -28,11 +31,16 @@ replace x y = map (\z -> if z == x then y else z)
|
||||||
show' :: Show a => a -> Text
|
show' :: Show a => a -> Text
|
||||||
show' = pack . show
|
show' = pack . show
|
||||||
|
|
||||||
|
-- |After this time all entries are Markdown
|
||||||
|
markdownCutoff :: UTCTime
|
||||||
|
markdownCutoff = fromJust $ parseTime defaultTimeLocale "%s" "1367149834"
|
||||||
|
|
||||||
data BlogURL = BlogURL
|
data BlogURL = BlogURL
|
||||||
|
|
||||||
-- blog CSS (admin is still static)
|
-- blog CSS (admin is still static)
|
||||||
stylesheetSource = $(luciusFile "res/blogstyle.lucius")
|
stylesheetSource = $(luciusFile "res/blogstyle.lucius")
|
||||||
blogStyle = renderCssUrl undefined stylesheetSource
|
blogStyle = renderCssUrl undefined stylesheetSource
|
||||||
|
|
||||||
-- blog HTML
|
-- blog HTML
|
||||||
blogTemplate :: BlogLang -> Text -> Html -> Html
|
blogTemplate :: BlogLang -> Text -> Html -> Html
|
||||||
blogTemplate lang t_append body = [shamlet|
|
blogTemplate lang t_append body = [shamlet|
|
||||||
|
@ -78,6 +86,12 @@ showFooter l v = [shamlet|
|
||||||
<a class="link" href="/notice">#{noticeText l}
|
<a class="link" href="/notice">#{noticeText l}
|
||||||
|]
|
|]
|
||||||
|
|
||||||
|
isEntryMarkdown :: Entry -> Bool
|
||||||
|
isEntryMarkdown e = edate e > markdownCutoff
|
||||||
|
|
||||||
|
renderEntryMarkdown :: Text -> Html
|
||||||
|
renderEntryMarkdown = markdown def {msXssProtect = False} . fromStrict
|
||||||
|
|
||||||
renderEntries :: Bool -> [Entry] -> Text -> Maybe Html -> Html
|
renderEntries :: Bool -> [Entry] -> Text -> Maybe Html -> Html
|
||||||
renderEntries showAll entries topText footerLinks = [shamlet|
|
renderEntries showAll entries topText footerLinks = [shamlet|
|
||||||
<span class="innerTitle">#{topText}
|
<span class="innerTitle">#{topText}
|
||||||
|
@ -85,6 +99,11 @@ renderEntries showAll entries topText footerLinks = [shamlet|
|
||||||
<ul style="max-width:57em;">
|
<ul style="max-width:57em;">
|
||||||
$forall entry <- elist
|
$forall entry <- elist
|
||||||
<li>
|
<li>
|
||||||
|
$if (isEntryMarkdown entry)
|
||||||
|
<a href=#{linkElems entry}>#{linkText $ length $ comments entry}
|
||||||
|
<b>#{title entry}
|
||||||
|
^{renderEntryMarkdown $ append " " $ btext entry}
|
||||||
|
$else
|
||||||
<a href=#{linkElems entry}>#{linkText $ length $ comments entry}
|
<a href=#{linkElems entry}>#{linkText $ length $ comments entry}
|
||||||
^{preEscapedToHtml $ append " " $ btext entry}
|
^{preEscapedToHtml $ append " " $ btext entry}
|
||||||
$if ((/=) (mtext entry) empty)
|
$if ((/=) (mtext entry) empty)
|
||||||
|
@ -119,7 +138,7 @@ showLinks Nothing lang = [shamlet|
|
||||||
nLink = T.concat ["/", show' lang, "/?page=2"]
|
nLink = T.concat ["/", show' lang, "/?page=2"]
|
||||||
|
|
||||||
renderEntry :: Entry -> Html
|
renderEntry :: Entry -> Html
|
||||||
renderEntry Entry{..} = [shamlet|
|
renderEntry e@Entry{..} = [shamlet|
|
||||||
<span class="innerTitle">#{title}
|
<span class="innerTitle">#{title}
|
||||||
<span class="righttext">
|
<span class="righttext">
|
||||||
<i>#{woText}
|
<i>#{woText}
|
||||||
|
@ -127,6 +146,10 @@ renderEntry Entry{..} = [shamlet|
|
||||||
<article>
|
<article>
|
||||||
<ul style="max-width:57em;">
|
<ul style="max-width:57em;">
|
||||||
<li>
|
<li>
|
||||||
|
$if (isEntryMarkdown e)
|
||||||
|
^{renderEntryMarkdown btext}
|
||||||
|
<p>^{renderEntryMarkdown $ mtext}
|
||||||
|
$else
|
||||||
^{preEscapedToHtml $ btext}
|
^{preEscapedToHtml $ btext}
|
||||||
<p>^{preEscapedToHtml $ mtext}
|
<p>^{preEscapedToHtml $ mtext}
|
||||||
<div class="innerBoxComments">
|
<div class="innerBoxComments">
|
||||||
|
|
Loading…
Reference in a new issue