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           Network.URI
  10 import           Rakka.Page
  11 import           Rakka.SystemConfig
  12 import           Rakka.Wiki
  13 import           Rakka.Wiki.Interpreter
  14
  15
  16 interpreters :: [Interpreter]
  17 interpreters = [ lineBreakInterp
  18                , spanInterp
  19                , divInterp
  20                , pageNameInterp
  21                , otherLangsInterp
  22                , editPageInterp
  23                ]
  24
  25
  26 lineBreakInterp :: Interpreter
  27 lineBreakInterp = InlineCommandInterpreter {
  28                     iciName      = "br"
  29                   , iciInterpret
  30                       = \ _ (InlineCommand _ attrs _) -> return $ LineBreak attrs
  31                   }
  32
  33
  34 spanInterp :: Interpreter
  35 spanInterp = InlineCommandInterpreter {
  36                iciName      = "span"
  37              , iciInterpret
  38                  = \ _ (InlineCommand _ attrs contents) -> return $ Span attrs contents
  39              }
  40
  41
  42 divInterp :: Interpreter
  43 divInterp = BlockCommandInterpreter {
  44               bciName      = "div"
  45             , bciInterpret
  46                 = \ _ (BlockCommand _ attrs contents)
  47                 -> return $ Div attrs (map Block contents)
  48             }
  49
  50
  51 pageNameInterp :: Interpreter
  52 pageNameInterp = InlineCommandInterpreter {
  53                    iciName      = "pageName"
  54                  , iciInterpret
  55                      = \ ctx _ -> return $ Text (ctxPageName ctx)
  56                  }
  57
  58
  59 otherLangsInterp :: Interpreter
  60 otherLangsInterp
  61     = BlockCommandInterpreter {
  62         bciName      = "inOtherLanguages"
  63       , bciInterpret
  64           = \ ctx _ ->
  65             case fmap pageOtherLang (ctxMainPage ctx) of
  66               Nothing
  67                 -> return EmptyBlock
  68
  69               Just linkTable
  70                   -> do Languages langTable <- getSysConf (ctxSysConf ctx)
  71                         let merged = mergeTables langTable (M.toList linkTable)
  72                         return $ mkLangList merged
  73       }
  74     where
  75       mergeTables :: Map LanguageTag LanguageName
  76                   -> [(LanguageTag, PageName)]
  77                   -> [(LanguageName, PageName)]
  78       mergeTables _ []     = []
  79       mergeTables m (x:xs) = let (langTag, pageName) = x
  80                                  langName            = fromMaybe langTag (M.lookup langTag m)
  81                              in
  82                                (langName, pageName) : mergeTables m xs
  83
  84       mkLangList :: [(LanguageName, PageName)] -> BlockElement
  85       mkLangList xs = List Bullet (map mkLangLink xs)
  86
  87       mkLangLink :: (LanguageName, PageName) -> ListItem
  88       mkLangLink (langName, pageName)
  89           = [Inline (PageLink (Just pageName) Nothing (Just langName))]
  90
  91
  92 -- <input type="button"
  93 --        value="Edit"
  94 --        onclick="Rakka.editPage(\"http://example.org/\", \"Foo\")"
  95 --        class="editButton" />
  96 editPageInterp :: Interpreter
  97 editPageInterp
  98     = InlineCommandInterpreter {
  99         iciName      = "editPage"
 100       , iciInterpret
 101           = \ ctx (InlineCommand _ args _) ->
 102             do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
 103
 104                let pageName = fromMaybe (ctxPageName ctx) (lookup "page" args)
 105                    label    = fromMaybe "Edit this page" (lookup "label" args)
 106                    uri      = uriToString id baseURI ""
 107                    attrs    = [ ("type"   , "button")
 108                               , ("value"  , label)
 109                               , ("onclick", "Rakka.editPage(\"" ++ uri ++ "\", \"" ++ pageName ++ "\")")
 110                               , ("class"  , "editButton")
 111                               ]
 112
 113                return (Input attrs)
 114       }