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

module Graph.CommonGraph where

import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.IntMap as I
import Data.List (group, sort)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust, isJust)
import qualified Data.Vector.Unboxed as VU
import Data.Word (Word32, Word8)
import Debug.Trace (trace)
import GHC.Generics (Generic)
import Graph.IntMap
  ( Edge8 (..),
    EdgeAttribute (..),
    ExtractNodeType (..),
    Graph (..),
    adjacentNodesByAttr,
  )

-- | Word32 is used for the node because graph drawing is most likely used in a browser with javascript and the ints there have 32 bits, and this is more than enough
type UINode = Word32

-- | A shorthand for multiple edges
type CGraph n e = Graph n [e]

-- | Layouted Graph, assign a (x,y) position to every node
--   also returning the blocks in yCoordinateassignment, the final layouting has to be done in javascript
type CGraphL n e = (Graph n [e], Map UINode (X, Y), YBlockLines)

type X = Int
type Y = Int
type YBlock      =  (Y, [(UINode, X)])
type YBlocks     =  (Y, [[(UINode, X)]])
type YBlockLines = [(Y, [[(UINode, X)]])]

-- | Nodes could be grouped into lists. But as a lof of algorithms walk through the graph, 
--   it is more convenient to see for example if a node is connected vertically than to see if it is part of a list of vertically grouped nodes.
--   This is of course a matter of taste and there probably good arguments to put nodes in lists
data EdgeType
  = NormalEdge
  | VerticalEdge -- ^When having options, they appear continuously in one column. We mark this in the graph with vertical edges from the first option to the second and so on
  | VirtualHorEdge -- ^Virtual edges are not displayed but used to put several graphs in a row for layouting and navigation with the keyboard
  | SeparatingEdge -- ^To connect graph components that are separate
  deriving (Int -> EdgeType -> ShowS
[EdgeType] -> ShowS
EdgeType -> String
(Int -> EdgeType -> ShowS)
-> (EdgeType -> String) -> ([EdgeType] -> ShowS) -> Show EdgeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EdgeType -> ShowS
showsPrec :: Int -> EdgeType -> ShowS
$cshow :: EdgeType -> String
show :: EdgeType -> String
$cshowList :: [EdgeType] -> ShowS
showList :: [EdgeType] -> ShowS
Show, (forall x. EdgeType -> Rep EdgeType x)
-> (forall x. Rep EdgeType x -> EdgeType) -> Generic EdgeType
forall x. Rep EdgeType x -> EdgeType
forall x. EdgeType -> Rep EdgeType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EdgeType -> Rep EdgeType x
from :: forall x. EdgeType -> Rep EdgeType x
$cto :: forall x. Rep EdgeType x -> EdgeType
to :: forall x. Rep EdgeType x -> EdgeType
Generic, EdgeType -> EdgeType -> Bool
(EdgeType -> EdgeType -> Bool)
-> (EdgeType -> EdgeType -> Bool) -> Eq EdgeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EdgeType -> EdgeType -> Bool
== :: EdgeType -> EdgeType -> Bool
$c/= :: EdgeType -> EdgeType -> Bool
/= :: EdgeType -> EdgeType -> Bool
Eq, Eq EdgeType
Eq EdgeType =>
(EdgeType -> EdgeType -> Ordering)
-> (EdgeType -> EdgeType -> Bool)
-> (EdgeType -> EdgeType -> Bool)
-> (EdgeType -> EdgeType -> Bool)
-> (EdgeType -> EdgeType -> Bool)
-> (EdgeType -> EdgeType -> EdgeType)
-> (EdgeType -> EdgeType -> EdgeType)
-> Ord EdgeType
EdgeType -> EdgeType -> Bool
EdgeType -> EdgeType -> Ordering
EdgeType -> EdgeType -> EdgeType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EdgeType -> EdgeType -> Ordering
compare :: EdgeType -> EdgeType -> Ordering
$c< :: EdgeType -> EdgeType -> Bool
< :: EdgeType -> EdgeType -> Bool
$c<= :: EdgeType -> EdgeType -> Bool
<= :: EdgeType -> EdgeType -> Bool
$c> :: EdgeType -> EdgeType -> Bool
> :: EdgeType -> EdgeType -> Bool
$c>= :: EdgeType -> EdgeType -> Bool
>= :: EdgeType -> EdgeType -> Bool
$cmax :: EdgeType -> EdgeType -> EdgeType
max :: EdgeType -> EdgeType -> EdgeType
$cmin :: EdgeType -> EdgeType -> EdgeType
min :: EdgeType -> EdgeType -> EdgeType
Ord)

type GraphMoveX = Int

type Column = (GraphMoveX, [UINode])

-- | A type class for the node type, so that an individual node type can be used
--   Some functions had to be introduced that are special for the original purpose. The main reason for not using grapviz was that it became clear that a binding to graphviz does not allow to adjust algorithms easily
class NodeClass n where
  isDummy :: EdgeClass e => CGraph n e -> UINode -> Bool
  isCase :: EdgeClass e => CGraph n e -> UINode -> Bool
  isConnNode :: EdgeClass e => CGraph n e -> UINode -> Bool
  isFunction :: EdgeClass e => CGraph n e -> UINode -> Bool -- ^ This special for displaying function networks
  isMainArg :: EdgeClass e => CGraph n e -> UINode -> Bool -- ^ This special for displaying function networks
  isSubLabel :: n -> Bool
  isArgLabel :: n -> Bool -- ^ This special for displaying function networks
  subLabels :: n -> Int
  connectionNode :: n
  dummyNode :: Int -> n -- Depth -> n
  nestingFeatures :: n -> Maybe LayerFeatures
  updateLayer :: Maybe LayerFeatures -> n -> n
  verticalNumber :: n -> Maybe Int -- we want to keep the order of vertically connected Nodes,

type ChannelNrIn = Maybe Channel

type ChannelNrOut = Channel

-- | A channel (or port) is used if a node has several subfields that are connected separately
--   For example the nth type of a type node
type Channel = Int

-- | Edges can are also be implemented individually
class EdgeClass e where
  dummyEdge :: ChannelNrIn -> ChannelNrOut -> e
  standard :: EdgeType -> e
  edgeType :: e -> EdgeType
  channelNrIn :: e -> ChannelNrIn
  channelNrOut :: e -> ChannelNrOut

------------------------------------------------------------------------------------------------------
-- * Grouping edges into classes with non overlapping bits, 
--
-- $bits
--
-- For example vertBit = 00000001 = 1, virtBit = 00000010 = 2, sepBit = 00000100 =4, ...
--   Up to 8 bits. This was used to have a superfast lookup with an intmap. Maybe a normal Map with a key (UINode,Word32) would have been easier, with Word32 being the edge type. But this is faster.

vertBit :: Word8
vertBit :: Word8
vertBit = Word8
0x1

virtBit :: Word8
virtBit :: Word8
virtBit = Word8
0x2

sepBit :: Word8
sepBit :: Word8
sepBit = Word8
0x4

instance EdgeClass e => EdgeAttribute [e] where -- Why can two nodes be connected with more than one edge?
-- To connect one function with several input types that are part of one type node
  fastEdgeAttr :: [e] -> Word8
fastEdgeAttr (e
e : [e]
_) = EdgeType -> Word8
f (e -> EdgeType
forall e. EdgeClass e => e -> EdgeType
edgeType e
e)
    where
      f :: EdgeType -> Word8
f EdgeType
VerticalEdge = Word8
vertBit
      f EdgeType
VirtualHorEdge = Word8
virtBit
      f EdgeType
_ = Word8
0
  fastEdgeAttr [e]
_ = Word8
0
  edgeFromAttr :: Map Word8 [e]
edgeFromAttr =
    [(Word8, [e])] -> Map Word8 [e]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (Word8
vertBit, [EdgeType -> e
forall e. EdgeClass e => EdgeType -> e
standard EdgeType
VerticalEdge]),
        (Word8
virtBit, [EdgeType -> e
forall e. EdgeClass e => EdgeType -> e
standard EdgeType
VirtualHorEdge]),
        (Word8
0, [EdgeType -> e
forall e. EdgeClass e => EdgeType -> e
standard EdgeType
NormalEdge])
      ]

--  show_e (Just [UIEdgeLabel standard Nothing 0 e]) = show e
  show_e :: Maybe [e] -> String
show_e Maybe [e]
_ = String
"no Edge"
  bases :: [e] -> [Edge8]
bases [e]
_ = [Word8 -> Edge8
Edge8 Word8
0, Word8 -> Edge8
Edge8 Word8
vertBit, Word8 -> Edge8
Edge8 Word8
virtBit]

------------------------------------------------------------------------------------------------------
-- * Querying nodes that are connected by a certain type of edge
--   

-- | All children that are connected but without the vertically connected nodes
childrenNoVertical :: EdgeClass e => Graph n [e] -> Word32 -> VU.Vector Word32
childrenNoVertical :: forall e n. EdgeClass e => Graph n [e] -> Word32 -> Vector Word32
childrenNoVertical Graph n [e]
gr Word32
n =
  Graph n [e] -> Bool -> Word32 -> Edge8 -> Vector Word32
forall el nl.
EdgeAttribute el =>
Graph nl el -> Bool -> Word32 -> Edge8 -> Vector Word32
adjacentNodesByAttr Graph n [e]
gr Bool
True Word32
n (Word8 -> Edge8
Edge8 Word8
virtBit)
    Vector Word32 -> Vector Word32 -> Vector Word32
forall a. Unbox a => Vector a -> Vector a -> Vector a
VU.++ Graph n [e] -> Bool -> Word32 -> Edge8 -> Vector Word32
forall el nl.
EdgeAttribute el =>
Graph nl el -> Bool -> Word32 -> Edge8 -> Vector Word32
adjacentNodesByAttr Graph n [e]
gr Bool
True Word32
n (Word8 -> Edge8
Edge8 Word8
0)

-- | All parents that are connected but without the vertically connected nodes
parentsNoVertical :: EdgeClass e => Graph n [e] -> Word32 -> VU.Vector Word32
parentsNoVertical :: forall e n. EdgeClass e => Graph n [e] -> Word32 -> Vector Word32
parentsNoVertical Graph n [e]
gr Word32
n =
  Graph n [e] -> Bool -> Word32 -> Edge8 -> Vector Word32
forall el nl.
EdgeAttribute el =>
Graph nl el -> Bool -> Word32 -> Edge8 -> Vector Word32
adjacentNodesByAttr Graph n [e]
gr Bool
False Word32
n (Word8 -> Edge8
Edge8 Word8
virtBit)
    Vector Word32 -> Vector Word32 -> Vector Word32
forall a. Unbox a => Vector a -> Vector a -> Vector a
VU.++ Graph n [e] -> Bool -> Word32 -> Edge8 -> Vector Word32
forall el nl.
EdgeAttribute el =>
Graph nl el -> Bool -> Word32 -> Edge8 -> Vector Word32
adjacentNodesByAttr Graph n [e]
gr Bool
False Word32
n (Word8 -> Edge8
Edge8 Word8
0)

-- | All parents that are connected but without the virtual connected nodes
parentsNoVirtual :: EdgeClass e => CGraph n e -> Word32 -> VU.Vector Word32
parentsNoVirtual :: forall e n. EdgeClass e => Graph n [e] -> Word32 -> Vector Word32
parentsNoVirtual CGraph n e
gr Word32
n =
  (CGraph n e -> Bool -> Word32 -> Edge8 -> Vector Word32
forall el nl.
EdgeAttribute el =>
Graph nl el -> Bool -> Word32 -> Edge8 -> Vector Word32
adjacentNodesByAttr CGraph n e
gr Bool
False Word32
n (Word8 -> Edge8
Edge8 Word8
vertBit))
    Vector Word32 -> Vector Word32 -> Vector Word32
forall a. Unbox a => Vector a -> Vector a -> Vector a
VU.++ (CGraph n e -> Bool -> Word32 -> Edge8 -> Vector Word32
forall el nl.
EdgeAttribute el =>
Graph nl el -> Bool -> Word32 -> Edge8 -> Vector Word32
adjacentNodesByAttr CGraph n e
gr Bool
False Word32
n (Word8 -> Edge8
Edge8 Word8
0))

-- | All parents that are connected but without the virtual or vertically connected nodes
parentsNoVerticalOrVirtual :: EdgeClass e => CGraph n e -> Word32 -> VU.Vector Word32
parentsNoVerticalOrVirtual :: forall e n. EdgeClass e => Graph n [e] -> Word32 -> Vector Word32
parentsNoVerticalOrVirtual CGraph n e
gr Word32
n = CGraph n e -> Bool -> Word32 -> Edge8 -> Vector Word32
forall el nl.
EdgeAttribute el =>
Graph nl el -> Bool -> Word32 -> Edge8 -> Vector Word32
adjacentNodesByAttr CGraph n e
gr Bool
False Word32
n (Word8 -> Edge8
Edge8 Word8
0)

-- | Children that are connected vertically
childrenVertical :: EdgeClass e => Graph n [e] -> Word32 -> VU.Vector Word32
childrenVertical :: forall e n. EdgeClass e => Graph n [e] -> Word32 -> Vector Word32
childrenVertical Graph n [e]
gr Word32
n = Graph n [e] -> Bool -> Word32 -> Edge8 -> Vector Word32
forall el nl.
EdgeAttribute el =>
Graph nl el -> Bool -> Word32 -> Edge8 -> Vector Word32
adjacentNodesByAttr Graph n [e]
gr Bool
True Word32
n (Word8 -> Edge8
Edge8 Word8
vertBit)

-- | Parents that are connected vertically
parentsVertical :: EdgeClass e => Graph n [e] -> Word32 -> VU.Vector Word32
parentsVertical :: forall e n. EdgeClass e => Graph n [e] -> Word32 -> Vector Word32
parentsVertical Graph n [e]
gr Word32
n = Graph n [e] -> Bool -> Word32 -> Edge8 -> Vector Word32
forall el nl.
EdgeAttribute el =>
Graph nl el -> Bool -> Word32 -> Edge8 -> Vector Word32
adjacentNodesByAttr Graph n [e]
gr Bool
False Word32
n (Word8 -> Edge8
Edge8 Word8
vertBit)

-- | Children that are connected with a separating edge
childrenSeparating :: EdgeClass e => CGraph n e -> Word32 -> VU.Vector Word32
childrenSeparating :: forall e n. EdgeClass e => Graph n [e] -> Word32 -> Vector Word32
childrenSeparating CGraph n e
gr Word32
n = CGraph n e -> Bool -> Word32 -> Edge8 -> Vector Word32
forall el nl.
EdgeAttribute el =>
Graph nl el -> Bool -> Word32 -> Edge8 -> Vector Word32
adjacentNodesByAttr CGraph n e
gr Bool
True Word32
n (Word8 -> Edge8
Edge8 Word8
sepBit)

-- | Find all vertically connected nodes, by exploring incoming and outgoing vertical edges 
verticallyConnectedNodes :: EdgeClass e => CGraph n e -> UINode -> [UINode]
verticallyConnectedNodes :: forall e n. EdgeClass e => CGraph n e -> Word32 -> [Word32]
verticallyConnectedNodes CGraph n e
g Word32
n =
  Vector Word32 -> [Word32]
forall a. Unbox a => Vector a -> [a]
VU.toList (Vector Word32 -> [Word32]) -> Vector Word32 -> [Word32]
forall a b. (a -> b) -> a -> b
$
    Vector Word32 -> Vector Word32
goUp (CGraph n e -> Word32 -> Vector Word32
forall e n. EdgeClass e => Graph n [e] -> Word32 -> Vector Word32
parentsVertical CGraph n e
g Word32
n)
      Vector Word32 -> Vector Word32 -> Vector Word32
forall a. Unbox a => Vector a -> Vector a -> Vector a
VU.++ Word32 -> Vector Word32 -> Vector Word32
forall a. Unbox a => a -> Vector a -> Vector a
VU.cons Word32
n (Vector Word32 -> Vector Word32
goDown (CGraph n e -> Word32 -> Vector Word32
forall e n. EdgeClass e => Graph n [e] -> Word32 -> Vector Word32
childrenVertical CGraph n e
g Word32
n))
  where
    goUp :: Vector Word32 -> Vector Word32
goUp Vector Word32
nodes
      | Vector Word32 -> Bool
forall a. Unbox a => Vector a -> Bool
VU.null Vector Word32
nodes = Vector Word32
forall a. Unbox a => Vector a
VU.empty
      | Bool
otherwise =
        Vector Word32
nodes
          Vector Word32 -> Vector Word32 -> Vector Word32
forall a. Unbox a => Vector a -> Vector a -> Vector a
VU.++ (Word32 -> Vector Word32) -> Vector Word32 -> Vector Word32
forall a b.
(Unbox a, Unbox b) =>
(a -> Vector b) -> Vector a -> Vector b
VU.concatMap (Vector Word32 -> Vector Word32
goUp (Vector Word32 -> Vector Word32)
-> (Word32 -> Vector Word32) -> Word32 -> Vector Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CGraph n e -> Word32 -> Vector Word32
forall e n. EdgeClass e => Graph n [e] -> Word32 -> Vector Word32
parentsVertical CGraph n e
g) Vector Word32
nodes
    goDown :: Vector Word32 -> Vector Word32
goDown Vector Word32
nodes
      | Vector Word32 -> Bool
forall a. Unbox a => Vector a -> Bool
VU.null Vector Word32
nodes = Vector Word32
forall a. Unbox a => Vector a
VU.empty
      | Bool
otherwise =
        Vector Word32
nodes
          Vector Word32 -> Vector Word32 -> Vector Word32
forall a. Unbox a => Vector a -> Vector a -> Vector a
VU.++ (Word32 -> Vector Word32) -> Vector Word32 -> Vector Word32
forall a b.
(Unbox a, Unbox b) =>
(a -> Vector b) -> Vector a -> Vector b
VU.concatMap (Vector Word32 -> Vector Word32
goDown (Vector Word32 -> Vector Word32)
-> (Word32 -> Vector Word32) -> Word32 -> Vector Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CGraph n e -> Word32 -> Vector Word32
forall e n. EdgeClass e => Graph n [e] -> Word32 -> Vector Word32
childrenVertical CGraph n e
g) Vector Word32
nodes

------------------------------------------------------------------------------------------------------
-- * Borders of cells
--   Cells have a nesting and border type, when a box has to be drawn around a graph

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

type BoxId = Word32 -- ^ I use the node of the function that is exploded as the box id

data LayerFeatures = LayerFeatures
  { LayerFeatures -> Int
layer :: Nesting, -- ^Graphs that are inside graphs get a higher nesting value (I use this to make every new layer a little bit darker). This is used to calculate the subgraph windows
    LayerFeatures -> Maybe Word32
boxId :: Maybe BoxId, -- ^ There can be several subgraphs in a graph, that are surrounded by a box. This value has to be unique for every box
    LayerFeatures -> Maybe Border
border :: Maybe Border -- ^Set the css values (border, boxshadow)
  }
  deriving (Int -> LayerFeatures -> ShowS
[LayerFeatures] -> ShowS
LayerFeatures -> String
(Int -> LayerFeatures -> ShowS)
-> (LayerFeatures -> String)
-> ([LayerFeatures] -> ShowS)
-> Show LayerFeatures
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LayerFeatures -> ShowS
showsPrec :: Int -> LayerFeatures -> ShowS
$cshow :: LayerFeatures -> String
show :: LayerFeatures -> String
$cshowList :: [LayerFeatures] -> ShowS
showList :: [LayerFeatures] -> ShowS
Show, (forall x. LayerFeatures -> Rep LayerFeatures x)
-> (forall x. Rep LayerFeatures x -> LayerFeatures)
-> Generic LayerFeatures
forall x. Rep LayerFeatures x -> LayerFeatures
forall x. LayerFeatures -> Rep LayerFeatures x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LayerFeatures -> Rep LayerFeatures x
from :: forall x. LayerFeatures -> Rep LayerFeatures x
$cto :: forall x. Rep LayerFeatures x -> LayerFeatures
to :: forall x. Rep LayerFeatures x -> LayerFeatures
Generic)

instance FromJSON LayerFeatures

instance ToJSON LayerFeatures

lb :: Nesting -> Maybe BoxId -> Maybe LayerFeatures
lb :: Int -> Maybe Word32 -> Maybe LayerFeatures
lb Int
n Maybe Word32
b = LayerFeatures -> Maybe LayerFeatures
forall a. a -> Maybe a
Just (Int -> Maybe Word32 -> Maybe Border -> LayerFeatures
LayerFeatures Int
n Maybe Word32
b (Border -> Maybe Border
forall a. a -> Maybe a
Just Border
LeftBorder))

rb :: Nesting -> Maybe BoxId -> Maybe LayerFeatures
rb :: Int -> Maybe Word32 -> Maybe LayerFeatures
rb Int
n Maybe Word32
b = LayerFeatures -> Maybe LayerFeatures
forall a. a -> Maybe a
Just (Int -> Maybe Word32 -> Maybe Border -> LayerFeatures
LayerFeatures Int
n Maybe Word32
b (Border -> Maybe Border
forall a. a -> Maybe a
Just Border
RightBorder))

tb :: Nesting -> Maybe BoxId -> Maybe LayerFeatures
tb :: Int -> Maybe Word32 -> Maybe LayerFeatures
tb Int
n Maybe Word32
b = LayerFeatures -> Maybe LayerFeatures
forall a. a -> Maybe a
Just (Int -> Maybe Word32 -> Maybe Border -> LayerFeatures
LayerFeatures Int
n Maybe Word32
b (Border -> Maybe Border
forall a. a -> Maybe a
Just Border
TopBorder))

bb :: Nesting -> Maybe BoxId -> Maybe LayerFeatures
bb :: Int -> Maybe Word32 -> Maybe LayerFeatures
bb Int
n Maybe Word32
b = LayerFeatures -> Maybe LayerFeatures
forall a. a -> Maybe a
Just (Int -> Maybe Word32 -> Maybe Border -> LayerFeatures
LayerFeatures Int
n Maybe Word32
b (Border -> Maybe Border
forall a. a -> Maybe a
Just Border
BottomBorder))

ltb :: Nesting -> Maybe BoxId -> Maybe LayerFeatures
ltb :: Int -> Maybe Word32 -> Maybe LayerFeatures
ltb Int
n Maybe Word32
b = LayerFeatures -> Maybe LayerFeatures
forall a. a -> Maybe a
Just (Int -> Maybe Word32 -> Maybe Border -> LayerFeatures
LayerFeatures Int
n Maybe Word32
b (Border -> Maybe Border
forall a. a -> Maybe a
Just Border
LeftTopBorder))

rtb :: Nesting -> Maybe BoxId -> Maybe LayerFeatures
rtb :: Int -> Maybe Word32 -> Maybe LayerFeatures
rtb Int
n Maybe Word32
b = LayerFeatures -> Maybe LayerFeatures
forall a. a -> Maybe a
Just (Int -> Maybe Word32 -> Maybe Border -> LayerFeatures
LayerFeatures Int
n Maybe Word32
b (Border -> Maybe Border
forall a. a -> Maybe a
Just Border
RightTopBorder))

lbb :: Nesting -> Maybe BoxId -> Maybe LayerFeatures
lbb :: Int -> Maybe Word32 -> Maybe LayerFeatures
lbb Int
n Maybe Word32
b = LayerFeatures -> Maybe LayerFeatures
forall a. a -> Maybe a
Just (Int -> Maybe Word32 -> Maybe Border -> LayerFeatures
LayerFeatures Int
n Maybe Word32
b (Border -> Maybe Border
forall a. a -> Maybe a
Just Border
LeftBottomBorder))

rbb :: Nesting -> Maybe BoxId -> Maybe LayerFeatures
rbb :: Int -> Maybe Word32 -> Maybe LayerFeatures
rbb Int
n Maybe Word32
b = LayerFeatures -> Maybe LayerFeatures
forall a. a -> Maybe a
Just (Int -> Maybe Word32 -> Maybe Border -> LayerFeatures
LayerFeatures Int
n Maybe Word32
b (Border -> Maybe Border
forall a. a -> Maybe a
Just Border
RightBottomBorder))

mid :: Nesting -> Maybe BoxId -> Maybe LayerFeatures
mid :: Int -> Maybe Word32 -> Maybe LayerFeatures
mid Int
n Maybe Word32
b = LayerFeatures -> Maybe LayerFeatures
forall a. a -> Maybe a
Just (Int -> Maybe Word32 -> Maybe Border -> LayerFeatures
LayerFeatures Int
n Maybe Word32
b Maybe Border
forall a. Maybe a
Nothing)

data Border
  = LeftBorder
  | RightBorder
  | TopBorder
  | BottomBorder
  | LeftTopBorder
  | RightTopBorder
  | LeftBottomBorder
  | RightBottomBorder
  deriving (Int -> Border -> ShowS
[Border] -> ShowS
Border -> String
(Int -> Border -> ShowS)
-> (Border -> String) -> ([Border] -> ShowS) -> Show Border
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Border -> ShowS
showsPrec :: Int -> Border -> ShowS
$cshow :: Border -> String
show :: Border -> String
$cshowList :: [Border] -> ShowS
showList :: [Border] -> ShowS
Show, (forall x. Border -> Rep Border x)
-> (forall x. Rep Border x -> Border) -> Generic Border
forall x. Rep Border x -> Border
forall x. Border -> Rep Border x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Border -> Rep Border x
from :: forall x. Border -> Rep Border x
$cto :: forall x. Rep Border x -> Border
to :: forall x. Rep Border x -> Border
Generic)

instance FromJSON Border

instance ToJSON Border

------------------------------------------------------------------------------------------------------
-- * Helper functions
--

myFromJust :: Int -> Maybe a -> a
myFromJust :: forall a. Int -> Maybe a -> a
myFromJust Int
i Maybe a
term
  | Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
term -- Debug.Trace.trace ("myFromJustTrue "++ show i)
    =
    Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe a
term
  | Bool
otherwise =
    String -> (Maybe a -> a) -> Maybe a -> a
forall a. String -> a -> a
Debug.Trace.trace
      (String
"myFromJust " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i)
      Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust
      Maybe a
term

myHead :: Int -> [a] -> a
myHead :: forall a. Int -> [a] -> a
myHead Int
i [a]
a
  | [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
a = String -> a
forall a. HasCallStack => String -> a
error (String
"head: empty list " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i)
  | Bool
otherwise = [a] -> a
forall a. HasCallStack => [a] -> a
head [a]
a

myLast :: Int -> [a] -> a
myLast :: forall a. Int -> [a] -> a
myLast Int
i [a]
a
  | [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
a = String -> a
forall a. HasCallStack => String -> a
error (String
"last: empty list " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i)
  | Bool
otherwise = [a] -> a
forall a. HasCallStack => [a] -> a
last [a]
a

vHead :: (VU.Unbox a) => Int -> VU.Vector a -> a
vHead :: forall a. Unbox a => Int -> Vector a -> a
vHead Int
i Vector a
a
  | Vector a -> Bool
forall a. Unbox a => Vector a -> Bool
VU.null Vector a
a = String -> a
forall a. HasCallStack => String -> a
error (String
"VU.head: empty list " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i)
  | Bool
otherwise = Vector a -> a
forall a. Unbox a => Vector a -> a
VU.head Vector a
a

rmdups :: (Ord a) => [a] -> [a]
rmdups :: forall a. Ord a => [a] -> [a]
rmdups = ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [a] -> a
forall a. Int -> [a] -> a
myHead Int
500) ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
group ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Ord a => [a] -> [a]
sort