* updating entries and entrylist

* entryEscape ("\n" -> "<br>")

2 files changed, 78 insertions, 26 deletions

diff --git a/src/Blog.hs b/src/Blog.hs
index 8e53046edd..f7e5f5f3b7 100644
--- a/src/Blog.hs
+++ b/src/Blog.hs
@@ -193,6 +193,39 @@ adminIndex sUser = adminTemplate "Index" $
                   H.td $ H.textarea ! A.name "mtext" ! A.cols "100" ! A.rows "15" $ mempty
       H.input ! A.type_ "hidden" ! A.name "author" ! A.value (toValue sUser)
       H.input ! A.style "margin-left: 20px" ! A.type_ "submit" ! A.value "Absenden"
+      adminFooter
+
+adminFooter :: Html
+adminFooter =  H.p $ do 
+    preEscapedText "<a href=/>Startseite</a> -- Entrylist: <a href=/admin/entrylist/de>DE</a>"
+    preEscapedText " & <a href=/admin/entrylist/en>EN</a> -- <a href=#>Backup</a> (NYI)"
+
+adminEntryList :: [Entry] -> Html
+adminEntryList entries = adminTemplate "Entrylist" $
+  H.div ! A.style "float: center;" $ do
+    H.table $ do
+        sequence_ $ map showEntryItem entries
+    adminFooter
+  where
+    showEntryItem :: Entry -> Html
+    showEntryItem (Entry{..}) = H.tr $ do
+        H.td $ H.a ! A.href (toValue $ "/admin/edit/" ++ show entryId) $ toHtml title
+        H.td $ toHtml $ formatTime defaultTimeLocale "[On %D at %H:%M]" edate
+
+
+editPage :: Entry -> Html
+editPage (Entry{..}) = adminTemplate "Index" $
+  H.div ! A.style "float: center;" $
+    H.form ! A.action "/admin/updateentry" ! A.method "POST" $ do
+      H.table $ do
+        H.tr $ do H.td $ "Titel:"
+                  H.td $ H.input ! A.type_ "text" ! A.name "title" ! A.value (toValue title)
+        H.tr $ do H.td ! A.style "vertical-align: top;" $ "Text:"
+                  H.td $ H.textarea ! A.name "btext" ! A.cols "100" ! A.rows "15" $ toHtml btext
+        H.tr $ do H.td ! A.style "vertical-align: top;" $ "Mehr Text:"
+                  H.td $ H.textarea ! A.name "mtext" ! A.cols "100" ! A.rows "15" $ toHtml mtext
+      H.input ! A.type_ "hidden" ! A.name "eid" ! A.value (toValue $ unEntryId entryId)
+      H.input ! A.style "margin-left: 20px" ! A.type_ "submit" ! A.value "Absenden"
       H.p $ do preEscapedText "<a href=/>Startseite</a> -- Entrylist: <a href=/admin/entrylist/de>DE</a>"
                preEscapedText " & <a href=/admin/entrylist/en>EN</a> -- <a href=#>Backup</a> (NYI)"
 
diff --git a/src/Main.hs b/src/Main.hs
index b05599de58..fdf2134c92 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -54,9 +54,20 @@ tazBlog acid =
          , path $ \(year :: Int) -> path $ \(month :: Int) -> path $ \(id_ :: String) -> formatOldLink year month id_
          , dir "res" $ serveDirectory DisableBrowsing [] "../res"
          , dir "notice" $ ok $ toResponse showSiteNotice
+         {- :Admin handlers -}
          , do dirs "admin/postentry" $ nullDir
               guardSession acid
               postEntry acid
+         , do dirs "admin/entrylist" $ dir (show DE) $ nullDir
+              guardSession acid
+              entryList acid DE
+         , do dirs "admin/entrylist" $ dir (show EN) $ nullDir
+              guardSession acid
+              entryList acid EN
+         , do guardSession acid
+              dirs "admin/edit" $ path $ \(eId :: Integer) -> editEntry acid eId
+         , do dirs "admin/updateentry" $ nullDir
+              updateEntry acid
          , do dir "admin" $ nullDir
               guardSession acid
               ok $ toResponse $ adminIndex ("tazjin" :: Text)
@@ -65,18 +76,6 @@ tazBlog acid =
          , serveDirectory DisableBrowsing [] "../res"
          ]
 
-{-
-adminHandler :: AcidState Blog -> ServerPart Response
-adminHandler acid = 
-  msum [ dir "postentry" $ postEntry acid
-       , dir "entrylist" $ dir (show DE) $ entryList DE
-       , dir "entrylist" $ dir (show EN) $ entryList EN
-       , dir "edit" $ path $ \(eId :: Integer) -> editEntry eId 
-       , dir "doedit" $ updateEntry 
-       , ok $ toResponse $ adminIndex ("tazjin" :: Text) --User NYI
-       ]
--}
-
 blogHandler :: AcidState Blog -> BlogLang -> ServerPart Response
 blogHandler acid lang = 
     msum [ path $ \(eId :: Integer) -> showEntry acid lang $ EntryId eId
@@ -124,45 +123,65 @@ addComment acid lang eId = do
   update' acid (AddComment eId nComment)
   seeOther ("/" ++ show lang ++ "/" ++ show eId) (toResponse())
 
-{- ADMIN stuff -}
-
-
-updateEntry :: ServerPart Response
-updateEntry = undefined
+{- ADMIN stuff -} 
 
 postEntry :: AcidState Blog -> ServerPart Response
 postEntry acid = do
     decodeBody tmpPolicy
     now <- liftIO $ getCurrentTime
     let eId = timeToId now
-    lang <- lookText' "lang"
+    lang <- look "lang"
+    nBtext <- lookText' "btext"
+    nMtext <- lookText' "mtext"
     nEntry <- Entry <$> pure eId
                     <*> getLang lang
                     <*> lookText' "author"
                     <*> lookText' "title"
-                    <*> lookText' "btext"
-                    <*> lookText' "mtext"
+                    <*> pure (entryEscape nBtext)
+                    <*> pure (entryEscape nMtext)
                     <*> pure now
                     <*> pure [] -- NYI
                     <*> pure []
     update' acid (InsertEntry nEntry)
-    seeOther ("/" ++ (T.unpack lang) ++ "/" ++ show eId) (toResponse())
+    seeOther ("/" ++ lang ++ "/" ++ show eId) (toResponse())
   where
     timeToId :: UTCTime -> EntryId
     timeToId t = EntryId . read $ formatTime defaultTimeLocale "%s" t
-    getLang :: Text -> ServerPart BlogLang
+    getLang :: String -> ServerPart BlogLang
     getLang "de" = return DE
     getLang "en" = return EN
 
+entryEscape :: Text -> Text
+entryEscape = T.replace "\n" "<br>"
 
-entryList :: BlogLang -> ServerPart Response
-entryList lang = undefined
+entryList :: AcidState Blog -> BlogLang -> ServerPart Response
+entryList acid lang = do
+    entries <- query' acid (LatestEntries lang)
+    ok $ toResponse $ adminEntryList entries
 
-editEntry :: Integer -> ServerPart Response
-editEntry i = undefined
+editEntry :: AcidState Blog -> Integer -> ServerPart Response
+editEntry acid i = do
+    (Just entry) <- query' acid (GetEntry eId)
+    ok $ toResponse $ editPage entry
   where
     eId = EntryId i
 
+updateEntry :: AcidState Blog -> ServerPart Response
+updateEntry acid = do
+    decodeBody tmpPolicy
+    (eId :: Integer) <- lookRead "eid"
+    (Just entry) <- query' acid (GetEntry $ EntryId eId)
+    nTitle <- lookText' "title"
+    nBtext <- lookText' "btext"
+    nMtext <- lookText' "mtext"
+    let nEntry = entry { title = nTitle
+                        , btext = entryEscape nBtext
+                        , mtext = entryEscape nMtext}
+    update' acid (UpdateEntry nEntry)
+    seeOther (concat $ intersperse' "/" [show $ lang entry, show eId])
+             (toResponse ())
+
+
 guardSession :: AcidState Blog -> ServerPartT IO ()
 guardSession acid = do
     (sId :: Text) <- readCookieValue "session"