module Tables(PathTable(..), WidTable(..), updatePath, lookupPath, wid2path0,
pruneWid, updateWid, subWids, lookupWid, path2wid0, PathTree,
moveWids,movePaths, prunePath) where
import Path
import Table
import PathTree
import Utils(oo)
import Xtypes
type WidTable = PathTree WindowId
path2wid0 :: PathTree n
path2wid0 = forall n. PathTree n
Tip
lookupWid :: PathTree WindowId -> [Direction] -> WindowId
lookupWid = forall {n} {t}.
Show n =>
(PathTree n -> t) -> t -> PathTree n -> [Direction] -> t
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 = forall {n} {t}.
Show n =>
(PathTree n -> t) -> t -> PathTree n -> [Direction] -> t
subTree forall a. a -> a
id 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 = forall {t1} {t2} {t3} {t4}.
(t1 -> t2) -> (t3 -> t4 -> t1) -> t3 -> t4 -> t2
oo (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= WindowId
noWindow)) (forall {n} {t}.
Show n =>
(PathTree n -> t) -> t -> PathTree n -> [Direction] -> t
subTree (forall {a}. [a] -> PathTree a -> [a]
listWids []) [])
listWids :: [a] -> PathTree a -> [a]
listWids = 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 (forall n. n -> PathTree n -> PathTree n -> PathTree n
Node WindowId
wid forall n. PathTree n
Tip 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> 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 forall n. PathTree n
Tip [Direction]
path') forall n. PathTree n
Tip
Node WindowId
w PathTree WindowId
l PathTree WindowId
r -> 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)
_ -> 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 -> forall n. n -> PathTree n -> PathTree n -> PathTree n
Node WindowId
nowid forall n. PathTree n
Tip ((PathTree WindowId -> PathTree WindowId)
-> PathTree WindowId -> [Direction] -> PathTree WindowId
updTree PathTree WindowId -> PathTree WindowId
f forall n. PathTree n
Tip [Direction]
path')
Node WindowId
w PathTree WindowId
l PathTree WindowId
r -> 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)
_ -> 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 -> 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 forall n. DynTree n
DynTip Int
n [Direction]
path')
Dynamic DynTree (PathTree WindowId)
t' -> 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' =
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 forall n. PathTree n
Tip [Direction]
path') forall n. DynTree n
DynTip 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' = 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 forall a. Integral a => a -> a -> a
`rem` Int
2 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 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 -> forall n. n -> DynTree n -> DynTree n -> DynTree n
DynNode forall n. PathTree n
Tip ((PathTree WindowId -> PathTree WindowId)
-> DynTree (PathTree WindowId)
-> Int
-> [Direction]
-> DynTree (PathTree WindowId)
updateDyn' PathTree WindowId -> PathTree WindowId
f forall n. DynTree n
DynTip Int
n [Direction]
path') forall n. DynTree n
DynTip
DynNode PathTree WindowId
t' DynTree (PathTree WindowId)
l DynTree (PathTree WindowId)
r -> 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 -> forall n. n -> DynTree n -> DynTree n -> DynTree n
DynNode forall n. PathTree n
Tip forall n. DynTree n
DynTip ((PathTree WindowId -> PathTree WindowId)
-> DynTree (PathTree WindowId)
-> Int
-> [Direction]
-> DynTree (PathTree WindowId)
updateDyn' PathTree WindowId -> PathTree WindowId
f forall n. DynTree n
DynTip Int
n [Direction]
path')
DynNode PathTree WindowId
t' DynTree (PathTree WindowId)
l DynTree (PathTree WindowId)
r -> 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
wid2path0 :: Table k v
wid2path0 = forall {k} {v}. Table k v
emptyTable
lookupPath :: Table a [Direction] -> a -> [Direction]
lookupPath Table a [Direction]
wid2path a
wid = forall {a} {t3} {b}.
Ord a =>
t3 -> ((a, b) -> t3) -> a -> Table a b -> t3
tableLookup [Direction]
nopath forall a b. (a, b) -> b
snd a
wid Table a [Direction]
wid2path
updatePath :: Table k v -> k -> v -> Table k v
updatePath Table k v
wid2path k
wid v
path' = forall {k} {v}. Ord k => (k, v) -> Table k v -> Table k v
tableUpdate (k
wid, v
path') Table k v
wid2path
movePaths :: Table k [Direction]
-> [Direction] -> [Direction] -> Table k [Direction]
movePaths Table k [Direction]
wid2path [Direction]
opath [Direction]
npath = forall {t} {v} {k}. (t -> v) -> Table k t -> Table k v
mapTable [Direction] -> [Direction]
move Table k [Direction]
wid2path
where
move :: [Direction] -> [Direction]
move [Direction]
path = [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 forall a. Eq a => a -> a -> Bool
== Direction
y = [Direction] -> [Direction] -> [Direction]
repath [Direction]
xs [Direction]
ys
repath [Direction]
_ [Direction]
_ = [Direction]
path
prunePath :: Table b v -> b -> Table b v
prunePath Table b v
wid2path b
w = forall {k} {v}. Ord k => [(k, v)] -> Table k v
table forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/=b
w)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall {k} {v}. Table k v -> [(k, v)]
listTable Table b v
wid2path