1/*   core
    2     Author: Giménez, Christian.
    3
    4     Copyright (C) 2017 Giménez, Christian
    5
    6     This program is free software: you can redistribute it and/or modify
    7     it under the terms of the GNU General Public License as published by
    8     the Free Software Foundation, either version 3 of the License, or
    9     at your option) any later version.
   10
   11     This program is distributed in the hope that it will be useful,
   12     but WITHOUT ANY WARRANTY; without even the implied warranty of
   13     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   14     GNU General Public License for more details.
   15
   16     You should have received a copy of the GNU General Public License
   17     along with this program.  If not, see <http://www.gnu.org/licenses/>.
   18
   19     05 ago 2017
   20*/
   21
   22
   23:- module(core, [
   24	      iana_token//1,
   25	      x_name//1,
   26	      param//1,
   27	      content_line//1,
   28	      param_value//1,
   29	      param_name//1,
   30	      name//1,
   31	      value//1,
   32	      params//1
   33	  ]).

core: iCalendar Core Implementation

iCalendar core DCGs and validators.

Standards

This is an implementation of the RFC 5545:

The following standards are or will be supported in other libraries:

   52:- license(gplv3).   53
   54:- use_module(library(dcg/basics)).
 alphas(-Codes:codes)//
Match ALPHA (lowercase or uppercase alphabetic character). */
   61alphas(Codes) --> [C], {code_type(C, alpha)}, alphas(R),
   62		  !, {append([C],R, Codes)}.
   63alphas([C]) --> [C], {code_type(C, alpha)}.
 alpha(-Code:int)//
Lowercase or uppercase alphabetic char. */
   70alpha(C) --> [C], {code_type(C, alpha)}.
   71
   72iana_int(`-`) --> "-", !.
   73iana_int(Digits) --> digit(D),!, digits(Digits1),
   74		     {append([[D], Digits1], Digits)}.
   75iana_int(Alphas) --> alphas(Alphas), !.
 iana_token(-Val:codes)//
ABNF: iana-token = 1*(ALPHA / DIGIT / "-") */
   82iana_token(Token) --> iana_int(Int), iana_token(More), !,
   83				    {append([Int, More], Token)}.
   84iana_token(Token) --> iana_int(Token).
   85
   86vendor_id([V1,V2,V3]) --> (digit(V1) ; alpha(V1)),
   87			  (digit(V2) ; alpha(V2)),
   88			  (digit(V3) ; alpha(V3)).
 x_name(-Token:codes)//
ABNF: x-name = "X-" [vendorid "-"] 1*(ALPHA / DIGIT / "-") */
   95x_name(Token) --> "X-", vendor_id(V), "-",
   96		  !, iana_token(T),
   97		  {append([`X-`,V,`-`,T], Token)}.
 paramtext(-Text:codes)//
ABNF: `paramtext = *SAFE-CHAR` */
  104paramtext(Text) --> string_without("\";:,",Text).
 quoted_string(-Text:codes)//
ABNF: `quoted-string = DQUOTE *QSAFE-CHAR DQUOTE` */
  111quoted_string(Text) --> "\"", string_without("\"",Text), "\"".
 param_value(-Text:codes)//
ABNF: param-value = paramtext / quoted-string. */
  118param_value(Text) --> quoted_string(Text) ; paramtext(Text).
 param_values(-Values:list)//
ABNF: `*("," param-value)`
Arguments:
Values- A list of codes. The different parameters parsed. */
  128param_values(Values) --> ",", param_value(Text), param_values(Rest), !,
  129			 {append([[Text], Rest], Values)}.
  130param_values([]) --> [].
 param_name(-Name:codes)//
ABNF: name = iana-token / x-name */
  137param_name(Name) --> x_name(Name) ; iana_token(Name).
 param(-Param:pred)//
ABNF: param = param-name "=" param-value *("," param-value)
Arguments:
Param- A param/2 predicate: param(Name: codes, Values: list). Values is a list of codes. */
  146param(param(Name, Values)) --> param_name(Name), "=", param_value(Val1), param_values(Vals2),
  147			       {append([[Val1], Vals2], Values)}.
 name(-Name:codes)//
ABNF: name = iana-token / x-name */
  154name(Name) --> x_name(Name) ; iana_token(Name).
 crlf//
Originally accepts characters [13,10], but in this implementation we'll be flexible to accept one of those and EOS too. */
  161crlf --> [13,10], !.
  162crlf --> [13], !.
  163crlf --> [10], !.
  164crlf --> eos, !.
 value(-Val:codes)//
ABNF: value = *VALUE-CHAR

ABNF: VALUE-CHAR = WSP / %x21-7E / NON-US-ASCII */

  173value(Val) --> string_without("\n\t\r", Val).
 params(-Params:list)//
ABNF: *(";" param )
Arguments:
Params- A list of codes. */
  182params(Params) --> ";",
  183		   !, param(P), params(Rest),
  184		   {append([[P], Rest], Params)}.
  185params([]) --> [].
 content_line(-Content:pred)//
ABNF: contentline = name *(";" param ) ":" value CRLF
Arguments:
Content- A content/3 predicate: content(Name: codes, Params: list, Val:codes) where Params is a list of codes. */
  194content_line(content(Name, Params, Val)) --> name(Name), params(Params), ":", value(Val), crlf.