documentation in the Editor files

2 files changed, 87 insertions, 30 deletions

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"
+  ]