Commit c6dac1f8 authored by Jeroen Henrix's avatar Jeroen Henrix

Added "Generate API documentation" example

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@1673 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 636132e3
......@@ -17,6 +17,8 @@ import SmallExamples
import GUIDemo
import BugReport
import Coffeemachine
import APIDocumentation
//import Newsgroups
import ChangeHandling
//import textEditor
......@@ -73,5 +75,6 @@ where
]
, rpcExamples
, ginExamples
, apiDocumentationExamples
, clientExample
]
definition module APIDocumentation
import iTasks
apiDocumentationExamples :: [Workflow]
implementation module APIDocumentation
from StdFunc import id
import StdFile
import StdList
import StdString
import Error
import Maybe
import File
import FilePath
import Directory
import Text
from LaTeX import :: LaTeX (CleanCode, CleanInline, EmDash, Emph, Index, Itemize, Item, NewParagraph, Section, Subsection), printLaTeX
from LaTeX import qualified :: LaTeX (Text)
import iTasks
import DocumentDB
import CleanDocParser
from general import qualified ::Optional(..)
from general import ::Bind(..), ::Env(..)
from Heap import ::Ptr
from scanner import
::Assoc(..),
::Priority(..)
from syntax import
::AttributeVar,
::AttrInequality,
::AType(..),
::ATypeVar,
::BasicType(..),
::ClassDef,
::ConsVariable,
::DefinedSymbol(..),
::FunKind,
::FunSpecials(..),
::GenericCaseDef,
::GenericDef,
::GenericTypeContext(..),
::Global(..),
::GlobalIndex,
::Ident(..),
::Import,
::ImportedObject,
::Index,
::ParsedDefinition(..),
::ParsedExpr,
::ParsedImport,
::ParsedInstanceAndMembers,
::ParsedTypeDef,
::Position,
::Rhs,
::RhsDefsOfType,
::Special(..),
::SpecialSubstitution(..),
::StrictnessList,
::SymbolPtr,
::SymbolTableEntry,
::SymbolType(..),
::TCClass(..),
::TempVarId,
::Type(..),
::TypeAttribute(..),
::TypeContext(..),
::TypeDef,
::TypeKind,
::TypeSymbIdent(..),
::TypeSymbProperties,
::TypeVar(..),
::TypeVarInfo,
::TypeVarInfoPtr,
::VarInfo,
::VarInfoPtr,
instance toString BasicType
apiDocumentationExamples :: [Workflow]
apiDocumentationExamples =
[ workflow "Examples/Miscellaneous/Generate API documentation" "Generate iTasks API documentation in LaTeX format" generateTeXExample ]
generateTeXExample :: Task Void
generateTeXExample = updateInformation "Enter API Directory:" [] (".." </> "Server" </> "API")
>>= \directory -> generateTeX directory >>= transform printLaTeX
>>= \tex -> createDocumentTask "iTasks_API_documentation.tex" "application/x-tex" tex
>>= showInformation "Download iTasks API documentation in TeX format" []
>>| stop
derive class iTask LaTeX
generateTeX :: !FilePath -> Task [LaTeX]
generateTeX path
| endsWith ".dcl" path =
accWorldError (documentDCL path) id >>= \moduleDoc ->
return (moduleToTeX moduleDoc)
| otherwise =
accWorldOSError (isSubDirectory path) >>= \isSubDir ->
if isSubDir
(accWorldOSError (readDirectory path) >>= \entries ->
sequence ("Generating TeX documentation in " +++ path)
[ generateTeX (path </> e) \\ e <- entries | e <> "." && e <> ".."] >>= transform flatten
)
(return [])
where
isSubDirectory :: !String *World -> (MaybeOSError Bool, *World)
isSubDirectory filename world
# (res, world) = getFileInfo filename world
| isError res = (liftError res, world)
= (Ok (fromOk res).directory, world)
:: ModuleDoc =
{ ident :: !String
, functions :: ![FunctionDoc]
}
:: FunctionDoc =
{ ident :: !String
, operator :: !Maybe String
, title :: !String
, params :: ![ParameterDoc]
, description :: !String
, returnType :: !TypeDoc
, returnDescription :: !String
, context :: !Maybe String
}
:: ParameterDoc =
{ title :: !String
, description :: !String
, type :: !TypeDoc
}
:: TypeDoc :== String
derive class iTask ModuleDoc, FunctionDoc, ParameterDoc
moduleToTeX :: !ModuleDoc -> [LaTeX]
moduleToTeX {ModuleDoc | ident, functions} = [ Section ident : flatten (map functionToTeX functions) ]
functionToTeX :: !FunctionDoc -> [LaTeX]
functionToTeX {FunctionDoc | ident, operator, params, description, returnType, returnDescription, context }
= [ Subsection (case operator of
Just op = ident +++ " operator"
Nothing = ident)
, Index ident
, CleanCode
[ (case operator of
Just op = parens ident +++ " " +++ op
Nothing = ident
)
+++ " :: "
+++ join " " [p.ParameterDoc.type \\ p <- params]
+++ " -> " +++ returnType
+++ (case context of
Nothing = ""
Just c = "| " +++ c)
]
, 'LaTeX'.Text description
, NewParagraph
, Emph ['LaTeX'.Text "Parameters:"]
, (if (isEmpty params)
('LaTeX'.Text "(none)")
(Itemize (map parameterToTeX params))
)
, NewParagraph
, Emph ['LaTeX'.Text "Returns:"]
, CleanInline returnType
, EmDash
, 'LaTeX'.Text returnDescription
]
parameterToTeX :: !ParameterDoc -> LaTeX
parameterToTeX {ParameterDoc | title, type, description} =
Item [ 'LaTeX'.Text title
, CleanInline (" :: " +++ type)
, EmDash
, 'LaTeX'.Text description
]
documentDCL :: !FilePath *World -> (MaybeErrorString ModuleDoc, *World)
documentDCL filename world
# (res, world) = readFile filename world
| isError res = (Error ("Failed to read file: " +++ toString (fromError res)), world)
# (ok, errorFile, world) = fopen "errors.txt" FWriteText world
| not ok = (Error "Failed to open errors.txt file", world)
# (defs, errorFile) = parseModule (fromOk res) False errorFile
# (ok,world) = fclose errorFile world
| not ok = (Error "Failed to close errors.txt file", world)
# (_,world) = deleteFile "errors.txt" world
= (Ok { ModuleDoc
| ident = dropExtension (dropDirectory filename)
, functions = documentDefinitions defs
}
, world)
documentDefinitions :: ![ParsedDefinition] -> [FunctionDoc]
documentDefinitions [] = []
documentDefinitions [PD_Documentation docstr: PD_TypeSpec pos ident prio optSymbtype specials: defs]
# res = parseDocBlock docstr
# doc = case res of
Ok doc = doc
Error err = emptyDocBlock
= case documentFunction doc ident prio optSymbtype of
Just fd = [fd:documentDefinitions defs]
Nothing = documentDefinitions defs
documentDefinitions [def:defs] = documentDefinitions defs
documentFunction :: !DocBlock Ident Priority ('general'.Optional SymbolType) -> Maybe FunctionDoc
documentFunction doc ident prio 'general'.No = Nothing
documentFunction doc ident prio ('general'.Yes st) = Just
{ FunctionDoc
| ident = ident.id_name
, operator = case prio of
Prio LeftAssoc i = Just ("infixl " +++ toString i)
Prio RightAssoc i = Just ("infixr " +++ toString i)
Prio NoAssoc i = Just ("infix " +++ toString i)
NoPrio = Nothing
, title = ""
, params = [documentParameter d p \\ d <- doc.DocBlock.params & p <- st.st_args ]
, description = fromMaybe "(No description)" doc.DocBlock.description
, returnType = printAType False st.st_result
, returnDescription = fromMaybe "(No return)" doc.DocBlock.return
, context = printContexts st.st_context
}
documentParameter :: !ParamDoc AType -> ParameterDoc
documentParameter doc type =
{ ParameterDoc
| title = fromMaybe "(No title)" doc.ParamDoc.title
, description = fromMaybe "(No description)" doc.ParamDoc.description
, type = printAType True type
}
printAType :: !Bool !AType -> String
printAType withParens atype = printType withParens atype.at_type
printType :: !Bool !Type -> String
printType withParens (TA ident []) = ident.type_ident.id_name
printType withParens (TA ident [param])
| ident.type_ident.id_name == "_List" = "[" +++ printAType False param +++ "]"
printType withParens (TA ident params)
| ident.type_ident.id_name % (0,5) == "_Tuple" = parens (join "," (map (printAType False) params))
printType withParens (TA ident params) = (if withParens parens id) (join " " [ident.type_ident.id_name : map (printAType True) params])
printType withParens (TAS ident params _) = printType withParens (TA ident params) // skip strictness annotations
printType withParens (TV tv) = tv.tv_ident.id_name
printType withParens (--> a b) = parens (printAType False a +++ "->" +++ printAType False b)
printType withParens (TB bt) = toString bt
printType _ _ = "(unknown type)"
printContexts :: [TypeContext] -> Maybe String
printContexts [] = Nothing
printContexts contexts = Just (join " & " (map printContext contexts))
printContext :: TypeContext -> String
printContext { tc_class, tc_types } = printTCClass tc_class +++ " " +++ join "," (map (printType False) tc_types)
printTCClass :: TCClass -> String
printTCClass (TCClass global) = printGlobalDefinedSymbol global
printTCClass (TCGeneric {GenericTypeContext | gtc_class}) = printGlobalDefinedSymbol gtc_class
printGlobalDefinedSymbol :: !(Global DefinedSymbol) -> String
printGlobalDefinedSymbol { Global | glob_object = { DefinedSymbol | ds_ident }} = ds_ident.id_name
parens :: !String -> String
parens s = "(" +++ s +++ ")"
createDocumentTask :: !String !String !String -> Task Document
createDocumentTask name mime content = mkInstantTask "Create document" create
where
create taskNr iworld
# (res,iworld) = createDocument name mime content iworld
= (TaskFinished res,iworld)
definition module CleanDocParser
from Maybe import ::Maybe
from Error import ::MaybeErrorString, ::MaybeError
from hashtable import ::HashTable
from syntax import ::ParsedDefinition
parseModule :: !String !Bool *File -> ([ParsedDefinition], *File)
:: DocBlock =
{ description :: !Maybe String
, params :: ![ParamDoc]
, return :: !Maybe String
, throws :: ![String]
, gin :: !Bool
, title :: !Maybe String
, icon :: !Maybe String
, parallel :: !Bool
, shape :: !Maybe String
}
:: ParamDoc =
{ name :: !String
, title :: !Maybe String
, description :: !Maybe String
}
emptyDocBlock :: DocBlock
parseDocBlock :: !String -> MaybeErrorString DocBlock
implementation module GinCleanParser
implementation module CleanDocParser
import StdEnv
import Text
import Maybe
import Error
import ParserCombinators
import GenEq
from general import :: Optional(..)
from checksupport import ::Heaps
from Heap import ::Heap, newHeap
from Heap import ::Heap, newHeap, ::Ptr
from hashtable import ::HashTable, newHashTable, set_hte_mark
from predef import init_identifiers
import syntax
import scanner
import parse
from scanner import
::Token(..),
::Priority(..),
::Assoc(..),
::ScanState(..),
::RScanState(..),
::Buffer(..),
::LongToken(..),
::FilePosition(..),
::ScanInput(..),
::Input(..),
::SBuffer(..),
::InputStream(..),
setUseLayout,
::ScanContext(..),
GeneralContext,
class nextToken(..),
instance nextToken ScanState,
class tokenBack(..),
instance tokenBack ScanState,
setUseUnderscoreIdents,
instance == Token
from syntax import
::SymbolTable,
::SymbolTableEntry,
::ModuleKind(..),
::ParsedDefinition
from parse import
::ParseErrorAdmin(..),
::ParseState(..),
::ParseContext(..),
SetGlobalContext,
wantDefinitions,
PS_SupportGenericsMask
parseModule :: !String !Bool *File -> ([ParsedDefinition], *File)
parseModule input iclmodule error
# hash_table = newHashTable newHeap
......@@ -42,7 +78,6 @@ try_module_header is_icl_mod scanState
= try_module_token MK_Module scanState
| token == DefModuleToken
= try_module_token MK_Module scanState
= abort (toString token)
try_module_token :: !ModuleKind !ScanState -> (!Bool,!ModuleKind,!String,!ScanState)
try_module_token mod_type scanState
......@@ -75,3 +110,127 @@ stringScanner input
, ss_tokenBuffer = Buffer0
}
//Lexer for documentation blocks
:: DocToken = ParamDocToken
| ThrowsDocToken
| ReturnDocToken
| GinDocToken
| TitleDocToken
| IconDocToken
| ParallelSplitDocToken
| ParallelDocToken
| ColonDocToken
| TextDocToken !String
| NewLineDocToken
derive gEq DocToken
instance == DocToken
where
(==) a b = a === b
isText :: !DocToken -> Bool
isText (TextDocToken _) = True
isText _ = False
:: LexFunction :== String Int -> Maybe (DocToken, Int)
lex :: !String -> [DocToken]
lex input = (lex` 0 0 lexFunctions)
where
lexFunctions :: [LexFunction]
lexFunctions = [ lexFixed "@param " ParamDocToken
, lexFixed "@throws " ThrowsDocToken
, lexFixed "@return " ReturnDocToken
, lexFixed "@gin " GinDocToken
, lexFixed "@gin-title " TitleDocToken
, lexFixed "@gin-icon " IconDocToken
, lexFixed "@gin-parallel " ParallelDocToken
, lexFixed ":" ColonDocToken
, lexFixed "\n*" NewLineDocToken
]
lex` :: !Int !Int ![LexFunction] -> [DocToken]
lex` offset start _ | offset >= size input
= if (offset <> start) [TextDocToken (trim (input % (start, offset - 1)))] []
lex` offset start [] = lex` (offset + 1) start lexFunctions
lex` offset start [f:fs]
# text = if (offset <> start) [TextDocToken (trim (input % (start, offset - 1)))] []
= case f input offset of
Just (NewLineDocToken,offset) = text ++ lex` offset offset lexFunctions
Just (token,offset) = text ++ [token : lex` offset offset lexFunctions]
Nothing = lex` offset start fs
//Lex token of fixed size
lexFixed chars token input offset
| input % (offset,offset + (size chars) - 1) == chars = Just (token, offset + size chars)
= Nothing
//Parser for documentation blocks
:: DocBlock =
{ description :: !Maybe String
, params :: ![ParamDoc]
, return :: !Maybe String
, throws :: ![String]
, gin :: !Bool
, title :: !Maybe String
, icon :: !Maybe String
, parallel :: !Bool
, shape :: !Maybe String
}
:: ParamDoc =
{ name :: !String
, title :: !Maybe String
, description :: !Maybe String
}
emptyDocBlock :: DocBlock
emptyDocBlock =
{ DocBlock
| description = Nothing
, params = []
, return = Nothing
, throws = []
, gin = True
, title = Nothing
, icon = Nothing
, parallel = False
, shape = Nothing
}
parseDocBlock :: !String -> MaybeErrorString DocBlock
parseDocBlock str
# doc = pDocBlock (lex str)
| isEmpty doc = Error "Parse error"
= Ok (snd (hd doc))
pDocBlock :: Parser DocToken DocBlock
pDocBlock = begin1 pDocBlock`
where
pDocBlock` =
pDescription <&> \description ->
(<*> (pParam <!> pReturn <!> pThrows <!> pGin <!> pTitle <!> pIcon <!> pParallel)) <&> \args ->
yield ((seq args) (description emptyDocBlock))
pDescription = pText <&> \description ->
yield (\doc -> { DocBlock | doc & description = Just description })
pParam = symbol ParamDocToken &> pText <&> \title -> symbol ColonDocToken &> pText <&> \description ->
yield (\doc -> { DocBlock | doc & params = doc.params
++ [{ ParamDoc | name = makeIdent title, title = Just title, description = Just description }] })
where
makeIdent s = replaceSubString " " "_" (toLowerCase s)
pReturn = symbol ReturnDocToken &> pText <&> \return ->
yield (\doc -> { DocBlock | doc & return = Just return })
pThrows = symbol ThrowsDocToken &> pText <&> \throws ->
yield (\doc -> { DocBlock | doc & throws = doc.throws ++ [throws]})
pGin = symbol GinDocToken &> pText <&> \gin ->
yield (\doc -> { DocBlock | doc & gin = toLowerCase gin == "true" })
pTitle = symbol TitleDocToken &> pText <&> \title ->
yield (\doc -> { DocBlock | doc & title = Just title })
pIcon = symbol IconDocToken &> pText <&> \icon ->
yield (\doc -> { DocBlock | doc & icon = Just icon })
pParallel = symbol ParallelDocToken &> pText <&> \parallel ->
yield (\doc -> { DocBlock | doc & parallel = toLowerCase parallel == "true" })
pText = satisfy isText <@ \(TextDocToken t) -> t
definition module GinCleanParser
from hashtable import ::HashTable
from syntax import ::ParsedDefinition
parseModule :: !String !Bool *File -> ([ParsedDefinition], *File)
......@@ -8,61 +8,59 @@ import Error
import Text
import ParserCombinators
import GinCleanParser
import CleanDocParser
import GinSyntax
from general import ::Optional(..)
from Heap import ::Ptr
from scanner import
::Assoc(..),
::Priority(..)
from syntax import
::AttributeVar,
::AttrInequality,
::AType(..),
::ATypeVar,
::AttrInequality,
::AttributeVar,
::BasicType,
::ClassDef,
::ConsVariable,
::DefinedSymbol,
::FunKind,
::FunSpecials,
::GenericCaseDef,
::GenericDef,
::Global,
::GlobalIndex,
::Ident(..),
::Import,
::ImportedObject,
::Index,
::ParsedDefinition(..),
::ParsedExpr,
::ParsedImport,
::ParsedInstanceAndMembers,
::ParsedTypeDef,
::Position,
::Rhs,
::RhsDefsOfType,
::StrictnessList,
::SymbolTableEntry,
::SymbolPtr,
::SymbolTableEntry,
::SymbolType(..),
::TempVarId,
::Type(..),
::TypeAttribute(..),
::TypeContext,
::TypeKind,
::TypeSymbIdent,
::TypeVar,
::GenericCaseDef,
::GenericDef,
::ImportedObject,