[Fencommits] fenserve: implement FilterByField

[Tuukka Hastrup]

Sat May 26 03:11:18 EEST 2007  Tuukka Hastrup <Tuukka.Hastrup at iki.fi>
  * implement FilterByField
diff -rN -u old-fenserve/fendata/Potions.hs new-fenserve/fendata/Potions.hs
--- old-fenserve/fendata/Potions.hs	2007-05-26 03:12:11.000000000 +0300
+++ new-fenserve/fendata/Potions.hs	2007-05-26 03:12:11.000000000 +0300
@@ -11,7 +11,7 @@
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Maybe (fromJust, fromMaybe, isJust)
-import Data.List (sortBy)
+import Data.List (sortBy, filter)
 import Data.Set (Set)
 import qualified Data.Set as Set
 
@@ -32,10 +32,14 @@
             ++ concatFor (Map.toList $ stateSchema s) (\(cat,fs) ->
                    AllItems cat
                  : NewItemButton cat
+                 : Concat []
                  : Forall (catType cat) 0 Nothing (Concat [])
                  : concatFor fs (\f -> [ Field cat f Nothing
                                        , SortByField cat f 1 Nothing
                                        , SortByField cat f (-1) Nothing
+                                       , FilterByField cat f (-1) Nothing Nothing
+                                       , FilterByField cat f 0 Nothing Nothing
+                                       , FilterByField cat f 1 Nothing Nothing
                                        ])) where
     f (n, Fun ts _ _) = Call n (replicate (length ts) Nothing)
 
@@ -45,6 +49,7 @@
 expType (NewItemButton cat) = string
 expType (Var _) = error "no type inference yet"
 expType (SortByField cat _ _ _) = catType cat
+expType (FilterByField cat _ _ _ _) = catType cat
 expType (Forall _ _ _ _) = string
 expType (Concat _) = string
 expType (Str _) = string
@@ -78,6 +83,7 @@
 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@(FilterByField cat field i exp exp0) cx ty = renderMaybeExp' exp (\e -> cx $ FilterByField cat field i (Just e) exp0) (catType cat) +++ editLink cx e0 ty (" whose "++field++if i<0 then " comes before " else if i>0 then " comes after " else " is ") +++ renderMaybeExp' exp0 (\e -> cx $ FilterByField cat field i exp (Just e)) string
 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)
@@ -99,6 +105,7 @@
 isComplete (AllItems _) = True
 isComplete (NewItemButton _) = True
 isComplete (SortByField _ _ _ exp) = maybe False isComplete exp
+isComplete (FilterByField _ _ _ exp exp0) = all (maybe False isComplete) [exp,exp0]
 isComplete (Forall _ _ exp body) = maybe False isComplete exp && isComplete body
 isComplete (Var _)        = True
 isComplete (Concat exps)    = all (maybe False isComplete) exps
@@ -126,6 +133,12 @@
     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 (FilterByField cat field i (Just exp) (Just exp0)) = do
+    state <- get; let xs = evalStateT (runExp env exp) state
+    x0 <- runExp env exp0
+    let rs = filter (\a -> compare (f state a) x0 == compare i 0) xs
+    msum $ map return rs
+  where f state x = itemFields (stateItems state Map.! read x) Map.! field
 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 03:12:11.000000000 +0300
+++ new-fenserve/fendata/PotionTypes.hs	2007-05-26 03:12:11.000000000 +0300
@@ -27,6 +27,7 @@
          | NewItemButton Category
          | Var Int
          | SortByField Category Field Int (Maybe Exp)
+         | FilterByField Category Field Int (Maybe Exp) (Maybe Exp)
          | Forall Type Int (Maybe Exp) Exp -- body should always be a Concat
          | Concat [Maybe Exp]
          | Str String