mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* using Text from Data.Text (stict) instead of String for text in entries and comments

Browse source
This commit is contained in:
"Vincent Ambo ext:(%22) 2012-03-06 17:28:30 +01:00
parent f113778e17
commit d4fa02deed
1 changed files with 10 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
src/Blog.hs
View file

@ -5,9 +5,11 @@ module Blog where
import Data.Data (Data, Typeable) import Data.Data (Data, Typeable)
import Data.List (intersperse) import Data.List (intersperse)
import Data.Monoid (mempty) import Data.Monoid (mempty)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time import Data.Time
import System.Locale (defaultTimeLocale) import System.Locale (defaultTimeLocale)
import Text.Blaze (toValue, preEscapedString) import Text.Blaze (toValue, preEscapedText)
import Text.Blaze.Html5 (Html, (!), a, form, input, p, toHtml, label) import Text.Blaze.Html5 (Html, (!), a, form, input, p, toHtml, label)
import Text.Blaze.Html5.Attributes (action, enctype, href, name, size, type_, value) import Text.Blaze.Html5.Attributes (action, enctype, href, name, size, type_, value)
import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5 as H
@ -36,6 +38,8 @@ data Entry = Entry{
data BlogError = NoEntries | NotFound | DBError data BlogError = NoEntries | NotFound | DBError
blogText :: (a -> String) -> a -> Text
blogText f = T.pack . f
intersperse' :: a -> [a] -> [a] intersperse' :: a -> [a] -> [a]
intersperse' sep l = sep : intersperse sep l intersperse' sep l = sep : intersperse sep l
@ -85,7 +89,7 @@ renderEntries showAll entries topText footerLinks =
showEntry :: Entry -> Html showEntry :: Entry -> Html
showEntry e = H.li $ do showEntry e = H.li $ do
entryLink e entryLink e
preEscapedString $ " " ++ (text e) ++ "<br>&nbsp;</br>" preEscapedText $ T.concat [" ", blogText text e, "<br>&nbsp;</br>"]
entryLink e = H.a ! A.href (toValue $ concat $ intersperse' "/" $ linkElems e) $ entryLink e = H.a ! A.href (toValue $ concat $ intersperse' "/" $ linkElems e) $
toHtml ("[" ++ show(length $ comments e) ++ "]") toHtml ("[" ++ show(length $ comments e) ++ "]")
linkElems e = [show(lang e), show(year e), show(month e), show(day e), _id e] linkElems e = [show(lang e), show(year e), show(month e), show(day e), _id e]
@ -97,8 +101,8 @@ renderEntry entry = H.div ! A.class_ "innerBox" $ do
H.div ! A.class_ "innerBoxTop" $ toHtml $ title entry H.div ! A.class_ "innerBoxTop" $ toHtml $ title entry
H.div ! A.class_ "innerBoxMiddle" $ do H.div ! A.class_ "innerBoxMiddle" $ do
H.article $ H.ul $ H.li $ do H.article $ H.ul $ H.li $ do
preEscapedString $ text entry preEscapedText $ blogText text entry
preEscapedString $ mtext entry preEscapedText $ blogText mtext entry
H.div ! A.class_ "innerBoxComments" $ do H.div ! A.class_ "innerBoxComments" $ do
H.div ! A.name "cHead" ! A.style "font-size:large;font-weight:bold;" $ toHtml $ cHead (lang entry) H.div ! A.name "cHead" ! A.style "font-size:large;font-weight:bold;" $ toHtml $ cHead (lang entry)
H.ul $ renderComments (comments entry) (lang entry) H.ul $ renderComments (comments entry) (lang entry)
@ -125,7 +129,7 @@ renderComments comments lang = sequence_ $ map showComment comments
showComment c = H.li $ do showComment c = H.li $ do
H.a ! A.name (toValue $ cdate c) ! A.href (toValue $ "#" ++ (show $ cdate c)) ! A.class_ "cl" $ H.a ! A.name (toValue $ cdate c) ! A.href (toValue $ "#" ++ (show $ cdate c)) ! A.class_ "cl" $
H.i $ toHtml $ (cauthor c ++ ": ") H.i $ toHtml $ (cauthor c ++ ": ")
preEscapedString $ ctext c preEscapedText $ blogText ctext c
H.p ! A.class_ "tt" $ toHtml (timeString $ cdate c) H.p ! A.class_ "tt" $ toHtml (timeString $ cdate c)
getTime :: Integer -> Maybe UTCTime getTime :: Integer -> Maybe UTCTime
getTime t = parseTime defaultTimeLocale "%s" (show t) getTime t = parseTime defaultTimeLocale "%s" (show t)
@ -150,7 +154,7 @@ showFooter l v = H.div ! A.class_ "rightbox" ! A.style "text-align:right;" $ do
toHtml (" and without PHP, Java, Perl, MySQL and Python." :: String) toHtml (" and without PHP, Java, Perl, MySQL and Python." :: String)
H.br H.br
H.a ! A.href (toValue repoURL) $ toHtml $ ("Version " :: String) ++ v H.a ! A.href (toValue repoURL) $ toHtml $ ("Version " :: String) ++ v
preEscapedString "&nbsp;" preEscapedText "&nbsp;"
H.a ! A.href "/notice" $ toHtml $ noticeText l H.a ! A.href "/notice" $ toHtml $ noticeText l
-- Error pages -- Error pages