Tables.hs

module Tables(PathTable(..), WidTable(..), updatePath, lookupPath, wid2path0,
              pruneWid, updateWid, subWids, lookupWid, path2wid0, PathTree,
	      moveWids,movePaths, prunePath) where
import Direction
--import Fudget
import Path
import Table
import PathTree
import Utils(oo)
import Xtypes

-- Most functions here should be imported from PathTree instead !!!

type WidTable = PathTree WindowId

path2wid0 = Tip

lookupWid = subTree (\(Node w _ _) -> w) noWindow

moveWids path2wid opath npath = insertTree st pt npath where
    st = subTree id Tip path2wid opath 
    pt = pruneWid path2wid opath

subWids = oo (filter (/= noWindow)) (subTree (listWids []) [])

listWids = listNodes

updateWid t path' wid = insertTree (Node wid Tip Tip) t path'

pruneWid t path' = insertTree Tip t path'

insertTree = updTree . const
updTree f t path' =
    case path' of
      [] -> f t
      L : path'' -> updLeft f t path''
      R : path'' -> updRight f t path''
      Dno n : path'' -> updateDyn f t (pos n) path''

updLeft f t path' =
    case t of
      Tip -> Node nowid (updTree f Tip path') Tip
      Node w l r -> Node w (updTree f l path') r
      Dynamic _ -> error "tables.m: updLeft (Dynamic _)"

updRight f t path' =
    case t of
      Tip -> Node nowid Tip (updTree f Tip path')
      Node w l r -> Node w l (updTree f r path')
      Dynamic _ -> error "tables.m: updRight (Dynamic _)"

updateDyn f t n path' =
    case t of
      Tip -> Dynamic (updateDyn' f DynTip n path')
      Dynamic t' -> Dynamic (updateDyn' f t' n path')

updateDyn' f DynTip 0 path' =
    DynNode (updTree f Tip path') DynTip DynTip
updateDyn' f (DynNode t l r) 0 path' = DynNode (updTree f t path') l r
updateDyn' f t n path' =
    (if n `rem` 2 == 0 then updDynLeft else updDynRight) f
                                                         t
                                                         (n `quot` 2)
                                                         path'

updDynLeft f t n path' =
    case t of
      DynTip -> DynNode Tip (updateDyn' f DynTip n path') DynTip
      DynNode t' l r -> DynNode t' (updateDyn' f l n path') r

updDynRight f t n path' =
    case t of
      DynTip -> DynNode Tip DynTip (updateDyn' f DynTip n path')
      DynNode t' l r -> DynNode t' l (updateDyn' f r n path')

nowid = noWindow

-------
type PathTable = Table (WindowId, Path)

nopath = here -- error "window not associated with a path"

wid2path0 = emptyTable

-- This part should be replaced with something more efficient!!
lookupPath wid2path wid =
    tableLookup nopath snd (wid, nopath) wid2path

-- normal code
updatePath wid2path wid path' = tableUpdate (wid, path') wid2path

movePaths wid2path opath npath = mapTable move wid2path where
  move (wid,path) = (wid,repath opath path) where
     repath [] rest = absPath npath rest
     repath (x:xs) (y:ys) | x == y = repath xs ys
     repath _ _ = path

-- should be implemented in Tree234
prunePath wid2path w = table $ filter ((/=w).fst) $ listTable wid2path