[Fencommits] fenserve: specify in a parameter where editing an item redirects

[Benja Fallenstein]

Wed May 23 16:34:40 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * specify in a parameter where editing an item redirects
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs	2007-05-23 16:34:49.000000000 +0300
+++ new-fenserve/fendata/Main.hs	2007-05-23 16:34:49.000000000 +0300
@@ -390,11 +390,12 @@
     concatFor (Map.toList $ stateItems s) $ \(id, Item fields _) ->
         (++  "<p><form action='delItem' method=post>\
              \<input type=hidden name=item value='"++show id++"'>\
-             \<a href='item/"++show id++"'>[Edit item]</a> "++mdot++"\
+             \<a href='item/"++show id++"?returnTo=table'>[Edit item]</a> "++mdot++"\
              \<button style='cursor: pointer; background: none; border: none; font: inherit; margin: 0; padding: 0'>[Delete item]</button></form><hr>") . ("<p>"++)
         . concatFor (Map.toList fields) $ \(f:fs,v) ->
             "<b>" ++ (toUpper f : fs) ++ ":</b> " ++ v ++ "<br>",
-    s) where new = ("<p><form action='newItem' method=post>" ++) .
+    s) where new = ("<p><form action='newItem' method=post>\
+                    \<input type=hidden name=returnTo value=table>" ++) .
                    (++"<a href='addCategory'>[Add category]</a></form>") .
                    concatFor (Map.keys $ stateSchema s) $ \cat ->
                        "<button style='cursor: pointer; background: none; border: none; font: inherit; margin: 0; padding: 0' name=cat value='"++cat++"'>[New "++cat++"]</button>"++mdot
@@ -402,23 +403,27 @@
                  
 mdot = "<span style='margin-left: 0.5em; margin-right: 0.5em; font-weight: bold'>&#xb7;</span>"
     
-showItem :: String -> () -> MyState -> (String, MyState)
-showItem item () s = let Item fields cats = stateItems s Map.! read item in (
-    ("<form method=post>"++) . (++"<p><input type=submit></form>") .
+showItem :: String -> Request -> MyState -> (String, MyState)
+showItem item req s = let Item fields cats = stateItems s Map.! read item in (
+    (("<form method=post>"++returnTo)++) . (++"<p><input type=submit></form>") .
     concatFor (Set.toList cats) $ \cat -> let cfs = stateSchema s Map.! cat in
         (("<p>"++cat++":<br>")++) . concatFor cfs $ \field ->
             field ++ ": <input name='" ++ quote field ++ "' "
          ++ "value='" ++ quote (fields Map.! field) ++ "'><br>",
-    s)
+    s) where returnTo = flip (maybe "") (lookM req "returnTo") $ \uri ->
+                 "<input type=hidden name=returnTo value='"++quote(escape uri)++"'>"
+    
     
 updateItem :: String -> Request -> MyState -> (String, MyState)
-updateItem item_s req s = ("/table", s') where
+updateItem item_s req s = (returnTo, s') where
+    returnTo = maybe "" ("../"++) (lookM req "returnTo")
     item = read item_s
     s' = s { stateItems = Map.insert item (Item fields' cats) (stateItems s) }
     Item fields cats = stateItems s Map.! item
     fields' = flip Map.mapWithKey fields $ \k v -> fromMaybe v (lookM req k)
 
-newItem msg s = ("item/"++show id, s') where
+newItem msg s = ("item/"++show id++returnTo, s') where
+    returnTo = maybe "" (("?returnTo="++) . escape) (lookM msg "returnTo")
     id = nextId $ stateItems s
     s' = s { stateItems = Map.insert id item $ stateItems s }
     item = Item (Map.fromList $ [(f,"") | f <- catFs]) (Set.fromList [cat])