[Fencommits] fenserve: allow specifying the category of a hole in a potion name

[Benja Fallenstein]

Thu May 24 17:06:26 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * allow specifying the category of a hole in a potion name
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs	2007-05-24 17:06:32.000000000 +0300
+++ new-fenserve/fendata/Main.hs	2007-05-24 17:06:32.000000000 +0300
@@ -355,7 +355,8 @@
 makeFun :: Request -> MyState -> (HTML, MyState)
 makeFun msg s = let ?state = s; ?link = False in
     (para ("Save '"+++renderExp' exp id (error "some type")+++"' as the "
-       +++ "following potion (" +++ code "$" +++ " marks a hole):")
+       +++ "following potion (" +++ code "$(cat)" +++ ", where 'cat' is \
+           \a category name, marks a hole):")
  +++ formP "addpotion" (para (textarea "template" 3 80 "")
                     +++ para (submit "Save") +++ hidden "exp" (show exp)), s)
     where Just exp = fmap read $ lookM msg "exp"
@@ -381,14 +382,19 @@
 addPotion msg s = ("/", s { statePotions = newPotions }) where
     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
+    name = getName template where
+        getName ('$':'(':cs) = 'X' : getName (drop 1 $ dropWhile (/= ')') cs)
+        getName (' ':cs) = '_' : getName cs
+        getName (c:cs) = c : getName cs
+        getName "" = ""
+    (parts, types) = f template ""
     potion = Fun types (map toHTML parts) exp
     newPotions = Map.insert name potion $ statePotions s
-    f ('$':cs) part = reverse part : f cs ""
+    f ('$':'(':cs) part = (reverse part : ps, t : ts)
+        where (ps,ts) = f (drop 1 $ dropWhile (/= ')') cs) ""
+              t = catType $ takeWhile (/= ')') cs
     f (c:cs) part = f cs (c:part)
-    f "" part = [reverse part]
+    f "" part = ([reverse part], [])
 
 commaList :: ToHTML a => [a] -> HTML
 commaList [] = toHTML ""