[Fencommits] fenserve: tweak potion saving, derive internal name from template

[Tuukka Hastrup]

Mon May 21 00:20:21 EEST 2007  Tuukka Hastrup <Tuukka.Hastrup at iki.fi>
  * tweak potion saving, derive internal name from template
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs	2007-05-21 00:21:02.000000000 +0300
+++ new-fenserve/fendata/Main.hs	2007-05-21 00:21:02.000000000 +0300
@@ -337,15 +337,15 @@
                          ++ "'>" ++ s ++ "</a>"
 
 makeFun :: Request -> MyState -> (String, MyState)
-makeFun msg s = 
-    ("<form action='addpotion' method='post'>\
-     \  <p><input name='name' value=''>\
-     \  <p><textarea name='template' rows='3' cols='80'>\
-     \  </textarea>\
-     \  <p><input type='submit' value='Submit'>\
+makeFun msg s = let ?state = s; ?link = False in
+    ("<p>Save '"++renderExp' exp id (error "some type")++"'\
+     \as the following potion (<code>$</code> marks a hole):\
+     \<form action='addpotion' method='post'>\
+     \  <p><textarea name='template' rows='3' cols='80'></textarea>\
+     \  <p><input type='submit' value='Save'>\
      \  <input type='hidden' name='exp' value='"++quote (show exp)++"'>\
      \</form>", s) where
-  Just (exp :: Exp) = fmap read $ lookM msg "exp"
+  Just exp = fmap read $ lookM msg "exp"
 
 editTemplate :: Request -> MyState -> (String, MyState)
 editTemplate msg s = 
@@ -367,16 +367,16 @@
 
 addPotion :: Request -> MyState -> (String, MyState)
 addPotion msg s = ("/", s { statePotions = newPotions }) where
-    Just name = lookM msg "name"
     Just template = lookM msg "template"
     Just exp = fmap read $ lookM msg "exp"
+    name = map (\x -> case x of ' ' -> '_'; '$' -> 'X'; c -> c) template
     parts = f template ""
     types = take ((length parts) - 1) $ repeat string
     potion = Fun types parts exp
     newPotions = Map.insert name potion $ statePotions s
-    f ('$':cs) name = reverse name : f cs ""
-    f (c:cs) name = f cs (c:name)
-    f "" name = [reverse name]
+    f ('$':cs) part = reverse part : f cs ""
+    f (c:cs) part = f cs (c:part)
+    f "" part = [reverse part]
 
 main = stdHTTP [ debugFilter
                , h ["potion"] GET $ ok $ \() -> run $