Rakka/Wiki/Formatter.hs

   1 module Rakka.Wiki.Formatter
   2     ( formatWikiElements
   3     )
   4     where
   5
   6 import           Control.Arrow
   7 import           Control.Arrow.ArrowList
   8 import           Data.List
   9 import           Rakka.Wiki
  10 import           Text.XML.HXT.Arrow.XmlArrow
  11 import           Text.XML.HXT.DOM.TypeDefs
  12
  13
  14 -- 複數の Inline を一つに纏める
  15 packParagraph :: [WikiElement] -> [Either BlockElement [InlineElement]]
  16 packParagraph elems = map pack grp
  17     where
  18       grp :: [[WikiElement]]
  19       grp = groupBy criteria elems
  20
  21       criteria :: WikiElement -> WikiElement -> Bool
  22       criteria (Inline _) (Inline _) = True
  23       criteria _ _                   = False
  24
  25       pack :: [WikiElement] -> Either BlockElement [InlineElement]
  26       pack (Block b : []) = Left b
  27       pack xs             = Right [ case x of
  28                                       Inline i -> i | x <- xs ]
  29
  30
  31 formatWikiElements :: (ArrowXml a, ArrowChoice a) => a [WikiElement] XmlTree
  32 formatWikiElements
  33     = proc elems
  34     -> do chunk <- arrL id -< packParagraph elems
  35           case chunk of
  36             Left  x  -> formatBlock     -< x
  37             Right xs -> formatParagraph -< xs
  38
  39
  40 formatBlock :: (ArrowXml a, ArrowChoice a) => a BlockElement XmlTree
  41 formatBlock
  42     = proc b
  43     -> do case b of
  44             Header level text
  45                 -> formatHeader -< (level, text)
  46             EmptyLine
  47                 -> none -< ()
  48
  49
  50 formatHeader :: ArrowXml a => a (Int, String) XmlTree
  51 formatHeader
  52     = proc (level, text)
  53     -> selem ("h" ++ show level) [txt text] -<< ()
  54
  55
  56 formatParagraph :: (ArrowXml a, ArrowChoice a) => a [InlineElement] XmlTree
  57 formatParagraph
  58     = proc xs
  59     -> do elem <- arrL id -< xs
  60           tree <- ( eelem "p"
  61                     += formatInline ) -< elem
  62           returnA -< tree
  63
  64
  65 formatInline :: (ArrowXml a, ArrowChoice a) => a InlineElement XmlTree
  66 formatInline
  67     = proc i
  68     -> do case i of
  69             Text text
  70                 -> mkText -< text