{-# LANGUAGE FlexibleContexts, FlexibleInstances, OverloadedStrings, TypeFamilies, NoMonomorphismRestriction #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TupleSections #-}

module Graph.SubGraphWindows (subgraphWindows, subgraphWithWindows, getColumns, getRows, ShowGraph, NestMap) 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 (catMaybes, fromJust, fromMaybe, isJust)
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Vector.Unboxed as VU
import Debug.Trace ( trace )
import Graph.CommonGraph
  ( CGraph, CGraphL, Column, YBlocks, YBlockLines, BoxId, Nesting, Border(..), LayerFeatures (..), NodeClass (dummyNode, isArgLabel, updateLayer),  EdgeClass, UINode, X, Y,
    bb, childrenSeparating, layer, lb, lbb, ltb,  mid, myHead, nestingFeatures, parentsVertical, rb, rbb, rtb, tb, vHead
  )
import Graph.IntMap (nodes)
import qualified Graph.IntMap as Graph

data Span = SpanLeftBorder | SpanMiddle | SpanRightBorder | SpanOutside deriving (Span -> Span -> Bool
(Span -> Span -> Bool) -> (Span -> Span -> Bool) -> Eq Span
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Span -> Span -> Bool
== :: Span -> Span -> Bool
$c/= :: Span -> Span -> Bool
/= :: Span -> Span -> Bool
Eq,Int -> Span -> ShowS
[Span] -> ShowS
Span -> String
(Int -> Span -> ShowS)
-> (Span -> String) -> ([Span] -> ShowS) -> Show Span
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Span -> ShowS
showsPrec :: Int -> Span -> ShowS
$cshow :: Span -> String
show :: Span -> String
$cshowList :: [Span] -> ShowS
showList :: [Span] -> ShowS
Show)
data SpanInOut = Outside | Inside

type Min = Int
type Max = Int

type ShowGraph n e = (Enum n, Graph.ExtractNodeType n, Show n, Show e)
type NestMap = Map Nesting (Set BoxId) -- ^ boxes/subgraphs in layer
type RowNodesPartOfBox = (X, [Bool]) -- for every element in the row/column: Is it a box node?

-- | Returns the boxes of the graph by examining the boxID of the cell
subgraphWindows :: (NodeClass n, EdgeClass e, ShowGraph n e, VU.Unbox UINode) =>
                   (NestMap, [BoxId]) -> (CGraphL n e, [[UINode]]) -> [(Nesting, BoxId, (Min,Max), (Min,Max))]
subgraphWindows :: forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(NestMap, [UINode])
-> (CGraphL n e, [[UINode]])
-> [(Int, UINode, (Int, Int), (Int, Int))]
subgraphWindows (NestMap
nestedGraphs, [UINode]
boxIds) ((Graph n [e]
graph, Map UINode (Int, Int)
pos, YBlockLines
yblocks), [[UINode]]
layers)
  | [(Int, n)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, n)]
ns = []
  | Bool
otherwise = [[(Int, UINode, (Int, Int), (Int, Int))]]
-> [(Int, UINode, (Int, Int), (Int, Int))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Int, UINode, (Int, Int), (Int, Int))]]
boxes
  where
    ns :: [(Int, n)]
ns = IntMap n -> [(Int, n)]
forall a. IntMap a -> [(Int, a)]
I.toList (Graph n [e] -> IntMap n
forall nl el. Graph nl el -> IntMap nl
Graph.nodeLabels Graph n [e]
graph)
    normPos :: Map UINode (Int, Int)
normPos = Map UINode (Int, Int, Maybe UINode) -> Map UINode (Int, Int)
forall k a b c. Map k (a, b, c) -> Map k (a, b)
strip ((Graph n [e], Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(CGraph n e, Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
normalisedPos (Graph n [e]
graph, Map UINode (Int, Int)
pos))
    rows :: Map Y [UINode]
    rows :: Map Int [UINode]
rows    =    CGraphL n e -> Map Int [UINode]
forall n e. CGraphL n e -> Map Int [UINode]
getRows (Graph n [e]
graph, Map UINode (Int, Int)
normPos, YBlockLines
yblocks)
    columns :: (Map Int [UINode], Map Int ([Column], YBlockLines))
columns = CGraphL n e -> (Map Int [UINode], Map Int ([Column], YBlockLines))
forall e n.
EdgeClass e =>
CGraphL n e -> (Map Int [UINode], Map Int ([Column], YBlockLines))
getColumns (Graph n [e]
graph, Map UINode (Int, Int)
normPos, YBlockLines
yblocks)
    zRows :: [(Nesting, [(BoxId, [RowNodesPartOfBox])])]
    zRows :: [(Int, [(UINode, [RowNodesPartOfBox])])]
zRows    = Graph n [e]
-> NestMap -> [Column] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
CGraph n e
-> NestMap -> [Column] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
zLayers Graph n [e]
graph NestMap
nestedGraphs (Map Int [UINode] -> [Column]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int [UINode]
rows)
    zColumns :: [(Int, [(UINode, [RowNodesPartOfBox])])]
zColumns = Graph n [e]
-> NestMap -> [Column] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
CGraph n e
-> NestMap -> [Column] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
zLayers Graph n [e]
graph NestMap
nestedGraphs (Map Int [UINode] -> [Column]
forall k a. Map k a -> [(k, a)]
Map.toList ((Map Int [UINode], Map Int ([Column], YBlockLines))
-> Map Int [UINode]
forall a b. (a, b) -> a
fst (Map Int [UINode], Map Int ([Column], YBlockLines))
columns))
    spansZRows :: Map Int [(UINode, Map Int [(Int, Int)])]
spansZRows = [(Int, [(UINode, [RowNodesPartOfBox])])]
-> Map Int [(UINode, Map Int [(Int, Int)])]
spans [(Int, [(UINode, [RowNodesPartOfBox])])]
zRows :: Map Nesting [(BoxId, (Map X [(Min, Max)]))]
    spansZColumns :: Map Int [(UINode, Map Int [(Int, Int)])]
spansZColumns = [(Int, [(UINode, [RowNodesPartOfBox])])]
-> Map Int [(UINode, Map Int [(Int, Int)])]
spans [(Int, [(UINode, [RowNodesPartOfBox])])]
zColumns :: Map Nesting [(BoxId, (Map X [(Min, Max)]))]
    boxes :: [[(Int, UINode, (Int, Int), (Int, Int))]]
boxes = ((Int, [(UINode, Map Int [(Int, Int)])])
 -> (Int, [(UINode, Map Int [(Int, Int)])])
 -> [(Int, UINode, (Int, Int), (Int, Int))])
-> [(Int, [(UINode, Map Int [(Int, Int)])])]
-> [(Int, [(UINode, Map Int [(Int, Int)])])]
-> [[(Int, UINode, (Int, Int), (Int, Int))]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int, [(UINode, Map Int [(Int, Int)])])
-> (Int, [(UINode, Map Int [(Int, Int)])])
-> [(Int, UINode, (Int, Int), (Int, Int))]
f (Map Int [(UINode, Map Int [(Int, Int)])]
-> [(Int, [(UINode, Map Int [(Int, Int)])])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int [(UINode, Map Int [(Int, Int)])]
spansZRows) (Map Int [(UINode, Map Int [(Int, Int)])]
-> [(Int, [(UINode, Map Int [(Int, Int)])])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int [(UINode, Map Int [(Int, Int)])]
spansZColumns)
    f :: (Nesting, [(BoxId, (Map X [(Min, Max)]))]) -> (Nesting, [(BoxId, (Map X [(Min, Max)]))]) -> [(Nesting, BoxId, (X,X), (Y,Y))]
    f :: (Int, [(UINode, Map Int [(Int, Int)])])
-> (Int, [(UINode, Map Int [(Int, Int)])])
-> [(Int, UINode, (Int, Int), (Int, Int))]
f (Int
nest0, [(UINode, Map Int [(Int, Int)])]
bs0) (Int
nest1, [(UINode, Map Int [(Int, Int)])]
bs1) = [(Int, UINode, (Int, Int), (Int, Int))]
bs
      where bs :: [(Int, UINode, (Int, Int), (Int, Int))]
bs = ((UINode, Map Int [(Int, Int)])
 -> (UINode, Map Int [(Int, Int)])
 -> (Int, UINode, (Int, Int), (Int, Int)))
-> [(UINode, Map Int [(Int, Int)])]
-> [(UINode, Map Int [(Int, Int)])]
-> [(Int, UINode, (Int, Int), (Int, Int))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (UINode, Map Int [(Int, Int)])
-> (UINode, Map Int [(Int, Int)])
-> (Int, UINode, (Int, Int), (Int, Int))
boxMinMax [(UINode, Map Int [(Int, Int)])]
bs0 [(UINode, Map Int [(Int, Int)])]
bs1
            boxMinMax :: (UINode, Map Int [(Int, Int)])
-> (UINode, Map Int [(Int, Int)])
-> (Int, UINode, (Int, Int), (Int, Int))
boxMinMax (UINode
bid0, Map Int [(Int, Int)]
ms0) (UINode
bid1, Map Int [(Int, Int)]
ms1) = (Int
nest0, UINode
bid0, [(Int, Int)] -> (Int, Int)
forall {a} {b}. (Ord a, Ord b) => [(a, b)] -> (a, b)
minmax (((Int, [(Int, Int)]) -> [(Int, Int)])
-> [(Int, [(Int, Int)])] -> [(Int, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, [(Int, Int)]) -> [(Int, Int)]
forall a b. (a, b) -> b
snd (Map Int [(Int, Int)] -> [(Int, [(Int, Int)])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int [(Int, Int)]
ms0)), [(Int, Int)] -> (Int, Int)
forall {a} {b}. (Ord a, Ord b) => [(a, b)] -> (a, b)
minmax (((Int, [(Int, Int)]) -> [(Int, Int)])
-> [(Int, [(Int, Int)])] -> [(Int, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, [(Int, Int)]) -> [(Int, Int)]
forall a b. (a, b) -> b
snd (Map Int [(Int, Int)] -> [(Int, [(Int, Int)])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int [(Int, Int)]
ms1)))
            minmax :: [(a, b)] -> (a, b)
minmax [(a, b)]
mm = ([a] -> a
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((a, b) -> a) -> [(a, b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> a
forall a b. (a, b) -> a
fst [(a, b)]
mm),
                         [b] -> b
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
mm))

-- | Adds windows by changing the border property of every cell by examining the boxID of the cell
subgraphWithWindows :: (NodeClass n, EdgeClass e, ShowGraph n e, VU.Unbox UINode) =>
                   (NestMap, [BoxId]) -> (CGraphL n e, [[UINode]]) -> (CGraphL n e, [[UINode]])
subgraphWithWindows :: forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(NestMap, [UINode])
-> (CGraphL n e, [[UINode]]) -> (CGraphL n e, [[UINode]])
subgraphWithWindows (NestMap
nestedGraphs, [UINode]
boxIds) ((Graph n [e]
graph, Map UINode (Int, Int)
pos, YBlockLines
yblocks), [[UINode]]
layers)
  | [(Int, n)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, n)]
ns = ((Graph n [e]
graph, Map UINode (Int, Int)
pos, YBlockLines
yblocks), [[UINode]]
layers)
  | Bool
otherwise = -- Debug.Trace.trace ("filledGraph " ++ show (filledGraph, newGraph))
    -- Debug.Trace.trace ("\n\nsubgraphWindows ") -- ++ show (graph,pos,newGraph,normalisedPos) ++"\n") -- ++ -- show newGraph ++"\n"++
  --                                      show pos ++"\n"++ show (rows,zRows,spans zRows) ++"\n"++ show (fst columns,zColumns, spans zColumns)) $
--    Debug.Trace.trace ("subgraphWindows newYblocks" ++ show (borders, newBlockNodes, yblocks, newYblocks))
    ((Graph n [e]
newGraph, Map UINode (Int, Int)
normPos, YBlockLines
newYblocks), [[UINode]]
layers)
  where
    newGraph :: Graph n [e]
newGraph =
      (Int -> n -> n) -> Graph n [e] -> Graph n [e]
forall el nl0 nl1.
EdgeAttribute el =>
(Int -> nl0 -> nl1) -> Graph nl0 el -> Graph nl1 el
Graph.mapNodeWithKey
        Int -> n -> n
forall n. (NodeClass n, Show n) => Int -> n -> n
changeNode
        Graph n [e]
filledGraph

    normPos :: Map UINode (Int, Int)
normPos = Map UINode (Int, Int, Maybe UINode) -> Map UINode (Int, Int)
forall k a b c. Map k (a, b, c) -> Map k (a, b)
strip ((Graph n [e], Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(CGraph n e, Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
normalisedPos (Graph n [e]
graph, Map UINode (Int, Int)
pos))
    origPos :: Map UINode (Int, Int)
origPos = Map UINode (Int, Int, Maybe UINode) -> Map UINode (Int, Int)
forall k a b c. Map k (a, b, c) -> Map k (a, b)
strip ((Graph n [e], Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(CGraph n e, Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
originalPos (Graph n [e]
graph, Map UINode (Int, Int)
pos))
    newYblocks :: YBlockLines
newYblocks = Map Int [[(UINode, Int)]] -> YBlockLines
forall k a. Map k a -> [(k, a)]
Map.toList (([[(UINode, Int)]] -> [[(UINode, Int)]] -> [[(UINode, Int)]])
-> Map Int [[(UINode, Int)]]
-> Map Int [[(UINode, Int)]]
-> Map Int [[(UINode, Int)]]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [[(UINode, Int)]] -> [[(UINode, Int)]] -> [[(UINode, Int)]]
f (YBlockLines -> Map Int [[(UINode, Int)]]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList YBlockLines
yblocks) (YBlockLines -> Map Int [[(UINode, Int)]]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (([[(UINode, (Int, Int))]] -> (Int, [[(UINode, Int)]]))
-> [[[(UINode, (Int, Int))]]] -> YBlockLines
forall a b. (a -> b) -> [a] -> [b]
map [[(UINode, (Int, Int))]] -> (Int, [[(UINode, Int)]])
extractY [[[(UINode, (Int, Int))]]]
yblocksWithHorBorders)))

    f :: [[(UINode, X)]] -> [[(UINode, X)]] -> [[(UINode, X)]]
    f :: [[(UINode, Int)]] -> [[(UINode, Int)]] -> [[(UINode, Int)]]
f [[(UINode, Int)]]
blocks0 [[(UINode, Int)]]
blocks1 = ([(UINode, Int)] -> [[(UINode, Int)]] -> [[(UINode, Int)]])
-> [[(UINode, Int)]] -> [[(UINode, Int)]] -> [[(UINode, Int)]]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [(UINode, Int)] -> [[(UINode, Int)]] -> [[(UINode, Int)]]
integrate [[(UINode, Int)]]
blocks1 [[(UINode, Int)]]
blocks0
      where integrate :: [(UINode, X)] -> [[(UINode, X)]] -> [[(UINode, X)]]
            integrate :: [(UINode, Int)] -> [[(UINode, Int)]] -> [[(UINode, Int)]]
integrate [(UINode, Int)]
b0 [[(UINode, Int)]]
blocks | ([(UINode, Int)] -> Bool) -> [[(UINode, Int)]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([(UINode, Int)] -> [(UINode, Int)] -> Bool
oneNodePartOf [(UINode, Int)]
b0) [[(UINode, Int)]]
blocks = [[(UINode, Int)]]
blocks
                                | Bool
otherwise = [(UINode, Int)]
b0 [(UINode, Int)] -> [[(UINode, Int)]] -> [[(UINode, Int)]]
forall a. a -> [a] -> [a]
: [[(UINode, Int)]]
blocks

    oneNodePartOf :: [(UINode, X)] -> [(UINode, X)] -> Bool
    oneNodePartOf :: [(UINode, Int)] -> [(UINode, Int)] -> Bool
oneNodePartOf [(UINode, Int)]
block0 [(UINode, Int)]
block1 = (UINode -> Bool) -> [UINode] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (UINode -> [UINode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [UINode]
nb1) [UINode]
nb0
      where nb0 :: [UINode]
nb0 = ((UINode, Int) -> UINode) -> [(UINode, Int)] -> [UINode]
forall a b. (a -> b) -> [a] -> [b]
map (UINode, Int) -> UINode
forall a b. (a, b) -> a
fst [(UINode, Int)]
block0
            nb1 :: [UINode]
nb1 = ((UINode, Int) -> UINode) -> [(UINode, Int)] -> [UINode]
forall a b. (a -> b) -> [a] -> [b]
map (UINode, Int) -> UINode
forall a b. (a, b) -> a
fst [(UINode, Int)]
block1
    extractY :: [[(UINode, (X,Y))]] -> (Y, [[(UINode, X)]])
    extractY :: [[(UINode, (Int, Int))]] -> (Int, [[(UINode, Int)]])
extractY [[(UINode, (Int, Int))]]
ls = ((Int, Int) -> Int
forall a b. (a, b) -> b
snd ((UINode, (Int, Int)) -> (Int, Int)
forall a b. (a, b) -> b
snd ([(UINode, (Int, Int))] -> (UINode, (Int, Int))
forall a. HasCallStack => [a] -> a
head ([[(UINode, (Int, Int))]] -> [(UINode, (Int, Int))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(UINode, (Int, Int))]]
ls))), ([(UINode, (Int, Int))] -> [(UINode, Int)])
-> [[(UINode, (Int, Int))]] -> [[(UINode, Int)]]
forall a b. (a -> b) -> [a] -> [b]
map (((UINode, (Int, Int)) -> (UINode, Int))
-> [(UINode, (Int, Int))] -> [(UINode, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (UINode, (Int, Int)) -> (UINode, Int)
forall {a} {b} {b}. (a, (b, b)) -> (a, b)
dropY ) [[(UINode, (Int, Int))]]
ls) where dropY :: (a, (b, b)) -> (a, b)
dropY (a
n, (b
x,b
y)) = (a
n,b
x)
    -- The horizontal borders of the box are new yblocks. In javascript the borders also have to be in the same vertical position
    yblocksWithHorBorders :: [[[(UINode, (X,Y))]]]
    yblocksWithHorBorders :: [[[(UINode, (Int, Int))]]]
yblocksWithHorBorders = (([(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]])
-> [[(UINode, (Int, Int))]] -> [[[(UINode, (Int, Int))]]]
forall a b. (a -> b) -> [a] -> [b]
map ([(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]]
continuousRow ([(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]])
-> ([(UINode, (Int, Int))] -> [(UINode, (Int, Int))])
-> [(UINode, (Int, Int))]
-> [[(UINode, (Int, Int))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UINode, (Int, Int)) -> (UINode, (Int, Int)) -> Ordering)
-> [(UINode, (Int, Int))] -> [(UINode, (Int, Int))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (UINode, (Int, Int)) -> (UINode, (Int, Int)) -> Ordering
forall {a} {a} {b} {a} {b}.
Ord a =>
(a, (a, b)) -> (a, (a, b)) -> Ordering
sortx) ([[(UINode, (Int, Int))]] -> [[[(UINode, (Int, Int))]]])
-> ([(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]])
-> [(UINode, (Int, Int))]
-> [[[(UINode, (Int, Int))]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UINode, (Int, Int)) -> (UINode, (Int, Int)) -> Bool)
-> [(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (UINode, (Int, Int)) -> (UINode, (Int, Int)) -> Bool
forall {a} {a} {a} {a} {a}.
Eq a =>
(a, (a, a)) -> (a, (a, a)) -> Bool
groupy ([(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]])
-> ([(UINode, (Int, Int))] -> [(UINode, (Int, Int))])
-> [(UINode, (Int, Int))]
-> [[(UINode, (Int, Int))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UINode, (Int, Int)) -> (UINode, (Int, Int)) -> Ordering)
-> [(UINode, (Int, Int))] -> [(UINode, (Int, Int))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (UINode, (Int, Int)) -> (UINode, (Int, Int)) -> Ordering
forall {a} {a} {a} {a} {a}.
Ord a =>
(a, (a, a)) -> (a, (a, a)) -> Ordering
sorty) [(UINode, (Int, Int))]
newBlockNodes
    continuousRow :: [(UINode, (X, Y))] -> [[(UINode, (X,Y))]]
    continuousRow :: [(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]]
continuousRow [(UINode, (Int, Int))]
row = [(UINode, (Int, Int))]
-> [(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]]
continuous [[(UINode, (Int, Int))] -> (UINode, (Int, Int))
forall a. HasCallStack => [a] -> a
head [(UINode, (Int, Int))]
row] [(UINode, (Int, Int))]
row
    groupy :: (a, (a, a)) -> (a, (a, a)) -> Bool
groupy (a
_,(a
x0,a
y0)) (a
_,(a
x1,a
y1)) = a
y0 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y1
    sortx :: (a, (a, b)) -> (a, (a, b)) -> Ordering
sortx (a
_,(a
x0,b
y0)) (a
_,(a
x1,b
y1)) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x0 a
x1
    sorty :: (a, (a, a)) -> (a, (a, a)) -> Ordering
sorty (a
_,(a
x0,a
y0)) (a
_,(a
x1,a
y1)) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
y0 a
y1

    continuous :: [(UINode, (X,Y))] -> [(UINode, (X,Y))] -> [[(UINode, (X,Y))]]
    continuous :: [(UINode, (Int, Int))]
-> [(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]]
continuous [(UINode, (Int, Int))]
cblock (b0 :: (UINode, (Int, Int))
b0@(UINode
n0,(Int
x0,Int
y0)) : b1 :: (UINode, (Int, Int))
b1@(UINode
n1,(Int
x1,Int
y1)) : [(UINode, (Int, Int))]
rest)
      | Int
x0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x1 = [(UINode, (Int, Int))]
-> [(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]]
continuous ([(UINode, (Int, Int))]
cblock [(UINode, (Int, Int))]
-> [(UINode, (Int, Int))] -> [(UINode, (Int, Int))]
forall a. [a] -> [a] -> [a]
++ [(UINode, (Int, Int))
b1]) ((UINode, (Int, Int))
b1 (UINode, (Int, Int))
-> [(UINode, (Int, Int))] -> [(UINode, (Int, Int))]
forall a. a -> [a] -> [a]
: [(UINode, (Int, Int))]
rest)
      | Bool
otherwise  = [(UINode, (Int, Int))]
cblock [(UINode, (Int, Int))]
-> [[(UINode, (Int, Int))]] -> [[(UINode, (Int, Int))]]
forall a. a -> [a] -> [a]
: ([(UINode, (Int, Int))]
-> [(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]]
continuous [(UINode, (Int, Int))
b1] ((UINode, (Int, Int))
b1 (UINode, (Int, Int))
-> [(UINode, (Int, Int))] -> [(UINode, (Int, Int))]
forall a. a -> [a] -> [a]
: [(UINode, (Int, Int))]
rest))
    continuous [(UINode, (Int, Int))]
cblock [b0 :: (UINode, (Int, Int))
b0@(UINode
n0,(Int
x0,Int
y0))] = [[(UINode, (Int, Int))] -> [(UINode, (Int, Int))]
forall a. HasCallStack => [a] -> [a]
init [(UINode, (Int, Int))]
cblock [(UINode, (Int, Int))]
-> [(UINode, (Int, Int))] -> [(UINode, (Int, Int))]
forall a. [a] -> [a] -> [a]
++ [(UINode, (Int, Int))
b0]]
    continuous [(UINode, (Int, Int))]
cblock [(UINode, (Int, Int))]
_ = [[(UINode, (Int, Int))]
cblock]

    newBlockNodes :: [(UINode, (X,Y))]
    newBlockNodes :: [(UINode, (Int, Int))]
newBlockNodes = [UINode] -> [(Int, Int)] -> [(UINode, (Int, Int))]
forall a b. [a] -> [b] -> [(a, b)]
zip [UINode]
borders ([Maybe (Int, Int)] -> [(Int, Int)]
forall a. [Maybe a] -> [a]
catMaybes ((UINode -> Maybe (Int, Int)) -> [UINode] -> [Maybe (Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\UINode
n -> UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (UINode -> UINode
forall a b. (Integral a, Num b) => a -> b
fromIntegral UINode
n) Map UINode (Int, Int)
origPos) [UINode]
borders)) -- should all be Just values
--    borders :: [(I.Key, n)]
    borders :: [UINode]
borders = ((Int, n) -> UINode) -> [(Int, n)] -> [UINode]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> UINode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UINode) -> ((Int, n) -> Int) -> (Int, n) -> UINode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, n) -> Int
forall a b. (a, b) -> a
fst)
                  (((Int, n) -> Bool) -> [(Int, n)] -> [(Int, n)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (Maybe Border) -> Bool
isHorizontalBorder (Maybe (Maybe Border) -> Bool)
-> ((Int, n) -> Maybe (Maybe Border)) -> (Int, n) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LayerFeatures -> Maybe Border)
-> Maybe LayerFeatures -> Maybe (Maybe Border)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LayerFeatures -> Maybe Border
border (Maybe LayerFeatures -> Maybe (Maybe Border))
-> ((Int, n) -> Maybe LayerFeatures)
-> (Int, n)
-> Maybe (Maybe Border)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Maybe LayerFeatures
forall n. NodeClass n => n -> Maybe LayerFeatures
nestingFeatures (n -> Maybe LayerFeatures)
-> ((Int, n) -> n) -> (Int, n) -> Maybe LayerFeatures
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, n) -> n
forall a b. (a, b) -> b
snd) (IntMap n -> [(Int, n)]
forall a. IntMap a -> [(Int, a)]
I.toList (Graph n [e] -> IntMap n
forall nl el. Graph nl el -> IntMap nl
Graph.nodeLabels Graph n [e]
newGraph)))

    isHorizontalBorder :: Maybe (Maybe Border) -> Bool
isHorizontalBorder (Just (Just Border
TopBorder)) = Bool
True
    isHorizontalBorder (Just (Just Border
LeftTopBorder)) = Bool
True
    isHorizontalBorder (Just (Just Border
RightTopBorder)) = Bool
True
    isHorizontalBorder (Just (Just Border
BottomBorder)) = Bool
True
    isHorizontalBorder (Just (Just Border
LeftBottomBorder)) = Bool
True
    isHorizontalBorder (Just (Just Border
RightBottomBorder)) = Bool
True
    isHorizontalBorder Maybe (Maybe Border)
_ = Bool
False

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

    changeLayer :: (NodeClass n, Show n) => Maybe LayerFeatures -> I.Key -> n -> n
    changeLayer :: forall n.
(NodeClass n, Show n) =>
Maybe LayerFeatures -> Int -> n -> n
changeLayer Maybe LayerFeatures
Nothing Int
n n
node
      | n -> Bool
forall n. NodeClass n => n -> Bool
isArgLabel n
node = -- Debug.Trace.trace ("changeLayer0 " ++ show (n,l,xy)) $ 
                          Maybe LayerFeatures -> n -> n
forall n. NodeClass n => Maybe LayerFeatures -> n -> n
updateLayer ((Int, Maybe UINode, (Span, Span))
-> Maybe LayerFeatures -> Maybe LayerFeatures
changeStyle (Int, Maybe UINode, (Span, Span))
l Maybe LayerFeatures
defaultFeatures) n
node
      | Bool
otherwise =       -- Debug.Trace.trace ("changeLayer1 " ++ show (n,l,xy,changeStyle l defaultFeatures)) $ 
                          Maybe LayerFeatures -> n -> n
forall n. NodeClass n => Maybe LayerFeatures -> n -> n
updateLayer ((Int, Maybe UINode, (Span, Span))
-> Maybe LayerFeatures -> Maybe LayerFeatures
changeStyle (Int, Maybe UINode, (Span, Span))
l Maybe LayerFeatures
defaultFeatures) n
node
      where
        l :: (Int, Maybe UINode, (Span, Span))
l = (Int, Int, Maybe UINode)
-> Map Int [(UINode, Map Int [(Int, Int)])]
-> Map Int [(UINode, Map Int [(Int, Int)])]
-> (Int, Maybe UINode, (Span, Span))
highestLayer (Int, Int, Maybe UINode)
xy Map Int [(UINode, Map Int [(Int, Int)])]
spansZRows Map Int [(UINode, Map Int [(Int, Int)])]
spansZColumns
        xy :: (Int, Int, Maybe UINode)
xy = (Int, Int, Maybe UINode)
-> Maybe (Int, Int, Maybe UINode) -> (Int, Int, Maybe UINode)
forall a. a -> Maybe a -> a
fromMaybe (Int
0, Int
0, Maybe UINode
forall a. Maybe a
Nothing) (UINode
-> Map UINode (Int, Int, Maybe UINode)
-> Maybe (Int, Int, Maybe UINode)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int -> UINode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) ((Graph n [e], Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(CGraph n e, Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
normalisedPos (Graph n [e]
graph, Map UINode (Int, Int)
pos)))
--        _xy2 = fromMaybe (0, 0) (Map.lookup (fromIntegral root) normalisedPos)
--        root = rootOf graph (fromIntegral n)

    changeLayer Maybe LayerFeatures
nestingFeats Int
n n
node
      | n -> Bool
forall n. NodeClass n => n -> Bool
isArgLabel n
node = --Debug.Trace.trace ("changeLayer2 " ++ show xy) $ 
                          Maybe LayerFeatures -> n -> n
forall n. NodeClass n => Maybe LayerFeatures -> n -> n
updateLayer ((Int, Maybe UINode, (Span, Span))
-> Maybe LayerFeatures -> Maybe LayerFeatures
changeStyle (Int, Maybe UINode, (Span, Span))
l (LayerFeatures -> Maybe LayerFeatures
forall a. a -> Maybe a
Just ((Maybe LayerFeatures -> LayerFeatures
forall a. HasCallStack => Maybe a -> a
fromJust Maybe LayerFeatures
nestingFeats) {layer = sel1 l}))) n
node
      | Bool
otherwise =       --Debug.Trace.trace ("changeLayer3 " ++ show xy) $ 
                          Maybe LayerFeatures -> n -> n
forall n. NodeClass n => Maybe LayerFeatures -> n -> n
updateLayer ((Int, Maybe UINode, (Span, Span))
-> Maybe LayerFeatures -> Maybe LayerFeatures
changeStyle (Int, Maybe UINode, (Span, Span))
l Maybe LayerFeatures
nestingFeats) n
node
      where
        l :: (Int, Maybe UINode, (Span, Span))
l = (Int, Int, Maybe UINode)
-> Map Int [(UINode, Map Int [(Int, Int)])]
-> Map Int [(UINode, Map Int [(Int, Int)])]
-> (Int, Maybe UINode, (Span, Span))
highestLayer (Int, Int, Maybe UINode)
xy Map Int [(UINode, Map Int [(Int, Int)])]
spansZRows Map Int [(UINode, Map Int [(Int, Int)])]
spansZColumns
        sel1 :: (a, b, c) -> a
sel1 (a
x,b
y,c
z) = a
x
        xy :: (Int, Int, Maybe UINode)
xy = (Int, Int, Maybe UINode)
-> Maybe (Int, Int, Maybe UINode) -> (Int, Int, Maybe UINode)
forall a. a -> Maybe a -> a
fromMaybe (Int
0, Int
0, Maybe UINode
forall a. Maybe a
Nothing) (UINode
-> Map UINode (Int, Int, Maybe UINode)
-> Maybe (Int, Int, Maybe UINode)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int -> UINode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) ((Graph n [e], Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(CGraph n e, Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
normalisedPos (Graph n [e]
graph, Map UINode (Int, Int)
pos)))

    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
      | Vector UINode -> Bool
forall a. Unbox a => Vector a -> Bool
VU.null Vector UINode
psVert = UINode
node
      | Bool
otherwise = CGraph n e -> UINode -> UINode
forall e n. EdgeClass e => CGraph n e -> UINode -> UINode
rootOf CGraph n e
gr (Int -> Vector UINode -> UINode
forall a. Unbox a => Int -> Vector a -> a
vHead Int
0 Vector UINode
psVert)
      where
        psVert :: Vector UINode
psVert = CGraph n e -> UINode -> Vector UINode
forall e n. EdgeClass e => Graph n [e] -> UINode -> Vector UINode
parentsVertical CGraph n e
gr UINode
node

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

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

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

    filledGraph :: Graph n [e]
filledGraph = [(UINode, n)] -> Graph n [e] -> Graph n [e]
forall el nl.
EdgeAttribute el =>
[(UINode, nl)] -> Graph nl el -> Graph nl el
Graph.insertNodes (((Int, n) -> (UINode, n)) -> [(Int, n)] -> [(UINode, n)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, n) -> (UINode, n)
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) = (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n, b
nl)

    addBoxId :: UINode -> (Any, Any) -> (Any, Any, Maybe UINode)
addBoxId UINode
k (Any
x,Any
y) = (Any
x,Any
y, Maybe UINode
bid)
      where bid :: Maybe UINode
bid = Maybe UINode
-> (LayerFeatures -> Maybe UINode)
-> Maybe LayerFeatures
-> Maybe UINode
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe UINode
forall a. Maybe a
Nothing LayerFeatures -> Maybe UINode
boxId Maybe LayerFeatures
lf :: Maybe BoxId
            lf :: Maybe LayerFeatures
lf = Maybe LayerFeatures
-> (n -> Maybe LayerFeatures) -> Maybe n -> Maybe LayerFeatures
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe LayerFeatures
forall a. Maybe a
Nothing n -> Maybe LayerFeatures
forall n. NodeClass n => n -> Maybe LayerFeatures
nestingFeatures Maybe n
lu :: Maybe LayerFeatures
            lu :: Maybe n
lu = UINode -> Graph n [e] -> Maybe n
forall nl el.
(Show nl, EdgeAttribute el) =>
UINode -> Graph nl el -> Maybe nl
Graph.lookupNode UINode
k Graph n [e]
graph
    newNodes :: [(Int, n)]
newNodes = (Int -> (Int, Int, Maybe UINode) -> (Int, n))
-> [Int] -> [(Int, Int, Maybe UINode)] -> [(Int, n)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> (Int, Int, Maybe UINode) -> (Int, n)
forall {b} {a} {p}. NodeClass b => a -> p -> (a, b)
dNode [(Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ..] [(Int, Int, Maybe UINode)]
holes
    newPos :: Map Integer (Int, Int, Maybe UINode)
newPos = [(Integer, (Int, Int, Maybe UINode))]
-> Map Integer (Int, Int, Maybe UINode)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Integer]
-> [(Int, Int, Maybe UINode)]
-> [(Integer, (Int, Int, Maybe UINode))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int -> Integer) -> [Int] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral [(Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ..]) [(Int, Int, Maybe UINode)]
holes)
    dNode :: a -> p -> (a, b)
dNode a
n p
_ = (a
n, Int -> b
forall n. NodeClass n => Int -> n
dummyNode Int
1)
    m :: Int
m | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Graph n [e] -> [Int]
forall {a} {el}. Graph a el -> [Int]
nodes Graph n [e]
graph)
      | Bool
otherwise = Int
0

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

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

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

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

    rows :: Map Y [UINode]
    rows :: Map Int [UINode]
rows    = CGraphL n e -> Map Int [UINode]
forall n e. CGraphL n e -> Map Int [UINode]
getRows    (Graph n [e]
filledGraph, Map UINode (Int, Int, Maybe UINode) -> Map UINode (Int, Int)
forall k a b c. Map k (a, b, c) -> Map k (a, b)
strip ((Graph n [e], Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(CGraph n e, Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
normalisedPos (Graph n [e]
graph, Map UINode (Int, Int)
pos)), YBlockLines
yblocks)
    columns :: (Map Int [UINode], Map Int ([Column], YBlockLines))
columns = CGraphL n e -> (Map Int [UINode], Map Int ([Column], YBlockLines))
forall e n.
EdgeClass e =>
CGraphL n e -> (Map Int [UINode], Map Int ([Column], YBlockLines))
getColumns (Graph n [e]
filledGraph, Map UINode (Int, Int, Maybe UINode) -> Map UINode (Int, Int)
forall k a b c. Map k (a, b, c) -> Map k (a, b)
strip ((Graph n [e], Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(CGraph n e, Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
normalisedPos (Graph n [e]
graph, Map UINode (Int, Int)
pos)), YBlockLines
yblocks)

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

    spansZRows :: Map Int [(UINode, Map Int [(Int, Int)])]
spansZRows = --Debug.Trace.trace ("zRows\n" ++ show (rows,zRows) ++ "\nspans zRows\n" ++ show (spans zRows) ++ 
                 --                   "\nzColumns\n" ++ show (fst columns, zColumns) ++ "\nspans zColumns\n" ++ show (spans zColumns)) $
                    [(Int, [(UINode, [RowNodesPartOfBox])])]
-> Map Int [(UINode, Map Int [(Int, Int)])]
spans [(Int, [(UINode, [RowNodesPartOfBox])])]
zRows
    spansZColumns :: Map Int [(UINode, Map Int [(Int, Int)])]
spansZColumns = [(Int, [(UINode, [RowNodesPartOfBox])])]
-> Map Int [(UINode, Map Int [(Int, Int)])]
spans [(Int, [(UINode, [RowNodesPartOfBox])])]
zColumns

    zRows :: [(Nesting, [(BoxId, [RowNodesPartOfBox])])]
    zRows :: [(Int, [(UINode, [RowNodesPartOfBox])])]
zRows    = Graph n [e]
-> NestMap -> [Column] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
CGraph n e
-> NestMap -> [Column] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
zLayers Graph n [e]
graph NestMap
nestedGraphs (Map Int [UINode] -> [Column]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int [UINode]
rows)
    zColumns :: [(Int, [(UINode, [RowNodesPartOfBox])])]
zColumns = Graph n [e]
-> NestMap -> [Column] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
CGraph n e
-> NestMap -> [Column] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
zLayers Graph n [e]
graph NestMap
nestedGraphs (Map Int [UINode] -> [Column]
forall k a. Map k a -> [(k, a)]
Map.toList ((Map Int [UINode], Map Int ([Column], YBlockLines))
-> Map Int [UINode]
forall a b. (a, b) -> a
fst (Map Int [UINode], Map Int ([Column], YBlockLines))
columns))

--------------------------------------------------------------------------------------------

    highestLayer ::
      (X, Y, Maybe BoxId) ->
      Map Nesting [(BoxId, Map X [(Min, Max)])] ->
      Map Nesting [(BoxId, Map X [(Min, Max)])] ->
      (Nesting, Maybe BoxId, (Span, Span))
    highestLayer :: (Int, Int, Maybe UINode)
-> Map Int [(UINode, Map Int [(Int, Int)])]
-> Map Int [(UINode, Map Int [(Int, Int)])]
-> (Int, Maybe UINode, (Span, Span))
highestLayer (Int
x, Int
y, Maybe UINode
bid) Map Int [(UINode, Map Int [(Int, Int)])]
hrows Map Int [(UINode, Map Int [(Int, Int)])]
cols = -- Debug.Trace.trace ("highestLayer " ++ show ((x,y,bid))) $
                                          Int -> (Int, Maybe UINode, (Span, Span))
findFirstWindow Int
maxZCoord
      where
        findFirstWindow :: Int -> (Int, Maybe UINode, (Span, Span))
findFirstWindow Int
0 = (Int
0, Maybe UINode
bid, (Span
SpanOutside, Span
SpanOutside))
        findFirstWindow Int
z
          | Span -> Span -> Bool
found Span
chead Span
rhead = (Int
z, Maybe UINode
bid, (Span
chead, Span
rhead))
          | Bool
otherwise = Int -> (Int, Maybe UINode, (Span, Span))
findFirstWindow (Int
z Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          where
            c :: [Span]
c = (Span -> Bool) -> [Span] -> [Span]
forall a. (a -> Bool) -> [a] -> [a]
filter (Span -> Span -> Bool
forall a. Eq a => a -> a -> Bool
/= Span
SpanOutside) (((UINode, Map Int [(Int, Int)]) -> Span)
-> [(UINode, Map Int [(Int, Int)])] -> [Span]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int) -> Bool -> Map Int [(Int, Int)] -> Span
overlappedByNeighbouringSpans (Int
x, Int
y) Bool
True (Map Int [(Int, Int)] -> Span)
-> ((UINode, Map Int [(Int, Int)]) -> Map Int [(Int, Int)])
-> (UINode, Map Int [(Int, Int)])
-> Span
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UINode, Map Int [(Int, Int)]) -> Map Int [(Int, Int)]
forall a b. (a, b) -> b
snd) [(UINode, Map Int [(Int, Int)])]
layerCols)
            r :: [Span]
r = (Span -> Bool) -> [Span] -> [Span]
forall a. (a -> Bool) -> [a] -> [a]
filter (Span -> Span -> Bool
forall a. Eq a => a -> a -> Bool
/= Span
SpanOutside) (((UINode, Map Int [(Int, Int)]) -> Span)
-> [(UINode, Map Int [(Int, Int)])] -> [Span]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int) -> Bool -> Map Int [(Int, Int)] -> Span
overlappedByNeighbouringSpans (Int
x, Int
y) Bool
False (Map Int [(Int, Int)] -> Span)
-> ((UINode, Map Int [(Int, Int)]) -> Map Int [(Int, Int)])
-> (UINode, Map Int [(Int, Int)])
-> Span
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UINode, Map Int [(Int, Int)]) -> Map Int [(Int, Int)]
forall a b. (a, b) -> b
snd) [(UINode, Map Int [(Int, Int)])]
layerRows)
            chead :: Span
chead | [Span] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Span]
c = Span
SpanOutside
                  | Bool
otherwise = [Span] -> Span
forall a. HasCallStack => [a] -> a
head [Span]
c
            rhead :: Span
rhead | [Span] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Span]
r = Span
SpanOutside
                  | Bool
otherwise = [Span] -> Span
forall a. HasCallStack => [a] -> a
head [Span]
r
            layerCols :: [(UINode, Map Int [(Int, Int)])]
layerCols = -- Debug.Trace.trace ("layerCols " ++ show (Map.lookup z cols)) $
                        [(UINode, Map Int [(Int, Int)])]
-> Maybe [(UINode, Map Int [(Int, Int)])]
-> [(UINode, Map Int [(Int, Int)])]
forall a. a -> Maybe a -> a
fromMaybe [] (Int
-> Map Int [(UINode, Map Int [(Int, Int)])]
-> Maybe [(UINode, Map Int [(Int, Int)])]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
z Map Int [(UINode, Map Int [(Int, Int)])]
cols)
            layerRows :: [(UINode, Map Int [(Int, Int)])]
layerRows = -- Debug.Trace.trace ("layerRows " ++ show (Map.lookup z hrows))
                        [(UINode, Map Int [(Int, Int)])]
-> Maybe [(UINode, Map Int [(Int, Int)])]
-> [(UINode, Map Int [(Int, Int)])]
forall a. a -> Maybe a -> a
fromMaybe [] (Int
-> Map Int [(UINode, Map Int [(Int, Int)])]
-> Maybe [(UINode, Map Int [(Int, Int)])]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
z Map Int [(UINode, 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 = -- Debug.Trace.trace (show ("overlappedByNeighbouringSpans col",(x,y),nspans, minmax spansCol, maybe SpanOutside spanPositionColumn (minmax spansCol)))
                                     (Span -> ((Int, Int) -> Span) -> Maybe (Int, Int) -> Span
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Span
SpanOutside (Int, Int) -> Span
spanPositionColumn ([(Int, Int)] -> Maybe (Int, Int)
forall {a} {b}. (Ord a, Ord b) => [(a, b)] -> Maybe (a, b)
minmax [(Int, Int)]
spansCol))
      | Bool
otherwise = -- Debug.Trace.trace (show ("overlappedByNeighbouringSpans row",(x,y),nspans, minmax spansRow, maybe SpanOutside spanPositionRow (minmax spansRow)))
                    Span -> ((Int, Int) -> Span) -> Maybe (Int, Int) -> Span
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Span
SpanOutside (Int, Int) -> Span
spanPositionRow ([(Int, Int)] -> Maybe (Int, Int)
forall {a} {b}. (Ord a, Ord b) => [(a, b)] -> Maybe (a, b)
minmax [(Int, Int)]
spansRow)
      where
        spanPositionColumn :: (Int, Int) -> Span
spanPositionColumn (Int
smin, Int
smax)
          | Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
smin = Span
SpanRightBorder
          | Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
smax = Span
SpanLeftBorder
          | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
smin Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
smin = Span
SpanLeftBorder
          | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
smax = Span
SpanRightBorder
          | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
smin Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
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
          | [(a, b)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, b)]
xs = Maybe (a, b)
forall a. Maybe a
Nothing
          | Bool
otherwise = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just ([a] -> a
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((a, b) -> a) -> [(a, b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> a
forall a b. (a, b) -> a
fst [(a, b)]
xs), [b] -> b
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
xs))

        goLeft :: Int -> [(Int, Int)]
goLeft Int
p
          | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = [(Int, Int)]
mm [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ Int -> [(Int, Int)]
goLeft (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          | Bool
otherwise = [(Int, Int)]
mm
          where
            mm :: [(Int, Int)]
mm = [(Int, Int)] -> Maybe [(Int, Int)] -> [(Int, Int)]
forall a. a -> Maybe a -> a
fromMaybe [] (Int -> Map Int [(Int, Int)] -> Maybe [(Int, Int)]
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
          | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Map Int [(Int, Int)] -> Int
forall k a. Map k a -> Int
Map.size Map Int [(Int, Int)]
nspans = [(Int, Int)]
mm [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ Int -> [(Int, Int)]
goRight (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          | Bool
otherwise = [(Int, Int)]
mm
          where
            mm :: [(Int, Int)]
mm = [(Int, Int)] -> Maybe [(Int, Int)] -> [(Int, Int)]
forall a. a -> Maybe a -> a
fromMaybe [] (Int -> Map Int [(Int, Int)] -> Maybe [(Int, Int)]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
p Map Int [(Int, Int)]
nspans)

{-
        goLeft p
          | null mm = mm
          | otherwise = mm ++ goLeft (p - 1)
          where
            mm = fromMaybe [] (Map.lookup p nspans)

        goRight p
          | null mm = mm
          | otherwise = mm ++ goRight (p + 1)
          where
            mm = fromMaybe [] (Map.lookup p nspans)
-}
        spansCol :: [(Int, Int)]
spansCol = Int -> [(Int, Int)]
goLeft Int
x [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ Int -> [(Int, Int)]
goRight (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        spansRow :: [(Int, Int)]
spansRow = Int -> [(Int, Int)]
goLeft Int
y [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ Int -> [(Int, Int)]
goRight (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)


strip :: Map k (a, b, c) -> Map k (a, b)
strip :: forall k a b c. Map k (a, b, c) -> Map k (a, b)
strip Map k (a, b, c)
m = ((a, b, c) -> (a, b)) -> Map k (a, b, c) -> Map k (a, b)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(a
x, b
y, c
bid) -> (a
x, b
y)) Map k (a, b, c)
m

originalPos :: (NodeClass n, EdgeClass e, ShowGraph n e, VU.Unbox UINode) =>
                 (CGraph n e, Map UINode (X, Y)) -> Map UINode (X, Y, Maybe BoxId)
originalPos :: forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(CGraph n e, Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
originalPos (CGraph n e
graph, Map UINode (Int, Int)
pos) = ((Int, Int, Maybe UINode) -> (Int, Int, Maybe UINode))
-> Map UINode (Int, Int, Maybe UINode)
-> Map UINode (Int, Int, Maybe UINode)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(Int
x, Int
y, Maybe UINode
bid) -> (Int
x, Int
y, Maybe UINode
bid)) (Map UINode (Int, Int, Maybe UINode)
-> Map UINode (Int, Int, Maybe UINode)
-> Map UINode (Int, Int, Maybe UINode)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ((UINode -> (Int, Int) -> (Int, Int, Maybe UINode))
-> Map UINode (Int, Int) -> Map UINode (Int, Int, Maybe UINode)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey UINode -> (Int, Int) -> (Int, Int, Maybe UINode)
addBoxId Map UINode (Int, Int)
pos) Map UINode (Int, Int, Maybe UINode)
newPos)
  where
    minX :: Int
minX | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
         | Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
nodePositions)
    minY :: Int
minY | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
         | Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd [(Int, Int)]
nodePositions)
    maxX :: Int
maxX | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
         | Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
nodePositions)
    maxY :: Int
maxY | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
         | Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd [(Int, Int)]
nodePositions)

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

    addBoxId :: UINode -> (Int, Int) -> (Int, Int, Maybe UINode)
addBoxId UINode
k (Int
x,Int
y) = (Int
x,Int
y, Maybe UINode
bid)
      where bid :: Maybe UINode
bid = Maybe UINode
-> (LayerFeatures -> Maybe UINode)
-> Maybe LayerFeatures
-> Maybe UINode
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe UINode
forall a. Maybe a
Nothing LayerFeatures -> Maybe UINode
boxId Maybe LayerFeatures
lf :: Maybe BoxId
            lf :: Maybe LayerFeatures
lf = Maybe LayerFeatures
-> (n -> Maybe LayerFeatures) -> Maybe n -> Maybe LayerFeatures
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe LayerFeatures
forall a. Maybe a
Nothing n -> Maybe LayerFeatures
forall n. NodeClass n => n -> Maybe LayerFeatures
nestingFeatures Maybe n
lu :: Maybe LayerFeatures
            lu :: Maybe n
lu = UINode -> CGraph n e -> Maybe n
forall nl el.
(Show nl, EdgeAttribute el) =>
UINode -> Graph nl el -> Maybe nl
Graph.lookupNode UINode
k CGraph n e
graph

    newPos :: Map UINode (Int, Int, Maybe UINode)
newPos = [(UINode, (Int, Int, Maybe UINode))]
-> Map UINode (Int, Int, Maybe UINode)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([UINode]
-> [(Int, Int, Maybe UINode)]
-> [(UINode, (Int, Int, Maybe UINode))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int -> UINode) -> [Int] -> [UINode]
forall a b. (a -> b) -> [a] -> [b]
map Int -> UINode
forall a b. (Integral a, Num b) => a -> b
fromIntegral [(Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ..]) [(Int, Int, Maybe UINode)]
holes)

    m :: Int
m | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (CGraph n e -> [Int]
forall {a} {el}. Graph a el -> [Int]
nodes CGraph n e
graph)
      | Bool
otherwise = Int
0

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

normalisedPos :: (NodeClass n, EdgeClass e, ShowGraph n e, VU.Unbox UINode) =>
                 (CGraph n e, Map UINode (X, Y)) -> Map UINode (X, Y, Maybe BoxId)
normalisedPos :: forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(CGraph n e, Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
normalisedPos (CGraph n e
graph, Map UINode (Int, Int)
pos) = ((Int, Int, Maybe UINode) -> (Int, Int, Maybe UINode))
-> Map UINode (Int, Int, Maybe UINode)
-> Map UINode (Int, Int, Maybe UINode)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(Int
x, Int
y, Maybe UINode
bid) -> (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
minX, Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
minY, Maybe UINode
bid)) (Map UINode (Int, Int, Maybe UINode)
-> Map UINode (Int, Int, Maybe UINode)
-> Map UINode (Int, Int, Maybe UINode)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ((UINode -> (Int, Int) -> (Int, Int, Maybe UINode))
-> Map UINode (Int, Int) -> Map UINode (Int, Int, Maybe UINode)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey UINode -> (Int, Int) -> (Int, Int, Maybe UINode)
addBoxId Map UINode (Int, Int)
pos) Map UINode (Int, Int, Maybe UINode)
newPos)
  where
    minX :: Int
minX | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
         | Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
nodePositions)
    minY :: Int
minY | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
         | Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd [(Int, Int)]
nodePositions)
    maxX :: Int
maxX | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
         | Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
nodePositions)
    maxY :: Int
maxY | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
         | Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd [(Int, Int)]
nodePositions)

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

    addBoxId :: UINode -> (Int, Int) -> (Int, Int, Maybe UINode)
addBoxId UINode
k (Int
x,Int
y) = (Int
x,Int
y, Maybe UINode
bid)
      where bid :: Maybe UINode
bid = Maybe UINode
-> (LayerFeatures -> Maybe UINode)
-> Maybe LayerFeatures
-> Maybe UINode
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe UINode
forall a. Maybe a
Nothing LayerFeatures -> Maybe UINode
boxId Maybe LayerFeatures
lf :: Maybe BoxId
            lf :: Maybe LayerFeatures
lf = Maybe LayerFeatures
-> (n -> Maybe LayerFeatures) -> Maybe n -> Maybe LayerFeatures
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe LayerFeatures
forall a. Maybe a
Nothing n -> Maybe LayerFeatures
forall n. NodeClass n => n -> Maybe LayerFeatures
nestingFeatures Maybe n
lu :: Maybe LayerFeatures
            lu :: Maybe n
lu = UINode -> CGraph n e -> Maybe n
forall nl el.
(Show nl, EdgeAttribute el) =>
UINode -> Graph nl el -> Maybe nl
Graph.lookupNode UINode
k CGraph n e
graph

    newPos :: Map UINode (Int, Int, Maybe UINode)
newPos = [(UINode, (Int, Int, Maybe UINode))]
-> Map UINode (Int, Int, Maybe UINode)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([UINode]
-> [(Int, Int, Maybe UINode)]
-> [(UINode, (Int, Int, Maybe UINode))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int -> UINode) -> [Int] -> [UINode]
forall a b. (a -> b) -> [a] -> [b]
map Int -> UINode
forall a b. (Integral a, Num b) => a -> b
fromIntegral [(Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ..]) [(Int, Int, Maybe UINode)]
holes)

    m :: Int
m | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (CGraph n e -> [Int]
forall {a} {el}. Graph a el -> [Int]
nodes CGraph n e
graph)
      | Bool
otherwise = Int
0

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


-- In every z-layer there can be several boxes
-- first we draw the big boxes in the 1-layer (0-layer is the unboxed graph) and the more embedded ones on top (2..maxZCoord)
zLayers :: (NodeClass n, EdgeClass e, ShowGraph n e, VU.Unbox UINode) =>
           CGraph n e -> NestMap -> [(X, [UINode])] -> [(Nesting, [(BoxId, [RowNodesPartOfBox])])]
zLayers :: forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
CGraph n e
-> NestMap -> [Column] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
zLayers CGraph n e
graph NestMap
nestedGraphs [Column]
xs = (Int -> (Int, [(UINode, [RowNodesPartOfBox])]))
-> [Int] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
forall a b. (a -> b) -> [a] -> [b]
map Int -> (Int, [(UINode, [RowNodesPartOfBox])])
getLayer ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int
1 .. Int
maxZCoord])
  where
    getLayer :: Nesting -> (Nesting, [(BoxId, [RowNodesPartOfBox])])
    getLayer :: Int -> (Int, [(UINode, [RowNodesPartOfBox])])
getLayer Int
z = -- Debug.Trace.trace ("zLayers " ++ show (z, maybe [] (map nodesPartOfBox) boxesOfLayerZ)) $
                 (Int
z, [(UINode, [RowNodesPartOfBox])]
-> ([UINode] -> [(UINode, [RowNodesPartOfBox])])
-> Maybe [UINode]
-> [(UINode, [RowNodesPartOfBox])]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((UINode -> (UINode, [RowNodesPartOfBox]))
-> [UINode] -> [(UINode, [RowNodesPartOfBox])]
forall a b. (a -> b) -> [a] -> [b]
map UINode -> (UINode, [RowNodesPartOfBox])
nodesPartOfBox) Maybe [UINode]
boxesOfLayerZ)
      where
        boxesOfLayerZ :: Maybe [BoxId]
        boxesOfLayerZ :: Maybe [UINode]
boxesOfLayerZ = (Set UINode -> [UINode]) -> Maybe (Set UINode) -> Maybe [UINode]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Set UINode -> [UINode]
forall a. Set a -> [a]
Set.toList (Int -> NestMap -> Maybe (Set UINode)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
z NestMap
nestedGraphs)
        nodesPartOfBox :: BoxId -> (BoxId, [RowNodesPartOfBox])
        nodesPartOfBox :: UINode -> (UINode, [RowNodesPartOfBox])
nodesPartOfBox UINode
bid = (UINode
bid, (Column -> RowNodesPartOfBox) -> [Column] -> [RowNodesPartOfBox]
forall a b. (a -> b) -> [a] -> [b]
map Column -> RowNodesPartOfBox
rowCol [Column]
xs)
          where
            rowCol :: (X, [UINode]) -> RowNodesPartOfBox
            rowCol :: Column -> RowNodesPartOfBox
rowCol (Int
x, [UINode]
ns) = -- Debug.Trace.trace ("zLayers " ++ show (z, x, map zBoxId ns, map lu ns)) $
                             (Int
x, (UINode -> Bool) -> [UINode] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map UINode -> Bool
zBoxId [UINode]
ns)
              where
                lu :: UINode -> (UINode, Maybe n)
lu UINode
n = (UINode
n, UINode -> CGraph n e -> Maybe n
forall nl el.
(Show nl, EdgeAttribute el) =>
UINode -> Graph nl el -> Maybe nl
Graph.lookupNode UINode
n CGraph n e
graph)

            zBoxId :: UINode -> Bool
            zBoxId :: UINode -> Bool
zBoxId UINode
n = -- Debug.Trace.trace ("zBoxId " ++ show (z,n,boxIdOfNode,bid,boxIdOfNode == Just bid,lu)) $
                       Maybe UINode
boxIdOfNode Maybe UINode -> Maybe UINode -> Bool
forall a. Eq a => a -> a -> Bool
== UINode -> Maybe UINode
forall a. a -> Maybe a
Just UINode
bid
              where
                lu :: Maybe n
lu = UINode -> CGraph n e -> Maybe n
forall nl el.
(Show nl, EdgeAttribute el) =>
UINode -> Graph nl el -> Maybe nl
Graph.lookupNode UINode
n CGraph n e
graph
                b :: Maybe LayerFeatures
b = Maybe LayerFeatures
-> (n -> Maybe LayerFeatures) -> Maybe n -> Maybe LayerFeatures
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe LayerFeatures
forall a. Maybe a
Nothing n -> Maybe LayerFeatures
forall n. NodeClass n => n -> Maybe LayerFeatures
nestingFeatures Maybe n
lu
                boxIdOfNode :: Maybe UINode
boxIdOfNode = Maybe UINode
-> (LayerFeatures -> Maybe UINode)
-> Maybe LayerFeatures
-> Maybe UINode
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe UINode
forall a. Maybe a
Nothing LayerFeatures -> Maybe UINode
boxId Maybe LayerFeatures
b

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

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

spans :: [(Nesting, [(BoxId, [RowNodesPartOfBox])])] -> Map Nesting [(BoxId, (Map X [(Min, Max)]))]
spans :: [(Int, [(UINode, [RowNodesPartOfBox])])]
-> Map Int [(UINode, Map Int [(Int, Int)])]
spans [(Int, [(UINode, [RowNodesPartOfBox])])]
ls = [(Int, [(UINode, Map Int [(Int, Int)])])]
-> Map Int [(UINode, Map Int [(Int, Int)])]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (((Int, [(UINode, [RowNodesPartOfBox])])
 -> (Int, [(UINode, Map Int [(Int, Int)])]))
-> [(Int, [(UINode, [RowNodesPartOfBox])])]
-> [(Int, [(UINode, Map Int [(Int, Int)])])]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [(UINode, [RowNodesPartOfBox])])
-> (Int, [(UINode, Map Int [(Int, Int)])])
zSpans [(Int, [(UINode, [RowNodesPartOfBox])])]
ls)
  where
    zSpans :: (Nesting, [(BoxId, [RowNodesPartOfBox])]) -> (Nesting, [(BoxId, Map X [(Min, Max)])])
    zSpans :: (Int, [(UINode, [RowNodesPartOfBox])])
-> (Int, [(UINode, Map Int [(Int, Int)])])
zSpans (Int
z, [(UINode, [RowNodesPartOfBox])]
bs) = (Int
z, ((UINode, [RowNodesPartOfBox]) -> (UINode, Map Int [(Int, Int)]))
-> [(UINode, [RowNodesPartOfBox])]
-> [(UINode, Map Int [(Int, Int)])]
forall a b. (a -> b) -> [a] -> [b]
map (UINode, [RowNodesPartOfBox]) -> (UINode, Map Int [(Int, Int)])
box [(UINode, [RowNodesPartOfBox])]
bs)
      where
        box :: (BoxId, [RowNodesPartOfBox]) -> (BoxId, Map X [(Min, Max)])
        box :: (UINode, [RowNodesPartOfBox]) -> (UINode, Map Int [(Int, Int)])
box (UINode
b, [RowNodesPartOfBox]
rowNodes) = (UINode
b, [(Int, [(Int, Int)])] -> Map Int [(Int, Int)]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((RowNodesPartOfBox -> (Int, [(Int, Int)]))
-> [RowNodesPartOfBox] -> [(Int, [(Int, Int)])]
forall a b. (a -> b) -> [a] -> [b]
map RowNodesPartOfBox -> (Int, [(Int, Int)])
rowsColums [RowNodesPartOfBox]
rowNodes))
        rowsColums :: (X, [Bool]) -> (X, [(Min, Max)])
        rowsColums :: RowNodesPartOfBox -> (Int, [(Int, Int)])
rowsColums (Int
x, [Bool]
nodePartOfBox) = -- Debug.Trace.trace (show ("boxids", boxids, bis, map minmax bis)) 
                                        (Int
x, ([(Int, Bool)] -> (Int, Int)) -> [[(Int, Bool)]] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map [(Int, Bool)] -> (Int, Int)
minmax [[(Int, Bool)]]
fbis)
          where minmax :: [(Int, Bool)] -> (Min,Max)
                minmax :: [(Int, Bool)] -> (Int, Int)
minmax [(Int, Bool)]
group = ((Int, Bool) -> Int
forall a b. (a, b) -> a
fst ([(Int, Bool)] -> (Int, Bool)
forall a. HasCallStack => [a] -> a
head [(Int, Bool)]
group), (Int, Bool) -> Int
forall a b. (a, b) -> a
fst ([(Int, Bool)] -> (Int, Bool)
forall a. HasCallStack => [a] -> a
last [(Int, Bool)]
group))
                bis :: [[(Int, Bool)]]
                bis :: [[(Int, Bool)]]
bis = ((Int, Bool) -> (Int, Bool) -> Bool)
-> [(Int, Bool)] -> [[(Int, Bool)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Int, Bool) -> (Int, Bool) -> Bool
forall {a} {a} {a}. Eq a => (a, a) -> (a, a) -> Bool
sec ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Bool]
nodePartOfBox)
                fbis :: [[(Int, Bool)]]
                fbis :: [[(Int, Bool)]]
fbis = ([(Int, Bool)] -> Bool) -> [[(Int, Bool)]] -> [[(Int, Bool)]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([(Int, Bool)] -> Bool) -> [(Int, Bool)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Bool)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (([(Int, Bool)] -> [(Int, Bool)])
-> [[(Int, Bool)]] -> [[(Int, Bool)]]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, Bool) -> Bool) -> [(Int, Bool)] -> [(Int, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int, Bool) -> Bool
forall a b. (a, b) -> b
snd) [[(Int, Bool)]]
bis)
                sec :: (a, a) -> (a, a) -> Bool
sec (a
_,a
a) (a
_,a
b) = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b

-- | To be able to jump vertically between nodes in an interactive ui
getColumns :: EdgeClass e => CGraphL n e -> (Map X [UINode], Map.Map Int ([Column], YBlockLines))
getColumns :: forall e n.
EdgeClass e =>
CGraphL n e -> (Map Int [UINode], Map Int ([Column], YBlockLines))
getColumns (Graph n [e]
gr, Map UINode (Int, Int)
m, YBlockLines
yblocks) = -- Debug.Trace.trace ("(zip tables yblocksOfTables)" ++ show (zip tables yblocksOfTables)) $
                              ([Column] -> Map Int [UINode]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [Column]
cols, [(Int, ([Column], YBlockLines))] -> Map Int ([Column], YBlockLines)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Int]
-> [([Column], YBlockLines)] -> [(Int, ([Column], YBlockLines))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] ([[Column]] -> [YBlockLines] -> [([Column], YBlockLines)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Column]]
tables [YBlockLines]
yblocksOfTablesAdj)))
  where
    srt :: [UINode] -> [[UINode]]
srt = ([UINode] -> [UINode]) -> [[UINode]] -> [[UINode]]
forall a b. (a -> b) -> [a] -> [b]
map ((UINode -> UINode -> Ordering) -> [UINode] -> [UINode]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy UINode -> UINode -> Ordering
sorty) ([[UINode]] -> [[UINode]])
-> ([UINode] -> [[UINode]]) -> [UINode] -> [[UINode]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UINode -> UINode -> Bool) -> [UINode] -> [[UINode]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy UINode -> UINode -> Bool
groupx ([UINode] -> [[UINode]])
-> ([UINode] -> [UINode]) -> [UINode] -> [[UINode]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UINode -> UINode -> Ordering) -> [UINode] -> [UINode]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy UINode -> UINode -> Ordering
sortx
    cols :: [Column]
cols = ([UINode] -> Column) -> [[UINode]] -> [Column]
forall a b. (a -> b) -> [a] -> [b]
map [UINode] -> Column
tupleWithX ( [UINode] -> [[UINode]]
srt ((Int -> UINode) -> [Int] -> [UINode]
forall a b. (a -> b) -> [a] -> [b]
map Int -> UINode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Graph n [e] -> [Int]
forall {a} {el}. Graph a el -> [Int]
Graph.nodes Graph n [e]
gr)) )
    tupleWithX :: [UINode] -> (X, [UINode])
    tupleWithX :: [UINode] -> Column
tupleWithX [UINode]
ls = (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> a
fst (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int -> [UINode] -> UINode
forall a. Int -> [a] -> a
myHead Int
78 [UINode]
ls) Map UINode (Int, Int)
m), [UINode]
ls)
    groupx :: UINode -> UINode -> Bool
groupx UINode
n0 UINode
n1 = Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> a
fst (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n0 Map UINode (Int, Int)
m) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> a
fst (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n1 Map UINode (Int, Int)
m)
    sortx :: UINode -> UINode -> Ordering
sortx UINode
n0 UINode
n1 = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> a
fst (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n0 Map UINode (Int, Int)
m)) (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> a
fst (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n1 Map UINode (Int, Int)
m))
    sorty :: UINode -> UINode -> Ordering
sorty UINode
n0 UINode
n1 = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> b
snd (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n0 Map UINode (Int, Int)
m)) (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> b
snd (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n1 Map UINode (Int, Int)
m))

    tables :: [[Column]]
tables = [Column] -> [[Column]]
divideTables [Column]
cols

    yblocksOfTablesAdj :: [YBlockLines]
yblocksOfTablesAdj = (YBlockLines -> YBlockLines) -> [YBlockLines] -> [YBlockLines]
forall a b. (a -> b) -> [a] -> [b]
map YBlockLines -> YBlockLines
adjustTable [YBlockLines]
yblocksOfTables
    adjustTable :: YBlockLines -> YBlockLines
    adjustTable :: YBlockLines -> YBlockLines
adjustTable YBlockLines
table = ((Int, [[(UINode, Int)]]) -> (Int, [[(UINode, Int)]]))
-> YBlockLines -> YBlockLines
forall a b. (a -> b) -> [a] -> [b]
map (Int, [[(UINode, Int)]]) -> (Int, [[(UINode, Int)]])
adjustLine YBlockLines
table
      where adjustLine :: YBlocks -> YBlocks
            adjustLine :: (Int, [[(UINode, Int)]]) -> (Int, [[(UINode, Int)]])
adjustLine (Int
y,[[(UINode, Int)]]
line) = (Int
y, ([(UINode, Int)] -> [(UINode, Int)])
-> [[(UINode, Int)]] -> [[(UINode, Int)]]
forall a b. (a -> b) -> [a] -> [b]
map [(UINode, Int)] -> [(UINode, Int)]
forall {a}. [(a, Int)] -> [(a, Int)]
adjustBlock [[(UINode, Int)]]
line)
            adjustBlock :: [(a, Int)] -> [(a, Int)]
adjustBlock [(a, Int)]
block = ((a, Int) -> (a, Int)) -> [(a, Int)] -> [(a, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (a, Int) -> (a, Int)
forall {a}. (a, Int) -> (a, Int)
node [(a, Int)]
block
            node :: (a, Int) -> (a, Int)
node (a
n,Int
x) = (a
n,Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lowestX)
    lowestX :: Int
lowestX = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((UINode, Int) -> Int) -> [(UINode, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (UINode, Int) -> Int
forall a b. (a, b) -> b
snd ([[(UINode, Int)]] -> [(UINode, Int)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[(UINode, Int)]]] -> [[(UINode, Int)]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[[(UINode, Int)]]]] -> [[[(UINode, Int)]]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((YBlockLines -> [[[(UINode, Int)]]])
-> [YBlockLines] -> [[[[(UINode, Int)]]]]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, [[(UINode, Int)]]) -> [[(UINode, Int)]])
-> YBlockLines -> [[[(UINode, Int)]]]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [[(UINode, Int)]]) -> [[(UINode, Int)]]
forall a b. (a, b) -> b
snd) [YBlockLines]
yblocksOfTables)))))
    yblocksOfTables :: [YBlockLines]
    yblocksOfTables :: [YBlockLines]
yblocksOfTables = (YBlockLines, [YBlockLines]) -> [YBlockLines]
forall a b. (a, b) -> b
snd (([Column]
 -> (YBlockLines, [YBlockLines]) -> (YBlockLines, [YBlockLines]))
-> (YBlockLines, [YBlockLines])
-> [[Column]]
-> (YBlockLines, [YBlockLines])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Column]
-> (YBlockLines, [YBlockLines]) -> (YBlockLines, [YBlockLines])
blocksOfTable (YBlockLines
yblocks,[]) [[Column]]
tables)

    -- There can be several graphs on the screen that are connected with separating edges
    divideTables :: [Column] -> [[Column]]
    divideTables :: [Column] -> [[Column]]
divideTables [] = []
    divideTables [Column]
layers = [Column]
layersWithoutSep [Column] -> [[Column]] -> [[Column]]
forall a. a -> [a] -> [a]
: [Column] -> [[Column]]
divideTables [Column]
rest
      where
        ([Column]
layersWithoutSep, [Column]
rest) = ([Column], [Column]) -> ([Column], [Column])
sumLayers ([], [Column]
layers)

        sumLayers :: ([Column], [Column]) -> ([Column], [Column]) -- type Column = (GraphMoveX, [UINode])
        sumLayers :: ([Column], [Column]) -> ([Column], [Column])
sumLayers ([Column]
s, []) = ([Column]
s, [])
        sumLayers ([Column]
s, Column
l : [Column]
ls)
          | [UINode] -> Bool
containsSeparatingEdge (Column -> [UINode]
forall a b. (a, b) -> b
snd Column
l) = ([Column]
s [Column] -> [Column] -> [Column]
forall a. [a] -> [a] -> [a]
++ [Column
l], [Column]
ls)
          | Bool
otherwise = ([Column], [Column]) -> ([Column], [Column])
sumLayers ([Column]
s [Column] -> [Column] -> [Column]
forall a. [a] -> [a] -> [a]
++ [Column
l], [Column]
ls)

        containsSeparatingEdge :: [UINode] -> Bool
containsSeparatingEdge = (UINode -> Bool) -> [UINode] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any UINode -> Bool
cs
          where cs :: UINode -> Bool
cs UINode
n = Vector UINode -> Int
forall a. Unbox a => Vector a -> Int
VU.length (Graph n [e] -> UINode -> Vector UINode
forall e n. EdgeClass e => Graph n [e] -> UINode -> Vector UINode
childrenSeparating Graph n [e]
gr UINode
n) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0

    blocksOfTable :: [Column] -> (YBlockLines, [YBlockLines]) -> (YBlockLines, [YBlockLines])
    blocksOfTable :: [Column]
-> (YBlockLines, [YBlockLines]) -> (YBlockLines, [YBlockLines])
blocksOfTable [Column]
_ ([],[YBlockLines]
res) = ([],[YBlockLines]
res)
    blocksOfTable [Column]
cols (YBlockLines
ybs, [YBlockLines]
res)
        | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (((Int, [[(UINode, Int)]]) -> Bool) -> YBlockLines -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([[(UINode, Int)]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[(UINode, Int)]] -> Bool)
-> ((Int, [[(UINode, Int)]]) -> [[(UINode, Int)]])
-> (Int, [[(UINode, Int)]])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [[(UINode, Int)]]) -> [[(UINode, Int)]]
forall a b. (a, b) -> b
snd)  YBlockLines
newYBlocks) = ([],[YBlockLines]
res)
        | Bool
otherwise = [Column]
-> (YBlockLines, [YBlockLines]) -> (YBlockLines, [YBlockLines])
blocksOfTable [Column]
cols (YBlockLines
reducedYBlocks, YBlockLines
newYBlocks YBlockLines -> [YBlockLines] -> [YBlockLines]
forall a. a -> [a] -> [a]
: [YBlockLines]
res)
      where
        table :: Set UINode
table = [UINode] -> Set UINode
forall a. Ord a => [a] -> Set a
Set.fromList ((Column -> [UINode]) -> [Column] -> [UINode]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Column -> [UINode]
forall a b. (a, b) -> b
snd [Column]
cols)
        (YBlockLines
reducedYBlocks, YBlockLines
newYBlocks) = ((((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))
 -> (Int, [[(UINode, Int)]]))
-> [((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))]
-> YBlockLines
forall a b. (a -> b) -> [a] -> [b]
map ((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))
-> (Int, [[(UINode, Int)]])
forall a b. (a, b) -> a
fst [((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))]
sub, (((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))
 -> (Int, [[(UINode, Int)]]))
-> [((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))]
-> YBlockLines
forall a b. (a -> b) -> [a] -> [b]
map ((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))
-> (Int, [[(UINode, Int)]])
forall a b. (a, b) -> b
snd [((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))]
sub)
          where sub :: [((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))]
sub = ((Int, [[(UINode, Int)]])
 -> ((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]])))
-> YBlockLines
-> [((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [[(UINode, Int)]])
-> ((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))
addBlockRemoveBlock YBlockLines
ybs
        addBlockRemoveBlock :: YBlocks -> (YBlocks,YBlocks)
        addBlockRemoveBlock :: (Int, [[(UINode, Int)]])
-> ((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))
addBlockRemoveBlock (Int
y,[[(UINode, Int)]]
yb) = ([[(UINode, Int)]], [[(UINode, Int)]])
-> ((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))
addY (([(UINode, Int)] -> Bool)
-> [[(UINode, Int)]] -> ([[(UINode, Int)]], [[(UINode, Int)]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break [(UINode, Int)] -> Bool
f [[(UINode, Int)]]
yb) -- | (head yb) `elem` table = (head yb, tail yb)
          where addY :: ([[(UINode, Int)]], [[(UINode, Int)]])
-> ((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))
addY ([[(UINode, Int)]]
yb0,[[(UINode, Int)]]
yb1) = ((Int
y,[[(UINode, Int)]]
yb0),(Int
y,[[(UINode, Int)]]
yb1))
                f :: [(UINode, X)] -> Bool
                f :: [(UINode, Int)] -> Bool
f [(UINode, Int)]
block = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (((UINode, Int) -> Bool) -> [(UINode, Int)] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (UINode, Int) -> Bool
el [(UINode, Int)]
block)
                el :: (UINode, Int) -> Bool
el (UINode
n,Int
_) = UINode
n UINode -> Set UINode -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set UINode
table

--        (elem table . head . head) ybs

-- | To be able to jump horizontally between nodes in an interactive ui
getRows :: CGraphL n e -> Map Y [UINode]
getRows :: forall n e. CGraphL n e -> Map Int [UINode]
getRows (Graph n [e]
gr, Map UINode (Int, Int)
m, YBlockLines
_) =
  [Column] -> Map Int [UINode]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Column] -> Map Int [UINode]) -> [Column] -> Map Int [UINode]
forall a b. (a -> b) -> a -> b
$
    ([UINode] -> Column) -> [[UINode]] -> [Column]
forall a b. (a -> b) -> [a] -> [b]
map [UINode] -> Column
tupleWithY ( [UINode] -> [[UINode]]
srt ((Int -> UINode) -> [Int] -> [UINode]
forall a b. (a -> b) -> [a] -> [b]
map Int -> UINode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Graph n [e] -> [Int]
forall {a} {el}. Graph a el -> [Int]
Graph.nodes Graph n [e]
gr)) )
  where
    srt :: [UINode] -> [[UINode]]
srt = ([UINode] -> [UINode]) -> [[UINode]] -> [[UINode]]
forall a b. (a -> b) -> [a] -> [b]
map ((UINode -> UINode -> Ordering) -> [UINode] -> [UINode]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy UINode -> UINode -> Ordering
sortx) ([[UINode]] -> [[UINode]])
-> ([UINode] -> [[UINode]]) -> [UINode] -> [[UINode]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UINode -> UINode -> Bool) -> [UINode] -> [[UINode]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy UINode -> UINode -> Bool
groupy ([UINode] -> [[UINode]])
-> ([UINode] -> [UINode]) -> [UINode] -> [[UINode]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UINode -> UINode -> Ordering) -> [UINode] -> [UINode]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy UINode -> UINode -> Ordering
sorty
    tupleWithY :: [UINode] -> (Y, [UINode])
    tupleWithY :: [UINode] -> Column
tupleWithY [UINode]
ls = (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> b
snd (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int -> [UINode] -> UINode
forall a. Int -> [a] -> a
myHead Int
579 [UINode]
ls) Map UINode (Int, Int)
m), [UINode]
ls)
    groupy :: UINode -> UINode -> Bool
groupy UINode
n0 UINode
n1 = Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> b
snd (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n0 Map UINode (Int, Int)
m) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> b
snd (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n1 Map UINode (Int, Int)
m)
    sortx :: UINode -> UINode -> Ordering
sortx UINode
n0 UINode
n1 = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> a
fst (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n0 Map UINode (Int, Int)
m)) (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> a
fst (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n1 Map UINode (Int, Int)
m))
    sorty :: UINode -> UINode -> Ordering
sorty UINode
n0 UINode
n1 = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> b
snd (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n0 Map UINode (Int, Int)
m)) (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> b
snd (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n1 Map UINode (Int, Int)
m))