1 module Rakka.Wiki.Interpreter.Base
7 import qualified Data.Map as M
10 import Rakka.SystemConfig
12 import Rakka.Wiki.Interpreter
13 import Text.XML.HXT.Arrow
14 import Text.XML.HXT.XPath
17 interpreters :: [Interpreter]
18 interpreters = [ lineBreakInterp
31 lineBreakInterp :: Interpreter
32 lineBreakInterp = InlineCommandInterpreter {
35 = \ _ (InlineCommand _ attrs _) -> return $ LineBreak attrs
39 spanInterp :: Interpreter
40 spanInterp = InlineCommandInterpreter {
43 = \ _ (InlineCommand _ attrs contents) -> return $ Span attrs contents
47 divInterp :: Interpreter
48 divInterp = BlockCommandInterpreter {
51 = \ _ (BlockCommand _ attrs contents)
52 -> return $ Div attrs (map Block contents)
56 pageNameInterp :: Interpreter
57 pageNameInterp = InlineCommandInterpreter {
60 = \ ctx _ -> return $ Text (fromMaybe "" $ ctxPageName ctx)
64 otherLangsInterp :: Interpreter
66 = BlockCommandInterpreter {
67 bciName = "inOtherLanguages"
70 let linkTable = case ctxMainPage ctx of
71 Just page -> runLA ( getXPathTreesInDoc "/page/otherLang/link"
73 ( getAttrValue0 "lang"
81 [] -> return EmptyBlock
82 _ -> do Languages langTable <- getSysConf (ctxSysConf ctx)
83 let merged = mergeTables langTable linkTable
84 return $ mkLangList merged
87 mergeTables :: Map LanguageTag LanguageName
88 -> [(LanguageTag, PageName)]
89 -> [(LanguageName, PageName)]
91 mergeTables m (x:xs) = let (langTag, name) = x
92 langName = fromMaybe langTag (M.lookup langTag m)
94 (langName, name) : mergeTables m xs
96 mkLangList :: [(LanguageName, PageName)] -> BlockElement
97 mkLangList = List Bullet . map mkLangLink
99 mkLangLink :: (LanguageName, PageName) -> ListItem
100 mkLangLink (langName, name)
101 = [Inline (PageLink (Just name) Nothing (Just langName))]
104 -- <input type="button"
105 -- value="Create new page"
106 -- onclick="Rakka.newPage()"
107 -- class="newButton controls" />
108 newPageInterp :: Interpreter
110 = InlineCommandInterpreter {
113 = \ _ (InlineCommand _ args _) ->
114 let label = fromMaybe "Create new page" (lookup "label" args)
115 attrs = [ ("type" , "button")
117 , ("onclick", "Rakka.newPage()")
118 , ("class" , "newButton controls")
125 -- <input type="button"
127 -- onclick="Rakka.editPage(\"Foo\")"
128 -- class="editButton controls" />
129 editPageInterp :: Interpreter
131 = InlineCommandInterpreter {
134 = \ ctx (InlineCommand _ args _) ->
135 let name = fromMaybe (fromMaybe "" $ ctxPageName ctx) (lookup "page" args)
136 label = fromMaybe "Edit this page" (lookup "label" args)
137 attrs = [ ("type" , "button")
139 , ("onclick", "Rakka.editPage(\"" ++ name ++ "\")")
140 , ("class" , "editButton controls")
147 -- <input type="button"
149 -- class="loginButton controls" />
150 loginInterp :: Interpreter
152 = InlineCommandInterpreter {
156 let attrs = [ ("type" , "button")
158 , ("class", "loginButton controls")
165 -- <input type="text"
166 -- class="searchField" />
167 searchFieldInterp :: Interpreter
169 = InlineCommandInterpreter {
170 iciName = "searchField"
173 let attrs = [ ("type" , "text")
174 , ("class", "searchField")
180 -- <input type="button"
181 -- value="Configuration"
182 -- class="configButton controls" />
183 configurationInterp :: Interpreter
185 = InlineCommandInterpreter {
186 iciName = "configuration"
189 let attrs = [ ("type" , "button")
190 , ("value", "Configuration")
191 , ("class", "configButton controls")