module Text.CSL.Output.Pandoc
( renderPandoc
, renderPandocStrict
, renderPandoc'
, Pandoc (..), Meta (..)
) where
import Data.Char ( toUpper, toLower )
import Data.List
import Text.CSL.Style
import Text.CSL.Output.Plain
renderPandoc :: Style -> [FormattedOutput] -> String
renderPandoc _
= show . clean . concatMap (render False)
renderPandoc' :: Style -> [FormattedOutput] -> String
renderPandoc' _
= show . Para . clean . concatMap (render False)
renderPandocStrict :: [FormattedOutput] -> String
renderPandocStrict
= show . cleanStrict . concatMap (render True)
render :: Bool -> FormattedOutput -> [Inline]
render _ (Delimiter s) = toStr s
render b (FO str fm xs) = toStr (prefix fm) ++
quote (formatted ++ rest) ++
toStr (suffix fm)
where
formatted = font_variant . font . text_case . trim $ str
rest = procList xs $ concatMap (render b)
trim = if b then id else unwords . words
cleaner = if b then cleanStrict else clean
quote i = if i /= [] && quotes fm
then [Quoted DoubleQuote . valign . cleaner $ i]
else valign (cleaner i)
capital s = toUpper (head s) : (tail s)
text_case s
| "capitalize-first" <- textCase fm = procList s capital
| "capitalize-all" <- textCase fm = procList s $ unwords . map capital . words
| "lowercase" <- textCase fm = map toLower s
| "uppercase" <- textCase fm = map toUpper s
| otherwise = s
font_variant i
| "small-caps" <- fontVariant fm = [SmallCaps i]
| otherwise = i
font
| "italic" <- fontStyle fm = return . Emph . toStr
| "oblique" <- fontStyle fm = return . Emph . toStr
| "normal" <- fontStyle fm
, "bold" <- fontWeight fm = return . Strong . toStr
| otherwise = toStr
valign i
| "sup" <- verticalAlign fm = [Superscript i]
| "sub" <- verticalAlign fm = [Subscript i]
| otherwise = i
toStr :: String -> [Inline]
toStr s
| ' ':xs <- s = Space : toStr xs
| x :xs <- s = cleanStrict $ Str [x] : toStr xs
| otherwise = []
cleanStrict :: [Inline] -> [Inline]
cleanStrict [] = []
cleanStrict (i:is)
| Str [] <- i = cleanStrict is
| Str " " <- i = Space : cleanStrict is
| Str sa <- i, is /= []
, Str sb <- head is = Str (sa ++ sb) : cleanStrict (tail is)
| otherwise = i : cleanStrict is
clean :: [Inline] -> [Inline]
clean [] = []
clean (i:is) = if lastInline [i] == headInline is && isPunct
then i : clean (tailInline is)
else i : clean is
where isPunct = and . map (flip elem ";,:. ") $ headInline is
headInline :: [Inline] -> String
headInline [] = []
headInline (i:_)
| Str s <- i = head' s
| Space <- i = " "
| otherwise = headInline $ getInline i
where
head' s = if s /= [] then [head s] else []
lastInline :: [Inline] -> String
lastInline [] = []
lastInline (i:[])
| Str s <- i = last' s
| Space <- i = " "
| otherwise = lastInline $ getInline i
where
last' s = if s /= [] then [last s] else []
lastInline (_:xs) = lastInline xs
tailInline :: [Inline] -> [Inline]
tailInline [] = []
tailInline (i:xs)
| Str s <- i = cleanStrict $ Str (tail' s) : xs
| Emph is <- i = cleanStrict $ Emph (tailInline is) : xs
| SmallCaps is <- i = cleanStrict $ SmallCaps (tailInline is) : xs
| Strong is <- i = cleanStrict $ Strong (tailInline is) : xs
| Superscript is <- i = cleanStrict $ Superscript (tailInline is) : xs
| Subscript is <- i = cleanStrict $ Subscript (tailInline is) : xs
| Quoted q is <- i = cleanStrict $ Quoted q (tailInline is) : xs
| Space <- i = cleanStrict $ xs
| otherwise = []
where
tail' s = if s /= [] then tail s else []
getInline :: Inline -> [Inline]
getInline i
| Emph is <- i = is
| SmallCaps is <- i = is
| Strong is <- i = is
| Superscript is <- i = is
| Subscript is <- i = is
| Quoted _ is <- i = is
| otherwise = []
data Pandoc
= Pandoc Meta [Block]
deriving (Eq, Read, Show)
data Meta
= Meta [Inline] [String] String
deriving (Eq, Show, Read)
data Block
= Para [Inline]
deriving (Show, Eq, Read)
data Inline
= Str String
| Emph [Inline]
| SmallCaps [Inline]
| Strong [Inline]
| Superscript [Inline]
| Subscript [Inline]
| Space
| Quoted QuoteType [Inline]
deriving (Show, Eq, Read)
data QuoteType = DoubleQuote deriving (Show, Eq, Read)