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 :: PathTree n
path2wid0 = PathTree n
forall n. PathTree n
Tip

lookupWid :: PathTree WindowId -> [Direction] -> WindowId
lookupWid = (PathTree WindowId -> WindowId)
-> WindowId -> PathTree WindowId -> [Direction] -> WindowId
forall n a2.
Show n =>
(PathTree n -> a2) -> a2 -> PathTree n -> [Direction] -> a2
subTree (\(Node WindowId
w PathTree WindowId
_ PathTree WindowId
_) -> WindowId
w) WindowId
noWindow

moveWids :: PathTree WindowId
-> [Direction] -> [Direction] -> PathTree WindowId
moveWids PathTree WindowId
path2wid [Direction]
opath [Direction]
npath = PathTree WindowId
-> PathTree WindowId -> [Direction] -> PathTree WindowId
insertTree PathTree WindowId
st PathTree WindowId
pt [Direction]
npath where
    st :: PathTree WindowId
st = (PathTree WindowId -> PathTree WindowId)
-> PathTree WindowId
-> PathTree WindowId
-> [Direction]
-> PathTree WindowId
forall n a2.
Show n =>
(PathTree n -> a2) -> a2 -> PathTree n -> [Direction] -> a2
subTree PathTree WindowId -> PathTree WindowId
forall a. a -> a
id PathTree WindowId
forall n. PathTree n
Tip PathTree WindowId
path2wid [Direction]
opath 
    pt :: PathTree WindowId
pt = PathTree WindowId -> [Direction] -> PathTree WindowId
pruneWid PathTree WindowId
path2wid [Direction]
opath

subWids :: PathTree WindowId -> [Direction] -> [WindowId]
subWids = ([WindowId] -> [WindowId])
-> (PathTree WindowId -> [Direction] -> [WindowId])
-> PathTree WindowId
-> [Direction]
-> [WindowId]
forall t1 t2 t3 t4.
(t1 -> t2) -> (t3 -> t4 -> t1) -> t3 -> t4 -> t2
oo ((WindowId -> Bool) -> [WindowId] -> [WindowId]
forall a. (a -> Bool) -> [a] -> [a]
filter (WindowId -> WindowId -> Bool
forall a. Eq a => a -> a -> Bool
/= WindowId
noWindow)) ((PathTree WindowId -> [WindowId])
-> [WindowId] -> PathTree WindowId -> [Direction] -> [WindowId]
forall n a2.
Show n =>
(PathTree n -> a2) -> a2 -> PathTree n -> [Direction] -> a2
subTree ([WindowId] -> PathTree WindowId -> [WindowId]
forall a. [a] -> PathTree a -> [a]
listWids []) [])

listWids :: [a] -> PathTree a -> [a]
listWids = [a] -> PathTree a -> [a]
forall a. [a] -> PathTree a -> [a]
listNodes

updateWid :: PathTree WindowId -> [Direction] -> WindowId -> PathTree WindowId
updateWid PathTree WindowId
t [Direction]
path' WindowId
wid = PathTree WindowId
-> PathTree WindowId -> [Direction] -> PathTree WindowId
insertTree (WindowId
-> PathTree WindowId -> PathTree WindowId -> PathTree WindowId
forall n. n -> PathTree n -> PathTree n -> PathTree n
Node WindowId
wid PathTree WindowId
forall n. PathTree n
Tip PathTree WindowId
forall n. PathTree n
Tip) PathTree WindowId
t [Direction]
path'

pruneWid :: PathTree WindowId -> [Direction] -> PathTree WindowId
pruneWid PathTree WindowId
t [Direction]
path' = PathTree WindowId
-> PathTree WindowId -> [Direction] -> PathTree WindowId
insertTree PathTree WindowId
forall n. PathTree n
Tip PathTree WindowId
t [Direction]
path'

insertTree :: PathTree WindowId
-> PathTree WindowId -> [Direction] -> PathTree WindowId
insertTree = (PathTree WindowId -> PathTree WindowId)
-> PathTree WindowId -> [Direction] -> PathTree WindowId
updTree ((PathTree WindowId -> PathTree WindowId)
 -> PathTree WindowId -> [Direction] -> PathTree WindowId)
-> (PathTree WindowId -> PathTree WindowId -> PathTree WindowId)
-> PathTree WindowId
-> PathTree WindowId
-> [Direction]
-> PathTree WindowId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathTree WindowId -> PathTree WindowId -> PathTree WindowId
forall a b. a -> b -> a
const
updTree :: (PathTree WindowId -> PathTree WindowId)
-> PathTree WindowId -> [Direction] -> PathTree WindowId
updTree PathTree WindowId -> PathTree WindowId
f PathTree WindowId
t [Direction]
path' =
    case [Direction]
path' of
      [] -> PathTree WindowId -> PathTree WindowId
f PathTree WindowId
t
      Direction
L : [Direction]
path'' -> (PathTree WindowId -> PathTree WindowId)
-> PathTree WindowId -> [Direction] -> PathTree WindowId
updLeft PathTree WindowId -> PathTree WindowId
f PathTree WindowId
t [Direction]
path''
      Direction
R : [Direction]
path'' -> (PathTree WindowId -> PathTree WindowId)
-> PathTree WindowId -> [Direction] -> PathTree WindowId
updRight PathTree WindowId -> PathTree WindowId
f PathTree WindowId
t [Direction]
path''
      Dno Int
n : [Direction]
path'' -> (PathTree WindowId -> PathTree WindowId)
-> PathTree WindowId -> Int -> [Direction] -> PathTree WindowId
updateDyn PathTree WindowId -> PathTree WindowId
f PathTree WindowId
t (Int -> Int
pos Int
n) [Direction]
path''

updLeft :: (PathTree WindowId -> PathTree WindowId)
-> PathTree WindowId -> [Direction] -> PathTree WindowId
updLeft PathTree WindowId -> PathTree WindowId
f PathTree WindowId
t [Direction]
path' =
    case PathTree WindowId
t of
      PathTree WindowId
Tip -> WindowId
-> PathTree WindowId -> PathTree WindowId -> PathTree WindowId
forall n. n -> PathTree n -> PathTree n -> PathTree n
Node WindowId
nowid ((PathTree WindowId -> PathTree WindowId)
-> PathTree WindowId -> [Direction] -> PathTree WindowId
updTree PathTree WindowId -> PathTree WindowId
f PathTree WindowId
forall n. PathTree n
Tip [Direction]
path') PathTree WindowId
forall n. PathTree n
Tip
      Node WindowId
w PathTree WindowId
l PathTree WindowId
r -> WindowId
-> PathTree WindowId -> PathTree WindowId -> PathTree WindowId
forall n. n -> PathTree n -> PathTree n -> PathTree n
Node WindowId
w ((PathTree WindowId -> PathTree WindowId)
-> PathTree WindowId -> [Direction] -> PathTree WindowId
updTree PathTree WindowId -> PathTree WindowId
f PathTree WindowId
l [Direction]
path') PathTree WindowId
r
      Dynamic DynTree (PathTree WindowId)
_ -> [Char] -> PathTree WindowId
forall a. HasCallStack => [Char] -> a
error [Char]
"tables.m: updLeft (Dynamic _)"

updRight :: (PathTree WindowId -> PathTree WindowId)
-> PathTree WindowId -> [Direction] -> PathTree WindowId
updRight PathTree WindowId -> PathTree WindowId
f PathTree WindowId
t [Direction]
path' =
    case PathTree WindowId
t of
      PathTree WindowId
Tip -> WindowId
-> PathTree WindowId -> PathTree WindowId -> PathTree WindowId
forall n. n -> PathTree n -> PathTree n -> PathTree n
Node WindowId
nowid PathTree WindowId
forall n. PathTree n
Tip ((PathTree WindowId -> PathTree WindowId)
-> PathTree WindowId -> [Direction] -> PathTree WindowId
updTree PathTree WindowId -> PathTree WindowId
f PathTree WindowId
forall n. PathTree n
Tip [Direction]
path')
      Node WindowId
w PathTree WindowId
l PathTree WindowId
r -> WindowId
-> PathTree WindowId -> PathTree WindowId -> PathTree WindowId
forall n. n -> PathTree n -> PathTree n -> PathTree n
Node WindowId
w PathTree WindowId
l ((PathTree WindowId -> PathTree WindowId)
-> PathTree WindowId -> [Direction] -> PathTree WindowId
updTree PathTree WindowId -> PathTree WindowId
f PathTree WindowId
r [Direction]
path')
      Dynamic DynTree (PathTree WindowId)
_ -> [Char] -> PathTree WindowId
forall a. HasCallStack => [Char] -> a
error [Char]
"tables.m: updRight (Dynamic _)"

updateDyn :: (PathTree WindowId -> PathTree WindowId)
-> PathTree WindowId -> Int -> [Direction] -> PathTree WindowId
updateDyn PathTree WindowId -> PathTree WindowId
f PathTree WindowId
t Int
n [Direction]
path' =
    case PathTree WindowId
t of
      PathTree WindowId
Tip -> DynTree (PathTree WindowId) -> PathTree WindowId
forall n. DynTree (PathTree n) -> PathTree n
Dynamic ((PathTree WindowId -> PathTree WindowId)
-> DynTree (PathTree WindowId)
-> Int
-> [Direction]
-> DynTree (PathTree WindowId)
updateDyn' PathTree WindowId -> PathTree WindowId
f DynTree (PathTree WindowId)
forall n. DynTree n
DynTip Int
n [Direction]
path')
      Dynamic DynTree (PathTree WindowId)
t' -> DynTree (PathTree WindowId) -> PathTree WindowId
forall n. DynTree (PathTree n) -> PathTree n
Dynamic ((PathTree WindowId -> PathTree WindowId)
-> DynTree (PathTree WindowId)
-> Int
-> [Direction]
-> DynTree (PathTree WindowId)
updateDyn' PathTree WindowId -> PathTree WindowId
f DynTree (PathTree WindowId)
t' Int
n [Direction]
path')

updateDyn' :: (PathTree WindowId -> PathTree WindowId)
-> DynTree (PathTree WindowId)
-> Int
-> [Direction]
-> DynTree (PathTree WindowId)
updateDyn' PathTree WindowId -> PathTree WindowId
f DynTree (PathTree WindowId)
DynTip Int
0 [Direction]
path' =
    PathTree WindowId
-> DynTree (PathTree WindowId)
-> DynTree (PathTree WindowId)
-> DynTree (PathTree WindowId)
forall n. n -> DynTree n -> DynTree n -> DynTree n
DynNode ((PathTree WindowId -> PathTree WindowId)
-> PathTree WindowId -> [Direction] -> PathTree WindowId
updTree PathTree WindowId -> PathTree WindowId
f PathTree WindowId
forall n. PathTree n
Tip [Direction]
path') DynTree (PathTree WindowId)
forall n. DynTree n
DynTip DynTree (PathTree WindowId)
forall n. DynTree n
DynTip
updateDyn' PathTree WindowId -> PathTree WindowId
f (DynNode PathTree WindowId
t DynTree (PathTree WindowId)
l DynTree (PathTree WindowId)
r) Int
0 [Direction]
path' = PathTree WindowId
-> DynTree (PathTree WindowId)
-> DynTree (PathTree WindowId)
-> DynTree (PathTree WindowId)
forall n. n -> DynTree n -> DynTree n -> DynTree n
DynNode ((PathTree WindowId -> PathTree WindowId)
-> PathTree WindowId -> [Direction] -> PathTree WindowId
updTree PathTree WindowId -> PathTree WindowId
f PathTree WindowId
t [Direction]
path') DynTree (PathTree WindowId)
l DynTree (PathTree WindowId)
r
updateDyn' PathTree WindowId -> PathTree WindowId
f DynTree (PathTree WindowId)
t Int
n [Direction]
path' =
    (if Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then (PathTree WindowId -> PathTree WindowId)
-> DynTree (PathTree WindowId)
-> Int
-> [Direction]
-> DynTree (PathTree WindowId)
updDynLeft else (PathTree WindowId -> PathTree WindowId)
-> DynTree (PathTree WindowId)
-> Int
-> [Direction]
-> DynTree (PathTree WindowId)
updDynRight) PathTree WindowId -> PathTree WindowId
f
                                                         DynTree (PathTree WindowId)
t
                                                         (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2)
                                                         [Direction]
path'

updDynLeft :: (PathTree WindowId -> PathTree WindowId)
-> DynTree (PathTree WindowId)
-> Int
-> [Direction]
-> DynTree (PathTree WindowId)
updDynLeft PathTree WindowId -> PathTree WindowId
f DynTree (PathTree WindowId)
t Int
n [Direction]
path' =
    case DynTree (PathTree WindowId)
t of
      DynTree (PathTree WindowId)
DynTip -> PathTree WindowId
-> DynTree (PathTree WindowId)
-> DynTree (PathTree WindowId)
-> DynTree (PathTree WindowId)
forall n. n -> DynTree n -> DynTree n -> DynTree n
DynNode PathTree WindowId
forall n. PathTree n
Tip ((PathTree WindowId -> PathTree WindowId)
-> DynTree (PathTree WindowId)
-> Int
-> [Direction]
-> DynTree (PathTree WindowId)
updateDyn' PathTree WindowId -> PathTree WindowId
f DynTree (PathTree WindowId)
forall n. DynTree n
DynTip Int
n [Direction]
path') DynTree (PathTree WindowId)
forall n. DynTree n
DynTip
      DynNode PathTree WindowId
t' DynTree (PathTree WindowId)
l DynTree (PathTree WindowId)
r -> PathTree WindowId
-> DynTree (PathTree WindowId)
-> DynTree (PathTree WindowId)
-> DynTree (PathTree WindowId)
forall n. n -> DynTree n -> DynTree n -> DynTree n
DynNode PathTree WindowId
t' ((PathTree WindowId -> PathTree WindowId)
-> DynTree (PathTree WindowId)
-> Int
-> [Direction]
-> DynTree (PathTree WindowId)
updateDyn' PathTree WindowId -> PathTree WindowId
f DynTree (PathTree WindowId)
l Int
n [Direction]
path') DynTree (PathTree WindowId)
r

updDynRight :: (PathTree WindowId -> PathTree WindowId)
-> DynTree (PathTree WindowId)
-> Int
-> [Direction]
-> DynTree (PathTree WindowId)
updDynRight PathTree WindowId -> PathTree WindowId
f DynTree (PathTree WindowId)
t Int
n [Direction]
path' =
    case DynTree (PathTree WindowId)
t of
      DynTree (PathTree WindowId)
DynTip -> PathTree WindowId
-> DynTree (PathTree WindowId)
-> DynTree (PathTree WindowId)
-> DynTree (PathTree WindowId)
forall n. n -> DynTree n -> DynTree n -> DynTree n
DynNode PathTree WindowId
forall n. PathTree n
Tip DynTree (PathTree WindowId)
forall n. DynTree n
DynTip ((PathTree WindowId -> PathTree WindowId)
-> DynTree (PathTree WindowId)
-> Int
-> [Direction]
-> DynTree (PathTree WindowId)
updateDyn' PathTree WindowId -> PathTree WindowId
f DynTree (PathTree WindowId)
forall n. DynTree n
DynTip Int
n [Direction]
path')
      DynNode PathTree WindowId
t' DynTree (PathTree WindowId)
l DynTree (PathTree WindowId)
r -> PathTree WindowId
-> DynTree (PathTree WindowId)
-> DynTree (PathTree WindowId)
-> DynTree (PathTree WindowId)
forall n. n -> DynTree n -> DynTree n -> DynTree n
DynNode PathTree WindowId
t' DynTree (PathTree WindowId)
l ((PathTree WindowId -> PathTree WindowId)
-> DynTree (PathTree WindowId)
-> Int
-> [Direction]
-> DynTree (PathTree WindowId)
updateDyn' PathTree WindowId -> PathTree WindowId
f DynTree (PathTree WindowId)
r Int
n [Direction]
path')

nowid :: WindowId
nowid = WindowId
noWindow

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

nopath :: [Direction]
nopath = [Direction]
here -- error "window not associated with a path"

wid2path0 :: Table a
wid2path0 = Table a
forall a. Table a
emptyTable

-- This part should be replaced with something more efficient!!
lookupPath :: Table (a, [Direction]) -> a -> [Direction]
lookupPath Table (a, [Direction])
wid2path a
wid =
    [Direction]
-> ((a, [Direction]) -> [Direction])
-> (a, [Direction])
-> Table (a, [Direction])
-> [Direction]
forall a t1 b1 b2.
Ord a =>
t1 -> ((a, b1) -> t1) -> (a, b2) -> Table (a, b1) -> t1
tableLookup [Direction]
nopath (a, [Direction]) -> [Direction]
forall a b. (a, b) -> b
snd (a
wid, [Direction]
nopath) Table (a, [Direction])
wid2path

-- normal code
updatePath :: Table (a, b) -> a -> b -> Table (a, b)
updatePath Table (a, b)
wid2path a
wid b
path' = (a, b) -> Table (a, b) -> Table (a, b)
forall a b. Ord a => (a, b) -> Table (a, b) -> Table (a, b)
tableUpdate (a
wid, b
path') Table (a, b)
wid2path

movePaths :: Table (a, [Direction])
-> [Direction] -> [Direction] -> Table (a, [Direction])
movePaths Table (a, [Direction])
wid2path [Direction]
opath [Direction]
npath = ((a, [Direction]) -> (a, [Direction]))
-> Table (a, [Direction]) -> Table (a, [Direction])
forall t a. (t -> a) -> Table t -> Table a
mapTable (a, [Direction]) -> (a, [Direction])
forall a. (a, [Direction]) -> (a, [Direction])
move Table (a, [Direction])
wid2path where
  move :: (a, [Direction]) -> (a, [Direction])
move (a
wid,[Direction]
path) = (a
wid,[Direction] -> [Direction] -> [Direction]
repath [Direction]
opath [Direction]
path) where
     repath :: [Direction] -> [Direction] -> [Direction]
repath [] [Direction]
rest = [Direction] -> [Direction] -> [Direction]
absPath [Direction]
npath [Direction]
rest
     repath (Direction
x:[Direction]
xs) (Direction
y:[Direction]
ys) | Direction
x Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
y = [Direction] -> [Direction] -> [Direction]
repath [Direction]
xs [Direction]
ys
     repath [Direction]
_ [Direction]
_ = [Direction]
path

-- should be implemented in Tree234
prunePath :: Table (a, b) -> a -> Table (a, b)
prunePath Table (a, b)
wid2path a
w = [(a, b)] -> Table (a, b)
forall a b. Ord a => [(a, b)] -> Table (a, b)
table ([(a, b)] -> Table (a, b)) -> [(a, b)] -> Table (a, b)
forall a b. (a -> b) -> a -> b
$ ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=a
w)(a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a, b) -> a
forall a b. (a, b) -> a
fst) ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [(a, b)]
forall a b. (a -> b) -> a -> b
$ Table (a, b) -> [(a, b)]
forall a. Table a -> [a]
listTable Table (a, b)
wid2path