module Tables2(DTable(..), dtable0, lookupDe, listDe, updateDe) where
import Utils(pair)
import Direction() -- instances
import Path(here,Path(..))
import Sockets(Descriptor)
import Table

type DTable = Table (Descriptor, Path)

updateDe :: Path -> [Descriptor] -> DTable -> DTable
updateDe :: Path -> [Descriptor] -> DTable -> DTable
updateDe Path
path' [Descriptor]
ds DTable
dtable =
    [(Descriptor, Path)] -> DTable
forall a b. Ord a => [(a, b)] -> Table (a, b)
table ((Descriptor -> (Descriptor, Path))
-> [Descriptor] -> [(Descriptor, Path)]
forall a b. (a -> b) -> [a] -> [b]
map (Descriptor -> Path -> (Descriptor, Path)
forall a b. a -> b -> (a, b)
`pair` Path
path') [Descriptor]
ds [(Descriptor, Path)]
-> [(Descriptor, Path)] -> [(Descriptor, Path)]
forall a. [a] -> [a] -> [a]
++
           ((Descriptor, Path) -> Bool)
-> [(Descriptor, Path)] -> [(Descriptor, Path)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
/= Path
path') (Path -> Bool)
-> ((Descriptor, Path) -> Path) -> (Descriptor, Path) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Descriptor, Path) -> Path
forall a b. (a, b) -> b
snd) (DTable -> [(Descriptor, Path)]
forall a. Table a -> [a]
listTable DTable
dtable))

listDe :: DTable -> [Descriptor]
listDe :: DTable -> [Descriptor]
listDe DTable
dtable = ((Descriptor, Path) -> Descriptor)
-> [(Descriptor, Path)] -> [Descriptor]
forall a b. (a -> b) -> [a] -> [b]
map (Descriptor, Path) -> Descriptor
forall a b. (a, b) -> a
fst (DTable -> [(Descriptor, Path)]
forall a. Table a -> [a]
listTable DTable
dtable)

lookupDe :: DTable -> Descriptor -> Path
lookupDe :: DTable -> Descriptor -> Path
lookupDe DTable
dtable Descriptor
de =
    Path
-> ((Descriptor, Path) -> Path)
-> (Descriptor, Path)
-> DTable
-> Path
forall a t1 b1 b2.
Ord a =>
t1 -> ((a, b1) -> t1) -> (a, b2) -> Table (a, b1) -> t1
tableLookup ([Char] -> Path
forall a. HasCallStack => [Char] -> a
error ([Char]
"Descriptor without path: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Descriptor -> [Char]
forall a. Show a => a -> [Char]
show Descriptor
de)) (Descriptor, Path) -> Path
forall a b. (a, b) -> b
snd (Descriptor
de, Path
here) DTable
dtable

dtable0 :: DTable
dtable0 :: DTable
dtable0 = [(Descriptor, Path)] -> DTable
forall a b. Ord a => [(a, b)] -> Table (a, b)
table []