1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109

----------------------------------------------------------------------
--- Functions to generate documentation in "CDoc" format.
---
--- @author Sandra Dylus
--- @version November 2020
----------------------------------------------------------------------

module CurryDoc.CDoc where

import CurryDoc.AnaInfo
import CurryDoc.Read
import FlatCurry.Types
import FlatCurry.Files
import FlatCurry.FlexRigid
import Data.List
import ReadShowTerm

generateCDoc :: String  -> String -> [(SourceLine,String)] -> AnaInfo
             -> IO String
generateCDoc modName modCmts progCmts anaInfo = do
  fcyName <- getFlatCurryFileInLoadPath modName
  Prog _ _ types functions _ <- readFlatCurryFile fcyName
  let modInfo = ModuleInfo modName (author avCmts) mCmts
      funcInfo (Func qName@(mName, fName) _ _ tExpr rule) =
        FunctionInfo fName
        (removeForall tExpr)
        mName
        (funcComment fName progCmts)
        (getNondetInfo anaInfo qName)
        (flexRigid rule)
      typeInfo (Type (mName, tName) _ vars consDecl) =
        TypeInfo tName
        (map consSignature
             (filter (\ (Cons _ _ vis _) -> vis == Public) consDecl))
        (map fst vars)
        mName
        (dataComment tName progCmts)
        False
      typeInfo (TypeSyn qName@(mName, tName) _ vars tExpr) =
        TypeInfo tName
        [(qName, [removeForall tExpr])]
        (map fst vars)
        mName
        (dataComment tName progCmts)
        True
      (mCmts, avCmts) = splitComment modCmts
      funcInfos = map funcInfo
                      (filter (\ (Func _ _ vis _ _) -> vis == Public) functions)
      typeInfos = map typeInfo (concatMap filterT types)
  putStrLn $ "Writing " ++ modName ++ ".cdoc file"
  return $ showTerm (CurryInfo modInfo funcInfos typeInfos)
 where
   filterT f@(Type _    vis _ _) = if vis == Public then [f] else []
   filterT f@(TypeSyn _ vis _ _) = if vis == Public then [f] else []

-- Strip forall type quantifiers in order to keep compatibility
-- with Currygle 0.3.0:
removeForall :: TypeExpr -> TypeExpr
removeForall texp = case texp of
  ForallType _ te  -> removeForall te
  FuncType te1 te2 -> FuncType (removeForall te1) (removeForall te2)
  TCons qn tes     -> TCons qn (map removeForall tes)
  TVar _           -> texp

funcComment :: String -> [(SourceLine,String)] -> String
funcComment str = fst . splitComment . getFuncComment str

dataComment :: String -> [(SourceLine,String)] -> String
dataComment str = fst . splitComment . getDataComment str

flexRigid :: Rule -> FlexRigidResult
flexRigid (Rule _ expr) = getFlexRigid expr
flexRigid (External _)  = UnknownFR

-- the name
-- the author
-- the description
data ModuleInfo = ModuleInfo String String String

-- the module
-- the corresponding functions
-- the corresponding data and type declaration
data CurryInfo = CurryInfo ModuleInfo [FunctionInfo] [TypeInfo]

-- the name
-- the signature
-- the corresponding module
-- the description
-- True if property ist defined non-deterministically
-- the flex/rigid status
data FunctionInfo =
  FunctionInfo String TypeExpr String String Bool FlexRigidResult

-- the name
-- the signature (true indicates a type synonym, false a data type)
-- the corresponding module
-- the description
data TypeInfo =
  TypeInfo String [(QName, [TypeExpr])] [TVarIndex] String String Bool

-- auxilieres --------------------------------------------------------

author :: [(String, String)] -> String
author av = concat $ getCommentType "author" av

-- generate data and type constructors
consSignature :: ConsDecl -> (QName, [TypeExpr])
consSignature (Cons (mName, cName) _ _ tExprList) =
  ((mName, cName), map removeForall tExprList)