%{
open Dot_types
%}

%token STRICT
%token GRAPH
%token DIGRAPH
%token NODE
%token EDGE
%token SUBGRAPH
%token LBRACE
%token RBRACE
%token LPAREN
%token RPAREN
%token LBRACKET
%token RBRACKET
%token COMMA
%token SEMICOLON
%token EQUAL
%token AT
%token COLON
%token PLUS
%token DIR_EDGEOP
%token UNDIR_EDGEOP
%token <string> IDENT
%token <string> STRING
%token <string> NUMBER

%nonassoc below_LBRACE
%nonassoc LBRACE

%start graph
%type <Dot_types.graph> graph

%%
graph:
    strict_flag graph_kind opt_id LBRACE stmt_list RBRACE
      { { strict = $1 ; kind = $2 ; 
	  id = $3 ; stmt = Q.to_list $5 } }
;

strict_flag:
    /* empty */        { false }
  | STRICT             { true }
;

graph_kind:
      GRAPH   { `GRAPH }
  | DIGRAPH   { `DIGRAPH }
;

opt_id:
     /* empty */ { None }
  | id           { Some $1 }
;

stmt_list:
    stmt_semi           { Q.push Q.empty $1 }
  | stmt_list stmt_semi { Q.push $1 $2 }
;

stmt_semi:
    stmt            { $1 }
  | stmt SEMICOLON  { $1 }
;

stmt: 
    node_stmt           { `NODE $1 }
  | edge_stmt           { `EDGE $1 }
  | attr_stmt           { $1 }
  | id_equal            { `ID_EQUAL $1 }
  | subgraph            { `SUBGRAPH $1 }
;

id_equal:
    id EQUAL id       { ($1, $3) }
;

node_stmt:
    node_id opt_attr_list { let (id, port) = $1 in 
                            (id, port, Q.to_list $2) }
;

node_id:
    id opt_port       { ($1, $2) }
;

opt_port:
    /* empty */       { None }
  | port              { Some $1 }
;

port:
    port_location               { (`LOCATION $1, `NO_ANGLE) }
  | port_location port_angle    { (`LOCATION $1, `ANGLE $2) }
  | port_angle port_location    { (`LOCATION $2, `ANGLE $1) }
  | port_angle                  { (`NO_LOCATION, `ANGLE $1) }
;

port_location:
    COLON id                        { `ONE_ID $2 }
  | COLON LPAREN id COMMA id RPAREN { `TWO_ID ($3, $5) }
;

port_angle:
    AT id                   { $2 }
;

subgraph:
  | SUBGRAPH id LBRACE stmt_list RBRACE     { (Some $2, Q.to_list $4) }
  | SUBGRAPH    LBRACE stmt_list RBRACE     { (None, Q.to_list $3) }
  |             LBRACE stmt_list RBRACE     { (None, Q.to_list $2) }
  | SUBGRAPH id %prec below_LBRACE          { (Some $2, []) }
;

opt_attr_list:
    /* empty */             { Q.empty }
  | attr_list               { $1 }
;

attr_list:
  | LBRACKET a_list RBRACKET            { $2 }
  | attr_list LBRACKET a_list RBRACKET  { Q.concat $1 $3 }
;

a_list:
    a_list_item             { Q.push Q.empty $1 }
  | a_list a_list_item      { Q.push $1 $2 }
;

a_list_item:
    id EQUAL id COMMA       { ($1, $3) }
  | id EQUAL id             { ($1, $3) }
  | id COMMA                { ($1, "true") }
  | id                      { ($1, "true") }
;

attr_stmt:
    GRAPH attr_list          { `ATTR_GRAPH (Q.to_list $2) }
  | NODE  attr_list          { `ATTR_NODE  (Q.to_list $2) }
  | EDGE  attr_list          { `ATTR_EDGE  (Q.to_list $2) }
;

node_or_subgraph:
    node_id                  { `NODEID $1 }
  | subgraph                 { `SUBGRAPH $1 }
;

edge_stmt:
    node_or_subgraph edgeRHS_list opt_attr_list  { ($1, Q.to_list $2, Q.to_list $3) }
;

edgeRHS_list:
    edgeRHS                     { Q.push Q.empty $1 }
  | edgeRHS_list edgeRHS        { Q.push $1 $2 }
;

edgeRHS:
    DIR_EDGEOP node_or_subgraph    { (`DIRECTED, $2) }
  | UNDIR_EDGEOP node_or_subgraph  { (`UNDIRECTED, $2) }
;

id:
    IDENT             { $1 }
  | string            { String.concat "" (Q.to_list $1) }
  | NUMBER            { $1 }
;

string:
    STRING               { Q.push Q.empty $1 }
  | string PLUS STRING   { Q.push $1 $3 }
;