Commit 5cdedac3 authored by Michael Hanus 's avatar Michael Hanus
Browse files

currydoc extended to include properties in documentation

parent 4aa93755
......@@ -383,7 +383,7 @@ isTest = isTestType . funcType
-- The type of EasyCheck properties.
propType :: CTypeExpr
propType = listType (baseType (easyCheckModule, "Test"))
propType = baseType (easyCheckModule, "Prop")
isPropIOType :: CTypeExpr -> Bool
isPropIOType texp = case texp of
......
......@@ -47,6 +47,7 @@ import TotallyDefined
import Indeterministic
import SolutionCompleteness
import CurryDocAnaInfo
import CurryDocParams
import CurryDocRead
import CurryDocHtml
......@@ -202,7 +203,7 @@ makeSystemLibsIndex docdir modnames = do
groupByCategory = groupBy ((==) `on` fst3)
sortByName = sortBy ((<=) `on` snd3)
getModInfo :: String -> IO (Category,String, String)
getModInfo :: String -> IO (Category,String,String)
getModInfo modname = do
mmodsrc <- lookupModuleSourceInLoadPath modname
case mmodsrc of
......
----------------------------------------------------------------------
--- Datatype and operations to handle analysis information in CurryDoc.
---
--- @author Michael Hanus
--- @version April 2016
----------------------------------------------------------------------
module CurryDocAnaInfo where
import FlatCurry.Types
import TotallyDefined(Completeness(..))
-----------------------------------------------------------------------
-- Datatype for passing analysis results:
data AnaInfo =
AnaInfo (QName -> Bool) -- non-deterministic?
(QName -> Completeness) -- completely defined?
(QName -> Bool) -- indeterministically defined?
(QName -> Bool) -- solution complete?
getNondetInfo :: AnaInfo -> QName -> Bool
getNondetInfo (AnaInfo oi _ _ _) = oi
getCompleteInfo :: AnaInfo -> QName -> Completeness
getCompleteInfo (AnaInfo _ cdi _ _) = cdi
getIndetInfo :: AnaInfo -> QName -> Bool
getIndetInfo (AnaInfo _ _ idi _) = idi
getOpCompleteInfo :: AnaInfo -> QName -> Bool
getOpCompleteInfo (AnaInfo _ _ _ oci) = oci
-- Translate a standard analysis result into functional form:
getFunctionInfo :: [(QName,a)] -> QName -> a
getFunctionInfo [] n = error ("No analysis result for function "++show n)
getFunctionInfo ((fn,fi):fnis) n = if fn == n then fi
else getFunctionInfo fnis n
--------------------------------------------------------------------------
......@@ -7,6 +7,7 @@
module CurryDocCDoc where
import CurryDocAnaInfo
import CurryDocParams
import CurryDocRead
import FlatCurry.Types
......
......@@ -7,6 +7,7 @@
module CurryDocHtml where
import CurryDocAnaInfo
import CurryDocParams
import CurryDocRead
import CurryDocConfig
......@@ -14,6 +15,8 @@ import TotallyDefined(Completeness(..))
import AbstractCurry.Types
import AbstractCurry.Files
import AbstractCurry.Select
import AbstractCurry.Build
import AbstractCurry.Pretty
import qualified FlatCurry.Types as FC
import qualified FlatCurry.Goodies as FCG
import FilePath
......@@ -28,6 +31,7 @@ import Distribution
import CategorizedHtmlList
import Markdown
import Maybe
import Pretty(pretty,empty)
infixl 0 `withTitle`
......@@ -45,6 +49,7 @@ generateHtmlDocs docparams anainfo modname modcmts progcmts = do
let
exptypes = filter isExportedType types
expfuns = filter isExportedFun functions
properties = filter isProperty functions
navigation =
[ bold [htxt "Exported names:"]
, genHtmlExportIndex (map tName exptypes)
......@@ -56,18 +61,22 @@ generateHtmlDocs docparams anainfo modname modcmts progcmts = do
`addClass` "nav nav-sidebar"
]
content =
genHtmlModule docparams modcmts
++ [ h2 [htxt "Summary of exported operations:"]
, borderedTable (map (genHtmlFuncShort docparams progcmts anainfo) expfuns)
]
++ ifNotNull exptypes (\tys ->
[anchoredSection "exported_datatypes"
(h2 [htxt "Exported datatypes:"] : hrule : concatMap (genHtmlType docparams progcmts) tys)])
++ [anchoredSection "exported_operations"
(h2 [htxt "Exported operations:"] : map (genHtmlFunc docparams modname progcmts anainfo ops) expfuns)
]
genHtmlModule docparams modcmts ++
[ h2 [htxt "Summary of exported operations:"]
, borderedTable (map (genHtmlFuncShort docparams progcmts anainfo) expfuns)
] ++
ifNotNull exptypes (\tys ->
[anchoredSection "exported_datatypes"
(h2 [htxt "Exported datatypes:"] : hrule :
concatMap (genHtmlType docparams progcmts) tys)]) ++
[anchoredSection "exported_operations"
(h2 [htxt "Exported operations:"] :
map (genHtmlFunc docparams modname progcmts
(attachProperties2Funcs properties progcmts) anainfo ops)
expfuns)
]
mainPage title [htmltitle] (lefttopmenu types functions) rightTopMenu
navigation content
navigation content
where
title = "Module " ++ modname
......@@ -81,6 +90,31 @@ generateHtmlDocs docparams anainfo modname modcmts progcmts = do
++ ifNotNull ts (const [[href "#exported_datatypes" [htxt "Datatypes" ]]])
++ ifNotNull fs (const [[href "#exported_operations" [htxt "Operations"]]])
-- Associate the properties (first argument) to functions according to
-- their positions in the source code (we assume that they follow the function
-- definitions). Each property is represented by its name and the code.
attachProperties2Funcs :: [CFuncDecl] -> [(SourceLine,String)]
-> [(String,[(String,String)])]
attachProperties2Funcs _ [] = []
attachProperties2Funcs props ((sourceline,_) : slines) =
case sourceline of
FuncDef fn -> let (fprops,rslines) = span isPropFuncDef slines
in (fn, concatMap showProp fprops) :
attachProperties2Funcs props rslines
_ -> attachProperties2Funcs props slines
where
propNames = map (snd . funcName) props
showProp (FuncDef fn,_) =
let propdecl = fromJust (find (\fd -> snd (funcName fd) == fn) props)
in map (\rhs -> (fn, prettyRHS rhs)) (map ruleRHS (funcRules propdecl))
prettyRHS = pretty 78 . ppCRhs empty (setNoQualification defaultOptions)
isPropFuncDef (sline,_) =
case sline of FuncDef fn -> fn `elem` propNames
_ -> False
--- Translate a documentation comment to HTML and use markdown translation
--- if necessary
......@@ -173,6 +207,16 @@ getExportedFields = map fldName . filter isExportedField . concatMap getFields
getFields (CCons _ _ _ ) = []
getFields (CRecord _ _ fs) = fs
-- Is a function definition a property?
isProperty :: CFuncDecl -> Bool
isProperty fdecl = fst (funcName fdecl) /= easyCheckModule
&& isPropType (funcType fdecl)
where
isPropType :: CTypeExpr -> Bool
isPropType ct = ct == baseType (easyCheckModule,"Prop") -- I/O test?
|| resultType ct == baseType (easyCheckModule,"Prop")
easyCheckModule = "Test.EasyCheck"
--- generate HTML documentation for a module:
genHtmlModule :: DocParams -> String -> [HtmlExp]
......@@ -287,7 +331,8 @@ genHtmlField docparams fldcmts cname fldCons (CField (fmod,fname) _ ty)
(getConsComment fldcmts fname)
-- generate short HTML documentation for a function:
genHtmlFuncShort :: DocParams -> [(SourceLine,String)] -> AnaInfo -> CFuncDecl -> [[HtmlExp]]
genHtmlFuncShort :: DocParams -> [(SourceLine,String)] -> AnaInfo -> CFuncDecl
-> [[HtmlExp]]
genHtmlFuncShort docparams progcmts anainfo
(CFunc (fmod,fname) _ _ ftype _) =
[[code [opnameDoc
......@@ -305,11 +350,14 @@ genHtmlFuncShort docparams progcmts anainfo (CmtFunc _ n a vis ftype rules) =
genHtmlFuncShort docparams progcmts anainfo (CFunc n a vis ftype rules)
-- generate HTML documentation for a function:
genHtmlFunc :: DocParams -> String -> [(SourceLine,String)] -> AnaInfo
genHtmlFunc :: DocParams -> String -> [(SourceLine,String)]
-> [(String,[(String,String)])] -> AnaInfo
-> [COpDecl] -> CFuncDecl -> HtmlExp
genHtmlFunc docparams modname progcmts anainfo ops (CmtFunc _ n a vis ftype rules) =
genHtmlFunc docparams modname progcmts anainfo ops (CFunc n a vis ftype rules)
genHtmlFunc docparams modname progcmts anainfo ops
genHtmlFunc docparams modname progcmts funcprops anainfo ops
(CmtFunc _ n a vis ftype rules) =
genHtmlFunc docparams modname progcmts funcprops anainfo ops
(CFunc n a vis ftype rules)
genHtmlFunc docparams modname progcmts funcprops anainfo ops
(CFunc (fmod,fname) _ _ ftype rules) =
let (funcmt,paramcmts) = splitComment (getFuncComment fname progcmts)
in anchoredDiv fname
......@@ -323,12 +371,23 @@ genHtmlFunc docparams modname progcmts anainfo ops
genFuncPropIcons anainfo (fmod,fname)] ++
docComment2HTML docparams funcmt ++
genParamComment paramcmts ++
-- show properties, if present:
(if null funProperties
then []
else [dlist
[([explainCat "Properties:"],
[par (intercalate [breakline]
(map (\ (pn,pc) -> [code [htxt pc], nbsp,
htxt $ "("++pn++")"])
funProperties))])]] ) ++
-- show further infos for this function, if present:
(if furtherInfos == []
then []
else [dlist [([explainCat "Further infos:"],
[ulist furtherInfos])]] )]]]
where
funProperties = maybe [] id (lookup fname funcprops)
furtherInfos = genFuncPropComments anainfo (fmod,fname) rules ops
genParamComment paramcmts =
......@@ -339,8 +398,11 @@ genHtmlFunc docparams modname progcmts anainfo ops
, code [htxt (showCall fname (map fst params))]
]
, par [explainCat "Parameters:"]
, ulist (map (\(parid,parcmt) -> [code [htxt parid], htxt " : "]
++ removeTopPar (docComment2HTML docparams (removeDash parcmt))) parCmts)
, ulist (map (\(parid,parcmt) ->
[code [htxt parid], htxt " : "] ++
removeTopPar (docComment2HTML docparams
(removeDash parcmt)))
parCmts)
])
++ ifNotNull ret (\retCmt -> [dlist (map (\rescmt ->
([explainCat "Returns:"],
......
......@@ -2,22 +2,21 @@
--- Some auxiliary operations of CurryDoc to read programs.
---
--- @author Michael Hanus, Jan Tikovsky
--- @version January 2016
--- @version April 2016
----------------------------------------------------------------------
module CurryDocRead where
import FlatCurry.Types
import TotallyDefined(Completeness(..))
import Char
import FlatCurry.Types
import List(isSuffixOf)
--------------------------------------------------------------------------
-- read the comments of a source file to be put in the HTML documentation
readComments :: String -> IO (String,[(SourceLine,String)])
readComments filename =
do prog <- readFile filename
return (groupLines . filter (/=OtherLine) . map classifyLine . lines
$ prog)
readComments filename = do
prog <- readFile filename
return (groupLines . filter (/=OtherLine) . map classifyLine . lines $ prog)
--- This datatype is used to classify all input lines.
--- @cons Comment - a comment for CurryDoc
......@@ -87,21 +86,30 @@ classifyLine line
then OtherLine
else if id1 == "data" || id1 == "type" || id1 == "newtype"
then DataDef (getDatatypeName line)
else FuncDef id1
else if "'default" `isSuffixOf` id1
then OtherLine -- ignore default rules
else FuncDef id1
where
getDatatypeName = takeWhile isIdChar . dropWhile (==' ') . dropWhile isIdChar
-- get the first identifier (name or operator in brackets) in a string:
getFirstId :: String -> String
getFirstId [] = ""
getFirstId (c:cs) | isAlpha c = takeWhile isIdChar (c:cs)
| c == '(' = takeWhile (/=')') cs
| otherwise = ""
getFirstId (c:cs)
| isAlpha c = takeWhile isIdChar (c:cs)
| c == '(' = let bracketid = takeWhile (/=')') cs
in if all (`elem` infixIDs) bracketid
then bracketid
else ""
| otherwise = ""
-- is an alphanumeric character, underscore, or apostroph?
isIdChar :: Char -> Bool
isIdChar c = isAlphaNum c || c == '_' || c == '\''
-- All characters occurring in infix operators.
infixIDs :: String
infixIDs = "~!@#$%^&*+-=<>?./|\\:"
-- group the classified lines into module comment and list of
-- (Func/DataDef,comment) pairs:
......@@ -213,34 +221,6 @@ splitCommentParams param paramcmt (l:ls) =
(dropWhile isAlpha (tail l)) ls)
-----------------------------------------------------------------------
-- Datatype for passing analysis results:
data AnaInfo =
AnaInfo (QName -> Bool) -- non-deterministic?
(QName -> Completeness) -- completely defined?
(QName -> Bool) -- indeterministically defined?
(QName -> Bool) -- solution complete?
getNondetInfo :: AnaInfo -> QName -> Bool
getNondetInfo (AnaInfo oi _ _ _) = oi
getCompleteInfo :: AnaInfo -> QName -> Completeness
getCompleteInfo (AnaInfo _ cdi _ _) = cdi
getIndetInfo :: AnaInfo -> QName -> Bool
getIndetInfo (AnaInfo _ _ idi _) = idi
getOpCompleteInfo :: AnaInfo -> QName -> Bool
getOpCompleteInfo (AnaInfo _ _ _ oci) = oci
-- Translate a standard analysis result into functional form:
getFunctionInfo :: [(QName,a)] -> QName -> a
getFunctionInfo [] n = error ("No analysis result for function "++show n)
getFunctionInfo ((fn,fi):fnis) n = if fn == n then fi
else getFunctionInfo fnis n
--------------------------------------------------------------------------
-- auxiliaries:
isFunctionType :: TypeExpr -> Bool
......
......@@ -11,8 +11,8 @@ ANADIR = ../analysis
TOOL = $(BINDIR)/currydoc
# Source modules of currydoc
DEPS = CurryDoc.curry CurryDocRead.curry CurryDocHtml.curry \
CurryDocTeX.curry CurryDocCDoc.curry \
DEPS = CurryDoc.curry CurryDocRead.curry CurryDocAnaInfo.curry \
CurryDocHtml.curry CurryDocTeX.curry CurryDocCDoc.curry \
CurryDocParams.curry CurryDocConfig.curry \
$(LIBDIR)/Markdown.curry \
$(LIBDIR)/FlatCurry/FlexRigid.curry \
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment