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
  14
  15 interpreters :: [Interpreter]
  16 interpreters = [ lineBreakInterp
  17                , spanInterp
  18                , divInterp
  19                , pageNameInterp
  20                , otherLangsInterp
  21                ]
  22
  23
  24 lineBreakInterp :: Interpreter
  25 lineBreakInterp = InlineCommandInterpreter {
  26                     iciName      = "br"
  27                   , iciInterpret
  28                       = \ _ (InlineCommand _ attrs _) -> return $ LineBreak attrs
  29                   }
  30
  31
  32 spanInterp :: Interpreter
  33 spanInterp = InlineCommandInterpreter {
  34                iciName      = "span"
  35              , iciInterpret
  36                  = \ _ (InlineCommand _ attrs contents) -> return $ Span attrs contents
  37              }
  38
  39
  40 divInterp :: Interpreter
  41 divInterp = BlockCommandInterpreter {
  42               bciName      = "div"
  43             , bciInterpret
  44                 = \ _ (BlockCommand _ attrs contents) -> return $ Div attrs contents
  45             }
  46
  47
  48 pageNameInterp :: Interpreter
  49 pageNameInterp = InlineCommandInterpreter {
  50                    iciName      = "pageName"
  51                  , iciInterpret
  52                      = \ ctx _ -> return $ Text (ctxPageName ctx)
  53                  }
  54
  55
  56 otherLangsInterp :: Interpreter
  57 otherLangsInterp
  58     = BlockCommandInterpreter {
  59         bciName      = "inOtherLanguages"
  60       , bciInterpret
  61           = \ ctx _ ->
  62             case fmap pageOtherLang (ctxMainPage ctx) of
  63               Nothing
  64                 -> return EmptyBlock
  65
  66               Just linkTable
  67                   -> do Languages langTable <- getSysConf (ctxSysConf ctx)
  68                         let merged = mergeTables langTable (M.toList linkTable)
  69                         return $ List $ mkLangList merged
  70       }
  71     where
  72       mergeTables :: Map LanguageTag LanguageName
  73                   -> [(LanguageTag, PageName)]
  74                   -> [(LanguageName, PageName)]
  75       mergeTables _ []     = []
  76       mergeTables m (x:xs) = let (langTag, pageName) = x
  77                                  langName            = fromMaybe langTag (M.lookup langTag m)
  78                              in
  79                                (langName, pageName) : mergeTables m xs
  80
  81       mkLangList :: [(LanguageName, PageName)] -> ListElement
  82       mkLangList xs = ListElement Bullet (map mkLangLink xs)
  83
  84       mkLangLink :: (LanguageName, PageName) -> ListItem
  85       mkLangLink (langName, pageName)
  86           = [Right (PageLink (Just pageName) Nothing (Just langName))]