{-# LANGUAGE UnicodeSyntax, FlexibleContexts #-}
module GraphRewriting.Layout.PortSpec
	(module GraphRewriting.Layout.PortSpec,
	 module GraphRewriting.Layout.Position,
	 module Data.View)
where

import Prelude.Unicode
import GraphRewriting.Graph
import GraphRewriting.Layout.Position
import Data.View
import Data.Maybe (catMaybes)


-- | Port position relative to the node center, and the direction in which edges should stick out.
class PortSpec n where portSpec ∷ n → [(Vector2, Vector2)]

sameDir ∷ Vector2 → (Vector2, Vector2)
sameDir :: Vector2 -> (Vector2, Vector2)
sameDir Vector2
r = (Vector2
r,Vector2
r)

portDir ∷ PortSpec n ⇒ n → [Vector2]
portDir :: forall n. PortSpec n => n -> [Vector2]
portDir = ((Vector2, Vector2) -> Vector2)
-> [(Vector2, Vector2)] -> [Vector2]
forall a b. (a -> b) -> [a] -> [b]
map (Vector2, Vector2) -> Vector2
forall a b. (a, b) -> b
snd ([(Vector2, Vector2)] -> [Vector2])
-> (n -> [(Vector2, Vector2)]) -> n -> [Vector2]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> [(Vector2, Vector2)]
forall n. PortSpec n => n -> [(Vector2, Vector2)]
portSpec

relPortPos ∷ PortSpec n ⇒ n → [Vector2]
relPortPos :: forall n. PortSpec n => n -> [Vector2]
relPortPos = ((Vector2, Vector2) -> Vector2)
-> [(Vector2, Vector2)] -> [Vector2]
forall a b. (a -> b) -> [a] -> [b]
map (Vector2, Vector2) -> Vector2
forall a b. (a, b) -> a
fst ([(Vector2, Vector2)] -> [Vector2])
-> (n -> [(Vector2, Vector2)]) -> n -> [Vector2]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> [(Vector2, Vector2)]
forall n. PortSpec n => n -> [(Vector2, Vector2)]
portSpec

absPortPos ∷ (PortSpec n, View Position n) ⇒ n → [Vector2]
absPortPos :: forall n. (PortSpec n, View Position n) => n -> [Vector2]
absPortPos n
n = (Vector2 -> Vector2) -> [Vector2] -> [Vector2]
forall a b. (a -> b) -> [a] -> [b]
map ((Position -> Vector2) -> n -> Vector2
forall v n field. View v n => (v -> field) -> n -> field
examine Position -> Vector2
position n
n Vector2 -> Vector2 -> Vector2
forall a. Num a => a -> a -> a
+) (n -> [Vector2]
forall n. PortSpec n => n -> [Vector2]
relPortPos n
n)

propOfPort ∷ View [Port] n ⇒ (n → [a]) → Edge → n → [a]
propOfPort :: forall n a. View [Port] n => (n -> [a]) -> Port -> n -> [a]
propOfPort n -> [a]
portProps Port
e n
n = [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe a] -> [a]) -> [Maybe a] -> [a]
forall a b. (a -> b) -> a -> b
$ (Port -> a -> Maybe a) -> [Port] -> [a] -> [Maybe a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Port -> a -> Maybe a
forall {a}. Port -> a -> Maybe a
filterE (n -> [Port]
forall v n. View v n => n -> v
inspect n
n) (n -> [a]
portProps n
n)
	where filterE :: Port -> a -> Maybe a
filterE Port
edge a
portPos = if Port
edge Port -> Port -> Bool
forall α. Eq α => α -> α -> Bool
≡ Port
e then a -> Maybe a
forall a. a -> Maybe a
Just a
portPos else Maybe a
forall a. Maybe a
Nothing