[Fencommits] fenserve: move rendering code back to Rendering module, now that I've got rid of the mututal dependency by passing the list of potion primitives in the implicit parameter
Benja Fallenstein
benja.fallenstein at gmail.com
Wed Jun 20 20:26:20 EEST 2007
Wed Jun 20 20:26:11 EEST 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* move rendering code back to Rendering module, now that I've got rid of the mututal dependency by passing the list of potion primitives in the implicit parameter
diff -rN -u old-fenserve/fendata/Potions.hs new-fenserve/fendata/Potions.hs
--- old-fenserve/fendata/Potions.hs 2007-06-20 20:26:20.000000000 +0300
+++ new-fenserve/fendata/Potions.hs 2007-06-20 20:26:20.000000000 +0300
@@ -31,7 +31,6 @@
deriving (Read, Show, Typeable, Data, Eq, Ord)
-
mint ty (f, exec) = (I $ mintVar ty $ \var -> ren (f var), exec)
runExp :: (?imp :: Imp) => [Values] -> Exp -> Values
@@ -40,69 +39,6 @@
f (Potion _ g) = snd (g $ fromJust $ cast arg) env
-
-
-varType :: (?imp :: Imp) => Int -> RenderExp [(Bool, HTML)]
-varType i = ask >>= renderOne . renderType . snd . (!! i) . envVars
-
-varName :: (?imp :: Imp) => Int -> RenderExp [(Bool, HTML)]
-varName i = asks ((!! i) . envVars) >>= \(name,_) -> ren ("'", ital name, "'")
-
-mintVar :: Type -> (Int -> RenderExp a) -> RenderExp a
-mintVar t f = do var <- get; put (var + 1)
- local (\e -> e {envVars=(n var,t):envVars e}) (f var) where
- n i = (if i<26 then "" else n (i `div` 26))
- ++ [toEnum $ fromEnum 'a' + i `mod` 26]
-
-focusPath :: [Int] -> GenericT
-focusPath [] = mkT Focus
-focusPath (p:ps) = snd . f 0 where
- f i = gfoldl k (\x -> (i,x))
- k :: Data a => (Int, a -> b) -> a -> (Int, b)
- 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)
-
-
-data E = E Int Exp
-
-instance RenderOne E where
- renderOne (E i e) = do
- 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)]
-
-instance RenderOne (RenderExp [(Bool, HTML)]) where renderOne m = m
-instance RenderOne Type where renderOne = renderOne . renderType
-instance RenderOne Values where renderOne = renderOne . renderValues
-instance ToHTML a => RenderOne a where
- renderOne x = asks envPath >>= \p -> return [(False, toHTML x)]
-
-instance Ren () where ren () = return []
-instance (RenderOne x, Ren xs, Tuple x xs t) => Ren t where
- 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 exp)
- $ flip evalState 0 $ runReaderT (renderExp' exp) $ Env [] [] exp
-
-joinPieces :: (?imp :: Imp) => Exp -> [(Bool,HTML)] -> HTML
-joinPieces exp ((False,h):(False,i):xs) = joinPieces exp ((False,h&i):xs)
-joinPieces exp ((True,h):xs) = h & joinPieces exp xs
-joinPieces exp ((False,h):xs) = (& joinPieces exp xs) $ flip (tag "a") h
- [ P "class" "editLink"
- , P "href" $ "/potion/" ++ showExp exp ]
-joinPieces exp [] = HTML ""
-
-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
- 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
-
-
potions =
[ Potion "var" $ \(I i) ->
( ( varType i, " ", varName i )
diff -rN -u old-fenserve/fendata/Rendering.hs new-fenserve/fendata/Rendering.hs
--- old-fenserve/fendata/Rendering.hs 2007-06-20 20:26:20.000000000 +0300
+++ new-fenserve/fendata/Rendering.hs 2007-06-20 20:26:20.000000000 +0300
@@ -3,14 +3,14 @@
module Rendering where
import HTML
+import Syntax
import Types
import TupleUtils
import Utils
import Control.Monad
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 Control.Monad.State (StateT, get, put, evalState)
import Data.Generics
import Data.Int
@@ -48,3 +48,64 @@
renderValues vs = commaList $ map renderValue $ vs
+
+varType :: (?imp :: Imp) => Int -> RenderExp [(Bool, HTML)]
+varType i = ask >>= renderOne . renderType . snd . (!! i) . envVars
+
+varName :: (?imp :: Imp) => Int -> RenderExp [(Bool, HTML)]
+varName i = asks ((!! i) . envVars) >>= \(name,_) -> ren ("'", ital name, "'")
+
+mintVar :: Type -> (Int -> RenderExp a) -> RenderExp a
+mintVar t f = do var <- get; put (var + 1)
+ local (\e -> e {envVars=(n var,t):envVars e}) (f var) where
+ n i = (if i<26 then "" else n (i `div` 26))
+ ++ [toEnum $ fromEnum 'a' + i `mod` 26]
+
+focusPath :: [Int] -> GenericT
+focusPath [] = mkT Focus
+focusPath (p:ps) = snd . f 0 where
+ f i = gfoldl k (\x -> (i,x))
+ k :: Data a => (Int, a -> b) -> a -> (Int, b)
+ 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)
+
+
+data E = E Int Exp
+
+instance RenderOne E where
+ renderOne (E i e) = do
+ 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)]
+
+instance RenderOne (RenderExp [(Bool, HTML)]) where renderOne m = m
+instance RenderOne Type where renderOne = renderOne . renderType
+instance RenderOne Values where renderOne = renderOne . renderValues
+instance ToHTML a => RenderOne a where
+ renderOne x = asks envPath >>= \p -> return [(False, toHTML x)]
+
+instance Ren () where ren () = return []
+instance (RenderOne x, Ren xs, Tuple x xs t) => Ren t where
+ 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 exp)
+ $ flip evalState 0 $ runReaderT (renderExp' exp) $ Env [] [] exp
+
+joinPieces :: (?imp :: Imp) => Exp -> [(Bool,HTML)] -> HTML
+joinPieces exp ((False,h):(False,i):xs) = joinPieces exp ((False,h&i):xs)
+joinPieces exp ((True,h):xs) = h & joinPieces exp xs
+joinPieces exp ((False,h):xs) = (& joinPieces exp xs) $ flip (tag "a") h
+ [ P "class" "editLink"
+ , P "href" $ "/potion/" ++ showExp exp ]
+joinPieces exp [] = HTML ""
+
+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
+ 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
+
More information about the Fencommits
mailing list