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