%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% KATT Blueprint format grammar and transformations
%%%
%%% This grammar is used by Neotoma to generate a parser (katt_blueprint.erl).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

api <-
  empty_line*
  name:api_name?
  empty_line*
  description:api_description?
  empty_line*
  transactions:transactions
  footer:api_footer?
  eof
  `
    Name = proplists:get_value(name, Node),
    Description = proplists:get_value(description, Node),
    Transactions = proplists:get_value(transactions, Node),
    Footer = proplists:get_value(footer, Node),
    #katt_blueprint{
      name=null_if_empty(Name),
      description=null_if_empty(Description),
      transactions=Transactions,
      footer=null_if_empty(Footer)
    }
  `;

api_name <-
  !http_method "---" s+ name:text1 eolf
  `
    Name = proplists:get_value(name, Node),
    re:replace(Name, "\s+---$", "", [{return, binary}])
  `;

api_description <-
  !http_method "---" s* eol lines:api_description_line* "---" s* eolf
  `
    concatenate_lines(proplists:get_value(lines, Node))
  `;

api_description_line <-
  !("---" s* eolf) text:text0 eol
  `
    proplists:get_value(text, Node)
  `;

api_footer <-
  empty_line+ lines:api_footer_line*
  `
    concatenate_lines(proplists:get_value(lines, Node))
  `;

api_footer_line <-
  text:text0 eol
  `
    proplists:get_value(text, Node)
  `;

transactions <-
  head:transaction?
  tail:transactions_tail*
  `
    Head = proplists:get_value(head, Node),
    Tail = proplists:get_value(tail, Node),
    case Head of
      [] ->
        Tail;
      _ ->
        [Head | Tail]
    end
  `;

transactions_tail <-
  empty_line* transaction:transaction
  `
  proplists:get_value(transaction, Node)
  `;

transaction <-
  description:transaction_description?
  params:transaction_params?
  request:request
  response:response
  `
    Description = proplists:get_value(description, Node),
    Params = proplists:get_value(params, Node),
    Request = proplists:get_value(request, Node),
    Response = proplists:get_value(response, Node),

    #katt_transaction{
      description=null_if_empty(Description),
      params=Params,
      request=Request,
      response=Response
    }
  `;

transaction_description <-
  transaction_description_line+
  `
    concatenate_lines(Node)
  `;

transaction_description_line <-
  !http_method_or_transaction_param_keyword text:text0 eol
  `
    proplists:get_value(text, Node)
  `;

http_method_or_transaction_param_keyword <-
  http_method
  / transaction_param_keyword
  ~;

transaction_params <-
  params:transaction_param* empty_line*
  `
    proplists:get_value(params, Node)
  `;

transaction_param <-
  transaction_param_string
  / transaction_param_nonstring
  ~;

transaction_param_string <-
  transaction_param_keyword s+ name:transaction_param_name "=" '"' value:transaction_param_value_string '"' eol
  `
    Name = proplists:get_value(name, Node),
    Value = proplists:get_value(value, Node),

    {Name, Value}
  `;

transaction_param_nonstring <-
  transaction_param_keyword s+ name:transaction_param_name "=" value:transaction_param_value_nonstring eol
  `
    Name = proplists:get_value(name, Node),
    Value0 = proplists:get_value(value, Node),

    Value = try_to_convert_to([boolean, null, integer, float], Value0),
    {Name, Value}
  `;

transaction_param_keyword <-
  "PARAM"
  ~;

transaction_param_name <-
  [a-z0-9_]+
  `
    unicode:characters_to_list(concatenate_chars(Node))
  `;

transaction_param_value_string <-
  [^"]*
  `
    unicode:characters_to_list(concatenate_chars(Node))
  `;

transaction_param_value_nonstring <-
  text0
  `
    unicode:characters_to_list(Node)
  `;

%% Assembled from RFC 2616, 5323, 5789.
http_method <-
  "GET"
  / "POST"
  / "PUT"
  / "DELETE"
  / "OPTIONS"
  / "PATCH"
  / "PROPPATCH"
  / "LOCK"
  / "UNLOCK"
  / "COPY"
  / "MOVE"
  / "MKCOL"
  / "HEAD"
  ~;

request <-
  signature:signature headers:request_headers body:body?
  `
    {Method, Url} = proplists:get_value(signature, Node),
    Headers = proplists:get_value(headers, Node),
    Body = proplists:get_value(body, Node),
    #katt_request{
      method=Method,
      url=Url,
      headers=Headers,
      body=null_if_empty(Body)
    }
  `;

request_headers <-
  request_header*
  ~;

request_header <-
  in header:http_header
  `
    proplists:get_value(header, Node)
  `;

response <-
  status:response_status headers:response_headers body:body?
  `
    Status = proplists:get_value(status, Node),
    Headers = proplists:get_value(headers, Node),
    Body = proplists:get_value(body, Node),
    #katt_response{
      status=Status,
      headers=Headers,
      body=null_if_empty(Body)
    }
  `;

response_status <-
  out status:http_status s* eolf
  `
    proplists:get_value(status, Node)
  `;

response_headers <-
  response_header*
  ~;

response_header <-
  out http_header
  `
    [_, Header] = Node,
    Header
  `;

http_status <-
  [0-9]+
  `
    {Int, _Rest} = string:to_integer(unicode:characters_to_list(concatenate_chars(Node))),
    Int
  `;

http_header <-
  name:http_header_name ":" s* value:http_header_value eolf
  `
    Name = proplists:get_value(name, Node),
    Value = proplists:get_value(value, Node),
    {Name, Value}
  `;

%% See RFC 822, 3.1.2: "The field-name must be composed of printable ASCII
%% characters (i.e., characters that have values between 33. and 126., decimal,
%% except colon)."
http_header_name <-
  [\x21-\x39\x3B-\x7E]+
  `
    unicode:characters_to_list(concatenate_chars(Node))
  `;

http_header_value <-
  text0
  `
    unicode:characters_to_list(Node)
  `;

signature <-
  method:http_method s+ url:text1 eol
  `
    Method = unicode:characters_to_list(proplists:get_value(method, Node)),
    Url = unicode:characters_to_list(proplists:get_value(url, Node)),
    {Method, Url}
  `;

%% We do not support DelimitedBodyVariable.
body <-
  delimited_body_fixed
  / simple_body
  ~;

delimited_body_fixed <-
  "<<<" s* eol
  lines:delimited_body_fixed_line*
  ">>>" s* eolf
  `
    concatenate_lines(proplists:get_value(lines, Node))
  `;

delimited_body_fixed_line <-
  !(">>>" s* eolf) text:text0 eol
  `
    proplists:get_value(text, Node)
  `;

simple_body <-
  !"<<<" lines:simple_body_line+
  `
    concatenate_lines(proplists:get_value(lines, Node))
  `;

simple_body_line <-
  !in !out !empty_line text:text1 eolf
  `
    proplists:get_value(text, Node)
  `;

in <-
  ">" s+
  ~;

out <-
  "<" s+
  ~;


%%% Helper rules

text0 <-
  [^\n\r]*
  `
  concatenate_chars(Node)
  `;

text1 <-
  [^\n\r]+
  `
  concatenate_chars(Node)
  `;

empty_line <-
  s* eol
  ~;

eolf <-
  eol / eof
  ~;

eol <-
  "\n"
  / "\r\n"
  / "\r"
  ~;

eof <-
  !. ` <<>> `;

%% TODO: add support for the following unicode whitespace characters:
%% \u00A0\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007
%% \u2008\u2009\u200A\u202F\u205F\u3000\uFEFF
%% I.e. make support for what "\s" matches in JavaScript regexps,
%% sans "\r", "\n", "\u2028" and "\u2029".
%% See ECMA-262, 5.1 ed., 15.10.2.12.
s <-
  [\t\v\f ]
  ~;

%%% Records and extra functions
`
%%% This file is generated by neotoma.

-include("blueprint_types.hrl").

null_if_empty([]) ->
  null;
null_if_empty(String) ->
  String.

concatenate_lines([H|_]=Lines) when is_binary(H) ->
  StringList = lists:map(fun unicode:characters_to_list/1, Lines),
  unicode:characters_to_binary(string:join(StringList, "\n"));
concatenate_lines([]) ->
  [].

concatenate_chars(Chars) ->
  << <<Char/utf8>> || <<Char/utf8>> <- Chars >>.

try_to_convert_to([], _Value) ->
  throw({error, unknown_param_type});
try_to_convert_to([boolean|Rest], Value0) ->
  Value = string:to_lower(Value0),
  case Value of
    "true" ->
      true;
    "false" ->
      false;
    _ ->
      try_to_convert_to(Rest, Value0)
  end;
try_to_convert_to([float|Rest], Value) ->
  case string:to_float(Value) of
    {error, _} ->
      try_to_convert_to(Rest, Value);
    {FloatValue, []} ->
      FloatValue;
    _ ->
      try_to_convert_to(Rest, Value)
  end;
try_to_convert_to([integer|Rest], Value) ->
  case string:to_integer(Value) of
    {error, _} ->
      try_to_convert_to(Rest, Value);
    {IntValue, []} ->
      IntValue;
    _ ->
      try_to_convert_to(Rest, Value)
  end;
try_to_convert_to([null|Rest], Value0) ->
  Value = string:to_lower(Value0),
  case Value of
    "null" ->
      null;
    _ ->
      try_to_convert_to(Rest, Value)
  end.
`