module Language.Lexer.Tlex.Plugin.Debug.Graphviz (
    NodeShape (..),
    Node (..),
    Edge (..),
    Ast (..),
    outputAst,
) where

import           Language.Lexer.Tlex.Prelude

import qualified Prelude


data NodeShape
    = DoubleCircle
    | Circle
    deriving (NodeShape -> NodeShape -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeShape -> NodeShape -> Bool
$c/= :: NodeShape -> NodeShape -> Bool
== :: NodeShape -> NodeShape -> Bool
$c== :: NodeShape -> NodeShape -> Bool
Eq, Int -> NodeShape -> ShowS
[NodeShape] -> ShowS
NodeShape -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeShape] -> ShowS
$cshowList :: [NodeShape] -> ShowS
show :: NodeShape -> String
$cshow :: NodeShape -> String
showsPrec :: Int -> NodeShape -> ShowS
$cshowsPrec :: Int -> NodeShape -> ShowS
Show, Eq NodeShape
NodeShape -> NodeShape -> Bool
NodeShape -> NodeShape -> Ordering
NodeShape -> NodeShape -> NodeShape
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
min :: NodeShape -> NodeShape -> NodeShape
$cmin :: NodeShape -> NodeShape -> NodeShape
max :: NodeShape -> NodeShape -> NodeShape
$cmax :: NodeShape -> NodeShape -> NodeShape
>= :: NodeShape -> NodeShape -> Bool
$c>= :: NodeShape -> NodeShape -> Bool
> :: NodeShape -> NodeShape -> Bool
$c> :: NodeShape -> NodeShape -> Bool
<= :: NodeShape -> NodeShape -> Bool
$c<= :: NodeShape -> NodeShape -> Bool
< :: NodeShape -> NodeShape -> Bool
$c< :: NodeShape -> NodeShape -> Bool
compare :: NodeShape -> NodeShape -> Ordering
$ccompare :: NodeShape -> NodeShape -> Ordering
Ord, Int -> NodeShape
NodeShape -> Int
NodeShape -> [NodeShape]
NodeShape -> NodeShape
NodeShape -> NodeShape -> [NodeShape]
NodeShape -> NodeShape -> NodeShape -> [NodeShape]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NodeShape -> NodeShape -> NodeShape -> [NodeShape]
$cenumFromThenTo :: NodeShape -> NodeShape -> NodeShape -> [NodeShape]
enumFromTo :: NodeShape -> NodeShape -> [NodeShape]
$cenumFromTo :: NodeShape -> NodeShape -> [NodeShape]
enumFromThen :: NodeShape -> NodeShape -> [NodeShape]
$cenumFromThen :: NodeShape -> NodeShape -> [NodeShape]
enumFrom :: NodeShape -> [NodeShape]
$cenumFrom :: NodeShape -> [NodeShape]
fromEnum :: NodeShape -> Int
$cfromEnum :: NodeShape -> Int
toEnum :: Int -> NodeShape
$ctoEnum :: Int -> NodeShape
pred :: NodeShape -> NodeShape
$cpred :: NodeShape -> NodeShape
succ :: NodeShape -> NodeShape
$csucc :: NodeShape -> NodeShape
Enum)

type NodeId = Prelude.String

data Node = Node
    { Node -> String
nodeId    :: NodeId
    , Node -> Maybe String
nodeLabel :: Maybe Prelude.String
    , Node -> Maybe NodeShape
nodeShape :: Maybe NodeShape
    }
    deriving (Node -> Node -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq, Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Show)

data Edge = Edge
    { Edge -> String
edgeFrom  :: NodeId
    , Edge -> String
edgeTo    :: NodeId
    , Edge -> Maybe String
edgeLabel :: Maybe Prelude.String
    }
    deriving (Edge -> Edge -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Edge -> Edge -> Bool
$c/= :: Edge -> Edge -> Bool
== :: Edge -> Edge -> Bool
$c== :: Edge -> Edge -> Bool
Eq, Int -> Edge -> ShowS
[Edge] -> ShowS
Edge -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Edge] -> ShowS
$cshowList :: [Edge] -> ShowS
show :: Edge -> String
$cshow :: Edge -> String
showsPrec :: Int -> Edge -> ShowS
$cshowsPrec :: Int -> Edge -> ShowS
Show)

data Ast = Ast
    { Ast -> [Node]
nodes :: [Node]
    , Ast -> [Edge]
edges :: [Edge]
    }
    deriving (Ast -> Ast -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ast -> Ast -> Bool
$c/= :: Ast -> Ast -> Bool
== :: Ast -> Ast -> Bool
$c== :: Ast -> Ast -> Bool
Eq, Int -> Ast -> ShowS
[Ast] -> ShowS
Ast -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ast] -> ShowS
$cshowList :: [Ast] -> ShowS
show :: Ast -> String
$cshow :: Ast -> String
showsPrec :: Int -> Ast -> ShowS
$cshowsPrec :: Int -> Ast -> ShowS
Show)

outputAst :: Ast -> Prelude.String
outputAst :: Ast -> String
outputAst Ast
ast =
    String
"digraph {\n" forall a. [a] -> [a] -> [a]
++
    String
nodeDef forall a. [a] -> [a] -> [a]
++
    String
edgeDef forall a. [a] -> [a] -> [a]
++
    String
"}"
    where
        nodeDef :: String
nodeDef = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
            do \Node
n ->
                Node -> String
nodeId Node
n forall a. [a] -> [a] -> [a]
++
                String
" [" forall a. [a] -> [a] -> [a]
++
                do case Node -> Maybe String
nodeLabel Node
n of
                    Just String
lb -> String
"label = \"" forall a. [a] -> [a] -> [a]
++ String
lb forall a. [a] -> [a] -> [a]
++ String
"\","
                    Maybe String
Nothing -> String
""
                forall a. [a] -> [a] -> [a]
++
                do case Node -> Maybe NodeShape
nodeShape Node
n of
                    Maybe NodeShape
Nothing -> String
""
                    Just NodeShape
sh ->
                        String
"shape = " forall a. [a] -> [a] -> [a]
++
                        do case NodeShape
sh of
                            NodeShape
DoubleCircle -> String
"doublecircle"
                            NodeShape
Circle       -> String
"circle"
                        forall a. [a] -> [a] -> [a]
++
                        String
","
                forall a. [a] -> [a] -> [a]
++
                String
"];\n"
            do Ast -> [Node]
nodes Ast
ast

        edgeDef :: String
edgeDef = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
            do \Edge
e ->
                Edge -> String
edgeFrom Edge
e forall a. [a] -> [a] -> [a]
++
                String
" -> " forall a. [a] -> [a] -> [a]
++
                Edge -> String
edgeTo Edge
e forall a. [a] -> [a] -> [a]
++
                String
" [" forall a. [a] -> [a] -> [a]
++
                do case Edge -> Maybe String
edgeLabel Edge
e of
                    Just String
lb -> String
"label = \"" forall a. [a] -> [a] -> [a]
++ String
lb forall a. [a] -> [a] -> [a]
++ String
"\","
                    Maybe String
Nothing -> String
""
                forall a. [a] -> [a] -> [a]
++
                String
"];\n"
            do Ast -> [Edge]
edges Ast
ast