1{-
2  SkateBackendWiki: Backend to generate a Wiki documentation
3
4  Part of Skate: a Schema specification languge
5
6  Copyright (c) 2017, ETH Zurich.
7  All rights reserved.
8
9  This file is distributed under the terms in the attached LICENSE file.
10  If you do not find this file, copies can be found by writing to:
11  ETH Zurich D-INFK, Universit\"atstr. 6, CH-8092 Zurich. Attn: Systems Group.
12-}
13
14module SkateBackendWiki   where
15
16import Data.Time.Format
17import Data.Time.LocalTime
18import Data.Time.Clock.POSIX
19
20import Data.List
21import Data.Char
22
23import Text.ParserCombinators.Parsec.Pos
24
25
26import  SkateParser
27import SkateTypes
28import qualified AbsSyntaxWiki as W
29import SkateTypes
30import SkateSchema
31
32
33{- starts the compilation process of the schema -}
34compile :: String -> String -> SchemaRecord -> String
35compile infile outfile sr =
36    h ++ i ++ W.lineBreak ++ b ++ W.lineBreak ++ f
37    where
38        Schema sname sdesc decls imps _ = (schema sr)
39        h = wikiHeader sname sdesc infile
40        i = wikiImports imps
41        b = wikiBody decls sname
42        f = wikiFooter ""
43
44
45{- generate the header used in the Wiki syntax -}
46wikiHeader :: String -> String -> String -> String
47wikiHeader sname desc infile = W.title ("Schema: " ++ desc)
48    ++ W.textit "This document has been generated using Skate." ++ W.lineBreak
49    ++ W.textit "Input File: " ++ W.inlinecode infile ++ W.lineBreak
50    ++ W.textit "Schema Identifier: " ++ W.inlinecode sname ++ W.lineBreak
51    ++ W.tableOfContent
52
53
54
55wikiImports :: [String] -> String
56wikiImports imps = h ++ i
57    where
58        h = W.heading "Imports"
59        i = (if imps == [] then "No imports." else (W.unOrderedList 1 imps))
60
61
62wikiBody :: [Declaration] -> String-> String
63wikiBody decls sname = heading ++ concat declstr
64    where
65        heading =  W.hline
66        declstr = [wikiPrintDecl d 2 sname| d <- decls]
67
68
69wikiPrintDecl :: Declaration -> Int -> String -> String
70wikiPrintDecl d@(Fact fn fd attr sp) l prefix= (wikiPrintFact fn fd attr prefix l)
71wikiPrintDecl d@(Flags f fd w defs sp) l prefix = (wikiPrintFlags f w fd defs) prefix l
72wikiPrintDecl d@(Constants n cd t defs sp) l prefix = wikiPrintConstants n t cd defs prefix l
73wikiPrintDecl d@(Enumeration n ed defs sp) l prefix = wikiPrintEnum n ed defs prefix l
74wikiPrintDecl d@(Namespace n nd defs sp) l prefix = wikiPrintNameSpace n nd defs l prefix
75wikiPrintDecl d@(Section n defs sp) l prefix = wikiPrintSection n defs l prefix
76wikiPrintDecl d@(Text t sp) l prefix = wikiPrintText t
77
78
79{----------------------------------------------------------------------------}
80
81wikiPrintFact :: String -> String -> [FactAttrib] -> String -> Int -> String
82wikiPrintFact n d attrib prefix l = title ++ W.newLine
83    ++ "Fact Name: " ++ (W.inlinecode name) ++ W.lineBreak
84    ++ "Prolog: " ++ W.newLine  ++ (W.code prolog) ++ W.lineBreak
85    ++ "Fields: " ++ W.newLine
86    ++ (W.tableHeading ["Name", "Type", "Description"]) ++ (concat tableRows)
87    ++ W.lineBreak
88    where
89        title = W.headingGeneric ("Fact: " ++ d) l
90        tableRows = [W.tableRow (wikiPrintFactAttrib a) | a <- attrib]
91        name = makeDeclName prefix n
92        prologfields = (intersperse "," [wikiPrintFactFieldNames a | a <- attrib])
93        prolog = name ++ "(" ++ (concat prologfields) ++ ")"
94
95wikiPrintFactAttrib :: FactAttrib -> [String]
96wikiPrintFactAttrib fa@(FactAttrib n d t _) = [n, (show t), d]
97
98wikiPrintFactFieldNames :: FactAttrib -> String
99wikiPrintFactFieldNames fa@(FactAttrib n _ _ _) = n
100
101
102{----------------------------------------------------------------------------}
103
104
105wikiPrintFlags :: String -> Integer -> String -> [FlagDef] -> String -> Int -> String
106wikiPrintFlags n w d f prefix l = title ++ W.newLine
107    ++ "Flags Name: " ++ name ++ W.lineBreak
108    ++ "Prolog: " ++ W.newLine ++ (W.code (concat prolog)) ++ W.newLine
109    ++ "Flags: " ++ W.lineBreak
110    ++ (W.tableHeading ["Flag", "Value", "Description" ]) ++ (concat tableRows)
111    ++ W.lineBreak
112    where
113        title = W.headingGeneric ("Flags: " ++ d) l
114        flags = [wikiPrintFlagDefs fd n prefix | fd <- f]
115        tableRows = [W.tableRow [fn, fv, fd] | (fn, fd, fv) <- flags]
116        prolog = []
117        name = makeDeclName prefix n
118
119wikiPrintFlagDefs :: FlagDef -> String -> String -> (String, String, String)
120wikiPrintFlagDefs fd@(FlagDef n d v _) flag prefix = (fname, d, fval)
121    where
122        fname = makeFlagName prefix flag n
123        fval = (show (v))
124
125
126
127{----------------------------------------------------------------------------}
128
129
130wikiPrintConstants :: String -> TypeRef -> String -> [ ConstantDef ] -> String -> Int-> String
131wikiPrintConstants n t d defs prefix l =  title
132    ++ W.lineBreak
133    where
134        title = W.headingGeneric ("Constants: " ++ d) l
135
136
137{----------------------------------------------------------------------------}
138
139
140wikiPrintEnum :: String -> String ->  [ EnumDef ] -> String -> Int -> String
141wikiPrintEnum n d defs prefix l = title
142    ++ W.lineBreak
143    where
144        title = W.headingGeneric ("Enumeration: " ++ d) l
145
146
147{----------------------------------------------------------------------------}
148
149
150wikiPrintNameSpace :: String -> String ->  [ Declaration ] -> Int -> String -> String
151wikiPrintNameSpace n d decls l prefix =  h ++ W.lineBreak
152    ++ "Namespace identifier: " ++ W.inlinecode (makeNameSpacePrefix prefix n)
153    ++ W.lineBreak
154    ++ (concat ns)
155    ++ W.lineBreak
156    ++ "End of namespace " ++ n
157    ++ W.newLine ++ W.hline
158    ++ W.lineBreak
159    where
160        h = W.headingGeneric ("Namespace: " ++ d) l
161        newprefix = makeNameSpacePrefix prefix n
162        ns = [wikiPrintDecl d (l + 1) newprefix | d <- decls]
163
164
165{----------------------------------------------------------------------------}
166
167
168wikiPrintSection :: String -> [ Declaration ] -> Int -> String -> String
169wikiPrintSection  n decls l prefix = h ++ (concat subsection) ++ W.newLine
170    ++ W.lineBreak
171    where
172        h = W.headingGeneric n l
173        subsection = [wikiPrintDecl d (l + 1) prefix | d <- decls]
174
175
176{----------------------------------------------------------------------------}
177
178
179wikiPrintText :: String -> String
180wikiPrintText t = t ++ W.lineBreak
181
182
183{----------------------------------------------------------------------------}
184
185
186wikiPrintTypedef :: TypeBuiltIn -> String -> String -> String
187wikiPrintTypedef t s prefix = s ++ W.lineBreak
188
189
190{----------------------------------------------------------------------------}
191
192
193wikiFooter :: String -> String
194wikiFooter intf = "footer"
195
196
197wikiFootNote :: String
198wikiFootNote = W.footnote "This has been generated by Skate v. xx.xx on date."
199
200
201{----------------------------------------------------------------------------}
202
203
204{-Generic -}
205
206makeNameSpacePrefix :: String -> String -> String
207makeNameSpacePrefix prefix n = prefix ++ "_" ++ n
208
209makeDeclName :: String -> String -> String
210makeDeclName prefix n = prefix ++ "__" ++ n
211
212makeFlagName :: String -> String -> String -> String
213makeFlagName prefix flag name = map toUpper fname
214    where
215        fname = prefix ++ "_" ++ flag ++ "_" ++ name
216