[Fencommits] fenserve: limit number of items shown in table view

[Benja Fallenstein]

Sun Jul  1 03:47:30 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * limit number of items shown in table view
diff -rN -u old-fenserve/fendata/HTML.hs new-fenserve/fendata/HTML.hs
--- old-fenserve/fendata/HTML.hs	2007-07-01 21:43:37.000000000 +0300
+++ new-fenserve/fendata/HTML.hs	2007-07-01 21:43:37.000000000 +0300
@@ -50,6 +50,9 @@
     
 instance ToHTML () where
     toHTML () = HTML ""
+    
+instance ToHTML a => ToHTML [a] where
+    toHTML = catMap toHTML
 
 instance (ToHTML x, ToHTML xs, Tuple x xs t) => ToHTML t where
     toHTML t | x <- thead t, xs <- ttail t = x & xs
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs	2007-07-01 21:43:37.000000000 +0300
+++ new-fenserve/fendata/Main.hs	2007-07-01 21:43:37.000000000 +0300
@@ -112,13 +112,13 @@
       , catFor (Map.elems $ dbCategories $ impDB ?imp) $ \(Category cat name fs) ->
           ( h3 ("Category: ", name)
           , renderValues $ runExp [] $ Exp "tableView"
-              ( Exp "allItems" (I cat)
+              ( 0::Int, 20::Int, Exp "allItems" (I cat)
               , for fs $ \f -> ( fieldName $ getField f
                                , Exp "getField" ( f, Exp "var" $ I (0::Int) )))))
                                
   , h (Prefix ["potion"]) GET $ ok $ \[s] () -> respond $ either id id $ 
       evaluate $ html $ header & let exp = readExp $ unEscapeString s in
-          ( para $ tag' "small" "Potion:"
+          ( para $ tag' "small" "View:"
           , para $ renderExp exp
           , hr
           , renderValues $ runExp [] exp )
diff -rN -u old-fenserve/fendata/Potions.hs new-fenserve/fendata/Potions.hs
--- old-fenserve/fendata/Potions.hs	2007-07-01 21:43:37.000000000 +0300
+++ new-fenserve/fendata/Potions.hs	2007-07-01 21:43:37.000000000 +0300
@@ -56,6 +56,8 @@
 allValues = otherCase `extR` baseTypes where
     otherCase = fix $ \r -> do c <- dataTypeConstrs $ dataTypeOf $ head r
                                gunfold (\fs -> liftM2 ($) fs allValues) return c
+                               
+linkExp = link . (impRoot ?imp++) . ("potion/"++) . showExp
                            
         
              
@@ -169,13 +171,22 @@
       , \env -> let t = toUTCTime (TOD (fromIntegral $ impTime ?imp) 0)
                  in [DateValue (ctYear t) (fromEnum (ctMonth t)+1) (ctDay t)] )
                  
-  , Potion "tableView" $ \(exp, columns :: [(String,Exp)]) ->
+  , Potion "tableView" $ \(idx, n, exp, columns :: [(String,Exp)]) ->
       ( Single BlockType
       , []
       , ( "A table of ", E 0 exp )
-      , \env -> return $ BlockValue $ tag "table" [P "border" "1"]
-          ( tag "tr" [] $ catFor columns $ tag "th" [] . fst
-          , catFor (runExp env exp) $ \item -> tag "tr" [] $
-                catFor columns $ \(_,exp') ->
-                    tag "td" [] $ renderValues $ runExp ([item]:env) exp' ) )
+      , \env -> return $ BlockValue $ toHTML $
+          let items = runExp env exp; nitems = length items
+              l i | (i*n) == idx = bold 
+                  | otherwise = linkExp (Exp "tableView" (i*n,n,exp,columns)) in
+          ( para $ tag' "small"
+              ( "Show items: "
+                , intersperse ( toHTML ", " ) $
+                    [ l i ( show (i*n), "-", show (min (i*n+n) nitems) )
+                    | i <- [0..nitems `div` n]] )
+          , tag "table" [P "border" "1"]
+              ( tag "tr" [] $ catFor columns $ tag "th" [] . fst
+              , catFor (take n $ drop idx items) $ \item -> 
+                    tag "tr" [] $ catFor columns $ \(_,exp') ->
+                        tag "td" [] $ renderValues $ runExp ([item]:env) exp')))
   ]