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
30 lineBreakInterp :: Interpreter
31 lineBreakInterp = InlineCommandInterpreter {
34 = \ _ (InlineCommand _ attrs _) -> return $ LineBreak attrs
38 spanInterp :: Interpreter
39 spanInterp = InlineCommandInterpreter {
42 = \ _ (InlineCommand _ attrs contents) -> return $ Span attrs contents
46 divInterp :: Interpreter
47 divInterp = BlockCommandInterpreter {
50 = \ _ (BlockCommand _ attrs contents)
51 -> return $ Div attrs (map Block contents)
55 pageNameInterp :: Interpreter
56 pageNameInterp = InlineCommandInterpreter {
59 = \ ctx _ -> return $ Text (ctxPageName ctx)
63 otherLangsInterp :: Interpreter
65 = BlockCommandInterpreter {
66 bciName = "inOtherLanguages"
69 let linkTable = case ctxMainPage ctx of
70 Just page -> runLA ( getXPathTreesInDoc "/page/otherLang/link"
72 ( getAttrValue0 "lang"
80 [] -> return EmptyBlock
81 xs -> do Languages langTable <- getSysConf (ctxSysConf ctx)
82 let merged = mergeTables langTable linkTable
83 return $ mkLangList merged
86 mergeTables :: Map LanguageTag LanguageName
87 -> [(LanguageTag, PageName)]
88 -> [(LanguageName, PageName)]
90 mergeTables m (x:xs) = let (langTag, pageName) = x
91 langName = fromMaybe langTag (M.lookup langTag m)
93 (langName, pageName) : mergeTables m xs
95 mkLangList :: [(LanguageName, PageName)] -> BlockElement
96 mkLangList xs = List Bullet (map mkLangLink xs)
98 mkLangLink :: (LanguageName, PageName) -> ListItem
99 mkLangLink (langName, pageName)
100 = [Inline (PageLink (Just pageName) Nothing (Just langName))]
103 -- <input type="button"
105 -- onclick="Rakka.editPage(\"http://example.org/\", \"Foo\")"
106 -- class="editButton" />
107 editPageInterp :: Interpreter
109 = InlineCommandInterpreter {
112 = \ ctx (InlineCommand _ args _) ->
113 do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
115 let pageName = fromMaybe (ctxPageName ctx) (lookup "page" args)
116 label = fromMaybe "Edit this page" (lookup "label" args)
117 uri = uriToString id baseURI ""
118 attrs = [ ("type" , "button")
120 , ("onclick", "Rakka.editPage(\"" ++ uri ++ "\", \"" ++ pageName ++ "\")")
121 , ("class" , "editButton")