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