diff options
| -rw-r--r-- | TODO | 2 | ||||
| -rw-r--r-- | src/Blog.hs | 37 | ||||
| -rw-r--r-- | src/Locales.hs | 7 | ||||
| -rw-r--r-- | src/Main.hs | 17 |
4 files changed, 44 insertions, 19 deletions
diff --git a/TODO b/TODO index 2c6b5c9312c3..7c2dcaa91e2d 100644 --- a/TODO +++ b/TODO @@ -1 +1 @@ -* create entirely new CouchDB views to return the blog IDs in descending order +* handle BlogErrors diff --git a/src/Blog.hs b/src/Blog.hs index 82939641af82..8905bc11ca0b 100644 --- a/src/Blog.hs +++ b/src/Blog.hs @@ -39,8 +39,6 @@ data Entry = Entry{ blogText :: (a -> String) -> a -> Text blogText f = T.pack . f -data BlogError = NoEntries | NotFound | DBError - intersperse' :: a -> [a] -> [a] intersperse' sep l = sep : intersperse sep l @@ -55,11 +53,12 @@ blogTemplate lang t_append body = H.docTypeHtml $ do --add body H.body $ do H.div ! A.class_ "mainshell" $ H.div ! A.class_ "gradBox" $ do H.div ! A.class_ "header" $ do - H.a ! A.href "/" ! A.style "text-decoration:none;color:black;font-size:x-large;font-weight:bold;" $ toHtml $ blogTitle lang "" - H.br - H.span ! A.id "cosx" ! A.style "display:block;" $ H.b $ contactInfo iMessage - -- H.span ! A.id "cios" ! A.style "display:none;" $ H.b $ contactInfo "sms:tazjin@me.com" + H.a ! A.href "/" ! A.style "text-decoration:none;color:black;font-size:x-large;font-weight:bold;" $ + H.p ! A.style "clear: both;" $ do + H.span ! A.style "float: left;" ! A.id "cosx" $ H.b $ contactInfo iMessage + -- H.span ! A.id "cios" ! A.style "display:none;" $ H.b $ contactInfo "sms:tazjin@me.com" + H.span ! A.style "float:right;" $ preEscapedText $ rightText lang H.div ! A.class_ "myclear" $ mempty body H.div ! A.class_ "myclear" $ mempty @@ -157,6 +156,28 @@ showFooter l v = H.div ! A.class_ "rightbox" ! A.style "text-align:right;" $ do preEscapedText " " H.a ! A.href "/notice" $ toHtml $ noticeText l +showSiteNotice :: Html +showSiteNotice = H.docTypeHtml $ do + H.title $ "Impressum" + H.h2 $ preEscapedText "Impressum und <a alt=\"Verantwortlich im Sinne des Presserechtes\">ViSdP</a>" + H.i $ "[German law demands this]" + H.br + H.p $ do + toHtml ("Vincent Ambo" :: Text) + H.br + toHtml ("Benfleetstr. 8" :: Text) + H.br + toHtml ("50858 Köln" :: Text) + H.p $ H.a ! A.href "/" ! A.style "color:black" $ "Back" + +{- +<title>Impressum</title> + +<h2>Impressum und <a alt="Verantwortlich im Sinne des Presserechtes">ViSdP</a></h2> + +<i>[German law demands this]</i><p>Vincent Ambo<br>Benfleetstr. 8<br>50858 Köln<br /><br /><a href="/" style="color:black">Back</a> +-} + -- Error pages -showError :: BlogError -> Html -showError _ = undefined +showError :: BlogError -> BlogLang -> Html +showError NotFound l = undefined diff --git a/src/Locales.hs b/src/Locales.hs index 0f539516414c..047beb8aad9b 100644 --- a/src/Locales.hs +++ b/src/Locales.hs @@ -15,6 +15,9 @@ instance Show BlogLang where show EN = "en" show DE = "de" +data BlogError = NotFound | DBError + + version = "2.2b" allLang = [EN, DE] @@ -111,8 +114,8 @@ cTimeFormat EN = "[On %D at %H:%M]" -- right side text (this is inserted AS IS. Escape HTML!) rightText :: BlogLang -> Text -rightText DE = "English version <a href=\"en\">available here</a>" -rightText EN = "Deutsche Version <a href=\"de\">hier verfügbar</a>" +rightText DE = "English version <a href=\"/en\" style=\"color: black;\">available here</a>." +rightText EN = "Deutsche Version <a href=\"/de\" style=\"color: black;\">hier verfügbar</a>." -- static information repoURL :: Text = "https://bitbucket.org/tazjin/tazblog-haskell" diff --git a/src/Main.hs b/src/Main.hs index 5bc2ef2ce46d..e0714c95e5b4 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -39,13 +39,14 @@ tazBlog = do , do dir " " $ nullDir seeOther ("https://plus.google.com/115916629925754851590" :: String) (toResponse ()) , dir "res" $ serveDirectory DisableBrowsing [] "../res" + , dir "notice" $ ok $ toResponse showSiteNotice , serveDirectory DisableBrowsing [] "../res" ] blogHandler :: BlogLang -> ServerPart Response blogHandler lang = msum [ path $ \(year :: Int) -> path $ \(month :: Int) -> path $ --single entry - \(day :: Int) -> path $ \(id_ :: String) -> showEntry year month day id_ + \(day :: Int) -> path $ \(id_ :: String) -> showEntry lang id_ , path $ \(year :: Int ) -> path $ \(month :: Int) -> showMonth year month lang , do decodeBody tmpPolicy @@ -54,15 +55,15 @@ blogHandler lang = showIndex lang ] -showEntry :: Int -> Int -> Int -> String -> ServerPart Response -showEntry y m d i = do - entryJS <- liftIO $ runCouchDB' $ getDoc (db "tazblog") (doc i) +showEntry :: BlogLang -> String -> ServerPart Response +showEntry lang id_ = do + entryJS <- liftIO $ runCouchDB' $ getDoc (db "tazblog") (doc id_) let entry = maybeDoc entryJS - ok $ tryEntry entry + ok $ tryEntry entry lang -tryEntry :: Maybe Entry -> Response -tryEntry Nothing = toResponse $ showError NotFound -tryEntry (Just entry) = toResponse $ blogTemplate eLang eTitle $ renderEntry entry +tryEntry :: Maybe Entry -> BlogLang -> Response +tryEntry Nothing lang = toResponse $ showError NotFound lang +tryEntry (Just entry) _ = toResponse $ blogTemplate eLang eTitle $ renderEntry entry where eTitle = T.pack $ ": " ++ title entry eLang = lang entry |