diff --git a/src/PGF/Editor.hs b/src/PGF/Editor.hs index 5c693cc96..444e35b7e 100644 --- a/src/PGF/Editor.hs +++ b/src/PGF/Editor.hs @@ -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 diff --git a/src/exper/EditShell.hs b/src/exper/EditShell.hs index b00256478..40a8741e3 100644 --- a/src/exper/EditShell.hs +++ b/src/exper/EditShell.hs @@ -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" + ]