tools/docGen/createRdFiles.R

In Sage-Bionetworks/rSynapseClient: Synapse R Client from Sage Bionetworks

#!/usr/bin/env Rscript
#
# This script generates .Rd files for a list of chosen auto-generated S4 classes
# can be invoked from a shell script, e.g.:
# path/to/package/source/tools/docGen/autoGeneratedRdFiles.R path/to/package/source
# 
# Author: brucehoff
###############################################################################

if (!require(rjson)) {
  install.packages("rjson", repos="http://cran.us.r-project.org")
  if (!require(rjson)) stop("Could not install 'rjson'")
}

# This generates one .Rd file for an auto-generated S4 class using its JSON schema
createRdFromSchema<-function(className, schemaName, schemaPath, classToSchemaMap) {
  nameLine<-paste("\\name{", className, "}", sep="")
  aliasLine<-paste("\\alias{", className, "}", sep="")
  docTypeLine<-paste("\\docType{methods}", sep="")
  titleLine<-paste("\\title{\n", className, " Constructor\n}", sep="")
  descriptionLine<-paste("\\description{Constructor for ", className, "}", sep="")
  
  propertySchemas<-getEffectivePropertySchemas(schemaName, schemaPath)
  usageLine<-paste("\\usage{", className, "(", paste(names(propertySchemas), collapse=", "), ")}", sep="")
  
  arguments<-"\\arguments{"
  slots<-"\\section{Slots}{\n  \\describe{"
  seeAlsoClasses<-NULL
  referencedTypedLists<-NULL
  for (propertyName in names(propertySchemas)) {
    propertySchema <- propertySchemas[[propertyName]]
    propertyType <- getPropertyType(propertySchema, schemaPath, classToSchemaMap)
    if (propertyType$isTypedList) {
      referencedTypedLists<-append(referencedTypedLists, propertyType$type)
    }
    arguments<-paste(arguments, 
      itemRdEntry(propertyName, propertySchema$description, propertyTypeToString(propertyType)), sep="\n")
    slots<-paste(slots, slotRdEntry(propertyName, propertySchema$description, propertyTypeToString(propertyType)), sep="\n")
    if (!isPrimitiveType(propertyType$type)) seeAlsoClasses<-append(seeAlsoClasses, propertyType$type)
  }
  arguments<-paste(arguments, "}", sep="\n")
  slots<-paste(slots, "  }\n}", sep="\n")
  seealso<-"\\seealso{"
  for (seeAlsoClass in seeAlsoClasses) {
      seealso<-paste(seealso, paste("\\code{\\link{", seeAlsoClass, "}}", sep=""), sep="\n")
  }
  seealso<-paste(seealso, "}", sep="\n")
  content<-paste(
    nameLine, 
    aliasLine, 
    docTypeLine, 
    titleLine, 
    descriptionLine,
    usageLine,
    arguments,
    slots,
    seealso,
    sep="\n")
  
  result<-list(content=content, referencedTypedLists=referencedTypedLists)
}

itemRdEntry<-function(itemName, itemDescription, itemType) {
  normalizedItemDescription<-gsub("\\", "\\\\", itemDescription, fixed=TRUE)
  paste("  \\item{", itemName, "}{\n  ", normalizedItemDescription, " (", itemType, ")\n  }", sep="")
}

slotRdEntry<-function(itemName, itemDescription, itemType) {
  normalizedItemDescription<-gsub("\\", "\\\\", itemDescription, fixed=TRUE)
  paste("    \\item{\\code{", itemName, "}}{\n    ", normalizedItemDescription, " (", itemType, ")\n    }", sep="")
}

# given a 'propertySchema' return the R type
# the result could be a primitive type, an S-4 class, or a Typed List
# result has three fields, 
# (1) type and 
# (2) enum: If the type is an enum or a list of enums, this field enumerates the allowed types
# (3) isTypedList: TRUE iff the type is a TypedList 
# (4) isArray:  TRUE iff the type is an array
# Note:  This closely parallels the logic in defineRTypeFromPropertySchema
getPropertyType<-function(propertySchema, schemaPath, classToSchemaMap) {
  # This is the type 'in the language of the schema'
  schemaPropertyType<-schemaTypeFromProperty(propertySchema)
  primitiveRType<-TYPEMAP_FOR_ALL_PRIMITIVES[[schemaPropertyType]]
  if(length(primitiveRType)>0) {
    # No S4 class to define, just return type name
    list(type=primitiveRType, enum=propertySchema$enum, isTypedList=FALSE, isArray=FALSE)
  } else if (schemaPropertyType=="array") {
    elemRType <- getPropertyType(getArraySubSchema(propertySchema), schemaPath, classToSchemaMap)
    if (isPrimitiveType(elemRType$type)) {
      list(type=elemRType$type, enum=elemRType$enum, isTypedList=FALSE, isArray=TRUE)
    } else {
      list(type=listClassName(elemRType$type), enum=elemRType$enum, isTypedList=TRUE, isArray=TRUE)
    }
  } else {
    # check for an enum
    # this is getting subtle: The 'propertySchema' can be a reference, in which case we have to 
    # follow the reference and read it in from another file.  Alternatively the schema can
    # be defined in line, in which case we already have the schema and need not read it in.
    if (!is.null(propertySchema[["$ref"]])) {
      propertySchema <- readSchema(schemaPropertyType, schemaPath)
    }
    if (isEnum(propertySchema)) {
      # it's an 'enum' or similar
      list(type=TYPEMAP_FOR_ALL_PRIMITIVES[[propertySchema$type]], enum=propertySchema$enum, isTypedList=FALSE, isArray=FALSE)
    } else {
      list(type=classToSchemaMap[[schemaPropertyType]], isTypedList=FALSE, isArray=FALSE)
    }
  }  
}

propertyTypeToString<-function(propertyType) {
  if (is.null(propertyType$enum)) {
    propertyType$type
  } else {
    enumString<-paste(propertyType$enum, collapse=", ")
    if (isPrimitiveType(propertyType$type)) {
      if (propertyType$isArray) {
        sprintf("one or more of %s", enumString)
      } else {
        sprintf("one of %s", enumString)
      }
    } else {
      sprintf("%s of %s", propertyType$type, enumString)
    }
  }
}

# use a template here and just insert the names of the typed lists where appropriate (e.g. as aliases)
createTypedListRd<-function(referencedTypedLists, srcRootDir) {
  templateFile<-sprintf("%s/tools/docGen/typedListTemplate.Rd", srcRootDir)
  connection<-file(templateFile, open="r")
  template<-paste(readLines(connection), collapse="\n")
  close(connection)
  aliasLines<-paste(lapply(X=referencedTypedLists, FUN=function(x){paste("\\alias{",x,"}",sep="")}), collapse="\n")
  content<-gsub("##alias##", aliasLines, template, fixed=TRUE)
  content
}

# use a template here and just insert the names of the typed lists where appropriate (e.g. as aliases)
createAsTypedListRd<-function(referencedTypedLists, srcRootDir) {
  templateFile<-sprintf("%s/tools/docGen/asTypedListTemplate.Rd", srcRootDir)
  connection<-file(templateFile, open="r")
  template<-paste(readLines(connection), collapse="\n")
  close(connection)
  aliasLines<-paste(lapply(X=referencedTypedLists, FUN=function(x){paste("\\alias{as.",x,"}",sep="")}), collapse="\n")
  content<-gsub("##alias##", aliasLines, template, fixed=TRUE)
  usageLines<-paste(lapply(X=referencedTypedLists, FUN=function(x){paste("as.",x,"(x)\n",sep="")}), collapse="\n")
  content<-gsub("##usage##", usageLines, content, fixed=TRUE)
  content
}

# create the autogenerated files
# srcRootDir is the root directory for the code base
# the schemas are found in <srcRootDir>/inst/resources/schema
# the target dir is <srcRootDir>/man
autoGenerateRdFiles<-function(srcRootDir) {
  if (!file.exists(srcRootDir)) {
    stop(sprintf("%s does not exist.", srcRootDir))
  }
  filePath<-sprintf("%s/inst/resources/s4ClassesToGenerate.txt", srcRootDir)
  s4ClassesToAutoGenerate<-read.table(filePath,
    header=TRUE, colClasses=c("character", "character", "logical"))
  schemaPath<-sprintf("%s/inst/resources/schema", srcRootDir)
  classToSchemaMap<-list()
  for(i in 1:(dim(s4ClassesToAutoGenerate)[1])) { 
    schemaName<-s4ClassesToAutoGenerate[i,"schemaName"]
    className<-s4ClassesToAutoGenerate[i,"className"]
    classToSchemaMap[[schemaName]]<-className
  }
  referencedTypedLists<-NULL
  for(i in 1:(dim(s4ClassesToAutoGenerate)[1])) { 
    schemaName<-s4ClassesToAutoGenerate[i,"schemaName"]
    className<-s4ClassesToAutoGenerate[i,"className"]
    if (s4ClassesToAutoGenerate[i,"genDoc"]) {
      rdResult<-createRdFromSchema(className, schemaName, schemaPath, classToSchemaMap)
      referencedTypedLists<-unique(append(referencedTypedLists, rdResult$referencedTypedLists))
      writeContent(rdResult$content, className, srcRootDir)
    }
  }
  rdContent<-createTypedListRd(referencedTypedLists, srcRootDir)
  writeContent(rdContent, "TypedList", srcRootDir)
  rdContent<-createAsTypedListRd(referencedTypedLists, srcRootDir)
  writeContent(rdContent, "asTypedList", srcRootDir)
}

writeContent<-function(content, className, srcRootDir) {
  fileName<-sprintf("%s/man/%s.Rd", srcRootDir, className)
  connection<-file(fileName, open="w")
  writeChar(content, connection, eos=NULL)
  writeChar("\n", connection, eos=NULL)
  close(connection)
#  cat(sprintf("Created %s\n", fileName))
}

# now call autoGenerateRdFiles
args <- commandArgs(TRUE)
srcRootDir<-args[1]
# 'source' some functions shared with the synapse client package
source(sprintf("%s/R/AAAAshared.R",srcRootDir))
autoGenerateRdFiles(srcRootDir)