1:- module(st_parse, [
    2    st_parse/3 % +Codes, -Blocks, +Options
    3]).

Template parser

Parses a list of tokens into a template structure. */

   10:- use_module(library(error)).   11:- use_module(library(option)).   12
   13:- use_module(st_white).   14:- use_module(st_tokens).
 st_parse(+Codes, -Templ, +Options) is det
Parses given list of codes into a template.

Throws various parsing errors.

   22st_parse(Codes, Blocks, Options):-
   23    st_tokens(Codes, Options, Tokens),
   24    phrase(blocks(Tmp, Options), Tokens, Rest), !,
   25    check_rest(Rest),
   26    Blocks = Tmp.
   27
   28% Checks the remaining tokens.
   29% Some tokens (end, else, else_if)
   30% could appear by mistake without the
   31% block-starting token. This will catch
   32% such errors.
   33
   34check_rest([]):- !.
   35
   36check_rest([end|_]):-
   37    throw(error(unexpected_block_end)).
   38
   39check_rest([else|_]):-
   40    throw(error(unexpected_else)).
   41
   42check_rest([else_if(_)|_]):-
   43    throw(error(unexpected_else_if)).
   44
   45% Takes as many blocks as possible.
   46
   47blocks([Block|Blocks], Options) -->
   48    block(Block, Options), !,
   49    blocks(Blocks, Options).
   50
   51blocks([], _) --> [].
   52
   53% Output statement.
   54
   55block(out(Term), _) -->
   56    [out(Term)].
   57
   58% Unescaped output statement.
   59
   60block(out_unescaped(Term), _) -->
   61    [out_unescaped(Term)].
   62
   63% Each loop.
   64
   65block(each(Items, Item, Blocks), Options) -->
   66    [each(Items, Item)], blocks(Blocks, Options), block_end.
   67
   68block(each(Items, Item, Index, Blocks), Options) -->
   69    [each(Items, Item, Index)], blocks(Blocks, Options), block_end.
   70
   71block(each(Items, Item, Index, Len, Blocks), Options) -->
   72    [each(Items, Item, Index, Len)], blocks(Blocks, Options), block_end.
   73
   74% if/else/else if blocks.
   75
   76block(if(Cond, True, Rest), Options) -->
   77    [if(Cond)], blocks(True, Options), cond_rest(Rest, Options).
   78
   79% Text output.
   80
   81block(text(String), Options) -->
   82    [text(Codes)], !,
   83    {
   84        (   option(strip(true), Options)
   85        ->  st_strip_indent(Codes, Stripped),
   86            string_codes(String, Stripped)
   87        ;   string_codes(String, Codes))
   88
   89    }.
   90
   91% Include.
   92
   93block(include(File), _) -->
   94    [include(File)].
   95
   96block(include(File, Var), _) -->
   97    [include(File, Var)].
   98
   99% Dynamic include.
  100
  101block(dynamic_include(FileVar), _) -->
  102    [dynamic_include(FileVar)].
  103
  104block(dynamic_include(FileVar, Var), _) -->
  105    [dynamic_include(FileVar, Var)].
  106
  107% Block usage.
  108
  109block(block(File, Blocks), Options) -->
  110    [block(File)], blocks(Blocks, Options), block_end.
  111
  112block(block(File, Var, Blocks), Options) -->
  113    [block(File, Var)], blocks(Blocks, Options), block_end.
  114
  115% Block content.
  116
  117block(slot, _) -->
  118    [slot].
  119
  120% Recognizes block end or
  121% throws an error when one not found.
  122
  123block_end -->
  124    [end], !.
  125
  126block_end -->
  127    { throw(error(expecting_block_end)) }.
  128
  129% Remainer part of if/else if block.
  130
  131cond_rest([], _) -->
  132    [end], !.
  133
  134cond_rest(Blocks, Options) -->
  135    [else], blocks(Blocks, Options), block_end, !.
  136
  137cond_rest([if(Cond, True, Rest)], Options) -->
  138    [else_if(Cond)], blocks(True, Options), cond_rest(Rest, Options), !.
  139
  140cond_rest(_, _) -->
  141    { throw(error(expecting_cond_else_or_end)) }