diff --git a/TODO b/TODO index 2c6b5c931..7c2dcaa91 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 82939641a..8905bc11c 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 ViSdP" + 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" + +{- +
Vincent Ambo
Benfleetstr. 8
50858 Köln
Back
+-}
+
-- 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 0f5395164..047beb8aa 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 available here"
-rightText EN = "Deutsche Version hier verfügbar"
+rightText DE = "English version available here."
+rightText EN = "Deutsche Version hier verfügbar."
-- static information
repoURL :: Text = "https://bitbucket.org/tazjin/tazblog-haskell"
diff --git a/src/Main.hs b/src/Main.hs
index 5bc2ef2ce..e0714c95e 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