module Tile.Routing
  ( Traversal (..),
    buildScheduleFrom,
    buildSchedule,
    buildOccludedScheduleFrom,
  )
where

import Tile.Schedule
import Tile.Shape
import Tile.Tile
import Tile.Tiling
import Tile.Tree

data Traversal = DFS | BFS
  deriving (Int -> Traversal -> ShowS
[Traversal] -> ShowS
Traversal -> String
(Int -> Traversal -> ShowS)
-> (Traversal -> String)
-> ([Traversal] -> ShowS)
-> Show Traversal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Traversal -> ShowS
showsPrec :: Int -> Traversal -> ShowS
$cshow :: Traversal -> String
show :: Traversal -> String
$cshowList :: [Traversal] -> ShowS
showList :: [Traversal] -> ShowS
Show, Traversal -> Traversal -> Bool
(Traversal -> Traversal -> Bool)
-> (Traversal -> Traversal -> Bool) -> Eq Traversal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Traversal -> Traversal -> Bool
== :: Traversal -> Traversal -> Bool
$c/= :: Traversal -> Traversal -> Bool
/= :: Traversal -> Traversal -> Bool
Eq)

buildScheduleFrom :: (Tiling t) => Traversal -> t -> [a] -> Tile -> Schedule a
buildScheduleFrom :: forall t a. Tiling t => Traversal -> t -> [a] -> Tile -> Schedule a
buildScheduleFrom Traversal
traversal t
tiling [a]
members Tile
startTile =
  let SendTree Tree Tile
tree = t -> Tile -> SendTree
forall t. Tiling t => t -> Tile -> SendTree
sendTree t
tiling Tile
startTile
   in case Traversal
traversal of
        Traversal
DFS -> [a] -> Tree Tile -> Schedule a
forall a. [a] -> Tree Tile -> Schedule a
dfsFaultFree [a]
members Tree Tile
tree
        Traversal
BFS -> [a] -> [Tree Tile] -> Schedule a
forall a. [a] -> [Tree Tile] -> Schedule a
bfsFaultFree [a]
members [Tree Tile
tree]

buildSchedule :: (Tiling t) => Traversal -> t -> [a] -> Shape -> Schedule a
buildSchedule :: forall t a.
Tiling t =>
Traversal -> t -> [a] -> Shape -> Schedule a
buildSchedule Traversal
traversal t
tiling [a]
members Shape
shp =
  Traversal -> t -> [a] -> Tile -> Schedule a
forall t a. Tiling t => Traversal -> t -> [a] -> Tile -> Schedule a
buildScheduleFrom Traversal
traversal t
tiling [a]
members (Shape -> Tile
rootTile Shape
shp)

buildOccludedScheduleFrom ::
  (Tiling t, Eq a) =>
  Traversal ->
  Occlusion a ->
  t ->
  [a] ->
  Tile ->
  Maybe (RoutedSchedule a)
buildOccludedScheduleFrom :: forall t a.
(Tiling t, Eq a) =>
Traversal
-> Occlusion a -> t -> [a] -> Tile -> Maybe (RoutedSchedule a)
buildOccludedScheduleFrom Traversal
traversal Occlusion a
occ t
tiling [a]
members Tile
startTile = do
  let SendTree Tree Tile
tree = t -> Tile -> SendTree
forall t. Tiling t => t -> Tile -> SendTree
sendTree t
tiling Tile
startTile
      prunedTree :: Tree Tile
prunedTree = Occlusion a -> [a] -> Tree Tile -> Tree Tile
forall a. Eq a => Occlusion a -> [a] -> Tree Tile -> Tree Tile
pruneOccluded Occlusion a
occ [a]
members Tree Tile
tree
  startRep <- Occlusion a -> [a] -> Tile -> Maybe a
forall a. Eq a => Occlusion a -> [a] -> Tile -> Maybe a
representative Occlusion a
occ [a]
members (Tree Tile -> Tile
forall a. Tree a -> a
treeLabel Tree Tile
prunedTree)
  let steps = case Traversal
traversal of
        Traversal
DFS -> Occlusion a -> [a] -> Tree Tile -> Schedule a
forall a. Eq a => Occlusion a -> [a] -> Tree Tile -> Schedule a
dfsOccluded Occlusion a
occ [a]
members Tree Tile
prunedTree
        Traversal
BFS -> Occlusion a -> [a] -> [Tree Tile] -> Schedule a
forall a. Eq a => Occlusion a -> [a] -> [Tree Tile] -> Schedule a
bfsOccluded Occlusion a
occ [a]
members [Tree Tile
prunedTree]
  pure RoutedSchedule {ingress = startRep, routedSteps = steps}

pruneOccluded :: (Eq a) => Occlusion a -> [a] -> Tree Tile -> Tree Tile
pruneOccluded :: forall a. Eq a => Occlusion a -> [a] -> Tree Tile -> Tree Tile
pruneOccluded Occlusion a
occ [a]
members (Tree Tile
t [Tree Tile]
kids) =
  Tile -> [Tree Tile] -> Tree Tile
forall a. a -> [Tree a] -> Tree a
Tree Tile
t ((Tree Tile -> [Tree Tile]) -> [Tree Tile] -> [Tree Tile]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree Tile -> [Tree Tile]
project [Tree Tile]
kids)
  where
    project :: Tree Tile -> [Tree Tile]
project subtree :: Tree Tile
subtree@(Tree Tile
childTile [Tree Tile]
_)
      | Just a
_ <- Occlusion a -> [a] -> Tile -> Maybe a
forall a. Eq a => Occlusion a -> [a] -> Tile -> Maybe a
representative Occlusion a
occ [a]
members Tile
childTile = [Occlusion a -> [a] -> Tree Tile -> Tree Tile
forall a. Eq a => Occlusion a -> [a] -> Tree Tile -> Tree Tile
pruneOccluded Occlusion a
occ [a]
members Tree Tile
subtree]
      | Bool
otherwise = []

dfsFaultFree :: [a] -> Tree Tile -> Schedule a
dfsFaultFree :: forall a. [a] -> Tree Tile -> Schedule a
dfsFaultFree [a]
members (Tree Tile
t [Tree Tile]
kids) =
  let steps :: [Step a]
steps = [Step a
step | Tree Tile
child <- [Tree Tile]
kids, Just Step a
step <- [[a] -> Tile -> Tile -> Maybe (Step a)
forall a. [a] -> Tile -> Tile -> Maybe (Step a)
stepFor [a]
members Tile
t (Tree Tile -> Tile
forall a. Tree a -> a
treeLabel Tree Tile
child)]]
   in [Step a]
steps [Step a] -> [Step a] -> [Step a]
forall a. [a] -> [a] -> [a]
++ (Tree Tile -> [Step a]) -> [Tree Tile] -> [Step a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([a] -> Tree Tile -> [Step a]
forall a. [a] -> Tree Tile -> Schedule a
dfsFaultFree [a]
members) [Tree Tile]
kids

bfsFaultFree :: [a] -> [Tree Tile] -> Schedule a
bfsFaultFree :: forall a. [a] -> [Tree Tile] -> Schedule a
bfsFaultFree [a]
_ [] = []
bfsFaultFree [a]
members [Tree Tile]
trees =
  let steps :: [Step a]
steps = [Step a
step | Tree Tile
t [Tree Tile]
kids <- [Tree Tile]
trees, Tree Tile
child <- [Tree Tile]
kids, Just Step a
step <- [[a] -> Tile -> Tile -> Maybe (Step a)
forall a. [a] -> Tile -> Tile -> Maybe (Step a)
stepFor [a]
members Tile
t (Tree Tile -> Tile
forall a. Tree a -> a
treeLabel Tree Tile
child)]]
      nextLevel :: [Tree Tile]
nextLevel = (Tree Tile -> [Tree Tile]) -> [Tree Tile] -> [Tree Tile]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree Tile -> [Tree Tile]
forall a. Tree a -> [Tree a]
subtrees [Tree Tile]
trees
   in [Step a]
steps [Step a] -> [Step a] -> [Step a]
forall a. [a] -> [a] -> [a]
++ [a] -> [Tree Tile] -> [Step a]
forall a. [a] -> [Tree Tile] -> Schedule a
bfsFaultFree [a]
members [Tree Tile]
nextLevel

dfsOccluded :: (Eq a) => Occlusion a -> [a] -> Tree Tile -> Schedule a
dfsOccluded :: forall a. Eq a => Occlusion a -> [a] -> Tree Tile -> Schedule a
dfsOccluded Occlusion a
occ [a]
members (Tree Tile
t [Tree Tile]
kids) =
  let steps :: [Step a]
steps = [Step a
step | Tree Tile
child <- [Tree Tile]
kids, Just Step a
step <- [Occlusion a -> [a] -> Tile -> Tile -> Maybe (Step a)
forall a.
Eq a =>
Occlusion a -> [a] -> Tile -> Tile -> Maybe (Step a)
stepForOccluded Occlusion a
occ [a]
members Tile
t (Tree Tile -> Tile
forall a. Tree a -> a
treeLabel Tree Tile
child)]]
   in [Step a]
steps [Step a] -> [Step a] -> [Step a]
forall a. [a] -> [a] -> [a]
++ (Tree Tile -> [Step a]) -> [Tree Tile] -> [Step a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Occlusion a -> [a] -> Tree Tile -> [Step a]
forall a. Eq a => Occlusion a -> [a] -> Tree Tile -> Schedule a
dfsOccluded Occlusion a
occ [a]
members) [Tree Tile]
kids

bfsOccluded :: (Eq a) => Occlusion a -> [a] -> [Tree Tile] -> Schedule a
bfsOccluded :: forall a. Eq a => Occlusion a -> [a] -> [Tree Tile] -> Schedule a
bfsOccluded Occlusion a
_ [a]
_ [] = []
bfsOccluded Occlusion a
occ [a]
members [Tree Tile]
trees =
  let steps :: [Step a]
steps = [Step a
step | Tree Tile
t [Tree Tile]
kids <- [Tree Tile]
trees, Tree Tile
child <- [Tree Tile]
kids, Just Step a
step <- [Occlusion a -> [a] -> Tile -> Tile -> Maybe (Step a)
forall a.
Eq a =>
Occlusion a -> [a] -> Tile -> Tile -> Maybe (Step a)
stepForOccluded Occlusion a
occ [a]
members Tile
t (Tree Tile -> Tile
forall a. Tree a -> a
treeLabel Tree Tile
child)]]
      nextLevel :: [Tree Tile]
nextLevel = (Tree Tile -> [Tree Tile]) -> [Tree Tile] -> [Tree Tile]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree Tile -> [Tree Tile]
forall a. Tree a -> [Tree a]
subtrees [Tree Tile]
trees
   in [Step a]
steps [Step a] -> [Step a] -> [Step a]
forall a. [a] -> [a] -> [a]
++ Occlusion a -> [a] -> [Tree Tile] -> [Step a]
forall a. Eq a => Occlusion a -> [a] -> [Tree Tile] -> Schedule a
bfsOccluded Occlusion a
occ [a]
members [Tree Tile]
nextLevel