[Fencommits] fenserve: edit and reply work

[Benja Fallenstein]

Thu Mar 22 22:16:24 EET 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * edit and reply work
diff -rN -u old-fenserve/board-demo.page new-fenserve/board-demo.page
--- old-fenserve/board-demo.page	2007-03-22 22:16:44.000000000 +0200
+++ new-fenserve/board-demo.page	2007-03-22 22:16:44.000000000 +0200
@@ -2,7 +2,10 @@
 import Fenfire.RDF
 
 import qualified Data.List as List
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, catMaybes)
+
+import System.Time
+import System.IO.Unsafe (unsafePerformIO)
 
 dc = "http://purl.org/dc/elements/1.1/"
 dcterms = "http://purl.org/dc/terms/"
@@ -77,28 +80,64 @@
                           | otherwise            = "Re: " ++ s
                   title = maybe "" (\irt -> addRe $ postTitle $ IRI irt)
                                    (lookM ?req "inReplyTo") in
-      <form action="" method="POST">
+      <form action=(path $ rqURI ?req) method="POST">
         <p><b>Title:</b> <input type="text" name="title" value=title/></p>
         <p><b>Your name:</b> <input type="text" name="author"/></p>
         <% maybe (HTML "") 
                  (\irt -> <input type="hidden" name="inReplyTo" value=irt/>)
                  (lookM ?req "inReplyTo") %>
+        <input type="hidden" name="view" value="post"/>
         <p><textarea name="content" rows="10" cols="70"></textarea></p>
         <p><input type="submit"/></p>
       </form>
       
 editForm :: (?graph :: Graph, ?req :: Request) => () -> HTML
 editForm () = let post = IRI (lookWithDefault "post" "ex:post" ?req) in
-      <form action="" method="POST">
+      <form action=(path $ rqURI ?req) method="POST">
         <p><b>Title:</b> <input type="text" name="title" 
                                 value=(postTitle post)/></p>
         <p><b>Your name:</b> <input type="text" name="author"
                                     value=(postAuthor post)/></p>
+        <input type="hidden" name="view" value="edit"/>
         <input type="hidden" name="post" value=(iriStr post)/>
         <p><textarea name="content" rows="10" cols="70">
            <% postContent post %></textarea></p>
         <p><input type="submit"/></p>
       </form>
+      
+postHandler :: Handler
+postHandler req = do
+    let time = unsafeGetW3CTime ()
+    let f = lit . g; g = fromMaybe "" . lookM ?req
+        p = IRI $ "ex:post:" ++ literalStr time
+        board = maybe blog IRI $ lookM ?req "board"
+        parent = fmap IRI $ lookM ?req "inReplyTo"
+        graph' = foldr Fenfire.RDF.insert ?graph $ [
+            (p, sioc_has_container, board),
+            (p, dc_title, f "title"),
+            (p, dc_creator, f "author"),
+            (p, content_encoded, f "content"),
+            (p, dcterms_created, time),
+            (p, dcterms_modified, time)]
+            ++ catMaybes [do parent' <- parent -- running in Maybe
+                             return (p, sioc_reply_of, parent')]
+    bid <- writeGraph graph'
+    putEntry ["testdata","blog"] $ FileEntry $ bIRI bid
+    pageHandler (let ?graph = graph' in renderBoard blog) ?req
+
+editHandler :: Handler
+editHandler req = do
+    let time = unsafeGetW3CTime ()
+    let f = lit . g; g = fromMaybe "" . lookM ?req
+        graph' = foldr Fenfire.RDF.update ?graph $ [
+            (post, dc_title, f "title"),
+            (post, dc_creator, f "author"),
+            (post, content_encoded, f "content"),
+            (post, dcterms_modified, time)]
+    bid <- writeGraph graph'
+    putEntry ["testdata","blog"] $ FileEntry $ bIRI bid
+    pageHandler (let ?graph = graph' in renderBoard blog) ?req
+
 
 handler req = do 
     e <- getEntry ["testdata","blog"]
@@ -107,6 +146,24 @@
 
     let ?graph = graph; ?req = req in 
       case (lookM req "view", rqMethod req) of
-        (Just "post", GET) -> pageHandler (postForm ()) req
-        (Just "edit", GET) -> pageHandler (editForm ()) req
-        _ -> flip pageHandler req $ let ?graph = graph in renderBoard blog
+        (Just "post", GET)  -> pageHandler (postForm ()) req
+        (Just "edit", GET)  -> pageHandler (editForm ()) req
+        (Just "post", POST) -> postHandler req
+        (Just "edit", POST) -> editHandler req
+        _ -> pageHandler (renderBoard blog) req
+
+
+-------------------------------------------------------------------------
+-- Utilities.
+-------------------------------------------------------------------------
+
+unsafeGetW3CTime () = Literal (iso8601 y (fromEnum mo + 1) d h m s) Plain where
+    time = unsafePerformIO $ getClockTime -- XXX
+    CalendarTime y mo d h m s ps wd yd tzn tz isDST = toUTCTime $ time 
+
+iso8601 y mo d h m s =
+    let  p n i = take (n - length (show i)) (repeat '0') ++ show i
+    in   p 4 y ++ '-':p 2 mo ++ '-':p 2 d ++
+     'T':p 2 h ++ ':':p 2  m ++ ':':p 2 s ++ ['Z']
+    
+