Rakka/Wiki/Interpreter/Base.hs

   1 module Rakka.Wiki.Interpreter.Base
   2     ( interpreters
   3     )
   4     where
   5
   6 import           Data.Map (Map)
   7 import qualified Data.Map as M
   8 import           Data.Maybe
   9 import           Rakka.Page
  10 import           Rakka.SystemConfig
  11 import           Rakka.Wiki
  12 import           Rakka.Wiki.Interpreter
  13 import           Text.XML.HXT.Arrow
  14
  15
  16 interpreters :: [Interpreter]
  17 interpreters = [ lineBreakInterp
  18                , spanInterp
  19                , divInterp
  20                , pageNameInterp
  21                , otherLangsInterp
  22                , newPageInterp
  23                , editPageInterp
  24                , loginInterp
  25                , searchFieldInterp
  26                ]
  27
  28
  29 lineBreakInterp :: Interpreter
  30 lineBreakInterp = InlineCommandInterpreter {
  31                     iciName = "br"
  32                   , iciInterpret
  33                       = \ _ (InlineCommand _ attrs _) -> return $ LineBreak attrs
  34                   }
  35
  36
  37 spanInterp :: Interpreter
  38 spanInterp = InlineCommandInterpreter {
  39                iciName = "span"
  40              , iciInterpret
  41                  = \ _ (InlineCommand _ attrs contents) -> return $ Span attrs contents
  42              }
  43
  44
  45 divInterp :: Interpreter
  46 divInterp = BlockCommandInterpreter {
  47               bciName = "div"
  48             , bciInterpret
  49                 = \ _ (BlockCommand _ attrs contents)
  50                 -> return $ Div attrs (map Block contents)
  51             }
  52
  53
  54 pageNameInterp :: Interpreter
  55 pageNameInterp = InlineCommandInterpreter {
  56                    iciName = "pageName"
  57                  , iciInterpret
  58                      = \ ctx _ -> return $ Text (fromMaybe "" $ ctxPageName ctx)
  59                  }
  60
  61
  62 otherLangsInterp :: Interpreter
  63 otherLangsInterp
  64     = BlockCommandInterpreter {
  65         bciName = "inOtherLanguages"
  66       , bciInterpret
  67           = \ ctx _ ->
  68             let linkTable = case ctxMainPage ctx of
  69                               Just page -> runLA ( getXPathTreesInDoc "/page/otherLang/link"
  70                                                    >>>
  71                                                    ( getAttrValue0 "lang"
  72                                                      &&&
  73                                                      getAttrValue0 "page"
  74                                                    )
  75                                                  ) page
  76                               Nothing   -> []
  77             in
  78               case linkTable of
  79                 [] -> return EmptyBlock
  80                 _  -> do Languages langTable <- getSysConf (ctxSysConf ctx)
  81                          let merged = mergeTables langTable linkTable
  82                          return $ mkLangList merged
  83       }
  84     where
  85       mergeTables :: Map LanguageTag LanguageName
  86                   -> [(LanguageTag, PageName)]
  87                   -> [(LanguageName, PageName)]
  88       mergeTables _ []     = []
  89       mergeTables m (x:xs) = let (langTag, name) = x
  90                                  langName        = fromMaybe langTag (M.lookup langTag m)
  91                              in
  92                                (langName, name) : mergeTables m xs
  93
  94       mkLangList :: [(LanguageName, PageName)] -> BlockElement
  95       mkLangList xs = List Bullet (map mkLangLink xs)
  96
  97       mkLangLink :: (LanguageName, PageName) -> ListItem
  98       mkLangLink (langName, name)
  99           = [Inline (PageLink (Just name) Nothing (Just langName))]
 100
 101
 102 -- <input type="button"
 103 --        value="Create new page"
 104 --        onclick="Rakka.newPage()"
 105 --        class="newButton" />
 106 newPageInterp :: Interpreter
 107 newPageInterp
 108     = InlineCommandInterpreter {
 109         iciName = "newPage"
 110       , iciInterpret
 111           = \ _ (InlineCommand _ args _) ->
 112             let label = fromMaybe "Create new page" (lookup "label" args)
 113                 attrs = [ ("type"   , "button")
 114                         , ("value"  , label)
 115                         , ("onclick", "Rakka.newPage()")
 116                         , ("class"  , "newButton")
 117                         ]
 118             in
 119               return (Input attrs)
 120       }
 121
 122
 123 -- <input type="button"
 124 --        value="Edit"
 125 --        onclick="Rakka.editPage(\"Foo\")"
 126 --        class="editButton" />
 127 editPageInterp :: Interpreter
 128 editPageInterp
 129     = InlineCommandInterpreter {
 130         iciName = "editPage"
 131       , iciInterpret
 132           = \ ctx (InlineCommand _ args _) ->
 133             let name  = fromMaybe (fromMaybe "" $ ctxPageName ctx) (lookup "page" args)
 134                 label = fromMaybe "Edit this page" (lookup "label" args)
 135                 attrs = [ ("type"   , "button")
 136                         , ("value"  , label)
 137                         , ("onclick", "Rakka.editPage(\"" ++ name ++ "\")")
 138                         , ("class"  , "editButton")
 139                         ]
 140             in
 141               return (Input attrs)
 142       }
 143
 144
 145 -- <input type="button"
 146 --        value="Login"
 147 --        class="loginButton" />
 148 loginInterp :: Interpreter
 149 loginInterp
 150     = InlineCommandInterpreter {
 151         iciName = "login"
 152       , iciInterpret
 153           = \ _ _ ->
 154             let attrs = [ ("type" , "button")
 155                         , ("value", "Login")
 156                         , ("class", "loginButton")
 157                         ]
 158             in
 159               return (Input attrs)
 160       }
 161
 162
 163 -- <input type="text"
 164 --        class="searchField" />
 165 searchFieldInterp :: Interpreter
 166 searchFieldInterp
 167     = InlineCommandInterpreter {
 168         iciName = "searchField"
 169       , iciInterpret
 170           = \ _ _ ->
 171             let attrs = [ ("type" , "text")
 172                         , ("class", "searchField")
 173                         ]
 174             in
 175               return (Input attrs)
 176       }