chore(blog): Minor changes to integrate DNS based backend
This commit is contained in:
parent
c5ef3e01b2
commit
bd47122afb
5 changed files with 18 additions and 21 deletions
|
@ -12,7 +12,6 @@
|
||||||
module Blog where
|
module Blog where
|
||||||
|
|
||||||
import BlogStore
|
import BlogStore
|
||||||
import Data.Maybe (fromJust)
|
|
||||||
import Data.Text (Text, empty, pack)
|
import Data.Text (Text, empty, pack)
|
||||||
import Data.Text.Lazy (fromStrict)
|
import Data.Text.Lazy (fromStrict)
|
||||||
import Data.Time
|
import Data.Time
|
||||||
|
@ -26,12 +25,9 @@ import qualified Data.Text as T
|
||||||
replace :: Eq a => a -> a -> [a] -> [a]
|
replace :: Eq a => a -> a -> [a] -> [a]
|
||||||
replace x y = map (\z -> if z == x then y else z)
|
replace x y = map (\z -> if z == x then y else z)
|
||||||
|
|
||||||
show' :: Show a => a -> Text
|
-- |After this date all entries are Markdown
|
||||||
show' = pack . show
|
markdownCutoff :: Day
|
||||||
|
markdownCutoff = fromGregorian 2013 04 28
|
||||||
-- |After this time all entries are Markdown
|
|
||||||
markdownCutoff :: UTCTime
|
|
||||||
markdownCutoff = fromJust $ parseTimeM False defaultTimeLocale "%s" "1367149834"
|
|
||||||
|
|
||||||
-- blog HTML
|
-- blog HTML
|
||||||
blogTemplate :: BlogLang -> Text -> Html -> Html
|
blogTemplate :: BlogLang -> Text -> Html -> Html
|
||||||
|
@ -99,7 +95,7 @@ $maybe links <- pageLinks
|
||||||
where
|
where
|
||||||
linkElems Entry{..} = concat $ ["/", show lang, "/", show entryId]
|
linkElems Entry{..} = concat $ ["/", show lang, "/", show entryId]
|
||||||
|
|
||||||
showLinks :: Maybe Integer -> BlogLang -> Html
|
showLinks :: Maybe Int -> BlogLang -> Html
|
||||||
showLinks (Just i) lang = [shamlet|
|
showLinks (Just i) lang = [shamlet|
|
||||||
$if ((>) i 1)
|
$if ((>) i 1)
|
||||||
<div .navigation>
|
<div .navigation>
|
||||||
|
|
|
@ -5,7 +5,7 @@ import qualified Data.Text as T
|
||||||
|
|
||||||
import Control.Monad (liftM)
|
import Control.Monad (liftM)
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Data.Time (UTCTime, getCurrentTime)
|
import Data.Time (UTCTime(..), getCurrentTime, secondsToDiffTime)
|
||||||
import Network.URI
|
import Network.URI
|
||||||
import Text.RSS
|
import Text.RSS
|
||||||
|
|
||||||
|
@ -13,11 +13,11 @@ import BlogStore
|
||||||
import Locales
|
import Locales
|
||||||
|
|
||||||
createChannel :: BlogLang -> UTCTime -> [ChannelElem]
|
createChannel :: BlogLang -> UTCTime -> [ChannelElem]
|
||||||
createChannel l now = [ Language $ show l
|
createChannel l now = [ Language $ show l
|
||||||
, Copyright "Vincent Ambo"
|
, Copyright "Vincent Ambo"
|
||||||
, WebMaster "tazjin@gmail.com"
|
, WebMaster "tazjin@gmail.com"
|
||||||
, ChannelPubDate now
|
, ChannelPubDate now
|
||||||
]
|
]
|
||||||
|
|
||||||
createRSS :: BlogLang -> UTCTime -> [Item] -> RSS
|
createRSS :: BlogLang -> UTCTime -> [Item] -> RSS
|
||||||
createRSS l t = RSS (rssTitle l) (rssLink l) (rssDesc l) (createChannel l t)
|
createRSS l t = RSS (rssTitle l) (rssLink l) (rssDesc l) (createChannel l t)
|
||||||
|
@ -26,7 +26,7 @@ createItem :: Entry -> Item
|
||||||
createItem Entry{..} = [ Title $ T.unpack title
|
createItem Entry{..} = [ Title $ T.unpack title
|
||||||
, Link $ makeLink lang entryId
|
, Link $ makeLink lang entryId
|
||||||
, Description $ T.unpack btext
|
, Description $ T.unpack btext
|
||||||
, PubDate edate]
|
, PubDate $ UTCTime edate $ secondsToDiffTime 0 ]
|
||||||
|
|
||||||
makeLink :: BlogLang -> EntryId -> URI
|
makeLink :: BlogLang -> EntryId -> URI
|
||||||
makeLink l i = let url = "http://tazj.in/" ++ show l ++ "/" ++ show i
|
makeLink l i = let url = "http://tazj.in/" ++ show l ++ "/" ++ show i
|
||||||
|
|
|
@ -21,7 +21,7 @@ instance FromReqURI BlogLang where
|
||||||
"en" -> Just EN
|
"en" -> Just EN
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
pageSize :: Integer
|
pageSize :: Int
|
||||||
pageSize = 3
|
pageSize = 3
|
||||||
|
|
||||||
tmpPolicy :: BodyPolicy
|
tmpPolicy :: BodyPolicy
|
||||||
|
@ -68,12 +68,12 @@ tryEntry (Just entry) _ = ok $ toResponse $ blogTemplate eLang eTitle $ renderEn
|
||||||
eTitle = T.append ": " (title entry)
|
eTitle = T.append ": " (title entry)
|
||||||
eLang = lang entry
|
eLang = lang entry
|
||||||
|
|
||||||
offset :: Maybe Integer -> Integer
|
offset :: Maybe Int -> Int
|
||||||
offset = maybe 0 ((*) pageSize)
|
offset = maybe 0 ((*) pageSize)
|
||||||
|
|
||||||
showIndex :: BlogCache -> BlogLang -> ServerPart Response
|
showIndex :: BlogCache -> BlogLang -> ServerPart Response
|
||||||
showIndex cache lang = do
|
showIndex cache lang = do
|
||||||
(page :: Maybe Integer) <- optional $ lookRead "page"
|
(page :: Maybe Int) <- optional $ lookRead "page"
|
||||||
entries <- listEntries cache (offset page) pageSize
|
entries <- listEntries cache (offset page) pageSize
|
||||||
ok $ toResponse $ blogTemplate lang "" $
|
ok $ toResponse $ blogTemplate lang "" $
|
||||||
renderEntries entries (Just $ showLinks page lang)
|
renderEntries entries (Just $ showLinks page lang)
|
||||||
|
|
|
@ -13,7 +13,8 @@ library
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -W
|
ghc-options: -W
|
||||||
exposed-modules: Blog, BlogStore, Locales, Server, RSS
|
exposed-modules: Blog, BlogStore, Locales, Server, RSS
|
||||||
build-depends: base,
|
build-depends: aeson,
|
||||||
|
base,
|
||||||
bytestring,
|
bytestring,
|
||||||
happstack-server,
|
happstack-server,
|
||||||
text,
|
text,
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
{ mkDerivation, acid-state, base, base64-bytestring, blaze-html
|
{ mkDerivation, aeson, acid-state, base, base64-bytestring, blaze-html
|
||||||
, blaze-markup, bytestring, cache, crypto-api, cryptohash, dns, hamlet
|
, blaze-markup, bytestring, cache, crypto-api, cryptohash, dns, hamlet
|
||||||
, happstack-server, markdown, mtl, network, network-uri
|
, happstack-server, markdown, mtl, network, network-uri
|
||||||
, old-locale, options, rss, shakespeare, stdenv, text
|
, old-locale, options, rss, shakespeare, stdenv, text
|
||||||
|
@ -11,7 +11,7 @@ mkDerivation {
|
||||||
isLibrary = true;
|
isLibrary = true;
|
||||||
isExecutable = true;
|
isExecutable = true;
|
||||||
libraryHaskellDepends = [
|
libraryHaskellDepends = [
|
||||||
base base64-bytestring blaze-html blaze-markup bytestring
|
aeson base base64-bytestring blaze-html blaze-markup bytestring
|
||||||
cache crypto-api cryptohash dns hamlet happstack-server markdown mtl
|
cache crypto-api cryptohash dns hamlet happstack-server markdown mtl
|
||||||
network network-uri old-locale rss shakespeare text time
|
network network-uri old-locale rss shakespeare text time
|
||||||
transformers
|
transformers
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue