module Text.Pandoc.Builder ( module Text.Pandoc.Definition
, Many(..)
, Inlines
, Blocks
, (<>)
, singleton
, toList
, fromList
, isNull
, doc
, ToMetaValue(..)
, HasMeta(..)
, setTitle
, setAuthors
, setDate
, text
, str
, emph
, strong
, strikeout
, superscript
, subscript
, smallcaps
, singleQuoted
, doubleQuoted
, cite
, codeWith
, code
, space
, softbreak
, linebreak
, math
, displayMath
, rawInline
, link
, linkWith
, image
, imageWith
, note
, spanWith
, trimInlines
, para
, plain
, lineBlock
, codeBlockWith
, codeBlock
, rawBlock
, blockQuote
, bulletList
, orderedListWith
, orderedList
, definitionList
, header
, headerWith
, horizontalRule
, table
, simpleTable
, divWith
)
where
import Text.Pandoc.Definition
import Data.String
import Data.Monoid
import qualified Data.Map as M
import Data.Sequence (Seq, (|>), viewr, viewl, ViewR(..), ViewL(..))
import qualified Data.Sequence as Seq
import Data.Traversable (Traversable)
import Data.Foldable (Foldable)
import qualified Data.Foldable as F
import Data.List (groupBy)
import Data.Data
import Control.Arrow ((***))
import GHC.Generics (Generic)
#if MIN_VERSION_base(4,5,0)
#else
infixr 6 <>
(<>) :: Monoid m => m -> m -> m
(<>) = mappend
#endif
newtype Many a = Many { unMany :: Seq a }
deriving (Data, Ord, Eq, Typeable, Foldable, Traversable, Functor, Show, Read)
deriving instance Generic (Many a)
toList :: Many a -> [a]
toList = F.toList
singleton :: a -> Many a
singleton = Many . Seq.singleton
fromList :: [a] -> Many a
fromList = Many . Seq.fromList
isNull :: Many a -> Bool
isNull = Seq.null . unMany
type Inlines = Many Inline
type Blocks = Many Block
deriving instance Monoid Blocks
instance Monoid Inlines where
mempty = Many mempty
(Many xs) `mappend` (Many ys) =
case (viewr xs, viewl ys) of
(EmptyR, _) -> Many ys
(_, EmptyL) -> Many xs
(xs' :> x, y :< ys') -> Many (meld `mappend` ys')
where meld = case (x, y) of
(Space, Space) -> xs' |> Space
(Space, SoftBreak) -> xs' |> SoftBreak
(SoftBreak, Space) -> xs' |> SoftBreak
(Str t1, Str t2) -> xs' |> Str (t1 <> t2)
(Emph i1, Emph i2) -> xs' |> Emph (i1 <> i2)
(Strong i1, Strong i2) -> xs' |> Strong (i1 <> i2)
(Subscript i1, Subscript i2) -> xs' |> Subscript (i1 <> i2)
(Superscript i1, Superscript i2) -> xs' |> Superscript (i1 <> i2)
(Strikeout i1, Strikeout i2) -> xs' |> Strikeout (i1 <> i2)
(Space, LineBreak) -> xs' |> LineBreak
(LineBreak, Space) -> xs' |> LineBreak
(SoftBreak, LineBreak) -> xs' |> LineBreak
(LineBreak, SoftBreak) -> xs' |> LineBreak
(SoftBreak, SoftBreak) -> xs' |> SoftBreak
_ -> xs' |> x |> y
instance IsString Inlines where
fromString = text
trimInlines :: Inlines -> Inlines
#if MIN_VERSION_containers(0,4,0)
trimInlines (Many ils) = Many $ Seq.dropWhileL isSp $
Seq.dropWhileR isSp $ ils
#else
trimInlines (Many ils) = Many $ Seq.dropWhileL isSp $
Seq.reverse $ Seq.dropWhileL isSp $
Seq.reverse ils
#endif
where isSp Space = True
isSp SoftBreak = True
isSp _ = False
doc :: Blocks -> Pandoc
doc = Pandoc nullMeta . toList
class ToMetaValue a where
toMetaValue :: a -> MetaValue
instance ToMetaValue MetaValue where
toMetaValue = id
instance ToMetaValue Blocks where
toMetaValue = MetaBlocks . toList
instance ToMetaValue Inlines where
toMetaValue = MetaInlines . toList
instance ToMetaValue Bool where
toMetaValue = MetaBool
instance ToMetaValue a => ToMetaValue [a] where
toMetaValue = MetaList . map toMetaValue
instance ToMetaValue a => ToMetaValue (M.Map String a) where
toMetaValue = MetaMap . M.map toMetaValue
class HasMeta a where
setMeta :: ToMetaValue b => String -> b -> a -> a
deleteMeta :: String -> a -> a
instance HasMeta Meta where
setMeta key val (Meta ms) = Meta $ M.insert key (toMetaValue val) ms
deleteMeta key (Meta ms) = Meta $ M.delete key ms
instance HasMeta Pandoc where
setMeta key val (Pandoc (Meta ms) bs) =
Pandoc (Meta $ M.insert key (toMetaValue val) ms) bs
deleteMeta key (Pandoc (Meta ms) bs) =
Pandoc (Meta $ M.delete key ms) bs
setTitle :: Inlines -> Pandoc -> Pandoc
setTitle = setMeta "title"
setAuthors :: [Inlines] -> Pandoc -> Pandoc
setAuthors = setMeta "author"
setDate :: Inlines -> Pandoc -> Pandoc
setDate = setMeta "date"
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 =
if any is_newline xs
then SoftBreak
else Space
conv xs = Str xs
is_space ' ' = True
is_space '\r' = True
is_space '\n' = True
is_space '\t' = True
is_space _ = False
is_newline '\r' = True
is_newline '\n' = True
is_newline _ = 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
softbreak :: Inlines
softbreak = singleton SoftBreak
linebreak :: Inlines
linebreak = singleton LineBreak
math :: String -> Inlines
math = singleton . Math InlineMath
displayMath :: String -> Inlines
displayMath = singleton . Math DisplayMath
rawInline :: String -> String -> Inlines
rawInline format = singleton . RawInline (Format format)
link :: String
-> String
-> Inlines
-> Inlines
link = linkWith nullAttr
linkWith :: Attr
-> String
-> String
-> Inlines
-> Inlines
linkWith attr url title x = singleton $ Link attr (toList x) (url, title)
image :: String
-> String
-> Inlines
-> Inlines
image = imageWith nullAttr
imageWith :: Attr
-> String
-> String
-> Inlines
-> Inlines
imageWith attr url title x = singleton $ Image attr (toList x) (url, title)
note :: Blocks -> Inlines
note = singleton . Note . toList
spanWith :: Attr -> Inlines -> Inlines
spanWith attr = singleton . Span attr . toList
para :: Inlines -> Blocks
para = singleton . Para . toList
plain :: Inlines -> Blocks
plain ils = if isNull ils
then mempty
else singleton . Plain . toList $ ils
lineBlock :: [Inlines] -> Blocks
lineBlock = singleton . LineBlock . map toList
codeBlockWith :: Attr -> String -> Blocks
codeBlockWith attrs = singleton . CodeBlock attrs
codeBlock :: String -> Blocks
codeBlock = codeBlockWith nullAttr
rawBlock :: String -> String -> Blocks
rawBlock format = singleton . RawBlock (Format 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 = headerWith nullAttr
headerWith :: Attr -> Int -> Inlines -> Blocks
headerWith attr level = singleton . Header level attr . 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
numcols = case (headers:rows) of
[] -> 0
xs -> maximum (map length xs)
headers' = if null headers
then replicate numcols mempty
else headers
simpleTable :: [Blocks]
-> [[Blocks]]
-> Blocks
simpleTable headers rows =
table mempty (replicate numcols defaults) headers rows
where defaults = (AlignDefault, 0)
numcols = case (headers:rows) of
[] -> 0
xs -> maximum (map length xs)
divWith :: Attr -> Blocks -> Blocks
divWith attr = singleton . Div attr . toList