{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

module Graph.SubGraphWindows (subgraphWindows, getColumns, getRows) where

import qualified Data.IntMap as I
import Data.List (groupBy, sortBy, (\\))
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Data.Vector.Unboxed as VU
import Debug.Trace ( trace )
import Graph.CommonGraph
  ( CGraph,
    CGraphL,
    Column,
    LayerFeatures (..),
    NodeClass (dummyNode, isArgLabel, updateLayer),
    EdgeClass,
    UINode,
    bb,
    childrenSeparating,
    layer,
    lb,
    lbb,
    ltb,
    mid,
    myhead,
    nestingFeatures,
    parentsVertical,
    rb,
    rbb,
    rtb,
    tb,
  )
import Graph.GraphDrawing (getColumns, getRows)
import Graph.IntMap (nodes)
import qualified Graph.IntMap as Graph

data Span = SpanLeftBorder | SpanMiddle | SpanRightBorder | SpanOutside deriving (Int -> Span -> ShowS
[Span] -> ShowS
Span -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Span] -> ShowS
$cshowList :: [Span] -> ShowS
show :: Span -> String
$cshow :: Span -> String
showsPrec :: Int -> Span -> ShowS
$cshowsPrec :: Int -> Span -> ShowS
Show)

data SpanInOut = Outside | Inside

type Layer = Int -- the nesting of the window:
-- 0 -> dummy node
-- 1 -> not part of a window
-- 2 -> first window layer

type X = Int

type Y = Int

type Min = Int

type Max = Int

subgraphWindows :: (EdgeClass e, NodeClass n, Show n, VU.Unbox UINode) => CGraphL n e -> CGraphL n e
subgraphWindows :: forall e n.
(EdgeClass e, NodeClass n, Show n, Unbox UINode) =>
CGraphL n e -> CGraphL n e
subgraphWindows (Graph n [e]
graph, Map UINode (Int, Int)
pos)
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, n)]
ns = (Graph n [e]
graph, Map UINode (Int, Int)
pos)
  | Bool
otherwise -- Debug.Trace.trace ("subgraphWindows "++ show (graph,pos,newGraph,normalisedPos) ++"\n") -- ++ -- show newGraph ++"\n"++
  --                                      show pos ++"\n"++ show (rows,zRows,spans zRows) ++"\n"++ show (fst columns,zColumns, spans zColumns)) $
    =
    (Graph n [e]
newGraph, Map UINode (Int, Int)
normalisedPos)
  where
    newGraph :: Graph n [e]
newGraph =
      forall el nl0 nl1.
EdgeAttribute el =>
(Int -> nl0 -> nl1) -> Graph nl0 el -> Graph nl1 el
Graph.mapNodeWithKey
        forall n. NodeClass n => Int -> n -> n
changeNode
        Graph n [e]
filledGraph

    changeNode :: NodeClass n => I.Key -> n -> n
    changeNode :: forall n. NodeClass n => Int -> n -> n
changeNode Int
n n
node = forall n. NodeClass n => Maybe LayerFeatures -> Int -> n -> n
changeLayer Maybe LayerFeatures
nf Int
n n
node
      where nf :: Maybe LayerFeatures
nf = forall n. NodeClass n => n -> Maybe LayerFeatures
nestingFeatures n
node

    changeLayer :: NodeClass n => Maybe LayerFeatures -> I.Key -> n -> n
    changeLayer :: forall n. NodeClass n => Maybe LayerFeatures -> Int -> n -> n
changeLayer Maybe LayerFeatures
Nothing Int
n n
node
      | forall n. NodeClass n => n -> Bool
isArgLabel n
node = forall n. NodeClass n => Maybe LayerFeatures -> n -> n
updateLayer ((Int, (Span, Span)) -> Maybe LayerFeatures -> Maybe LayerFeatures
changeStyle (Int, (Span, Span))
l Maybe LayerFeatures
defaultFeatures) n
node
      | Bool
otherwise =       forall n. NodeClass n => Maybe LayerFeatures -> n -> n
updateLayer ((Int, (Span, Span)) -> Maybe LayerFeatures -> Maybe LayerFeatures
changeStyle (Int, (Span, Span))
l Maybe LayerFeatures
defaultFeatures) n
node
      where
        l :: (Int, (Span, Span))
l = (Int, Int)
-> Map Int (Map Int [(Int, Int)])
-> Map Int (Map Int [(Int, Int)])
-> (Int, (Span, Span))
highestLayer (Int, Int)
xy ([(Int, [(Int, [Int])])] -> Map Int (Map Int [(Int, Int)])
spans [(Int, [(Int, [Int])])]
zRows) ([(Int, [(Int, [Int])])] -> Map Int (Map Int [(Int, Int)])
spans [(Int, [(Int, [Int])])]
zColumns)
        xy :: (Int, Int)
xy = forall a. a -> Maybe a -> a
fromMaybe (Int
0, Int
0) (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Map UINode (Int, Int)
normalisedPos)
        _xy2 :: (Int, Int)
_xy2 = forall a. a -> Maybe a -> a
fromMaybe (Int
0, Int
0) (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall a b. (Integral a, Num b) => a -> b
fromIntegral UINode
root) Map UINode (Int, Int)
normalisedPos)
        root :: UINode
root = forall e n. EdgeClass e => CGraph n e -> UINode -> UINode
rootOf Graph n [e]
graph (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)

    changeLayer Maybe LayerFeatures
nestingFeats Int
n n
node
      | forall n. NodeClass n => n -> Bool
isArgLabel n
node = forall n. NodeClass n => Maybe LayerFeatures -> n -> n
updateLayer ((Int, (Span, Span)) -> Maybe LayerFeatures -> Maybe LayerFeatures
changeStyle (Int, (Span, Span))
l (forall a. a -> Maybe a
Just ((forall a. HasCallStack => Maybe a -> a
fromJust Maybe LayerFeatures
nestingFeats) {layer :: Int
layer = forall a b. (a, b) -> a
fst (Int, (Span, Span))
l}))) n
node
      | Bool
otherwise = forall n. NodeClass n => Maybe LayerFeatures -> n -> n
updateLayer ((Int, (Span, Span)) -> Maybe LayerFeatures -> Maybe LayerFeatures
changeStyle (Int, (Span, Span))
l Maybe LayerFeatures
nestingFeats) n
node
      where
        l :: (Int, (Span, Span))
l = (Int, Int)
-> Map Int (Map Int [(Int, Int)])
-> Map Int (Map Int [(Int, Int)])
-> (Int, (Span, Span))
highestLayer (Int, Int)
xy ([(Int, [(Int, [Int])])] -> Map Int (Map Int [(Int, Int)])
spans [(Int, [(Int, [Int])])]
zRows) ([(Int, [(Int, [Int])])] -> Map Int (Map Int [(Int, Int)])
spans [(Int, [(Int, [Int])])]
zColumns)
        xy :: (Int, Int)
xy = forall a. a -> Maybe a -> a
fromMaybe (Int
0, Int
0) (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Map UINode (Int, Int)
normalisedPos)

    rootOf :: EdgeClass e => CGraph n e -> UINode -> UINode
    rootOf :: forall e n. EdgeClass e => CGraph n e -> UINode -> UINode
rootOf CGraph n e
gr UINode
node
      | forall a. Unbox a => Vector a -> Bool
VU.null Vector UINode
psVert = UINode
node
      | Bool
otherwise = forall e n. EdgeClass e => CGraph n e -> UINode -> UINode
rootOf CGraph n e
gr (forall a. Unbox a => Vector a -> a
VU.head Vector UINode
psVert)
      where
        psVert :: Vector UINode
psVert = forall e n. EdgeClass e => Graph n [e] -> UINode -> Vector UINode
parentsVertical CGraph n e
gr UINode
node

    defaultFeatures :: Maybe LayerFeatures
defaultFeatures = forall a. a -> Maybe a
Just (Int -> Maybe Border -> LayerFeatures
LayerFeatures Int
0 forall a. Maybe a
Nothing)

    changeStyle :: (Int, (Span, Span)) -> Maybe LayerFeatures -> Maybe LayerFeatures
    changeStyle :: (Int, (Span, Span)) -> Maybe LayerFeatures -> Maybe LayerFeatures
changeStyle (Int
n, (Span
SpanLeftBorder, Span
SpanLeftBorder)) Maybe LayerFeatures
style = Maybe LayerFeatures
-> Int -> (Int -> Maybe LayerFeatures) -> Maybe LayerFeatures
maybeReplace Maybe LayerFeatures
style Int
n Int -> Maybe LayerFeatures
lbb -- LeftBottomBorder
    changeStyle (Int
n, (Span
SpanLeftBorder, Span
SpanMiddle)) Maybe LayerFeatures
style -- n >= 2    = maybeReplace style n mid
      =
      Maybe LayerFeatures
-> Int -> (Int -> Maybe LayerFeatures) -> Maybe LayerFeatures
maybeReplace Maybe LayerFeatures
style Int
n Int -> Maybe LayerFeatures
bb -- BottomBorder
    changeStyle (Int
n, (Span
SpanLeftBorder, Span
SpanRightBorder)) Maybe LayerFeatures
style -- n >= 2    = maybeReplace style n mid
      =
      Maybe LayerFeatures
-> Int -> (Int -> Maybe LayerFeatures) -> Maybe LayerFeatures
maybeReplace Maybe LayerFeatures
style Int
n Int -> Maybe LayerFeatures
rbb -- RightBottomBorder
    changeStyle (Int
n, (Span
SpanMiddle, Span
SpanLeftBorder)) Maybe LayerFeatures
style = Maybe LayerFeatures
-> Int -> (Int -> Maybe LayerFeatures) -> Maybe LayerFeatures
maybeReplace Maybe LayerFeatures
style Int
n Int -> Maybe LayerFeatures
lb -- LeftBorder
    changeStyle (Int
n, (Span
SpanMiddle, Span
SpanMiddle)) Maybe LayerFeatures
style = Maybe LayerFeatures
-> Int -> (Int -> Maybe LayerFeatures) -> Maybe LayerFeatures
maybeReplace Maybe LayerFeatures
style Int
n Int -> Maybe LayerFeatures
mid
    changeStyle (Int
n, (Span
SpanMiddle, Span
SpanRightBorder)) Maybe LayerFeatures
style -- n >= 2    = maybeReplace style n mid
      =
      Maybe LayerFeatures
-> Int -> (Int -> Maybe LayerFeatures) -> Maybe LayerFeatures
maybeReplace Maybe LayerFeatures
style Int
n Int -> Maybe LayerFeatures
rb -- RightBorder
    changeStyle (Int
n, (Span
SpanRightBorder, Span
SpanLeftBorder)) Maybe LayerFeatures
style -- n >= 4    = maybeReplace style n mid
      =
      Maybe LayerFeatures
-> Int -> (Int -> Maybe LayerFeatures) -> Maybe LayerFeatures
maybeReplace Maybe LayerFeatures
style Int
n Int -> Maybe LayerFeatures
ltb -- LeftTopBorder
    changeStyle (Int
n, (Span
SpanRightBorder, Span
SpanMiddle)) Maybe LayerFeatures
style -- n >= 4    = maybeReplace style n mid
      =
      Maybe LayerFeatures
-> Int -> (Int -> Maybe LayerFeatures) -> Maybe LayerFeatures
maybeReplace Maybe LayerFeatures
style Int
n Int -> Maybe LayerFeatures
tb -- TopBorder
    changeStyle (Int
n, (Span
SpanRightBorder, Span
SpanRightBorder)) Maybe LayerFeatures
style -- n >= 4    = maybeReplace style n mid
      =
      Maybe LayerFeatures
-> Int -> (Int -> Maybe LayerFeatures) -> Maybe LayerFeatures
maybeReplace Maybe LayerFeatures
style Int
n Int -> Maybe LayerFeatures
rtb -- RightTopBorder
    changeStyle (Int
_, (Span, Span)
_) Maybe LayerFeatures
style = Maybe LayerFeatures
style

    maybeReplace :: Maybe LayerFeatures -> Int -> (Int -> Maybe LayerFeatures) -> Maybe LayerFeatures
    maybeReplace :: Maybe LayerFeatures
-> Int -> (Int -> Maybe LayerFeatures) -> Maybe LayerFeatures
maybeReplace (Just (LayerFeatures Int
0 Maybe Border
_)) Int
n Int -> Maybe LayerFeatures
lf = Int -> Maybe LayerFeatures
lf Int
n
    maybeReplace (Just (LayerFeatures Int
x Maybe Border
_)) Int
_ Int -> Maybe LayerFeatures
lf = Int -> Maybe LayerFeatures
lf Int
x
    maybeReplace Maybe LayerFeatures
_ Int
n Int -> Maybe LayerFeatures
lf = forall a. String -> a -> a
Debug.Trace.trace String
"_" Int -> Maybe LayerFeatures
lf Int
n

    filledGraph :: Graph n [e]
filledGraph = forall el nl.
EdgeAttribute el =>
[(UINode, nl)] -> Graph nl el -> Graph nl el
Graph.insertNodes (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {b}. (Integral a, Num a) => (a, b) -> (a, b)
fr [(Int, n)]
newNodes) Graph n [e]
graph
    fr :: (a, b) -> (a, b)
fr (a
n, b
nl) = (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n, b
nl)
    normalisedPos :: Map UINode (Int, Int)
normalisedPos = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(Int
x, Int
y) -> (Int
x forall a. Num a => a -> a -> a
- Int
minX, Int
y forall a. Num a => a -> a -> a
- Int
minY)) (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map UINode (Int, Int)
pos Map UINode (Int, Int)
newPos)

    newNodes :: [(Int, n)]
newNodes = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {b} {a} {p}. NodeClass b => a -> p -> (a, b)
dNode [(Int
m forall a. Num a => a -> a -> a
+ Int
1) ..] [(Int, Int)]
holes
    newPos :: Map UINode (Int, Int)
newPos = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [(Int
m forall a. Num a => a -> a -> a
+ Int
1) ..]) [(Int, Int)]
holes)
    dNode :: a -> p -> (a, b)
dNode a
n p
_ = (a
n, forall n. NodeClass n => Int -> n
dummyNode Int
1)
    m :: Int
m = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall {a} {el}. Graph a el -> [Int]
nodes Graph n [e]
graph)

    holes :: [(Int, Int)]
    holes :: [(Int, Int)]
holes = [(Int
x, Int
y) | Int
x <- [Int
minX .. Int
maxX], Int
y <- [Int
minY .. Int
maxY]] forall a. Eq a => [a] -> [a] -> [a]
\\ [(Int, Int)]
nodePositions

    nodePositions :: [(Int, Int)]
nodePositions = forall k a. Map k a -> [a]
Map.elems Map UINode (Int, Int)
pos

    ns :: [(Int, n)]
ns = forall a. IntMap a -> [(Int, a)]
I.toList (forall nl el. Graph nl el -> IntMap nl
Graph.nodeLabels Graph n [e]
graph)

    minX :: Int
minX = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Int, Int)]
nodePositions)
    minY :: Int
minY = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Int, Int)]
nodePositions)
    maxX :: Int
maxX = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Int, Int)]
nodePositions)
    maxY :: Int
maxY = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Int, Int)]
nodePositions)

    rows :: Map Y [UINode]
    rows :: Map Int [UINode]
rows = forall n e. CGraphL n e -> Map Int [UINode]
getRows (Graph n [e]
filledGraph, Map UINode (Int, Int)
normalisedPos)
    columns :: (Map Int [UINode], Map Int [Column])
columns = forall e n.
EdgeClass e =>
CGraphL n e -> (Map Int [UINode], Map Int [Column])
getColumns (Graph n [e]
filledGraph, Map UINode (Int, Int)
normalisedPos)

    maxZCoord :: Int
maxZCoord = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_, n
nl) -> forall {n}. NodeClass n => n -> Int
zOfNode n
nl) [(Int, n)]
ns
    zOfNode :: n -> Int
zOfNode n
nl = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 LayerFeatures -> Int
layer (forall n. NodeClass n => n -> Maybe LayerFeatures
nestingFeatures n
nl)

    zLayers :: [(X, [UINode])] -> [(Layer, [(X, [Layer])])]
    zLayers :: [Column] -> [(Int, [(Int, [Int])])]
zLayers [Column]
xs = forall a b. (a -> b) -> [a] -> [b]
map Int -> (Int, [(Int, [Int])])
getLayer (forall a. [a] -> [a]
reverse [Int
1 .. Int
maxZCoord])
      where
        getLayer :: Int -> (Int, [(Int, [Int])])
getLayer Int
l = (Int
l, forall a b. (a -> b) -> [a] -> [b]
map Column -> (Int, [Int])
zOfNodes [Column]
xs)
          where
            zOfNodes :: Column -> (Int, [Int])
zOfNodes (Int
x, [UINode]
ns1) = (Int
x, forall a b. (a -> b) -> [a] -> [b]
map UINode -> Int
zLayer [UINode]
ns1)
            zLayer :: UINode -> Int
zLayer UINode
n
              | forall a. Maybe a -> Bool
isJust Maybe n
lu Bool -> Bool -> Bool
&& forall {n}. NodeClass n => n -> Int
zOfNode (forall a. HasCallStack => Maybe a -> a
fromJust Maybe n
lu) forall a. Ord a => a -> a -> Bool
>= Int
l = Int
l
              | Bool
otherwise = Int
0
              where
                lu :: Maybe n
lu = forall nl el.
(Show nl, EdgeAttribute el) =>
UINode -> Graph nl el -> Maybe nl
Graph.lookupNode UINode
n Graph n [e]
graph

    zRows :: [(Layer, [(X, [Layer])])]
    zRows :: [(Int, [(Int, [Int])])]
zRows = [Column] -> [(Int, [(Int, [Int])])]
zLayers (forall k a. Map k a -> [(k, a)]
Map.toList Map Int [UINode]
rows)
    zColumns :: [(Int, [(Int, [Int])])]
zColumns = [Column] -> [(Int, [(Int, [Int])])]
zLayers (forall k a. Map k a -> [(k, a)]
Map.toList (forall a b. (a, b) -> a
fst (Map Int [UINode], Map Int [Column])
columns))

    spans :: [(Layer, [(X, [Layer])])] -> Map Layer (Map X [(Min, Max)])
    spans :: [(Int, [(Int, [Int])])] -> Map Int (Map Int [(Int, Int)])
spans [(Int, [(Int, [Int])])]
ls = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall a b. (a -> b) -> [a] -> [b]
map forall {k}.
Ord k =>
(Int, [(k, [Int])]) -> (Int, Map k [(Int, Int)])
zSpans [(Int, [(Int, [Int])])]
ls)
      where
        zSpans :: (Int, [(k, [Int])]) -> (Int, Map k [(Int, Int)])
zSpans (Int
z, [(k, [Int])]
rs) = (Int
z, forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (a, [Int]) -> (a, [(Int, Int)])
rowsColums [(k, [Int])]
rs))
          where
            rowsColums :: (a, [Int]) -> (a, [(Int, Int)])
rowsColums (a
x, [Int]
layers) = (a
x, [Int] -> Int -> Int -> SpanInOut -> [(Int, Int)]
minMax [Int]
layers Int
0 Int
0 SpanInOut
Outside)

            minMax :: [Layer] -> Int -> Int -> SpanInOut -> [(Min, Max)]
            minMax :: [Int] -> Int -> Int -> SpanInOut -> [(Int, Int)]
minMax [] Int
start Int
i SpanInOut
Inside = [(Int
start, Int
i forall a. Num a => a -> a -> a
- Int
1)]
            minMax [] Int
_ Int
_ SpanInOut
_ = []
            minMax (Int
l : [Int]
layers) Int
start Int
i SpanInOut
Outside
              | Int
l forall a. Eq a => a -> a -> Bool
== Int
z = [Int] -> Int -> Int -> SpanInOut -> [(Int, Int)]
minMax [Int]
layers Int
i (Int
i forall a. Num a => a -> a -> a
+ Int
1) SpanInOut
Inside
              | Bool
otherwise = [Int] -> Int -> Int -> SpanInOut -> [(Int, Int)]
minMax [Int]
layers Int
start (Int
i forall a. Num a => a -> a -> a
+ Int
1) SpanInOut
Outside
            minMax (Int
l : [Int]
layers) Int
start Int
i SpanInOut
Inside
              | Int
l forall a. Eq a => a -> a -> Bool
== Int
z = [Int] -> Int -> Int -> SpanInOut -> [(Int, Int)]
minMax [Int]
layers Int
start (Int
i forall a. Num a => a -> a -> a
+ Int
1) SpanInOut
Inside
              | Bool
otherwise = (Int
start, Int
i forall a. Num a => a -> a -> a
- Int
1) forall a. a -> [a] -> [a]
: [Int] -> Int -> Int -> SpanInOut -> [(Int, Int)]
minMax [Int]
layers Int
start (Int
i forall a. Num a => a -> a -> a
+ Int
1) SpanInOut
Outside

    highestLayer ::
      (X, Y) ->
      Map Layer (Map X [(Min, Max)]) ->
      Map Layer (Map X [(Min, Max)]) ->
      (Layer, (Span, Span))
    highestLayer :: (Int, Int)
-> Map Int (Map Int [(Int, Int)])
-> Map Int (Map Int [(Int, Int)])
-> (Int, (Span, Span))
highestLayer (Int
x, Int
y) Map Int (Map Int [(Int, Int)])
hrows Map Int (Map Int [(Int, Int)])
cols = Int -> (Int, (Span, Span))
findFirstWindow Int
maxZCoord
      where
        findFirstWindow :: Int -> (Int, (Span, Span))
findFirstWindow Int
0 = (Int
0, (Span
SpanOutside, Span
SpanOutside))
        findFirstWindow Int
z
          | Span -> Span -> Bool
found Span
c Span
r = (Int
z, (Span
c, Span
r))
          | Bool
otherwise = Int -> (Int, (Span, Span))
findFirstWindow (Int
z forall a. Num a => a -> a -> a
- Int
1)
          where
            c :: Span
c = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Span
SpanOutside ((Int, Int) -> Bool -> Map Int [(Int, Int)] -> Span
overlappedByNeighbouringSpans (Int
x, Int
y) Bool
True) (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
z Map Int (Map Int [(Int, Int)])
cols)
            r :: Span
r = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Span
SpanOutside ((Int, Int) -> Bool -> Map Int [(Int, Int)] -> Span
overlappedByNeighbouringSpans (Int
x, Int
y) Bool
False) (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
z Map Int (Map Int [(Int, Int)])
hrows)
            found :: Span -> Span -> Bool
found Span
SpanOutside Span
_ = Bool
False
            found Span
_ Span
SpanOutside = Bool
False
            found Span
_ Span
_ = Bool
True

    -- Is there at least one neighboring row/column that includes the X/Y coordinate in its span
    overlappedByNeighbouringSpans :: (X, Y) -> Bool -> Map X [(Min, Max)] -> Span
    overlappedByNeighbouringSpans :: (Int, Int) -> Bool -> Map Int [(Int, Int)] -> Span
overlappedByNeighbouringSpans (Int
x, Int
y) Bool
isColumn Map Int [(Int, Int)]
nspans
      | Bool
isColumn = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Span
SpanOutside (Int, Int) -> Span
spanPositionColumn (forall {a} {b}. (Ord a, Ord b) => [(a, b)] -> Maybe (a, b)
minmax (Int -> [(Int, Int)]
goLeft Int
x forall a. [a] -> [a] -> [a]
++ Int -> [(Int, Int)]
goRight (Int
x forall a. Num a => a -> a -> a
+ Int
1)))
      | Bool
otherwise = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Span
SpanOutside (Int, Int) -> Span
spanPositionRow (forall {a} {b}. (Ord a, Ord b) => [(a, b)] -> Maybe (a, b)
minmax (Int -> [(Int, Int)]
goLeft Int
y forall a. [a] -> [a] -> [a]
++ Int -> [(Int, Int)]
goRight (Int
y forall a. Num a => a -> a -> a
+ Int
1)))
      where
        spanPositionColumn :: (Int, Int) -> Span
spanPositionColumn (Int
smin, Int
smax)
          | Int
y forall a. Eq a => a -> a -> Bool
== Int
smin = Span
SpanRightBorder
          | Int
y forall a. Eq a => a -> a -> Bool
== Int
smax = Span
SpanLeftBorder
          | Int
y forall a. Ord a => a -> a -> Bool
> Int
smin Bool -> Bool -> Bool
&& Int
y forall a. Ord a => a -> a -> Bool
< Int
smax = Span
SpanMiddle
          | Bool
otherwise = Span
SpanOutside
        spanPositionRow :: (Int, Int) -> Span
spanPositionRow (Int
smin, Int
smax)
          | Int
x forall a. Eq a => a -> a -> Bool
== Int
smin = Span
SpanLeftBorder
          | Int
x forall a. Eq a => a -> a -> Bool
== Int
smax = Span
SpanRightBorder
          | Int
x forall a. Ord a => a -> a -> Bool
> Int
smin Bool -> Bool -> Bool
&& Int
x forall a. Ord a => a -> a -> Bool
< Int
smax = Span
SpanMiddle
          | Bool
otherwise = Span
SpanOutside
        minmax :: [(a, b)] -> Maybe (a, b)
minmax [(a, b)]
xs
          | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, b)]
xs = forall a. Maybe a
Nothing
          | Bool
otherwise = forall a. a -> Maybe a
Just (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(a, b)]
xs), forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(a, b)]
xs))

        goLeft :: Int -> [(Int, Int)]
goLeft Int
p
          | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
mm = [(Int, Int)]
mm
          | Bool
otherwise = [(Int, Int)]
mm forall a. [a] -> [a] -> [a]
++ Int -> [(Int, Int)]
goLeft (Int
p forall a. Num a => a -> a -> a
- Int
1)
          where
            mm :: [(Int, Int)]
mm = forall a. a -> Maybe a -> a
fromMaybe [] (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
p Map Int [(Int, Int)]
nspans)

        goRight :: Int -> [(Int, Int)]
goRight Int
p
          | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
mm = [(Int, Int)]
mm
          | Bool
otherwise = [(Int, Int)]
mm forall a. [a] -> [a] -> [a]
++ Int -> [(Int, Int)]
goRight (Int
p forall a. Num a => a -> a -> a
+ Int
1)
          where
            mm :: [(Int, Int)]
mm = forall a. a -> Maybe a -> a
fromMaybe [] (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
p Map Int [(Int, Int)]
nspans)