From 561ed1fbbb624ddc51f5a97f4a81354e458e64cd Mon Sep 17 00:00:00 2001 From: Vincent Ambo Date: Sun, 25 Aug 2019 22:53:38 +0100 Subject: chore(tazblog): Remove i18n features The blog has been English only for a few years. Old entries that survived the migration to DNS will still be accessible. --- services/tazblog/blog/Main.hs | 3 +- services/tazblog/src/Blog.hs | 62 ++++++++++++++++------------------ services/tazblog/src/BlogStore.hs | 3 -- services/tazblog/src/Locales.hs | 71 --------------------------------------- services/tazblog/src/RSS.hs | 37 ++++++++++---------- services/tazblog/src/Server.hs | 63 +++++++++++++++------------------- services/tazblog/tazblog.cabal | 2 +- 7 files changed, 77 insertions(+), 164 deletions(-) delete mode 100644 services/tazblog/src/Locales.hs diff --git a/services/tazblog/blog/Main.hs b/services/tazblog/blog/Main.hs index 2842d1ee1b..6074f96b76 100644 --- a/services/tazblog/blog/Main.hs +++ b/services/tazblog/blog/Main.hs @@ -2,7 +2,6 @@ module Main where import Control.Applicative ((<$>), (<*>)) -import Locales (version) import Server (runBlog) import System.Environment (getEnv) @@ -20,6 +19,6 @@ readOpts = main :: IO () main = do - putStrLn ("TazBlog " ++ version ++ " in Haskell starting") opts <- readOpts + putStrLn ("tazblog starting on port " ++ (show $ blogPort opts)) runBlog (blogPort opts) (resourceDir opts) diff --git a/services/tazblog/src/Blog.hs b/services/tazblog/src/Blog.hs index 6c61c2ce26..29fac37ac7 100644 --- a/services/tazblog/src/Blog.hs +++ b/services/tazblog/src/Blog.hs @@ -12,15 +12,22 @@ module Blog where import BlogStore -import Data.Text (Text, empty, pack) +import Data.Text (Text, pack) import qualified Data.Text as T import Data.Text.Lazy (fromStrict) import Data.Time -import Locales import Text.Blaze.Html (preEscapedToHtml) import Text.Hamlet import Text.Markdown +blogTitle :: Text = "tazjin's blog" + +repoURL :: Text = "https://bitbucket.org/tazjin/tazblog-haskell" + +mailTo :: Text = "mailto:mail@tazj.in" + +twitter :: Text = "https://twitter.com/tazjin" + replace :: Eq a => a -> a -> [a] -> [a] replace x y = map (\z -> if z == x then y else z) @@ -28,27 +35,25 @@ replace x y = map (\z -> if z == x then y else z) markdownCutoff :: Day markdownCutoff = fromGregorian 2013 04 28 -blogTemplate :: BlogLang -> Text -> Html -> Html -blogTemplate lang t_append body = +blogTemplate :: Text -> Html -> Html +blogTemplate t_append body = [shamlet| $doctype 5 - + - - #{blogTitle lang t_append} + <link rel="alternate" type="application/rss+xml" title="RSS-Feed" href="/rss.xml"> + <title>#{blogTitle}#{t_append} <body> <header> <h1> - <a href="/" .unstyled-link>#{blogTitle lang empty} + <a href="/" .unstyled-link>#{blogTitle} <hr> ^{body} ^{showFooter} |] - where - rssUrl = T.concat ["/", show' lang, "/rss.xml"] showFooter :: Html showFooter = @@ -56,7 +61,7 @@ showFooter = <footer> <p .footer>Served without any dynamic languages. <p .footer> - <a href=#{repoURL} .uncoloured-link>Version #{version} + <a href=#{repoURL} .uncoloured-link> | <a href=#{twitter} .uncoloured-link>Twitter | @@ -90,28 +95,26 @@ $maybe links <- pageLinks ^{links} |] where - linkElems Entry {..} = concat $ ["/", show lang, "/", show entryId] + linkElems Entry {..} = concat $ ["/", show entryId] -showLinks :: Maybe Int -> BlogLang -> Html -showLinks (Just i) lang = +showLinks :: Maybe Int -> Html +showLinks (Just i) = [shamlet| $if ((>) i 1) <div .navigation> - <a href=#{nLink $ succ i} .uncoloured-link>#{backText lang} + <a href=#{nLink $ succ i} .uncoloured-link>Earlier | - <a href=#{nLink $ pred i} .uncoloured-link>#{nextText lang} + <a href=#{nLink $ pred i} .uncoloured-link>Later $elseif ((<=) i 1) - ^{showLinks Nothing lang} + ^{showLinks Nothing} |] where - nLink page = T.concat ["/", show' lang, "/?page=", show' page] -showLinks Nothing lang = + nLink page = T.concat ["/?page=", show' page] +showLinks Nothing = [shamlet| <div .navigation> - <a href=#{nLink} .uncoloured-link>#{backText lang} + <a href="/?page=2" .uncoloured-link>Earlier |] - where - nLink = T.concat ["/", show' lang, "/?page=2"] renderEntry :: Entry -> Html renderEntry e@Entry {..} = @@ -128,18 +131,11 @@ renderEntry e@Entry {..} = <hr> |] -showError :: BlogError -> BlogLang -> Html -showError NotFound l = - blogTemplate l (T.append ": " $ notFoundTitle l) - $ [shamlet| -<p>:( -<p>#{notFoundText l} -<hr> -|] -showError UnknownError l = - blogTemplate l "" +showError :: Text -> Text -> Html +showError title err = + blogTemplate (": " <> title) $ [shamlet| <p>:( -<p>#{unknownErrorText l} +<p>#{err} <hr> |] diff --git a/services/tazblog/src/BlogStore.hs b/services/tazblog/src/BlogStore.hs index 4e5171252e..195bcca0c0 100644 --- a/services/tazblog/src/BlogStore.hs +++ b/services/tazblog/src/BlogStore.hs @@ -40,7 +40,6 @@ import Data.List (sortBy) import Data.Text as T (Text, concat, pack) import Data.Text.Encoding (decodeUtf8', encodeUtf8) import Data.Time (Day) -import Locales (BlogLang (..)) import Network.DNS (DNSError, lookupTXT) import qualified Network.DNS.Resolver as R @@ -54,7 +53,6 @@ instance Show EntryId where data Entry = Entry { entryId :: EntryId, - lang :: BlogLang, author :: Text, title :: Text, text :: Text, @@ -166,7 +164,6 @@ entryFromDNS cache eid = do $ either Left ( \text -> Right $ Entry { entryId = eid, - lang = EN, author = "tazjin", title = t, text = text, diff --git a/services/tazblog/src/Locales.hs b/services/tazblog/src/Locales.hs deleted file mode 100644 index 79edcd75f3..0000000000 --- a/services/tazblog/src/Locales.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Locales where - -import Data.Maybe (fromMaybe) -import Data.Text (Text) -import qualified Data.Text as T -import Network.URI - -data BlogLang = EN | DE - deriving (Eq, Ord) - -instance Show BlogLang where - - show DE = "de" - show EN = "en" - -data BlogError = NotFound | UnknownError - -version = "6.0.0" - -blogTitle :: BlogLang -> Text -> Text -blogTitle DE s = T.concat ["Tazjins blog", s] -blogTitle EN s = T.concat ["Tazjin's blog", s] - -showLangText :: BlogLang -> Text -showLangText EN = "en" -showLangText DE = "de" - -backText :: BlogLang -> Text -backText DE = "Früher" -backText EN = "Earlier" - -nextText :: BlogLang -> Text -nextText DE = "Später" -nextText EN = "Later" - -readMore :: BlogLang -> Text -readMore DE = "[Weiterlesen]" -readMore EN = "[Read more]" - --- RSS Strings -rssTitle :: BlogLang -> String -rssTitle DE = "Tazjins Blog" -rssTitle EN = "Tazjin's Blog" - -rssDesc :: BlogLang -> String -rssDesc DE = "Feed zu Tazjins Blog" -rssDesc EN = "Feed for Tazjin's Blog" - -rssLink :: BlogLang -> URI -rssLink l = fromMaybe nullURI $ parseURI ("http://tazj.in/" ++ show l) - --- errors -notFoundTitle :: BlogLang -> Text -notFoundTitle DE = "Nicht gefunden" -notFoundTitle EN = "Not found" - -notFoundText :: BlogLang -> Text -notFoundText DE = "Das gewünschte Objekt wurde leider nicht gefunden." -notFoundText EN = "The requested object could not be found." - -unknownErrorText :: BlogLang -> Text -unknownErrorText DE = "Ein unbekannter Fehler ist aufgetreten." -unknownErrorText EN = "An unknown error has occured." - --- static information -repoURL :: Text = "https://bitbucket.org/tazjin/tazblog-haskell" -mailTo :: Text = "mailto:tazjin+blog@gmail.com" -twitter :: Text = "https://twitter.com/tazjin" diff --git a/services/tazblog/src/RSS.hs b/services/tazblog/src/RSS.hs index 0ee9a6e435..112dcc3438 100644 --- a/services/tazblog/src/RSS.hs +++ b/services/tazblog/src/RSS.hs @@ -7,42 +7,43 @@ where import BlogStore import Control.Monad (liftM) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromJust) import qualified Data.Text as T import Data.Time (UTCTime (..), getCurrentTime, secondsToDiffTime) -import Locales -import Network.URI +import Network.URI (URI, parseURI) import Text.RSS -createChannel :: BlogLang -> UTCTime -> [ChannelElem] -createChannel l now = - [ Language $ show l, +createChannel :: UTCTime -> [ChannelElem] +createChannel now = + [ Language "en", Copyright "Vincent Ambo", WebMaster "mail@tazj.in", ChannelPubDate now ] -createRSS :: BlogLang -> UTCTime -> [Item] -> RSS -createRSS l t = RSS (rssTitle l) (rssLink l) (rssDesc l) (createChannel l t) +createRSS :: UTCTime -> [Item] -> RSS +createRSS t = + let link = fromJust $ parseURI "https://tazj.in" + in RSS "tazjin's blog" link "tazjin's blog feed" (createChannel t) createItem :: Entry -> Item createItem Entry {..} = - [ Title $ T.unpack title, - Link $ makeLink lang entryId, + [ Title "tazjin's blog", + Link $ entryLink entryId, Description $ T.unpack text, PubDate $ UTCTime edate $ secondsToDiffTime 0 ] -makeLink :: BlogLang -> EntryId -> URI -makeLink l i = - let url = "http://tazj.in/" ++ show l ++ "/" ++ show i - in fromMaybe nullURI $ parseURI url +entryLink :: EntryId -> URI +entryLink i = + let url = "http://tazj.in/" ++ "/" ++ show i + in fromJust $ parseURI url createItems :: [Entry] -> [Item] createItems = map createItem -createFeed :: BlogLang -> [Entry] -> IO RSS -createFeed l e = getCurrentTime >>= (\t -> return $ createRSS l t $ createItems e) +createFeed :: [Entry] -> IO RSS +createFeed e = getCurrentTime >>= (\t -> return $ createRSS t $ createItems e) -renderFeed :: BlogLang -> [Entry] -> IO String -renderFeed l e = liftM (showXML . rssToXML) (createFeed l e) +renderFeed :: [Entry] -> IO String +renderFeed e = liftM (showXML . rssToXML) (createFeed e) diff --git a/services/tazblog/src/Server.hs b/services/tazblog/src/Server.hs index 492849a2f3..bec4d52909 100644 --- a/services/tazblog/src/Server.hs +++ b/services/tazblog/src/Server.hs @@ -10,20 +10,11 @@ import BlogStore import Control.Applicative (optional) import Control.Monad (msum) import Control.Monad.IO.Class (liftIO) -import Data.Char (toLower) import Data.Maybe (maybe) import qualified Data.Text as T import Happstack.Server hiding (Session) -import Locales import RSS -instance FromReqURI BlogLang where - fromReqURI sub = - case map toLower sub of - "de" -> Just DE - "en" -> Just EN - _ -> Nothing - pageSize :: Int pageSize = 3 @@ -33,26 +24,27 @@ tmpPolicy = defaultBodyPolicy "/tmp" 0 200000 1000 runBlog :: Int -> String -> IO () runBlog port respath = do withCache "blog.tazj.in." $ \cache -> - simpleHTTP nullConf {port = port} $ tazBlog cache respath + simpleHTTP nullConf {port = port} $ tazblog cache respath -tazBlog :: BlogCache -> String -> ServerPart Response -tazBlog cache resDir = do +tazblog :: BlogCache -> String -> ServerPart Response +tazblog cache resDir = do msum - [ path $ \(lang :: BlogLang) -> blogHandler cache lang, + [ -- legacy language-specific routes + dir "de" $ blogHandler cache, + dir "en" $ blogHandler cache, dir "static" $ staticHandler resDir, - blogHandler cache EN, + blogHandler cache, staticHandler resDir, - notFound $ toResponse $ showError NotFound DE + notFound $ toResponse $ showError "Not found" "Page not found" ] -blogHandler :: BlogCache -> BlogLang -> ServerPart Response -blogHandler cache lang = +blogHandler :: BlogCache -> ServerPart Response +blogHandler cache = msum - [ path $ \(eId :: Integer) -> showEntry cache lang $ EntryId eId, - nullDir >> showIndex cache lang, - dir "rss" $ nullDir >> showRSS cache lang, - dir "rss.xml" $ nullDir >> showRSS cache lang, - notFound $ toResponse $ showError NotFound lang + [ path $ \(eId :: Integer) -> showEntry cache $ EntryId eId, + nullDir >> showIndex cache, + dir "rss" $ nullDir >> showRSS cache, + dir "rss.xml" $ nullDir >> showRSS cache ] staticHandler :: String -> ServerPart Response @@ -61,31 +53,30 @@ staticHandler resDir = do setHeaderM "expires" "Tue, 20 Jan 2037 04:20:42 GMT" serveDirectory DisableBrowsing [] resDir -showEntry :: BlogCache -> BlogLang -> EntryId -> ServerPart Response -showEntry cache lang eId = do +showEntry :: BlogCache -> EntryId -> ServerPart Response +showEntry cache eId = do entry <- getEntry cache eId - tryEntry entry lang + tryEntry entry -tryEntry :: Maybe Entry -> BlogLang -> ServerPart Response -tryEntry Nothing lang = notFound $ toResponse $ showError NotFound lang -tryEntry (Just entry) _ = ok $ toResponse $ blogTemplate eLang eTitle $ renderEntry entry +tryEntry :: Maybe Entry -> ServerPart Response +tryEntry Nothing = notFound $ toResponse $ showError "Not found" "Blog entry not found" +tryEntry (Just entry) = ok $ toResponse $ blogTemplate eTitle $ renderEntry entry where eTitle = T.append ": " (title entry) - eLang = lang entry offset :: Maybe Int -> Int offset = maybe 0 ((*) pageSize) -showIndex :: BlogCache -> BlogLang -> ServerPart Response -showIndex cache lang = do +showIndex :: BlogCache -> ServerPart Response +showIndex cache = do (page :: Maybe Int) <- optional $ lookRead "page" entries <- listEntries cache (offset page) pageSize - ok $ toResponse $ blogTemplate lang "" - $ renderEntries entries (Just $ showLinks page lang) + ok $ toResponse $ blogTemplate "" + $ renderEntries entries (Just $ showLinks page) -showRSS :: BlogCache -> BlogLang -> ServerPart Response -showRSS cache lang = do +showRSS :: BlogCache -> ServerPart Response +showRSS cache = do entries <- listEntries cache 0 4 - feed <- liftIO $ renderFeed lang entries + feed <- liftIO $ renderFeed entries setHeaderM "content-type" "text/xml" ok $ toResponse feed diff --git a/services/tazblog/tazblog.cabal b/services/tazblog/tazblog.cabal index fc6b32a100..8be0c2e81d 100644 --- a/services/tazblog/tazblog.cabal +++ b/services/tazblog/tazblog.cabal @@ -12,7 +12,7 @@ library hs-source-dirs: src default-language: Haskell2010 ghc-options: -W - exposed-modules: Blog, BlogStore, Locales, Server, RSS + exposed-modules: Blog, BlogStore, Server, RSS build-depends: aeson, base, bytestring, -- cgit 1.4.1