summary refs log tree commit diff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--services/tazblog/blog/Main.hs3
-rw-r--r--services/tazblog/src/Blog.hs62
-rw-r--r--services/tazblog/src/BlogStore.hs3
-rw-r--r--services/tazblog/src/Locales.hs71
-rw-r--r--services/tazblog/src/RSS.hs37
-rw-r--r--services/tazblog/src/Server.hs63
-rw-r--r--services/tazblog/tazblog.cabal2
7 files changed, 77 insertions, 164 deletions
diff --git a/services/tazblog/blog/Main.hs b/services/tazblog/blog/Main.hs
index 2842d1ee1b72..6074f96b7685 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 6c61c2ce26c1..29fac37ac778 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
   <head>
     <meta charset="utf-8">
     <meta name="viewport" content="width=device-width, initial-scale=1">
-    <meta name="description" content=#{blogTitle lang t_append}>
+    <meta name="description" content=#{blogTitle}#{t_append}>
     <link rel="stylesheet" type="text/css" href="/static/blog.css" media="all">
-    <link rel="alternate" type="application/rss+xml" title="RSS-Feed" href=#{rssUrl}>
-    <title>#{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 4e5171252e7d..195bcca0c0eb 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 79edcd75f32a..000000000000
--- 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 0ee9a6e43539..112dcc34388a 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 492849a2f39d..bec4d529092c 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 fc6b32a10085..8be0c2e81df7 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,
generated by cgit-pink 1.4.1 (git 2.44.2) at 2024-11-26T09·27+0000