parsing in the toy editor

1 files changed, 38 insertions, 8 deletions

diff --git a/src/exper/EditShell.hs b/src/exper/EditShell.hs
index a50317d47..b00256478 100644
--- a/src/exper/EditShell.hs
+++ b/src/exper/EditShell.hs
@@ -3,6 +3,7 @@ module Main where
 import PGF.Editor
 import PGF
 
+import Data.Char
 import System (getArgs)
 
 main = do
@@ -15,25 +16,54 @@ main = do
 
 editLoop :: PGF -> Dict -> State -> IO State
 editLoop pgf dict st = do
-  putStrLn ("I want something of type " ++ prCId (focusType st))
+  putStrLn $ "I want something of type " ++ showType (focusType st) ++
+             " (0 - " ++ show (length (refineMenu dict st)-1) ++ ")"
   c   <- getLine
   st' <- interpret pgf dict st c
-  let t = etree2tree (tree st')
-  putStrLn (unlines ([
-    "Now I have",
-     showTree t] ++ 
-     linearizeAll pgf t))
   editLoop pgf dict st'
 
 interpret :: PGF -> Dict -> State -> String -> IO State
 interpret pgf dict st c = case words c of
   "r":f:_ -> do
-    return $ goNextMeta (refine dict (mkCId f) st)
+    let st' = goNext (refine dict (mkCId f) st)
+    prState 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'
+    return st'
   "m":_   -> do
-    putStrLn (unwords (map (prCId . fst) (refineMenu dict st)))
+    putStrLn (unwords (map prCId (refineMenu dict st)))
     return st
+  d : _ | all isDigit d -> do
+    let f = refineMenu dict st !! read d
+    let st' = goNextMeta (refine dict f st)
+    prState pgf st'
+    return st' 
+  ">":_ -> return (goNext st)
   _ -> do
     putStrLn "command not understood"
     return st
 
+prState pgf st = do
+  let t = stateTree st
+  putStrLn (unlines ([
+    "Now I have",
+     showTree t] ++ 
+     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
+  _   -> do
+    mapM_ putStrLn $ "choose tree" : 
+      [show i ++ " : " ++ showTree t | (i,t) <- zip [0..] ts]
+    d <- getLine
+    let t = ts !! read d
+    return $ replace dict t st
+
+