{-# LANGUAGE TemplateHaskell #-}

module Text.Dot.Types where

import "this" Prelude

import Control.Lens
import Data.Hashable


--------------------------------------------------------------------------------
-- Entities

-- | Represents the type of a graph entity.
--
-- DOT distinguishes between graphs, nodes, edges, and subgraphs /
-- clusters. This type differs slightly: it does not have a value for graphs, as it
-- is never required, and we differentiate subgraphs and clusters.
--
-- This type is used internally to distinguish entities, mostly for the purpose
-- of default attributes (see 'Text.Dot.defaults').
data EntityType = Node | Edge | Subgraph | Cluster
  deriving (Int -> EntityType -> ShowS
[EntityType] -> ShowS
EntityType -> String
(Int -> EntityType -> ShowS)
-> (EntityType -> String)
-> ([EntityType] -> ShowS)
-> Show EntityType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntityType -> ShowS
showsPrec :: Int -> EntityType -> ShowS
$cshow :: EntityType -> String
show :: EntityType -> String
$cshowList :: [EntityType] -> ShowS
showList :: [EntityType] -> ShowS
Show, EntityType -> EntityType -> Bool
(EntityType -> EntityType -> Bool)
-> (EntityType -> EntityType -> Bool) -> Eq EntityType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EntityType -> EntityType -> Bool
== :: EntityType -> EntityType -> Bool
$c/= :: EntityType -> EntityType -> Bool
/= :: EntityType -> EntityType -> Bool
Eq, Eq EntityType
Eq EntityType =>
(EntityType -> EntityType -> Ordering)
-> (EntityType -> EntityType -> Bool)
-> (EntityType -> EntityType -> Bool)
-> (EntityType -> EntityType -> Bool)
-> (EntityType -> EntityType -> Bool)
-> (EntityType -> EntityType -> EntityType)
-> (EntityType -> EntityType -> EntityType)
-> Ord EntityType
EntityType -> EntityType -> Bool
EntityType -> EntityType -> Ordering
EntityType -> EntityType -> EntityType
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 :: EntityType -> EntityType -> Ordering
compare :: EntityType -> EntityType -> Ordering
$c< :: EntityType -> EntityType -> Bool
< :: EntityType -> EntityType -> Bool
$c<= :: EntityType -> EntityType -> Bool
<= :: EntityType -> EntityType -> Bool
$c> :: EntityType -> EntityType -> Bool
> :: EntityType -> EntityType -> Bool
$c>= :: EntityType -> EntityType -> Bool
>= :: EntityType -> EntityType -> Bool
$cmax :: EntityType -> EntityType -> EntityType
max :: EntityType -> EntityType -> EntityType
$cmin :: EntityType -> EntityType -> EntityType
min :: EntityType -> EntityType -> EntityType
Ord, Int -> EntityType
EntityType -> Int
EntityType -> [EntityType]
EntityType -> EntityType
EntityType -> EntityType -> [EntityType]
EntityType -> EntityType -> EntityType -> [EntityType]
(EntityType -> EntityType)
-> (EntityType -> EntityType)
-> (Int -> EntityType)
-> (EntityType -> Int)
-> (EntityType -> [EntityType])
-> (EntityType -> EntityType -> [EntityType])
-> (EntityType -> EntityType -> [EntityType])
-> (EntityType -> EntityType -> EntityType -> [EntityType])
-> Enum EntityType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: EntityType -> EntityType
succ :: EntityType -> EntityType
$cpred :: EntityType -> EntityType
pred :: EntityType -> EntityType
$ctoEnum :: Int -> EntityType
toEnum :: Int -> EntityType
$cfromEnum :: EntityType -> Int
fromEnum :: EntityType -> Int
$cenumFrom :: EntityType -> [EntityType]
enumFrom :: EntityType -> [EntityType]
$cenumFromThen :: EntityType -> EntityType -> [EntityType]
enumFromThen :: EntityType -> EntityType -> [EntityType]
$cenumFromTo :: EntityType -> EntityType -> [EntityType]
enumFromTo :: EntityType -> EntityType -> [EntityType]
$cenumFromThenTo :: EntityType -> EntityType -> EntityType -> [EntityType]
enumFromThenTo :: EntityType -> EntityType -> EntityType -> [EntityType]
Enum, EntityType
EntityType -> EntityType -> Bounded EntityType
forall a. a -> a -> Bounded a
$cminBound :: EntityType
minBound :: EntityType
$cmaxBound :: EntityType
maxBound :: EntityType
Bounded)

instance Hashable EntityType where
  hashWithSalt :: Int -> EntityType -> Int
hashWithSalt Int
s EntityType
e = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (EntityType -> Int
forall a. Enum a => a -> Int
fromEnum EntityType
e)

-- | Opaque identifier for graph entities.
--
-- This type uniquely identifies an entity within the graph. To create one, see
-- 'Text.Dot.node', 'Text.Dot.edge', 'Text.Dot.subgraph', or 'Text.Dot.cluster'.
data Entity = Entity EntityType Int
  deriving (Entity -> Entity -> Bool
(Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool) -> Eq Entity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Entity -> Entity -> Bool
== :: Entity -> Entity -> Bool
$c/= :: Entity -> Entity -> Bool
/= :: Entity -> Entity -> Bool
Eq, Eq Entity
Eq Entity =>
(Entity -> Entity -> Ordering)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Entity)
-> (Entity -> Entity -> Entity)
-> Ord Entity
Entity -> Entity -> Bool
Entity -> Entity -> Ordering
Entity -> Entity -> Entity
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 :: Entity -> Entity -> Ordering
compare :: Entity -> Entity -> Ordering
$c< :: Entity -> Entity -> Bool
< :: Entity -> Entity -> Bool
$c<= :: Entity -> Entity -> Bool
<= :: Entity -> Entity -> Bool
$c> :: Entity -> Entity -> Bool
> :: Entity -> Entity -> Bool
$c>= :: Entity -> Entity -> Bool
>= :: Entity -> Entity -> Bool
$cmax :: Entity -> Entity -> Entity
max :: Entity -> Entity -> Entity
$cmin :: Entity -> Entity -> Entity
min :: Entity -> Entity -> Entity
Ord)

instance Hashable Entity where
  hashWithSalt :: Int -> Entity -> Int
hashWithSalt Int
s (Entity EntityType
t Int
i) = Int
s Int -> EntityType -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` EntityType
t Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int
i

-- | Retrieves the type of a given t'Entity'.
getType :: Entity -> EntityType
getType :: Entity -> EntityType
getType (Entity EntityType
t Int
_) = EntityType
t


--------------------------------------------------------------------------------
-- Internal state

-- | An entity's attributes.
--
-- Attributes are untyped, and are a simple mapping from 'Text' to 'Text', for
-- flexibility.
type Attributes = HashMap Text Text

-- | A path through the graph.
--
-- This opaque type represents the path from the root to the current scope. The
-- current path can be obtained via 'Text.Dot.path'.
newtype Path = Path { Path -> NonEmpty Entity
unwrapPath :: NonEmpty Entity }

makePrisms ''Path

type DotContext = [Entity]

data EdgeInfo = EdgeInfo Entity Entity Entity Entity

-- | Internal opaque graph state.
data DotGraph = DotGraph
  { DotGraph -> HashMap EntityType Attributes
_defaultAttributes :: HashMap EntityType Attributes
  , DotGraph -> HashMap Entity Attributes
_entityAttributes  :: HashMap Entity Attributes
  , DotGraph -> HashMap Entity EdgeInfo
_edgeInfo          :: HashMap Entity EdgeInfo
  , DotGraph -> HashMap Entity DotContext
_subgraphInfo      :: HashMap Entity DotContext
  , DotGraph -> NonEmpty DotContext
_contextStack      :: NonEmpty DotContext
  , DotGraph -> Int
_entityIndex       :: Int
  , DotGraph -> Entity
_latest            :: Entity
  }

makeLenses ''DotGraph

initialGraph :: Entity -> DotGraph
initialGraph :: Entity -> DotGraph
initialGraph = HashMap EntityType Attributes
-> HashMap Entity Attributes
-> HashMap Entity EdgeInfo
-> HashMap Entity DotContext
-> NonEmpty DotContext
-> Int
-> Entity
-> DotGraph
DotGraph HashMap EntityType Attributes
forall a. Monoid a => a
mempty HashMap Entity Attributes
forall a. Monoid a => a
mempty HashMap Entity EdgeInfo
forall a. Monoid a => a
mempty HashMap Entity DotContext
forall a. Monoid a => a
mempty (DotContext -> NonEmpty DotContext
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DotContext
forall a. Monoid a => a
mempty) Int
0