msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

documentation in the Editor files

Browse Source
This commit is contained in:
aarne
2008-12-10 13:22:54 +00:00
parent efdbf69b93
commit a554ced10d
2 changed files with 87 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

52
src/PGF/Editor.hs
View File

@@ -1,17 +1,22 @@
module PGF.Editor (
State, -- type-annotated possibly open tree with a position
Dict, -- abstract syntax in different views
new, -- :: Type -> State
refine, -- :: Dict -> CId -> State -> State
replace, -- :: Dict -> Tree -> State -> State
delete, -- :: State -> State
goNextMeta, -- :: State -> State
goNext, -- :: State -> State
goTop, -- :: State -> State
focusType, -- :: State -> Type
stateTree, -- :: State -> Tree
refineMenu, -- :: Dict -> State -> [CId]
pgf2dict -- :: PGF -> Dict
State, -- datatype -- type-annotated possibly open tree with a focus
Dict, -- datatype -- abstract syntax information optimized for editing
Position, -- datatype -- path from top to focus
new, -- :: Type -> State -- create new State
refine, -- :: Dict -> CId -> State -> State -- refine focus with CId
replace, -- :: Dict -> Tree -> State -> State -- replace focus with Tree
delete, -- :: State -> State -- replace focus with ?
goNextMeta, -- :: State -> State -- move focus to next ? node
goNext, -- :: State -> State -- move to next node
goTop, -- :: State -> State -- move focus to the top (=root)
goPosition, -- :: Position -> State -> State -- move focus to given position
mkPosition, -- :: [Int] -> Position -- list of choices (top = [])
focusType, -- :: State -> Type -- get the type of focus
stateTree, -- :: State -> Tree -- get the current tree
isMetaFocus, -- :: State -> Bool -- whether focus is ?
prState, -- :: State -> String -- print state, focus marked *
refineMenu, -- :: Dict -> State -> [CId] -- get refinement menu
pgf2dict -- :: PGF -> Dict -- create editing Dict from PGF
) where
import PGF.Data
@@ -48,6 +53,12 @@ isComplete s = isc (tree s) where
goTop :: State -> State
goTop = navigate (const top)
goPosition :: [Int] -> State -> State
goPosition p s = s{position = p}
mkPosition :: [Int] -> Position
mkPosition = id
refineMenu :: Dict -> State -> [CId]
refineMenu dict s = maybe [] (map fst) $ M.lookup (focusBType s) (refines dict)
@@ -82,14 +93,25 @@ tree2etree dict t = case t of
Meta _ -> annot ([],ty) tr
look f = maybe undefined id $ M.lookup f (functs dict)
prState :: State -> String
prState s = unlines [replicate i ' ' ++ f | (i,f) <- pr [] (tree s)] where
pr i t =
(ind i,prAtom i (atom t)) : concat [pr (sub j i) c | (j,c) <- zip [0..] (children t)]
prAtom i a = prFocus i ++ case a of
ACon f -> prCId f
AMeta i -> "?" ++ show i
prFocus i = if i == position s then "*" else ""
ind i = 2 * length i
sub j i = i ++ [j]
---- TODO
-- getPosition :: Language -> Int -> ETree -> Position
---- Trees and navigation
data ETree = ETree {
atom :: Atom,
typ :: BType,
atom :: Atom,
typ :: BType,
children :: [ETree]
}
deriving Show

65
src/exper/EditShell.hs
View File

@@ -6,8 +6,14 @@ import PGF
import Data.Char
import System (getArgs)
-- a rough editor shell using the PGF.Edito API
-- compile:
-- cd .. ; ghc --make exper/EditShell.hs
-- use:
-- EditShell file.pgf
main = do
putStrLn "Hi, I'm the Editor!"
putStrLn "Hi, I'm the Editor! Type h for help on commands."
file:_ <- getArgs
pgf <- readPGF file
let dict = pgf2dict pgf
@@ -16,8 +22,10 @@ main = do
editLoop :: PGF -> Dict -> State -> IO State
editLoop pgf dict st = do
putStrLn $ "I want something of type " ++ showType (focusType st) ++
" (0 - " ++ show (length (refineMenu dict st)-1) ++ ")"
putStrLn $ if isMetaFocus st
then "I want something of type " ++ showType (focusType st) ++
" (0 - " ++ show (length (refineMenu dict st)-1) ++ ")"
else "Do you want to change this node?"
c <- getLine
st' <- interpret pgf dict st c
editLoop pgf dict st'
@@ -26,12 +34,21 @@ interpret :: PGF -> Dict -> State -> String -> IO State
interpret pgf dict st c = case words c of
"r":f:_ -> do
let st' = goNext (refine dict (mkCId f) st)
prState pgf st'
prLState pgf st'
return st'
"p":ws -> do
let tts = parseAll pgf (focusType st) (dropWhile (not . isSpace) c)
st' <- selectReplace dict (concat tts) st >>= return . goNext
prState pgf st'
st' <- selectReplace dict (concat tts) st
prLState pgf st'
return st'
"a":_ -> do
t:_ <- generateRandom pgf (focusType st)
let st' = goNext (replace dict t st)
prLState pgf st'
return st'
"d":_ -> do
let st' = delete st
prLState pgf st'
return st'
"m":_ -> do
putStrLn (unwords (map prCId (refineMenu dict st)))
@@ -39,31 +56,49 @@ interpret pgf dict st c = case words c of
d : _ | all isDigit d -> do
let f = refineMenu dict st !! read d
let st' = goNextMeta (refine dict f st)
prState pgf st'
prLState pgf st'
return st'
">":_ -> return (goNext st)
p@('[':_):_ -> do
let st' = goPosition (mkPosition (read p)) st
prLState pgf st'
return st'
">":_ -> do
let st' = goNext st
prLState pgf st'
return st'
"h":_ -> putStrLn commandHelp >> return st
_ -> do
putStrLn "command not understood"
return st
prState pgf st = do
prLState pgf st = do
let t = stateTree st
putStrLn (unlines ([
"Now I have",
showTree t] ++
"Now I have:","",
prState st] ++
linearizeAll pgf t))
-- prompt selection from list of trees, such as ambiguous choice
selectReplace :: Dict -> [Tree] -> State -> IO State
selectReplace dict ts st = case ts of
[] -> putStrLn "no results" >> return st
[t] -> return $ replace dict t st
[t] -> return $ goNext $ replace dict t st
_ -> do
mapM_ putStrLn $ "choose tree" :
mapM_ putStrLn $ "choose tree by entering its number:" :
[show i ++ " : " ++ showTree t | (i,t) <- zip [0..] ts]
d <- getLine
let t = ts !! read d
return $ replace dict t st
return $ goNext $ replace dict t st
commandHelp = unlines [
"a -- refine with a random subtree",
"d -- delete current subtree",
"h -- display this help message",
"m -- show refinement menu",
"p Anything -- parse Anything and refine with it",
"r Function -- refine with Function",
"4 -- refine with 4th item from menu (see m)",
"[1,2,3] -- go to position 1,2,3",
"> -- go to next node"
]