* links on right side

TODO

@@ -1 +1 @@
-* create entirely new CouchDB views to return the blog IDs in descending order
+* handle BlogErrors

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.a ! A.href "/" ! A.style "text-decoration:none;color:black;font-size:x-large;font-weight:bold;" $
-                H.span ! A.id "cosx" ! A.style "display:block;" $ H.b $ contactInfo iMessage
+                H.p ! A.style "clear: both;" $ do
-               -- H.span ! A.id "cios" ! A.style "display:none;" $ H.b $ contactInfo "sms:tazjin@me.com"
+                    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 :: BlogError -> BlogLang -> Html
-showError _ = undefined
+showError NotFound l = undefined

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 DE = "English version <a href=\"/en\" style=\"color: black;\">available here</a>."
-rightText EN = "Deutsche Version <a href=\"de\">hier verf&uuml;gbar</a>"
+rightText EN = "Deutsche Version <a href=\"/de\" style=\"color: black;\">hier verf&uuml;gbar</a>."
 
 -- static information
 repoURL   :: Text = "https://bitbucket.org/tazjin/tazblog-haskell"

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 :: BlogLang -> String -> ServerPart Response
-showEntry y m d i = do
+showEntry lang id_ = do
-    entryJS <- liftIO $ runCouchDB' $ getDoc (db "tazblog") (doc i)
+    entryJS <- liftIO $ runCouchDB' $ getDoc (db "tazblog") (doc id_)
     let entry = maybeDoc entryJS
-    ok $ tryEntry entry
+    ok $ tryEntry entry lang
 
-tryEntry :: Maybe Entry -> Response
+tryEntry :: Maybe Entry -> BlogLang -> Response
-tryEntry Nothing = toResponse $ showError NotFound
+tryEntry Nothing lang = toResponse $ showError NotFound lang
-tryEntry (Just entry) = toResponse $ blogTemplate eLang eTitle $ renderEntry entry
+tryEntry (Just entry) _ = toResponse $ blogTemplate eLang eTitle $ renderEntry entry
     where
         eTitle = T.pack $ ": " ++ title entry
         eLang = lang entry