module Tile.Schedule
  ( Step (..),
    Schedule,
    RoutedSchedule (..),
    adjacencyList,
    Occlusion (..),
    representative,
    stepFor,
    stepForOccluded,
    reverseStep,
    reverseSchedule,
  )
where

import Data.List (find)
import Data.Map.Strict qualified as Map
import Tile.Geometry
import Tile.Tile

data Step a = Step
  { forall a. Step a -> a
from :: a,
    forall a. Step a -> a
to :: a
  }
  deriving (Int -> Step a -> ShowS
[Step a] -> ShowS
Step a -> String
(Int -> Step a -> ShowS)
-> (Step a -> String) -> ([Step a] -> ShowS) -> Show (Step a)
forall a. Show a => Int -> Step a -> ShowS
forall a. Show a => [Step a] -> ShowS
forall a. Show a => Step a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Step a -> ShowS
showsPrec :: Int -> Step a -> ShowS
$cshow :: forall a. Show a => Step a -> String
show :: Step a -> String
$cshowList :: forall a. Show a => [Step a] -> ShowS
showList :: [Step a] -> ShowS
Show, Step a -> Step a -> Bool
(Step a -> Step a -> Bool)
-> (Step a -> Step a -> Bool) -> Eq (Step a)
forall a. Eq a => Step a -> Step a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Step a -> Step a -> Bool
== :: Step a -> Step a -> Bool
$c/= :: forall a. Eq a => Step a -> Step a -> Bool
/= :: Step a -> Step a -> Bool
Eq, Eq (Step a)
Eq (Step a) =>
(Step a -> Step a -> Ordering)
-> (Step a -> Step a -> Bool)
-> (Step a -> Step a -> Bool)
-> (Step a -> Step a -> Bool)
-> (Step a -> Step a -> Bool)
-> (Step a -> Step a -> Step a)
-> (Step a -> Step a -> Step a)
-> Ord (Step a)
Step a -> Step a -> Bool
Step a -> Step a -> Ordering
Step a -> Step a -> Step a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Step a)
forall a. Ord a => Step a -> Step a -> Bool
forall a. Ord a => Step a -> Step a -> Ordering
forall a. Ord a => Step a -> Step a -> Step a
$ccompare :: forall a. Ord a => Step a -> Step a -> Ordering
compare :: Step a -> Step a -> Ordering
$c< :: forall a. Ord a => Step a -> Step a -> Bool
< :: Step a -> Step a -> Bool
$c<= :: forall a. Ord a => Step a -> Step a -> Bool
<= :: Step a -> Step a -> Bool
$c> :: forall a. Ord a => Step a -> Step a -> Bool
> :: Step a -> Step a -> Bool
$c>= :: forall a. Ord a => Step a -> Step a -> Bool
>= :: Step a -> Step a -> Bool
$cmax :: forall a. Ord a => Step a -> Step a -> Step a
max :: Step a -> Step a -> Step a
$cmin :: forall a. Ord a => Step a -> Step a -> Step a
min :: Step a -> Step a -> Step a
Ord)

type Schedule a = [Step a]

adjacencyList :: (Ord a) => Schedule a -> Map.Map a [a]
adjacencyList :: forall a. Ord a => Schedule a -> Map a [a]
adjacencyList =
  (Step a -> Map a [a] -> Map a [a])
-> Map a [a] -> [Step a] -> Map a [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    (\Step {from :: forall a. Step a -> a
from = a
p, to :: forall a. Step a -> a
to = a
c} Map a [a]
m -> ([a] -> [a] -> [a]) -> a -> [a] -> Map a [a] -> Map a [a]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) a
p [a
c] Map a [a]
m)
    Map a [a]
forall k a. Map k a
Map.empty

data RoutedSchedule a = RoutedSchedule
  { forall a. RoutedSchedule a -> a
ingress :: a,
    forall a. RoutedSchedule a -> Schedule a
routedSteps :: Schedule a
  }
  deriving (Int -> RoutedSchedule a -> ShowS
[RoutedSchedule a] -> ShowS
RoutedSchedule a -> String
(Int -> RoutedSchedule a -> ShowS)
-> (RoutedSchedule a -> String)
-> ([RoutedSchedule a] -> ShowS)
-> Show (RoutedSchedule a)
forall a. Show a => Int -> RoutedSchedule a -> ShowS
forall a. Show a => [RoutedSchedule a] -> ShowS
forall a. Show a => RoutedSchedule a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> RoutedSchedule a -> ShowS
showsPrec :: Int -> RoutedSchedule a -> ShowS
$cshow :: forall a. Show a => RoutedSchedule a -> String
show :: RoutedSchedule a -> String
$cshowList :: forall a. Show a => [RoutedSchedule a] -> ShowS
showList :: [RoutedSchedule a] -> ShowS
Show, RoutedSchedule a -> RoutedSchedule a -> Bool
(RoutedSchedule a -> RoutedSchedule a -> Bool)
-> (RoutedSchedule a -> RoutedSchedule a -> Bool)
-> Eq (RoutedSchedule a)
forall a. Eq a => RoutedSchedule a -> RoutedSchedule a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => RoutedSchedule a -> RoutedSchedule a -> Bool
== :: RoutedSchedule a -> RoutedSchedule a -> Bool
$c/= :: forall a. Eq a => RoutedSchedule a -> RoutedSchedule a -> Bool
/= :: RoutedSchedule a -> RoutedSchedule a -> Bool
Eq)

newtype Occlusion a = Occlusion
  { forall a. Occlusion a -> a -> Bool
isOccluded :: a -> Bool
  }

representative :: (Eq a) => Occlusion a -> [a] -> Tile -> Maybe a
representative :: forall a. Eq a => Occlusion a -> [a] -> Tile -> Maybe a
representative Occlusion a
occ [a]
members Tile
tile =
  (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Occlusion a -> a -> Bool
forall a. Occlusion a -> a -> Bool
isOccluded Occlusion a
occ) [[a]
members [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
r | Int
r <- Tile -> [Int]
tileRanks Tile
tile]

memberAt :: [a] -> Tile -> a
memberAt :: forall a. [a] -> Tile -> a
memberAt [a]
members = ([a]
members [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!!) (Int -> a) -> (Tile -> Int) -> Tile -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tile -> Int
root

stepFor :: [a] -> Tile -> Tile -> Maybe (Step a)
stepFor :: forall a. [a] -> Tile -> Tile -> Maybe (Step a)
stepFor [a]
members Tile
parent Tile
child
  | Tile -> Int
root Tile
parent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Tile -> Int
root Tile
child = Maybe (Step a)
forall a. Maybe a
Nothing
  | Bool
otherwise =
      Step a -> Maybe (Step a)
forall a. a -> Maybe a
Just
        Step
          { from :: a
from = [a] -> Tile -> a
forall a. [a] -> Tile -> a
memberAt [a]
members Tile
parent,
            to :: a
to = [a] -> Tile -> a
forall a. [a] -> Tile -> a
memberAt [a]
members Tile
child
          }

stepForOccluded :: (Eq a) => Occlusion a -> [a] -> Tile -> Tile -> Maybe (Step a)
stepForOccluded :: forall a.
Eq a =>
Occlusion a -> [a] -> Tile -> Tile -> Maybe (Step a)
stepForOccluded Occlusion a
occ [a]
members Tile
parent Tile
child =
  case (Occlusion a -> [a] -> Tile -> Maybe a
forall a. Eq a => Occlusion a -> [a] -> Tile -> Maybe a
representative Occlusion a
occ [a]
members Tile
parent, Occlusion a -> [a] -> Tile -> Maybe a
forall a. Eq a => Occlusion a -> [a] -> Tile -> Maybe a
representative Occlusion a
occ [a]
members Tile
child) of
    (Just a
fromMember, Just a
toMember)
      | a
fromMember a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
toMember ->
          Step a -> Maybe (Step a)
forall a. a -> Maybe a
Just
            Step
              { from :: a
from = a
fromMember,
                to :: a
to = a
toMember
              }
    (Maybe a, Maybe a)
_ -> Maybe (Step a)
forall a. Maybe a
Nothing

reverseStep :: Step a -> Step a
reverseStep :: forall a. Step a -> Step a
reverseStep Step {from :: forall a. Step a -> a
from = a
p, to :: forall a. Step a -> a
to = a
c} =
  Step {from :: a
from = a
c, to :: a
to = a
p}

reverseSchedule :: Schedule a -> Schedule a
reverseSchedule :: forall a. Schedule a -> Schedule a
reverseSchedule = (Step a -> Step a) -> [Step a] -> [Step a]
forall a b. (a -> b) -> [a] -> [b]
map Step a -> Step a
forall a. Step a -> Step a
reverseStep