1#key type regexpr
2TRIPLE <- "^\\{(.+)\\}"
3AMPERSAND <- "^&(.+)"
4SECTION <- "\\#([ A-z0-9.]+)"
5INVERTEDSECTION <- "\\^([ A-z0-9.]+)"
6ENDSECTION <- "/([ A-z0-9.]+)"
7PARTIAL <- ">\\s*(.+?)\\s*"
8COMMENT <- "!.+?"
9DELIM <- "=\\s*(.+?)\\s*="
10
11STANDALONE <- "[#/^][A-z0-9]+"
12
13#keytypes
14keytypes <- c("", "{}", "&", "#", "^", "/", ">")
15
16
17# current parsing code is not a clean parsing state machine!
18# This is partly due to that this would be clumsy in R,
19# It's on my list to do the parsing in C (would be significantly faster)
20parseTemplate <- function(template, partials=new.env(), debug=FALSE, strict=TRUE){
21  #TODO add delimiter switching
22
23  delim <- tag2delim()
24
25  template <- paste(template, collapse="\n")
26  template <- replace_delim_tags(template)
27  template <- removeComments(template, delim)
28
29  template <- inlinePartial(template, delim)
30  template <- inlineStandAlone2(template, delim, STANDALONE)
31#   template <- inlineStandAlone(template, delim, ENDSECTION)
32#   template <- inlineStandAlone(template, delim, SECTION)
33#   template <- inlineStandAlone(template, delim, INVERTEDSECTION)
34
35  KEY <- delimit("(.+?)", delim)
36
37  text <- strsplit(template, KEY)[[1]]
38  text <- literal_tags(text)
39  key <- getKeyInfo(template, KEY)
40  n <- nrow(key)
41
42  render <- list()
43  #default rendering method
44  render[1:n] <- list(renderHTML)
45  #literal rendering
46  literal <- key$type %in% c("{}", "&")
47  render[literal] <- list(renderText)
48
49  # parse sections and inverted sections
50  exclude <- logical(n)
51  insection <- integer(n)
52  stack <- 0L
53  for (i in seq_along(key$key)){
54     h <- stack[1]
55     insection[i] <- h
56     type <- key$type[i]
57
58     if(type %in% c("#", "^")){
59       # section and inverted section
60       stack <- c(i, stack)
61     } else if (type == "/"){
62       #end section
63       stack <- stack[-1]
64
65       if (key$key[h]!=key$key[i]){
66          stop("Template contains unbalanced closing tag. Found: '/", key$key[i], "' but expected: '/", key$key[h],"'")
67       }
68
69       # make a section or inverted section
70       idx <- which(h==insection)
71       kidx <- idx[-length(idx)]
72
73       renderFUN <- if (key$type[h] == "#") section
74                    else inverted
75
76       render[h] <- list(renderFUN( text[idx]
77                                  , key$key[kidx]
78                                  , render[kidx]
79                                  )
80                        )
81       } else if (type == ">"){
82         #partial
83         indent <- sub(">([ \t]*).+","\\1", key$rawkey[i])
84         render[i] <- list(partial(key$key[i], partials, indent))
85     }
86  }
87  if (length(stack) > 1){
88     stop("Template does not close the following tags: ", key$rawkey[stack])
89  }
90
91  exclude <- insection > 0
92  keys <- key$key[!exclude]
93  texts <- text[c(!exclude, TRUE)[seq_along(text)]] # only select text that is needed
94  renders <- render[!exclude]
95
96  compiled <- function(data=list(), context=list(data)){
97    values <- lapply(keys, resolve, context=context, strict=strict)
98    keyinfo <- key
99    renderTemplate( values=values
100                  , context=context
101                  , texts=texts
102                  , renders=renders
103                  , debug=debug
104                  )
105  }
106
107  class(compiled) <- "template"
108  compiled
109}
110
111getKeyInfo <- function(template, KEY){
112  first <- gregexpr(KEY, template)[[1]]
113  last <- attr(first, "match.length") + first - 1
114  keys <- substring(template, first, last)
115  keys <- gsub(KEY, "\\1", keys)
116
117  key <- data.frame(rawkey=keys, first=first, last=last, stringsAsFactors=FALSE)
118
119  # keys should not contain white space, (triple and ampersand may contain surrounding whitespace
120  key$key <- gsub("\\s", "", key$rawkey)
121  key$type <- factor("", levels=keytypes)
122
123  key$type[grep(TRIPLE, key$rawkey)] <- "{}"
124  key$type[grep(AMPERSAND, key$rawkey)] <- "&"
125  key$type[grep(SECTION, key$rawkey)] <- "#"
126  key$type[grep(INVERTEDSECTION, key$rawkey)] <- "^"
127  key$type[grep(ENDSECTION, key$rawkey)] <- "/"
128  key$type[grep(PARTIAL, key$rawkey)] <- ">"
129
130  key$key <- gsub(TRIPLE, "\\1",key$key)
131  key$key <- gsub(AMPERSAND, "\\1",key$key)
132  key$key <- gsub(SECTION, "\\1",key$key)
133  key$key <- gsub(INVERTEDSECTION, "\\1",key$key)
134  key$key <- gsub(ENDSECTION, "\\1",key$key)
135  key$key <- gsub(PARTIAL, "\\1",key$key)
136  key
137}
138
139inlineStandAlone2 <- function(text, delim, keyregexp){
140  # remove groups from regexp
141  keyregexp <- gsub("\\(|\\)","",keyregexp)
142
143  dKEY <- delimit(keyregexp, delim)
144
145  re <- paste("(?<=\n|^)([ \t]*)(",dKEY,")\\s*?(\n|$)", sep="")
146
147  rex <- gregexpr(re, text, perl=T)
148  rex1 <- gregexpr(dKEY, text)
149  gsub(re, "\\2",  text, perl=T)
150}
151
152inlineStandAlone <- function(text, delim, keyregexp){
153   # remove groups from regexp
154   keyregexp <- gsub("\\(|\\)","",keyregexp)
155
156   dKEY <- delimit(keyregexp, delim)
157
158   re <- paste("(^|\n)([ \t]*)(",dKEY,")\\s*?(\n|$)", sep="")
159
160   rex <- regexpr(re, text)
161   gsub(re, "\\1\\3",  text)
162}
163
164removeComments <- function(text, delim){
165   text <- inlineStandAlone(text, delim, COMMENT)
166
167   #remove inline comments
168   dCOMMENT <- paste(delim[1],COMMENT, delim[2], sep="")
169   gsub(dCOMMENT, "",  text)
170}
171
172inlinePartial <- function(text, delim){
173   dKEY <- paste(delim[1],PARTIAL, delim[2], sep="")
174   text <- gsub(dKEY, "{{>\\1}}", text)
175   re <- paste("(^|\n)([ \t]*)",dKEY,"\\s*?(\n|$)", sep="")
176   rep <- paste("\\1\\2", delim[1],">\\2\\3",delim[2], sep="")
177   gsub(re, rep,  text)
178}
179