[Fencommits] fenserve: add returnTo to addField

[Benja Fallenstein]

Wed May 23 17:14:13 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * add returnTo to addField
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs	2007-05-23 17:14:22.000000000 +0300
+++ new-fenserve/fendata/Main.hs	2007-05-23 17:14:22.000000000 +0300
@@ -261,7 +261,7 @@
                         ty <- lookM m "type"
                         return (read exp, read old, read ty)
 
-addField req state = ("item/"++item,state') where
+addField req state = (returnTo,state') where
     state' = state { stateSchema = Map.insert cat (fs ++ [name]) (stateSchema state),
                      stateItems = Map.map addField' (stateItems state) }
     fs = stateSchema state Map.! cat
@@ -272,6 +272,7 @@
     Just cat = lookM req "category"
     Just item = lookM req "item"
     Just name = lookM req "field" 
+    returnTo = fromMaybe ("item/"++item) (lookM req "returnTo")
 
 addCategory (c:cs) s = ("table",
     s { stateSchema = Map.insert (toLower c : cs) [] $ stateSchema s})
@@ -427,12 +428,14 @@
     (("<form method=post>"++returnTo)++) . (++"<p><input type=submit></form>") .
     concatFor (Set.toList cats) $ \cat -> let cfs = stateSchema s Map.! cat in
         (("<p>"++cat++":<br>")++) 
-        . (++ "<a href='/addField?item="++item++"&category="++cat
-           ++ "'>[add field to "++cat++"]</a><br>") 
+        . (++ "<p><a href='../addField?item="++item++"&category="++cat
+           ++ "&returnTo=item/"++item++quote (escape ("?returnTo="++escape uri))
+           ++ "'>[Add field to category "++capitalize cat++"]</a><br>") 
         . concatFor cfs $ \field ->
             field ++ ": <input name='" ++ quote field ++ "' "
          ++ "value='" ++ quote (fields Map.! field) ++ "'><br>",
-    s) where returnTo = flip (maybe "") (lookM req "returnTo") $ \uri ->
+    s) where uri = fromMaybe "" (lookM req "returnTo")
+             returnTo = flip (maybe "") (lookM req "returnTo") $ \uri ->
                  "<input type=hidden name=returnTo value='"++quote(escape uri)++"'>"
     
     
@@ -479,11 +482,13 @@
                , h ["addField"] GET $ ok $ \() req -> 
                    let Just cat = lookM req "category"
                        Just item = lookM req "item"
+                       returnTo = fromMaybe ("item/"++item) (lookM req "returnTo")
                    in respond $
                      "<h2>Add field to category "++cat++"</h2>\
                      \<form method=post>Field: <input name=field>\
                      \<input type=hidden name=category value='"++cat++"'>\
                      \<input type=hidden name=item value='"++item++"'>\
+                     \<input type=hidden name=returnTo value='"++quote returnTo++"'>\
                      \<input type=submit value='Submit'></form>"
                , h ["addField"] POST $ seeOther $ \() -> runRedirect addField
                , h ["addCategory"]   GET  $ ok $ \() () -> respond $