[Fencommits] fenserve: sightly saner expression syntax in the URIs

[Benja Fallenstein]

Fri Jun 15 21:32:19 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * sightly saner expression syntax in the URIs
diff -rN -u old-fenserve/fendata/Potions.hs new-fenserve/fendata/Potions.hs
--- old-fenserve/fendata/Potions.hs	2007-06-15 21:32:30.000000000 +0300
+++ new-fenserve/fendata/Potions.hs	2007-06-15 21:32:30.000000000 +0300
@@ -28,10 +28,14 @@
     deriving (Read, Show, Typeable, Data, Eq, Ord)
 
 readExp :: (?db :: DB, ?time :: Int64) => String -> Exp
-readExp = evalState parseExp . words where
+readExp = evalState parseExp . filter (not . null) . tokenize where
     parseExp :: (?db :: DB, ?time :: Int64, Data a) => State [String] a
     parseExp = otherCase `extR` stringCase `extR` expCase
     
+    tokenize (c:cs) | c `elem` ",()"        = "" : tokenize cs
+                    | (t:ts) <- tokenize cs = (c:t):ts
+    tokenize [] = [""]
+    
     pop = do x:xs <- get; put xs; return x
     stringCase = pop
     
@@ -43,8 +47,9 @@
     otherCase :: Data a => State [String] a
     otherCase = mfix $ \r -> do 
         let ty = dataTypeOf r; k m = do m -> f; parseExp -> x; return (f x)
-        c <- if maxConstrIndex ty > 1 then liftM (fromJust . readConstr ty) pop
-                                      else return $ head $ dataTypeConstrs ty
+        c <- case dataTypeRep ty of
+            AlgRep [c] -> return c
+            _ -> liftM (fromMaybe (error "bad arg") . readConstr ty) pop
         gunfold k return c
  
 mint ty (f, exec) = (I $ mintVar ty $ \var -> ren (f var), exec)