summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/PGF/Editor.hs97
1 files changed, 97 insertions, 0 deletions
diff --git a/src/PGF/Editor.hs b/src/PGF/Editor.hs
new file mode 100644
index 000000000..c01c9ca1b
--- /dev/null
+++ b/src/PGF/Editor.hs
@@ -0,0 +1,97 @@
+module PGF.Editor where
+
+import qualified Data.Map as M
+
+-- API
+
+replace :: Tree -> State -> State
+replace t = doInState (const t)
+
+delete :: State -> State
+delete s = replace (uTree (typ (tree s))) s
+
+new :: Type -> State
+new t = tree2state (uTree t)
+
+refineMenu :: Dict -> State -> [(Id,FType)]
+refineMenu dict s = maybe [] id $ M.lookup (focusType s) (refines dict)
+
+
+----
+
+data Tree = Tree {
+ atom :: Atom,
+ typ :: Type,
+ children :: [Tree]
+ }
+ deriving Show
+
+data Atom =
+ ACon Id
+ | AMeta Int
+ deriving Show
+
+uTree :: Type -> Tree
+uTree ty = Tree (AMeta 0) ty []
+
+data State = State {
+ position :: Position,
+ tree :: Tree
+ }
+ deriving Show
+
+type Position = [Int]
+
+top :: Position
+top = []
+
+up :: Position -> Position
+up = tail
+
+down :: Position -> Position
+down = (0:)
+
+left :: Position -> Position
+left p = case p of
+ (n:ns) | n > 0 -> n-1 : ns
+ _ -> top
+
+right :: Position -> Position
+right p = case p of
+ (n:ns) -> n+1 : ns
+ _ -> top
+
+tree2state :: Tree -> State
+tree2state = State top
+
+doInState :: (Tree -> Tree) -> State -> State
+doInState f s = s{tree = change (position s) (tree s)} where
+ change p t = case p of
+ [] -> f t
+ n:ns -> let (ts1,t0:ts2) = splitAt n (children t) in
+ t{children = ts1 ++ [change ns t0] ++ ts2}
+
+subtree :: Position -> Tree -> Tree
+subtree p t = case p of
+ [] -> t
+ n:ns -> subtree ns (children t !! n)
+
+focus :: State -> Tree
+focus s = subtree (position s) (tree s)
+
+focusType :: State -> Type
+focusType s = typ (focus s)
+
+navigate :: (Position -> Position) -> State -> State
+navigate p s = s{position = p (position s)}
+
+-------
+
+type Id = String ----
+type Type = Id ----
+type FType = ([Id],Id) ----
+
+data Dict = Dict {
+ funs :: M.Map Id FType,
+ refines :: M.Map Type [(Id,FType)]
+ }