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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131

----------------------------------------------------------------------
--- Functions to generate documentation in "CDoc" format.
---
--- @author Sandra Dylus
--- @version March 2021
----------------------------------------------------------------------

module CurryDoc.CDoc where

import Data.List

import FlatCurry.Types
import FlatCurry.Files
import FlatCurry.FlexRigid
import ReadShowTerm

import CurryDoc.AnaInfo
import CurryDoc.Read

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 (TypeNew (mName, tName) _ vars newconsDecl) =
        TypeInfo tName
        (map newconsSignature
             (filter (\ (NewCons _ vis _) -> vis == Public) [newconsDecl]))
        (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 []
   filterT f@(TypeNew _ 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)

-- generate data and type constructors
newconsSignature :: NewConsDecl -> (QName, [TypeExpr])
newconsSignature (NewCons (mName, cName) _ tExpr) =
  ((mName, cName), map removeForall [tExpr])