[Fencommits] fenserve: implement SortByField

[Tuukka Hastrup]

Sat May 26 02:20:14 EEST 2007  Tuukka Hastrup <Tuukka.Hastrup at iki.fi>
  * implement SortByField
diff -rN -u old-fenserve/fendata/Potions.hs new-fenserve/fendata/Potions.hs
--- old-fenserve/fendata/Potions.hs	2007-05-26 02:20:48.000000000 +0300
+++ new-fenserve/fendata/Potions.hs	2007-05-26 02:20:48.000000000 +0300
@@ -11,6 +11,7 @@
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Maybe (fromJust, fromMaybe, isJust)
+import Data.List (sortBy)
 import Data.Set (Set)
 import qualified Data.Set as Set
 
@@ -32,7 +33,10 @@
                    AllItems cat
                  : NewItemButton cat
                  : Forall (catType cat) 0 Nothing (Concat [])
-                 : map (\f -> Field cat f Nothing) fs) where
+                 : concatFor fs (\f -> [ Field cat f Nothing
+                                       , SortByField cat f 1 Nothing
+                                       , SortByField cat f (-1) Nothing
+                                       ])) where
     f (n, Fun ts _ _) = Call n (replicate (length ts) Nothing)
 
 expType (Call fun _) = funType $ readFun ?state fun
@@ -40,6 +44,7 @@
 expType (AllItems cat) = catType cat
 expType (NewItemButton cat) = string
 expType (Var _) = error "no type inference yet"
+expType (SortByField cat _ _ _) = catType cat
 expType (Forall _ _ _ _) = string
 expType (Concat _) = string
 expType (Str _) = string
@@ -72,6 +77,7 @@
 renderExp e0@(AllItems cat) cx ty = editLink cx e0 ty ("all the "++cat++"s in the system")
 renderExp e0@(NewItemButton cat) cx ty = editLink cx e0 ty ("a link for creating a new "++cat)
 renderExp exp@(Var i) cx ty = editLink cx exp ty (renderVar i)
+renderExp e0@(SortByField cat field i exp) cx ty = renderMaybeExp' exp (\e -> cx $ SortByField cat field i $ Just e) (catType cat) +++ editLink cx e0 ty (" sorted by "++field++if i<0 then ", descending" else ", ascending")
 renderExp e0@(Forall t i exp body) cx _ = editLink cx e0 string "For each of " +++ renderMaybeExp' exp (\e -> cx $ Forall t i (Just e) body) t
                             +++ editLink cx e0 string (" (call it '" +++ renderVar i +++ "'):\n")
                             +++ tag' "blockquote" (renderExp body (\e -> cx $ Forall t i exp e) string)
@@ -92,6 +98,7 @@
 isComplete (Field _ _ exp) = maybe False isComplete exp
 isComplete (AllItems _) = True
 isComplete (NewItemButton _) = True
+isComplete (SortByField _ _ _ exp) = maybe False isComplete exp
 isComplete (Forall _ _ exp body) = maybe False isComplete exp && isComplete body
 isComplete (Var _)        = True
 isComplete (Concat exps)    = all (maybe False isComplete) exps
@@ -113,6 +120,12 @@
     return $ html $ formP (?root++"newItem") $ 
         hidden "returnTo" "" +++
         button' "cat" cat (bold ("[Create a new "+++cat+++"]"))
+runExp env (SortByField cat field i (Just exp)) = do
+    state <- get; let xs = evalStateT (runExp env exp) state
+    let rs = order $ sortBy (\a b -> compare (f state a) (f state b)) xs
+    msum $ map return rs
+  where f state x = itemFields (stateItems state Map.! read x) Map.! field
+        order = if i<0 then reverse else id
 runExp env (Forall _ v (Just exp) body) = do 
     state <- get; let xs = evalStateT (runExp env exp) state
     rs <- forM xs $ \x -> runExp (Map.insert v x env) body
diff -rN -u old-fenserve/fendata/PotionTypes.hs new-fenserve/fendata/PotionTypes.hs
--- old-fenserve/fendata/PotionTypes.hs	2007-05-26 02:20:48.000000000 +0300
+++ new-fenserve/fendata/PotionTypes.hs	2007-05-26 02:20:48.000000000 +0300
@@ -26,6 +26,7 @@
          | AllItems Category
          | NewItemButton Category
          | Var Int
+         | SortByField Category Field Int (Maybe Exp)
          | Forall Type Int (Maybe Exp) Exp -- body should always be a Concat
          | Concat [Maybe Exp]
          | Str String
diff -rN -u old-fenserve/fendata/UI.hs new-fenserve/fendata/UI.hs
--- old-fenserve/fendata/UI.hs	2007-05-26 02:20:48.000000000 +0300
+++ new-fenserve/fendata/UI.hs	2007-05-26 02:20:48.000000000 +0300
@@ -13,7 +13,7 @@
          \    font: inherit; margin: 0; padding: 0 } \
          \.potion, .editPotion {\
          \    border: dashed black 1px; padding: 2px; \
-         \    margin: 2px; line-height: 90% } \
+         \    margin: 2px; line-height: 200% } \
          \span.editPotion:hover { background: #eee } \
          \span.editPotion:hover span.editPotion:hover { background: #ddd } \
          \span.editPotion:hover span.editPotion:hover span.editPotion:hover { background: #ccc } \