module Text.Pandoc.Builder ( module Text.Pandoc.Definition
, Inlines
, Blocks
, toList
, fromList
, empty
, (+++)
, doc
, setTitle
, setAuthors
, setDate
, text
, str
, emph
, strong
, strikeout
, superscript
, subscript
, smallcaps
, singleQuoted
, doubleQuoted
, cite
, codeWith
, code
, space
, emdash
, endash
, apostrophe
, linebreak
, math
, displayMath
, rawInline
, link
, image
, note
, para
, plain
, codeBlockWith
, codeBlock
, rawBlock
, blockQuote
, bulletList
, orderedListWith
, orderedList
, definitionList
, header
, horizontalRule
, table
, simpleTable
)
where
import Text.Pandoc.Definition
import Data.String
import Data.Monoid
import Data.Maybe (fromMaybe)
import Data.Sequence (Seq, fromList, singleton, empty, (><))
import Data.Foldable (Foldable, toList)
import Data.List (groupBy)
import Control.Arrow ((***))
type Inlines = Seq Inline
instance IsString Inlines where
fromString = text
type Blocks = Seq Block
(+++) :: Monoid a => a -> a -> a
(+++) = mappend
doc :: Blocks -> Pandoc
doc = Pandoc (Meta [] [] []) . toList
setTitle :: Inlines -> Pandoc -> Pandoc
setTitle t (Pandoc m bs) = Pandoc m{ docTitle = toList t } bs
setAuthors :: [Inlines] -> Pandoc -> Pandoc
setAuthors as (Pandoc m bs) = Pandoc m{ docAuthors = map toList as } bs
setDate :: Inlines -> Pandoc -> Pandoc
setDate d (Pandoc m bs) = Pandoc m{ docDate = toList d } bs
text :: String -> Inlines
text = fromList . map conv . breakBySpaces
where breakBySpaces = groupBy sameCategory
sameCategory x y = (is_space x && is_space y) ||
(not $ is_space x || is_space y)
conv xs | all is_space xs = Space
conv xs = Str xs
is_space ' ' = True
is_space '\n' = True
is_space '\t' = True
is_space _ = False
str :: String -> Inlines
str = singleton . Str
emph :: Inlines -> Inlines
emph = singleton . Emph . toList
strong :: Inlines -> Inlines
strong = singleton . Strong . toList
strikeout :: Inlines -> Inlines
strikeout = singleton . Strikeout . toList
superscript :: Inlines -> Inlines
superscript = singleton . Superscript . toList
subscript :: Inlines -> Inlines
subscript = singleton . Subscript . toList
smallcaps :: Inlines -> Inlines
smallcaps = singleton . SmallCaps . toList
singleQuoted :: Inlines -> Inlines
singleQuoted = quoted SingleQuote
doubleQuoted :: Inlines -> Inlines
doubleQuoted = quoted DoubleQuote
quoted :: QuoteType -> Inlines -> Inlines
quoted qt = singleton . Quoted qt . toList
cite :: [Citation] -> Inlines -> Inlines
cite cts = singleton . Cite cts . toList
codeWith :: Attr -> String -> Inlines
codeWith attrs = singleton . Code attrs
code :: String -> Inlines
code = codeWith nullAttr
space :: Inlines
space = singleton Space
emdash :: Inlines
emdash = singleton EmDash
endash :: Inlines
endash = singleton EnDash
apostrophe :: Inlines
apostrophe = singleton Apostrophe
ellipses :: Inlines
ellipses = singleton Ellipses
linebreak :: Inlines
linebreak = singleton LineBreak
math :: String -> Inlines
math = singleton . Math InlineMath
displayMath :: String -> Inlines
displayMath = singleton . Math DisplayMath
rawInline :: Format -> String -> Inlines
rawInline format = singleton . RawInline format
link :: String
-> String
-> Inlines
-> Inlines
link url title x = singleton $ Link (toList x) (url, title)
image :: String
-> String
-> Inlines
-> Inlines
image url title x = singleton $ Image (toList x) (url, title)
note :: Blocks -> Inlines
note = singleton . Note . toList
para :: Inlines -> Blocks
para = singleton . Para . toList
plain :: Inlines -> Blocks
plain = singleton . Plain . toList
codeBlockWith :: Attr -> String -> Blocks
codeBlockWith attrs = singleton . CodeBlock attrs
codeBlock :: String -> Blocks
codeBlock = codeBlockWith nullAttr
rawBlock :: Format -> String -> Blocks
rawBlock format = singleton . RawBlock format
blockQuote :: Blocks -> Blocks
blockQuote = singleton . BlockQuote . toList
orderedListWith :: ListAttributes -> [Blocks] -> Blocks
orderedListWith attrs = singleton . OrderedList attrs . map toList
orderedList :: [Blocks] -> Blocks
orderedList = orderedListWith (1, DefaultStyle, DefaultDelim)
bulletList :: [Blocks] -> Blocks
bulletList = singleton . BulletList . map toList
definitionList :: [(Inlines, [Blocks])] -> Blocks
definitionList = singleton . DefinitionList . map (toList *** map toList)
header :: Int
-> Inlines
-> Blocks
header level = singleton . Header level . toList
horizontalRule :: Blocks
horizontalRule = singleton HorizontalRule
table :: Inlines
-> [(Alignment, Double)]
-> [Blocks]
-> [[Blocks]]
-> Blocks
table caption cellspecs headers rows = singleton $
Table (toList caption) aligns widths
(map toList headers) (map (map toList) rows)
where (aligns, widths) = unzip cellspecs
simpleTable :: [Blocks]
-> [[Blocks]]
-> Blocks
simpleTable headers = table empty (mapConst defaults headers) headers
where defaults = (AlignDefault, 0)
mapConst :: Functor f => b -> f a -> f b
mapConst = fmap . const