X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FWiki%2FInterpreter%2FBase.hs;h=70951e6884ab1d43936d0d830d35e41e3ac16a50;hb=7a4f13a3d483c950743e1ced001ade4406d239d3;hp=80ecefc78dbcaebbe2a4a13a9377d412b3584aa6;hpb=e43bb104a7313dd696b8bb8aa3bafff94706a187;p=Rakka.git diff --git a/Rakka/Wiki/Interpreter/Base.hs b/Rakka/Wiki/Interpreter/Base.hs index 80ecefc..70951e6 100644 --- a/Rakka/Wiki/Interpreter/Base.hs +++ b/Rakka/Wiki/Interpreter/Base.hs @@ -3,13 +3,18 @@ module Rakka.Wiki.Interpreter.Base ) where +import Control.Arrow +import Control.Arrow.ListArrow import Data.Map (Map) import qualified Data.Map as M import Data.Maybe +import Network.URI import Rakka.Page import Rakka.SystemConfig import Rakka.Wiki import Rakka.Wiki.Interpreter +import Text.XML.HXT.Arrow.XmlArrow +import Text.XML.HXT.Arrow.XmlNodeSet interpreters :: [Interpreter] @@ -18,6 +23,7 @@ interpreters = [ lineBreakInterp , divInterp , pageNameInterp , otherLangsInterp + , editPageInterp ] @@ -60,28 +66,60 @@ otherLangsInterp bciName = "inOtherLanguages" , bciInterpret = \ ctx _ -> - case fmap pageOtherLang (ctxMainPage ctx) of - Nothing - -> return EmptyBlock - - Just linkTable - -> do Languages langTable <- getSysConf (ctxSysConf ctx) - let merged = mergeTables langTable (M.toList linkTable) - return $ mkLangList merged + let linkTable = case ctxMainPage ctx of + Just page -> runLA ( getXPathTreesInDoc "/page/otherLang/link" + >>> + ( getAttrValue0 "lang" + &&& + getAttrValue0 "page" + ) + ) page + Nothing -> [] + in + case linkTable of + [] -> return EmptyBlock + _ -> do Languages langTable <- getSysConf (ctxSysConf ctx) + let merged = mergeTables langTable linkTable + return $ mkLangList merged } where mergeTables :: Map LanguageTag LanguageName -> [(LanguageTag, PageName)] -> [(LanguageName, PageName)] mergeTables _ [] = [] - mergeTables m (x:xs) = let (langTag, pageName) = x - langName = fromMaybe langTag (M.lookup langTag m) + mergeTables m (x:xs) = let (langTag, name) = x + langName = fromMaybe langTag (M.lookup langTag m) in - (langName, pageName) : mergeTables m xs + (langName, name) : mergeTables m xs mkLangList :: [(LanguageName, PageName)] -> BlockElement mkLangList xs = List Bullet (map mkLangLink xs) mkLangLink :: (LanguageName, PageName) -> ListItem - mkLangLink (langName, pageName) - = [Inline (PageLink (Just pageName) Nothing (Just langName))] \ No newline at end of file + mkLangLink (langName, name) + = [Inline (PageLink (Just name) Nothing (Just langName))] + + +-- +editPageInterp :: Interpreter +editPageInterp + = InlineCommandInterpreter { + iciName = "editPage" + , iciInterpret + = \ ctx (InlineCommand _ args _) -> + do BaseURI baseURI <- getSysConf (ctxSysConf ctx) + + let name = fromMaybe (ctxPageName ctx) (lookup "page" args) + label = fromMaybe "Edit this page" (lookup "label" args) + uri = uriToString id baseURI "" + attrs = [ ("type" , "button") + , ("value" , label) + , ("onclick", "Rakka.editPage(\"" ++ uri ++ "\", \"" ++ name ++ "\")") + , ("class" , "editButton") + ] + + return (Input attrs) + }