[Fencommits] fenserve: render potion at the top of potion result page; needs cleanup

[Benja Fallenstein]

Sun Jun 17 01:22:02 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * render potion at the top of potion result page; needs cleanup
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs	2007-06-17 01:22:12.000000000 +0300
+++ new-fenserve/fendata/Main.hs	2007-06-17 01:22:12.000000000 +0300
@@ -99,5 +99,8 @@
               , for fs $ \f -> ( fieldName $ getField f
                                , Exp "getField" ( f, Exp "var" $ I (0::Int) )))))
                                
-  , page ["potion"] "Potion" $ renderValues $ runExp [] $ readExp $ lookE "exp"
+  , page ["potion"] "Potion"
+      ( renderExp getPotion $ readExp $ lookE "exp"
+      , hr
+      , renderValues $ runExp [] $ readExp $ lookE "exp" )
   ]
diff -rN -u old-fenserve/fendata/Potions.hs new-fenserve/fendata/Potions.hs
--- old-fenserve/fendata/Potions.hs	2007-06-17 01:22:12.000000000 +0300
+++ new-fenserve/fendata/Potions.hs	2007-06-17 01:22:12.000000000 +0300
@@ -9,6 +9,7 @@
 import Rendering
 
 import Control.Monad.Fix
+import Control.Monad.Reader (local)
 import Control.Monad.State
 
 import Data.Int
@@ -69,6 +70,12 @@
 getPotion name = case filter (\(Potion n _) -> n == name) potions of
                      (p:_) -> p; [] -> error $ "Potion not found: " ++ name
              
+data E = E Int Exp
+    
+instance RenderOne E where
+     renderOne (E i e) = 
+         local (\env -> env { envPath = envPath env ++ [i] }) (renderExp' getPotion e)
+
 potions =
   [ Potion "var" $ \(I i) ->
       ( ( varType i, " ", varName i )
@@ -86,11 +93,12 @@
       , \env -> runExp (map (runExp env) args) (fnBody (getFn fn)) )
   
   , Potion "getField" $ \(field, exp) ->
-      ( ( "the ", fieldName $ getField field, " of ", E 0 exp )
+      ( ( "the ", uncapitalize $ fieldName $ getField field, " of ", E 0 exp )
       , \env -> do ItemValue _ item <- runExp env exp; getValue item field )
 
   , Potion "allItems" $ \(I cat) ->
-      ( ( "all the ", plural $ catName $ getCategory cat, " in the database" )
+      ( ( "all the ", plural $ uncapitalize $ catName $ getCategory cat
+        , " in the database" )
       , \_ -> map (ItemValue cat) $ map itemId $ getItems cat )
 
   , Potion "sort" $ \(ty, e1, e2, order) -> mint (Single ty)
diff -rN -u old-fenserve/fendata/Rendering.hs new-fenserve/fendata/Rendering.hs
--- old-fenserve/fendata/Rendering.hs	2007-06-17 01:22:12.000000000 +0300
+++ new-fenserve/fendata/Rendering.hs	2007-06-17 01:22:12.000000000 +0300
@@ -8,12 +8,14 @@
 import Utils
 
 import Control.Monad
-import Control.Monad.Reader (ReaderT, ask, asks, local)
-import Control.Monad.State (StateT, get, put)
-import Control.Monad.Writer (Writer, tell)
+import Control.Monad.Reader (ReaderT, ask, asks, local, runReaderT)
+import Control.Monad.State (StateT, get, put, runStateT)
+import Control.Monad.Writer (Writer, tell, execWriter)
 
 import Data.Generics
+import Data.Int
 import Data.Map (Map)
+import Data.Maybe (fromMaybe)
 import qualified Data.Map as Map
 import Data.Typeable
 
@@ -46,10 +48,10 @@
 renderValues vs = commaList $ map renderValue $ vs
 
 
-varType :: (?db :: DB) => Int -> RenderExp ()
+varType :: (?db :: DB, ?time :: Int64) => Int -> RenderExp ()
 varType i = ask >>= tell . toHTML . renderType . snd . (!! i) . envVars 
 
-varName :: (?db :: DB) => Int -> RenderExp ()
+varName :: (?db :: DB, ?time :: Int64) => Int -> RenderExp ()
 varName i = asks ((!! i) . envVars) >>= \(name,_) -> ren ("'", ital name, "'")
 
 mintVar :: Type -> (Int -> RenderExp a) -> RenderExp a
@@ -68,17 +70,20 @@
 expWithFocus = ask >>= \env -> return $ focusPath (envPath env) (envWhole env)
 
 
-data E = E Int Exp
-    
 instance RenderOne (RenderExp a) where renderOne m = m >> return ()
 instance RenderOne Type where renderOne = renderOne . renderType
 instance RenderOne Values where renderOne = renderOne . renderValues
 instance ToHTML a => RenderOne a where renderOne x = tell (toHTML x)
-instance RenderOne E where
-     renderOne (E i e) = undefined
-         --local (\env -> env { envPath = envPath env ++ [i] }) (renderExp' e)
 
 instance Ren () where ren () = return ()
 instance (RenderOne x, Ren xs, Tuple x xs t) => Ren t where
     ren t | (x,xs) <- tsplit1 t = renderOne x >> ren xs
 
+
+renderExp :: (?db :: DB, ?time :: Int64) => (String -> Potion) -> Exp -> HTML
+renderExp getPotion exp = execWriter $ flip runStateT 0 $ runReaderT (renderExp' getPotion exp) $ Env [] [] exp
+    
+renderExp' :: (?db :: DB, ?time :: Int64) => (String -> Potion) -> Exp -> RenderExp ()
+renderExp' getPotion exp@(Exp n arg) = f (getPotion n) where
+    f (Potion _ f) = let (r,_) = f (fromMaybe (error "renderExp") $ cast arg) in ren r
+
diff -rN -u old-fenserve/fendata/Types.hs new-fenserve/fendata/Types.hs
--- old-fenserve/fendata/Types.hs	2007-06-17 01:22:12.000000000 +0300
+++ new-fenserve/fendata/Types.hs	2007-06-17 01:22:12.000000000 +0300
@@ -135,9 +135,9 @@
 -- Potions
 ----------------------------------------------------------------------------
 
-class RenderOne a where renderOne :: (?db :: DB) => a -> RenderExp ()
+class RenderOne a where renderOne :: (?db :: DB, ?time :: Int64) => a -> RenderExp ()
 
-class Ren a where ren :: (?db :: DB) => a -> RenderExp ()
+class Ren a where ren :: (?db :: DB, ?time :: Int64) => a -> RenderExp ()
 
 data Env = Env { envVars :: [(String,Type)], envPath :: [Int], envWhole :: Exp }