[Fencommits] fenserve: somake clicking on the replacemnt potions on the edit page actually replace the focused subexpression
Benja Fallenstein
benja.fallenstein at gmail.com
Sun Jul 1 21:43:38 EEST 2007
Sun Jul 1 21:41:47 EEST 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* somake clicking on the replacemnt potions on the edit page actually replace the focused subexpression
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs 2007-07-01 21:43:38.000000000 +0300
+++ new-fenserve/fendata/Main.hs 2007-07-01 21:43:38.000000000 +0300
@@ -104,7 +104,7 @@
forM_ rows $ \r -> do
item <- new_item $ Set.singleton cat
forM_ (zip fields r) $ \(field, value) ->
- modify $ u_value item field [InlineValue $ toHTML value]
+ modify $ u_value item field [InlineValue $ quoteBr value]
return "/table"
, page ["table"] "Table"
@@ -119,7 +119,7 @@
, h (Prefix ["potion"]) GET $ ok $ \[s] () -> respond $ either id id $
evaluate $ html $ header & let exp = readExp $ unEscapeString s in
( para $ tag' "small" "View:"
- , para $ renderExp exp
+ , para $ renderExp True exp
, hr
, renderValues $ runExp [] exp )
@@ -129,10 +129,14 @@
( para $ tag' "small" $
link (impRoot ?imp ++ "potion/" ++ showExp (removeFocus exp))
"<< Back"
- , para $ renderExp exp
+ , para $ renderExp True exp
, hr
, para
( "The focused subexpression is of type '"
, renderType $ expType focus, ".' Possible replacements:" )
- , ulist (expressionsOfType $ expType focus) renderExp )
+ , ulist (expressionsOfType $ expType focus) $ \repl ->
+ let e = focusFirstQuestion (replaceFocus repl exp)
+ p | isComplete e = "potion/" | otherwise = "edit/" in
+ tag "a" [ P "href" $ impRoot ?imp ++ p ++ showExp e
+ , P "class" "editLink" ] $ renderExp False repl )
]
diff -rN -u old-fenserve/fendata/Potions.hs new-fenserve/fendata/Potions.hs
--- old-fenserve/fendata/Potions.hs 2007-07-01 21:43:38.000000000 +0300
+++ new-fenserve/fendata/Potions.hs 2007-07-01 21:43:38.000000000 +0300
@@ -71,7 +71,7 @@
, Potion "literal" $ \(ty, values) ->
( ty
, []
- , I $ renderValues values
+ , I $ ital $ renderValues values
, \env -> values )
-- XXX this should be handled by converting Funs to Potions:
@@ -132,8 +132,8 @@
, Potion "cmpOp" $ \(op, e1, e2) ->
( ifMultiple (map expType [e1,e2]) (Single BooleanType)
, [ (op, Question ty, Question ty) | (op,ty) <- allValues ]
- , ( E 0 e1, " ", case op of Lt->"<"; Le->"<="; Eq->"="; Ge->">="; Gt->">"
- , " ", E 1 e2 )
+ , ( E 0 e1, " is "
+ , case op of Lt->"< "; Le->"<= "; Eq->""; Ge->">= "; Gt->"> ", E 1 e2 )
, \env -> do x <- runExp env e1; y <- runExp env e2
return $ BooleanValue $ case op of
Lt->x<y; Le->x<=y; Eq->x==y; Ge->x>=y; Gt->x>y )
diff -rN -u old-fenserve/fendata/Rendering.hs new-fenserve/fendata/Rendering.hs
--- old-fenserve/fendata/Rendering.hs 2007-07-01 21:43:38.000000000 +0300
+++ new-fenserve/fendata/Rendering.hs 2007-07-01 21:43:38.000000000 +0300
@@ -71,9 +71,22 @@
k (i,c) x = if typeOf x /= typeOf (undefined :: Exp) then fmap c (f i x)
else (i+1, c $ if i==p then focusPath' ps x else x)
+replaceFocus :: Exp -> GenericT
+replaceFocus e' = everywhere (mkT $ \e -> case e of Focus _ -> e'; _ -> e)
+
removeFocus :: GenericT
removeFocus = everywhere (mkT $ \e -> case e of Focus e' -> e'; _ -> e)
+isComplete :: GenericQ Bool
+isComplete =
+ everything (&&) (mkQ True $ \e -> case e of Question _ -> False; _ -> True)
+
+focusFirstQuestion :: GenericT
+focusFirstQuestion x = fromMaybe x (f x) where
+ f :: Data a => a -> Maybe a
+ f x = mkMp (\e -> case e of Question _ -> Just (Focus e); _ -> Nothing) x
+ `mplus` gmapMo f x
+
data E = E Int Exp
@@ -82,7 +95,8 @@
path <- asks envPath; let path' = path ++ [i]
l <- local (\env -> env { envPath = path' }) (renderExp' e)
exp <- liftM (focusPath path') (asks envWhole)
- return [(True, tag "span" [P "class" "potion"] $ joinPieces exp l)]
+ j <- liftM joinPieces' $ asks envLink
+ return [(True, tag "span" [P "class" "potion"] $ j exp l)]
instance RenderOne (RenderExp [(Bool, HTML)]) where renderOne m = m
instance RenderOne Type where renderOne = renderOne . renderType
@@ -95,9 +109,13 @@
ren t | (x,xs) <- tsplit1 t = liftM2 (++) (renderOne x) (ren xs)
-renderExp :: (?imp :: Imp) => Exp -> HTML
-renderExp exp = tag "span" [P "class" "potion"] $ joinPieces (Focus (removeFocus exp))
- $ flip evalState 0 $ runReaderT (renderExp' exp) $ Env [] [] exp
+renderExp :: (?imp :: Imp) => Bool -> Exp -> HTML
+renderExp link exp =
+ tag "span" [P "class" "potion"] $ joinPieces' link (Focus (removeFocus exp))
+ $ flip evalState 0 $ runReaderT (renderExp' exp) $ Env [] [] exp link
+
+joinPieces' True exp = joinPieces exp
+joinPieces' False _ = catMap snd
joinPieces :: (?imp :: Imp) => Exp -> [(Bool,HTML)] -> HTML
joinPieces exp ((False,h):(False,i):xs) = joinPieces exp ((False,h&i):xs)
@@ -109,7 +127,9 @@
renderExp' :: (?imp :: Imp) => Exp -> RenderExp [(Bool, HTML)]
renderExp' (Question ty) = ren ( "[which ", renderType ty, "?]" )
-renderExp' (Focus exp) = do h <- liftM2 joinPieces (asks envWhole) $ renderExp' exp
+renderExp' (Focus exp) = do h <- liftM3 joinPieces'
+ (asks envLink) (asks envWhole)
+ (renderExp' exp)
return [(True, tag "span" [P "class" "focus"] h)]
renderExp' 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-07-01 21:43:38.000000000 +0300
+++ new-fenserve/fendata/Types.hs 2007-07-01 21:43:38.000000000 +0300
@@ -156,7 +156,8 @@
-- Rendering of expressions
----------------------------------------------------------------------------
-data Env = Env { envVars :: [String], envPath :: [Int], envWhole :: Exp }
+data Env = Env { envVars :: [String], envPath :: [Int], envWhole :: Exp
+ , envLink :: Bool }
type RenderExp = ReaderT Env :$$: State Int
More information about the Fencommits
mailing list