module Text.Pandoc.Builder ( module Text.Pandoc.Definition
, Inlines(..)
, Blocks(..)
, (<>)
, Listable(..)
, doc
, setTitle
, setAuthors
, setDate
, text
, str
, emph
, strong
, strikeout
, superscript
, subscript
, smallcaps
, singleQuoted
, doubleQuoted
, cite
, codeWith
, code
, space
, linebreak
, math
, displayMath
, rawInline
, link
, image
, note
, trimInlines
, 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, (|>), viewr, viewl, ViewR(..), ViewL(..))
import qualified Data.Sequence as Seq
import Data.Foldable (Foldable)
import qualified Data.Foldable as F
import Data.List (groupBy, intersperse)
import Data.Data
import Data.Typeable
import Control.Arrow ((***))
#if MIN_VERSION_base(4,5,0)
#else
infixr 6 <>
(<>) :: Monoid m => m -> m -> m
(<>) = mappend
#endif
newtype Inlines = Inlines { unInlines :: Seq Inline }
deriving (Data, Ord, Eq, Typeable)
instance Show Inlines where
show = show . F.toList . unInlines
instance Read Inlines where
readsPrec n = map (\(x,y) -> (Inlines . Seq.fromList $ x, y)) . readsPrec n
instance Monoid Inlines where
mempty = Inlines mempty
(Inlines xs) `mappend` (Inlines ys) =
case (viewr xs, viewl ys) of
(EmptyR, _) -> Inlines ys
(_, EmptyL) -> Inlines xs
(xs' :> x, y :< ys') -> Inlines (meld `mappend` ys')
where meld = case (x, y) of
(Space, Space) -> xs' |> Space
(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
_ -> xs' |> x |> y
instance IsString Inlines where
fromString = text
newtype Blocks = Blocks { unBlocks :: Seq Block }
deriving (Data, Ord, Eq, Typeable, Monoid)
instance Show Blocks where
show = show . F.toList . unBlocks
instance Read Blocks where
readsPrec n = map (\(x,y) -> (Blocks . Seq.fromList $ x, y)) . readsPrec n
class Listable a b where
toList :: a -> [b]
fromList :: [b] -> a
foldMap :: (b -> a) -> a -> a
singleton :: b -> a
foldlM :: Monad m => (a -> b -> m a) -> a -> a -> m a
isNull :: a -> Bool
instance Listable Inlines Inline where
toList = F.toList . unInlines
fromList = Inlines . Seq.fromList
foldMap f = F.foldMap f . unInlines
singleton = Inlines . Seq.singleton
foldlM f x = F.foldlM f x . unInlines
isNull = Seq.null . unInlines
instance Listable Blocks Block where
toList = F.toList . unBlocks
fromList = Blocks . Seq.fromList
foldMap f = F.foldMap f . unBlocks
singleton = Blocks . Seq.singleton
foldlM f x = F.foldlM f x . unBlocks
isNull = Seq.null . unBlocks
trimInlines :: Inlines -> Inlines
#if MIN_VERSION_containers(0,4,0)
trimInlines (Inlines ils) = Inlines $ Seq.dropWhileL (== Space) $
Seq.dropWhileR (== Space) $ ils
#else
trimInlines (Inlines ils) = Inlines $ Seq.dropWhileL (== Space) $
Seq.reverse $ Seq.dropWhileL (== Space) $
Seq.reverse ils
#endif
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
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 mempty (mapConst defaults headers) headers
where defaults = (AlignDefault, 0)
mapConst :: Functor f => b -> f a -> f b
mapConst = fmap . const