X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FWiki%2FInterpreter%2FBase.hs;h=1af5c77e9844f7e5497b8c4ba364f3ac8440d101;hb=88747f2463963ff2895a597b3054b12b2288530e;hp=6b883c376c270d68a2ecfaa00b112706bb358b66;hpb=f53425414d1861f105a3063cdbb4bf96cdc755a2;p=Rakka.git diff --git a/Rakka/Wiki/Interpreter/Base.hs b/Rakka/Wiki/Interpreter/Base.hs index 6b883c3..1af5c77 100644 --- a/Rakka/Wiki/Interpreter/Base.hs +++ b/Rakka/Wiki/Interpreter/Base.hs @@ -3,8 +3,6 @@ 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 @@ -12,8 +10,7 @@ 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 +import Text.XML.HXT.XPath interpreters :: [Interpreter] @@ -24,12 +21,15 @@ interpreters = [ lineBreakInterp , otherLangsInterp , newPageInterp , editPageInterp + , loginInterp + , searchFieldInterp + , configurationInterp ] lineBreakInterp :: Interpreter lineBreakInterp = InlineCommandInterpreter { - iciName = "br" + iciName = "br" , iciInterpret = \ _ (InlineCommand _ attrs _) -> return $ LineBreak attrs } @@ -37,7 +37,7 @@ lineBreakInterp = InlineCommandInterpreter { spanInterp :: Interpreter spanInterp = InlineCommandInterpreter { - iciName = "span" + iciName = "span" , iciInterpret = \ _ (InlineCommand _ attrs contents) -> return $ Span attrs contents } @@ -45,7 +45,7 @@ spanInterp = InlineCommandInterpreter { divInterp :: Interpreter divInterp = BlockCommandInterpreter { - bciName = "div" + bciName = "div" , bciInterpret = \ _ (BlockCommand _ attrs contents) -> return $ Div attrs (map Block contents) @@ -54,16 +54,16 @@ divInterp = BlockCommandInterpreter { pageNameInterp :: Interpreter pageNameInterp = InlineCommandInterpreter { - iciName = "pageName" + iciName = "pageName" , iciInterpret - = \ ctx _ -> return $ Text (ctxPageName ctx) + = \ ctx _ -> return $ Text (fromMaybe "" $ ctxPageName ctx) } otherLangsInterp :: Interpreter otherLangsInterp = BlockCommandInterpreter { - bciName = "inOtherLanguages" + bciName = "inOtherLanguages" , bciInterpret = \ ctx _ -> let linkTable = case ctxMainPage ctx of @@ -93,7 +93,7 @@ otherLangsInterp (langName, name) : mergeTables m xs mkLangList :: [(LanguageName, PageName)] -> BlockElement - mkLangList xs = List Bullet (map mkLangLink xs) + mkLangList = List Bullet . map mkLangLink mkLangLink :: (LanguageName, PageName) -> ListItem mkLangLink (langName, name) @@ -103,18 +103,18 @@ otherLangsInterp -- +-- class="newButton controls" /> newPageInterp :: Interpreter newPageInterp = InlineCommandInterpreter { - iciName = "newPage" + iciName = "newPage" , iciInterpret = \ _ (InlineCommand _ args _) -> let label = fromMaybe "Create new page" (lookup "label" args) attrs = [ ("type" , "button") , ("value" , label) , ("onclick", "Rakka.newPage()") - , ("class" , "newButton") + , ("class" , "newButton controls") ] in return (Input attrs) @@ -124,19 +124,70 @@ newPageInterp -- +-- class="editButton controls" /> editPageInterp :: Interpreter editPageInterp = InlineCommandInterpreter { - iciName = "editPage" + iciName = "editPage" , iciInterpret = \ ctx (InlineCommand _ args _) -> - let name = fromMaybe (ctxPageName ctx) (lookup "page" args) + let name = fromMaybe (fromMaybe "" $ ctxPageName ctx) (lookup "page" args) label = fromMaybe "Edit this page" (lookup "label" args) attrs = [ ("type" , "button") , ("value" , label) , ("onclick", "Rakka.editPage(\"" ++ name ++ "\")") - , ("class" , "editButton") + , ("class" , "editButton controls") + ] + in + return (Input attrs) + } + + +-- +loginInterp :: Interpreter +loginInterp + = InlineCommandInterpreter { + iciName = "login" + , iciInterpret + = \ _ _ -> + let attrs = [ ("type" , "button") + , ("value", "Login") + , ("class", "loginButton controls") + ] + in + return (Input attrs) + } + + +-- +searchFieldInterp :: Interpreter +searchFieldInterp + = InlineCommandInterpreter { + iciName = "searchField" + , iciInterpret + = \ _ _ -> + let attrs = [ ("type" , "text") + , ("class", "searchField") + ] + in + return (Input attrs) + } + +-- +configurationInterp :: Interpreter +configurationInterp + = InlineCommandInterpreter { + iciName = "configuration" + , iciInterpret + = \ _ _ -> + let attrs = [ ("type" , "button") + , ("value", "Configuration") + , ("class", "configButton controls") ] in return (Input attrs)