1 module Rakka.Wiki.Interpreter.Base
7 import Control.Arrow.ListArrow
9 import qualified Data.Map as M
13 import Rakka.SystemConfig
15 import Rakka.Wiki.Interpreter
16 import Text.XML.HXT.Arrow.XmlArrow
17 import Text.XML.HXT.Arrow.XmlNodeSet
20 interpreters :: [Interpreter]
21 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 (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 xs = List Bullet (map mkLangLink xs)
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(\"http://example.org/\")"
107 -- class="newButton" />
108 newPageInterp :: Interpreter
110 = InlineCommandInterpreter {
113 = \ ctx (InlineCommand _ args _) ->
114 do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
116 let label = fromMaybe "Create new page" (lookup "label" args)
117 uri = uriToString id baseURI ""
118 attrs = [ ("type" , "button")
120 , ("onclick", "Rakka.newPage(\"" ++ uri ++ "\")")
121 , ("class" , "newButton")
128 -- <input type="button"
130 -- onclick="Rakka.editPage(\"http://example.org/\", \"Foo\")"
131 -- class="editButton" />
132 editPageInterp :: Interpreter
134 = InlineCommandInterpreter {
137 = \ ctx (InlineCommand _ args _) ->
138 do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
140 let name = fromMaybe (ctxPageName ctx) (lookup "page" args)
141 label = fromMaybe "Edit this page" (lookup "label" args)
142 uri = uriToString id baseURI ""
143 attrs = [ ("type" , "button")
145 , ("onclick", "Rakka.editPage(\"" ++ uri ++ "\", \"" ++ name ++ "\")")
146 , ("class" , "editButton")