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)
  45                 -> return $ Div attrs (map Block contents)
  46             }
  47
  48
  49 pageNameInterp :: Interpreter
  50 pageNameInterp = InlineCommandInterpreter {
  51                    iciName      = "pageName"
  52                  , iciInterpret
  53                      = \ ctx _ -> return $ Text (ctxPageName ctx)
  54                  }
  55
  56
  57 otherLangsInterp :: Interpreter
  58 otherLangsInterp
  59     = BlockCommandInterpreter {
  60         bciName      = "inOtherLanguages"
  61       , bciInterpret
  62           = \ ctx _ ->
  63             case fmap pageOtherLang (ctxMainPage ctx) of
  64               Nothing
  65                 -> return EmptyBlock
  66
  67               Just linkTable
  68                   -> do Languages langTable <- getSysConf (ctxSysConf ctx)
  69                         let merged = mergeTables langTable (M.toList linkTable)
  70                         return $ mkLangList merged
  71       }
  72     where
  73       mergeTables :: Map LanguageTag LanguageName
  74                   -> [(LanguageTag, PageName)]
  75                   -> [(LanguageName, PageName)]
  76       mergeTables _ []     = []
  77       mergeTables m (x:xs) = let (langTag, pageName) = x
  78                                  langName            = fromMaybe langTag (M.lookup langTag m)
  79                              in
  80                                (langName, pageName) : mergeTables m xs
  81
  82       mkLangList :: [(LanguageName, PageName)] -> BlockElement
  83       mkLangList xs = List Bullet (map mkLangLink xs)
  84
  85       mkLangLink :: (LanguageName, PageName) -> ListItem
  86       mkLangLink (langName, pageName)
  87           = [Inline (PageLink (Just pageName) Nothing (Just langName))]