{-# LANGUAGE ExtendedDefaultRules       #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE UndecidableInstances       #-}

module Commonmark.Pandoc
  ( Cm(..)
  )

where

import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.Read as TR
import Text.Pandoc.Definition
import Text.Pandoc.Walk
import qualified Text.Pandoc.Builder as B
import Commonmark.Types as C
import Commonmark.Entity (lookupEntity)
import Commonmark.Extensions.Math
import Commonmark.Extensions.Emoji
import Commonmark.Extensions.Wikilinks
import Commonmark.Extensions.PipeTable
import Commonmark.Extensions.Strikethrough
import Commonmark.Extensions.Superscript
import Commonmark.Extensions.Subscript
import Commonmark.Extensions.DefinitionList
import Commonmark.Extensions.Attributes
import Commonmark.Extensions.Footnote
import Commonmark.Extensions.TaskList
import Commonmark.Extensions.Alerts
import Commonmark.Extensions.Smart
import Data.Char (isSpace)
import Data.Coerce (coerce)

newtype Cm b a = Cm { forall b a. Cm b a -> a
unCm :: a }
  deriving (Int -> Cm b a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall b a. Show a => Int -> Cm b a -> ShowS
forall b a. Show a => [Cm b a] -> ShowS
forall b a. Show a => Cm b a -> String
showList :: [Cm b a] -> ShowS
$cshowList :: forall b a. Show a => [Cm b a] -> ShowS
show :: Cm b a -> String
$cshow :: forall b a. Show a => Cm b a -> String
showsPrec :: Int -> Cm b a -> ShowS
$cshowsPrec :: forall b a. Show a => Int -> Cm b a -> ShowS
Show, NonEmpty (Cm b a) -> Cm b a
Cm b a -> Cm b a -> Cm b a
forall b. Integral b => b -> Cm b a -> Cm b a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall b a. Semigroup a => NonEmpty (Cm b a) -> Cm b a
forall b a. Semigroup a => Cm b a -> Cm b a -> Cm b a
forall b a b. (Semigroup a, Integral b) => b -> Cm b a -> Cm b a
stimes :: forall b. Integral b => b -> Cm b a -> Cm b a
$cstimes :: forall b a b. (Semigroup a, Integral b) => b -> Cm b a -> Cm b a
sconcat :: NonEmpty (Cm b a) -> Cm b a
$csconcat :: forall b a. Semigroup a => NonEmpty (Cm b a) -> Cm b a
<> :: Cm b a -> Cm b a -> Cm b a
$c<> :: forall b a. Semigroup a => Cm b a -> Cm b a -> Cm b a
Semigroup, Cm b a
[Cm b a] -> Cm b a
Cm b a -> Cm b a -> Cm b a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall {b} {a}. Monoid a => Semigroup (Cm b a)
forall b a. Monoid a => Cm b a
forall b a. Monoid a => [Cm b a] -> Cm b a
forall b a. Monoid a => Cm b a -> Cm b a -> Cm b a
mconcat :: [Cm b a] -> Cm b a
$cmconcat :: forall b a. Monoid a => [Cm b a] -> Cm b a
mappend :: Cm b a -> Cm b a -> Cm b a
$cmappend :: forall b a. Monoid a => Cm b a -> Cm b a -> Cm b a
mempty :: Cm b a
$cmempty :: forall b a. Monoid a => Cm b a
Monoid)

instance Functor (Cm b) where
  fmap :: forall a b. (a -> b) -> Cm b a -> Cm b b
fmap a -> b
f (Cm a
x) = forall b a. a -> Cm b a
Cm (a -> b
f a
x)

instance Rangeable (Cm b B.Inlines) => IsInline (Cm b B.Inlines) where
  lineBreak :: Cm b Inlines
lineBreak = forall b a. a -> Cm b a
Cm Inlines
B.linebreak
  softBreak :: Cm b Inlines
softBreak = forall b a. a -> Cm b a
Cm Inlines
B.softbreak
  str :: Text -> Cm b Inlines
str Text
t = forall b a. a -> Cm b a
Cm forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.text Text
t
  entity :: Text -> Cm b Inlines
entity Text
t
    | Text -> Bool
illegalCodePoint Text
t = forall b a. a -> Cm b a
Cm forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.str Text
"\xFFFD"
    | Bool
otherwise = forall b a. a -> Cm b a
Cm forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.str forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
t forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
lookupEntity (Int -> Text -> Text
T.drop Int
1 Text
t)
  escapedChar :: Char -> Cm b Inlines
escapedChar Char
c = forall b a. a -> Cm b a
Cm forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.str forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c
  emph :: Cm b Inlines -> Cm b Inlines
emph Cm b Inlines
ils = Inlines -> Inlines
B.emph forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cm b Inlines
ils
  strong :: Cm b Inlines -> Cm b Inlines
strong Cm b Inlines
ils = Inlines -> Inlines
B.strong forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cm b Inlines
ils
  link :: Text -> Text -> Cm b Inlines -> Cm b Inlines
link Text
target Text
title Cm b Inlines
ils = Text -> Text -> Inlines -> Inlines
B.link Text
target Text
title forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cm b Inlines
ils
  image :: Text -> Text -> Cm b Inlines -> Cm b Inlines
image Text
target Text
title Cm b Inlines
ils = Text -> Text -> Inlines -> Inlines
B.image Text
target Text
title forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cm b Inlines
ils
  code :: Text -> Cm b Inlines
code Text
t = forall b a. a -> Cm b a
Cm forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.code Text
t
  rawInline :: Format -> Text -> Cm b Inlines
rawInline (C.Format Text
f) Text
t = forall b a. a -> Cm b a
Cm forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines
B.rawInline Text
f Text
t

instance Rangeable (Cm () B.Inlines) where
  ranged :: SourceRange -> Cm () Inlines -> Cm () Inlines
ranged SourceRange
_r Cm () Inlines
x = Cm () Inlines
x

instance Rangeable (Cm SourceRange B.Inlines) where
  ranged :: SourceRange -> Cm SourceRange Inlines -> Cm SourceRange Inlines
ranged SourceRange
r = forall a. HasAttributes a => Attributes -> a -> a
addAttributes [(Text
"data-pos", String -> Text
T.pack (forall a. Show a => a -> String
show SourceRange
r))]

instance Walkable Inline b => ToPlainText (Cm a b) where
  toPlainText :: Cm a b -> Text
toPlainText = forall a. Walkable Inline a => a -> Text
stringify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
unemoji forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Cm b a -> a
unCm

unemoji :: Inline -> Inline
unemoji :: Inline -> Inline
unemoji (Span (Text
"",[Text
"emoji"],[(Text
"data-emoji",Text
alias)]) [Inline]
_)
          = Text -> Inline
Str (Text
":" forall a. Semigroup a => a -> a -> a
<> Text
alias forall a. Semigroup a => a -> a -> a
<> Text
":")
unemoji Inline
x = Inline
x

instance (Rangeable (Cm a B.Inlines),
          Rangeable (Cm a B.Blocks))
      => IsBlock (Cm a B.Inlines) (Cm a B.Blocks) where
  paragraph :: Cm a Inlines -> Cm a Blocks
paragraph Cm a Inlines
ils = forall b a. a -> Cm b a
Cm forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.para forall a b. (a -> b) -> a -> b
$ forall b a. Cm b a -> a
unCm Cm a Inlines
ils
  plain :: Cm a Inlines -> Cm a Blocks
plain Cm a Inlines
ils = forall b a. a -> Cm b a
Cm forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.plain forall a b. (a -> b) -> a -> b
$ forall b a. Cm b a -> a
unCm Cm a Inlines
ils
  thematicBreak :: Cm a Blocks
thematicBreak = forall b a. a -> Cm b a
Cm Blocks
B.horizontalRule
  blockQuote :: Cm a Blocks -> Cm a Blocks
blockQuote Cm a Blocks
bs = Blocks -> Blocks
B.blockQuote forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cm a Blocks
bs
  codeBlock :: Text -> Text -> Cm a Blocks
codeBlock Text
info Text
t =
    forall b a. a -> Cm b a
Cm forall a b. (a -> b) -> a -> b
$ (Text, [Text], Attributes) -> Text -> Blocks
B.codeBlockWith forall {a}. (Text, [Text], [a])
attr forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
t forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripSuffix Text
"\n" Text
t
    where attr :: (Text, [Text], [a])
attr = (Text
"", [Text
lang | Bool -> Bool
not (Text -> Bool
T.null Text
lang)], [])
          lang :: Text
lang = (Char -> Bool) -> Text -> Text
T.takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) Text
info
  heading :: Int -> Cm a Inlines -> Cm a Blocks
heading Int
level Cm a Inlines
ils = forall b a. a -> Cm b a
Cm forall a b. (a -> b) -> a -> b
$ Int -> Inlines -> Blocks
B.header Int
level forall a b. (a -> b) -> a -> b
$ forall b a. Cm b a -> a
unCm Cm a Inlines
ils
  rawBlock :: Format -> Text -> Cm a Blocks
rawBlock (C.Format Text
f) Text
t = forall b a. a -> Cm b a
Cm forall a b. (a -> b) -> a -> b
$ Text -> Text -> Blocks
B.rawBlock Text
f Text
t
  referenceLinkDefinition :: Text -> (Text, Text) -> Cm a Blocks
referenceLinkDefinition Text
_ (Text, Text)
_ = forall b a. a -> Cm b a
Cm forall a. Monoid a => a
mempty
  list :: ListType -> ListSpacing -> [Cm a Blocks] -> Cm a Blocks
list (C.BulletList Char
_) ListSpacing
lSpacing [Cm a Blocks]
items =
    forall b a. a -> Cm b a
Cm forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
B.bulletList forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListSpacing -> [Blocks] -> [Blocks]
handleSpacing ListSpacing
lSpacing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall b a. Cm b a -> a
unCm forall a b. (a -> b) -> a -> b
$ [Cm a Blocks]
items
  list (C.OrderedList Int
startnum EnumeratorType
enumtype DelimiterType
delimtype) ListSpacing
lSpacing [Cm a Blocks]
items =
    forall b a. a -> Cm b a
Cm forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListAttributes -> [Blocks] -> Blocks
B.orderedListWith ListAttributes
attr forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListSpacing -> [Blocks] -> [Blocks]
handleSpacing ListSpacing
lSpacing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall b a. Cm b a -> a
unCm forall a b. (a -> b) -> a -> b
$ [Cm a Blocks]
items
    where sty :: ListNumberStyle
sty = case EnumeratorType
enumtype of
                  EnumeratorType
C.Decimal    -> ListNumberStyle
B.Decimal
                  EnumeratorType
C.UpperAlpha -> ListNumberStyle
B.UpperAlpha
                  EnumeratorType
C.LowerAlpha -> ListNumberStyle
B.LowerAlpha
                  EnumeratorType
C.UpperRoman -> ListNumberStyle
B.UpperRoman
                  EnumeratorType
C.LowerRoman -> ListNumberStyle
B.LowerRoman
          delim :: ListNumberDelim
delim = case DelimiterType
delimtype of
                    DelimiterType
C.Period    -> ListNumberDelim
B.Period
                    DelimiterType
C.OneParen  -> ListNumberDelim
B.OneParen
                    DelimiterType
C.TwoParens -> ListNumberDelim
B.TwoParens
          attr :: ListAttributes
attr = (Int
startnum, ListNumberStyle
sty, ListNumberDelim
delim)

instance Rangeable (Cm () B.Blocks) where
  ranged :: SourceRange -> Cm () Blocks -> Cm () Blocks
ranged SourceRange
_r Cm () Blocks
x = Cm () Blocks
x

instance Rangeable (Cm SourceRange B.Blocks) where
  ranged :: SourceRange -> Cm SourceRange Blocks -> Cm SourceRange Blocks
ranged SourceRange
r = forall a. HasAttributes a => Attributes -> a -> a
addAttributes [(Text
"data-pos", String -> Text
T.pack (forall a. Show a => a -> String
show SourceRange
r))]

instance HasMath (Cm b B.Inlines) where
  inlineMath :: Text -> Cm b Inlines
inlineMath Text
t = forall b a. a -> Cm b a
Cm forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.math Text
t
  displayMath :: Text -> Cm b Inlines
displayMath Text
t = forall b a. a -> Cm b a
Cm forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.displayMath Text
t

instance Rangeable (Cm b B.Inlines) => HasQuoted (Cm b B.Inlines) where
  singleQuoted :: Cm b Inlines -> Cm b Inlines
singleQuoted Cm b Inlines
x = Inlines -> Inlines
B.singleQuoted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cm b Inlines
x
  doubleQuoted :: Cm b Inlines -> Cm b Inlines
doubleQuoted Cm b Inlines
x = Inlines -> Inlines
B.doubleQuoted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cm b Inlines
x

instance HasEmoji (Cm b B.Inlines) where
  emoji :: Text -> Text -> Cm b Inlines
emoji Text
kw Text
t = forall b a. a -> Cm b a
Cm forall a b. (a -> b) -> a -> b
$ (Text, [Text], Attributes) -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"emoji"],[(Text
"data-emoji",Text
kw)])
                  forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.text Text
t

instance HasWikilinks (Cm b B.Inlines) where
  wikilink :: Text -> Cm b Inlines -> Cm b Inlines
wikilink Text
t Cm b Inlines
il = forall b a. a -> Cm b a
Cm forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
B.link Text
t Text
"wikilink" forall a b. (a -> b) -> a -> b
$ forall b a. Cm b a -> a
unCm Cm b Inlines
il

instance HasPipeTable (Cm a B.Inlines) (Cm a B.Blocks) where
  pipeTable :: [ColAlignment] -> [Cm a Inlines] -> [[Cm a Inlines]] -> Cm a Blocks
pipeTable [ColAlignment]
aligns [Cm a Inlines]
headerCells [[Cm a Inlines]]
rows =
    forall b a. a -> Cm b a
Cm forall a b. (a -> b) -> a -> b
$ Caption
-> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks
B.table Caption
B.emptyCaption [ColSpec]
colspecs
           ((Text, [Text], Attributes) -> [Row] -> TableHead
TableHead (Text, [Text], Attributes)
nullAttr (forall {b}. [Cm b Inlines] -> [Row]
toHeaderRow [Cm a Inlines]
headerCells))
           [(Text, [Text], Attributes)
-> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody (Text, [Text], Attributes)
nullAttr RowHeadColumns
0 [] forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {b}. [Cm b Inlines] -> Row
toRow [[Cm a Inlines]]
rows]
           ((Text, [Text], Attributes) -> [Row] -> TableFoot
TableFoot (Text, [Text], Attributes)
nullAttr [])
    where
     toHeaderRow :: [Cm b Inlines] -> [Row]
toHeaderRow [Cm b Inlines]
cells
       | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Cm b Inlines]
cells  = []
       | Bool
otherwise   = [forall {b}. [Cm b Inlines] -> Row
toRow [Cm b Inlines]
cells]
     toRow :: [Cm b Inlines] -> Row
toRow = (Text, [Text], Attributes) -> [Cell] -> Row
Row (Text, [Text], Attributes)
nullAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Blocks -> Cell
B.simpleCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Blocks
B.plain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Cm b a -> a
unCm)
     toPandocAlignment :: ColAlignment -> Alignment
toPandocAlignment ColAlignment
LeftAlignedCol = Alignment
AlignLeft
     toPandocAlignment ColAlignment
CenterAlignedCol = Alignment
AlignCenter
     toPandocAlignment ColAlignment
RightAlignedCol = Alignment
AlignRight
     toPandocAlignment ColAlignment
DefaultAlignedCol = Alignment
AlignDefault
     colspecs :: [ColSpec]
colspecs = forall a b. (a -> b) -> [a] -> [b]
map (\ColAlignment
al -> (ColAlignment -> Alignment
toPandocAlignment ColAlignment
al, ColWidth
ColWidthDefault))
                 [ColAlignment]
aligns

instance (Rangeable (Cm a B.Inlines), Rangeable (Cm a B.Blocks))
  => HasDefinitionList (Cm a B.Inlines) (Cm a B.Blocks) where
  definitionList :: ListSpacing -> [(Cm a Inlines, [Cm a Blocks])] -> Cm a Blocks
definitionList ListSpacing
_ [(Cm a Inlines, [Cm a Blocks])]
items =
    forall b a. a -> Cm b a
Cm forall a b. (a -> b) -> a -> b
$ [(Inlines, [Blocks])] -> Blocks
B.definitionList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map coerce :: forall a b. Coercible a b => a -> b
coerce [(Cm a Inlines, [Cm a Blocks])]
items

instance (Rangeable (Cm a B.Inlines), Rangeable (Cm a B.Blocks))
  => HasAlerts (Cm a B.Inlines) (Cm a B.Blocks) where
  alert :: AlertType -> Cm a Blocks -> Cm a Blocks
alert AlertType
alertType Cm a Blocks
bs =
    forall b a. a -> Cm b a
Cm forall a b. (a -> b) -> a -> b
$ (Text, [Text], Attributes) -> Blocks -> Blocks
B.divWith (Text
"",[Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ AlertType -> Text
alertName AlertType
alertType],[])
       forall a b. (a -> b) -> a -> b
$ (Text, [Text], Attributes) -> Blocks -> Blocks
B.divWith (Text
"",[Text
"title"],[])
           (Inlines -> Blocks
B.para (Text -> Inlines
B.str (AlertType -> Text
alertName AlertType
alertType)))
         forall a. Semigroup a => a -> a -> a
<> coerce :: forall a b. Coercible a b => a -> b
coerce Cm a Blocks
bs

instance (Rangeable (Cm a B.Inlines), Rangeable (Cm a B.Blocks))
  => HasTaskList (Cm a B.Inlines) (Cm a B.Blocks) where
  taskList :: ListType -> ListSpacing -> [(Bool, Cm a Blocks)] -> Cm a Blocks
taskList ListType
_ ListSpacing
spacing [(Bool, Cm a Blocks)]
items =
    forall b a. a -> Cm b a
Cm forall a b. (a -> b) -> a -> b
$ [Blocks] -> Blocks
B.bulletList forall a b. (a -> b) -> a -> b
$ ListSpacing -> [Blocks] -> [Blocks]
handleSpacing ListSpacing
spacing forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. (Bool, Cm a Blocks) -> Blocks
toTaskListItem [(Bool, Cm a Blocks)]
items

handleSpacing :: ListSpacing -> [B.Blocks] -> [B.Blocks]
handleSpacing :: ListSpacing -> [Blocks] -> [Blocks]
handleSpacing ListSpacing
TightList = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> Many a
B.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
paraToPlain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Many a -> [a]
B.toList)
handleSpacing ListSpacing
LooseList = forall a. a -> a
id

paraToPlain :: Block -> Block
paraToPlain :: Block -> Block
paraToPlain (Para [Inline]
xs) = [Inline] -> Block
Plain [Inline]
xs
paraToPlain Block
x = Block
x

toTaskListItem :: (Bool, Cm a B.Blocks) -> B.Blocks
toTaskListItem :: forall a. (Bool, Cm a Blocks) -> Blocks
toTaskListItem (Bool
checked, Cm a Blocks
item) = forall a. [a] -> Many a
B.fromList forall a b. (a -> b) -> a -> b
$
  case forall a. Many a -> [a]
B.toList forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce Cm a Blocks
item of
    (Plain [Inline]
ils : [Block]
rest) -> [Inline] -> Block
Plain (Inline
checkbox forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
ils) forall a. a -> [a] -> [a]
: [Block]
rest
    (Para  [Inline]
ils : [Block]
rest) -> [Inline] -> Block
Para  (Inline
checkbox forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
ils) forall a. a -> [a] -> [a]
: [Block]
rest
    [Block]
bs                 -> [Inline] -> Block
Plain [Inline
checkbox] forall a. a -> [a] -> [a]
: [Block]
bs
    where checkbox :: Inline
checkbox = Text -> Inline
Str (if Bool
checked then Text
"\9746" else Text
"\9744")

instance Rangeable (Cm a B.Blocks)
  => HasDiv (Cm a B.Blocks) where
  div_ :: Cm a Blocks -> Cm a Blocks
div_ Cm a Blocks
bs = (Text, [Text], Attributes) -> Blocks -> Blocks
B.divWith (Text, [Text], Attributes)
nullAttr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cm a Blocks
bs

instance HasStrikethrough (Cm a B.Inlines) where
  strikethrough :: Cm a Inlines -> Cm a Inlines
strikethrough Cm a Inlines
ils = Inlines -> Inlines
B.strikeout forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cm a Inlines
ils

instance HasSuperscript (Cm a B.Inlines) where
  superscript :: Cm a Inlines -> Cm a Inlines
superscript Cm a Inlines
ils = Inlines -> Inlines
B.superscript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cm a Inlines
ils

instance HasSubscript (Cm a B.Inlines) where
  subscript :: Cm a Inlines -> Cm a Inlines
subscript Cm a Inlines
ils = Inlines -> Inlines
B.subscript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cm a Inlines
ils

instance Rangeable (Cm a B.Inlines) => HasSpan (Cm a B.Inlines) where
  spanWith :: Attributes -> Cm a Inlines -> Cm a Inlines
spanWith Attributes
attrs Cm a Inlines
ils =
    (Text, [Text], Attributes) -> Inlines -> Inlines
B.spanWith (Attributes
-> (Text, [Text], Attributes) -> (Text, [Text], Attributes)
addToPandocAttr Attributes
attrs (Text, [Text], Attributes)
nullAttr) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cm a Inlines
ils

instance HasAttributes (Cm a B.Blocks) where
  addAttributes :: Attributes -> Cm a Blocks -> Cm a Blocks
addAttributes Attributes
attrs Cm a Blocks
b = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attributes -> Block -> Block
addBlockAttrs Attributes
attrs) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cm a Blocks
b

instance HasAttributes (Cm a B.Inlines) where
  addAttributes :: Attributes -> Cm a Inlines -> Cm a Inlines
addAttributes Attributes
attrs Cm a Inlines
il = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attributes -> Inline -> Inline
addInlineAttrs Attributes
attrs) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cm a Inlines
il

addBlockAttrs :: [(T.Text, T.Text)] -> Block -> Block
addBlockAttrs :: Attributes -> Block -> Block
addBlockAttrs Attributes
attrs (Header Int
n (Text, [Text], Attributes)
curattrs [Inline]
ils) =
  Int -> (Text, [Text], Attributes) -> [Inline] -> Block
Header Int
n (Attributes
-> (Text, [Text], Attributes) -> (Text, [Text], Attributes)
addToPandocAttr Attributes
attrs (Text, [Text], Attributes)
curattrs) [Inline]
ils
addBlockAttrs Attributes
attrs (CodeBlock (Text, [Text], Attributes)
curattrs Text
s) =
  (Text, [Text], Attributes) -> Text -> Block
CodeBlock (Attributes
-> (Text, [Text], Attributes) -> (Text, [Text], Attributes)
addToPandocAttr Attributes
attrs (Text, [Text], Attributes)
curattrs) Text
s
addBlockAttrs Attributes
attrs (Table (Text, [Text], Attributes)
curattrs Caption
capt [ColSpec]
colspecs TableHead
thead [TableBody]
tbody TableFoot
tfoot) =
  (Text, [Text], Attributes)
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table (Attributes
-> (Text, [Text], Attributes) -> (Text, [Text], Attributes)
addToPandocAttr Attributes
attrs (Text, [Text], Attributes)
curattrs) Caption
capt [ColSpec]
colspecs TableHead
thead [TableBody]
tbody TableFoot
tfoot
addBlockAttrs Attributes
attrs (Div (Text, [Text], Attributes)
curattrs [Block]
bs) =
  (Text, [Text], Attributes) -> [Block] -> Block
Div (Attributes
-> (Text, [Text], Attributes) -> (Text, [Text], Attributes)
addToPandocAttr Attributes
attrs (Text, [Text], Attributes)
curattrs) [Block]
bs
addBlockAttrs Attributes
attrs Block
x =
  (Text, [Text], Attributes) -> [Block] -> Block
Div (Attributes
-> (Text, [Text], Attributes) -> (Text, [Text], Attributes)
addToPandocAttr Attributes
attrs (Text, [Text], Attributes)
nullAttr) [Block
x]

addInlineAttrs :: [(T.Text, T.Text)] -> Inline -> Inline
addInlineAttrs :: Attributes -> Inline -> Inline
addInlineAttrs Attributes
attrs (Link (Text, [Text], Attributes)
curattrs [Inline]
ils (Text, Text)
target) =
  (Text, [Text], Attributes) -> [Inline] -> (Text, Text) -> Inline
Link (Attributes
-> (Text, [Text], Attributes) -> (Text, [Text], Attributes)
addToPandocAttr Attributes
attrs (Text, [Text], Attributes)
curattrs) [Inline]
ils (Text, Text)
target
addInlineAttrs Attributes
attrs (Image (Text, [Text], Attributes)
curattrs [Inline]
ils (Text, Text)
target) =
  (Text, [Text], Attributes) -> [Inline] -> (Text, Text) -> Inline
Image (Attributes
-> (Text, [Text], Attributes) -> (Text, [Text], Attributes)
addToPandocAttr Attributes
attrs (Text, [Text], Attributes)
curattrs) [Inline]
ils (Text, Text)
target
addInlineAttrs Attributes
attrs (Span (Text, [Text], Attributes)
curattrs [Inline]
ils) =
  (Text, [Text], Attributes) -> [Inline] -> Inline
Span (Attributes
-> (Text, [Text], Attributes) -> (Text, [Text], Attributes)
addToPandocAttr Attributes
attrs (Text, [Text], Attributes)
curattrs) [Inline]
ils
addInlineAttrs Attributes
attrs (Code (Text, [Text], Attributes)
curattrs Text
s) =
  (Text, [Text], Attributes) -> Text -> Inline
Code (Attributes
-> (Text, [Text], Attributes) -> (Text, [Text], Attributes)
addToPandocAttr Attributes
attrs (Text, [Text], Attributes)
curattrs) Text
s
addInlineAttrs Attributes
attrs Inline
x =
  (Text, [Text], Attributes) -> [Inline] -> Inline
Span (Attributes
-> (Text, [Text], Attributes) -> (Text, [Text], Attributes)
addToPandocAttr Attributes
attrs (Text, [Text], Attributes)
nullAttr) [Inline
x]

addToPandocAttr :: Attributes -> Attr -> Attr
addToPandocAttr :: Attributes
-> (Text, [Text], Attributes) -> (Text, [Text], Attributes)
addToPandocAttr Attributes
attrs (Text, [Text], Attributes)
attr = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {b}.
(Eq a, IsString a) =>
(a, b) -> (b, [b], [(a, b)]) -> (b, [b], [(a, b)])
go (Text, [Text], Attributes)
attr Attributes
attrs
 where
  go :: (a, b) -> (b, [b], [(a, b)]) -> (b, [b], [(a, b)])
go (a
"id", b
v) (b
_, [b]
cls, [(a, b)]
kvs) = (b
v, [b]
cls, [(a, b)]
kvs)
  go (a
"class", b
v) (b
ident, [b]
cls, [(a, b)]
kvs) = (b
ident, b
vforall a. a -> [a] -> [a]
:[b]
cls, [(a, b)]
kvs)
  go (a
k, b
v) (b
ident, [b]
cls, [(a, b)]
kvs) = (b
ident, [b]
cls, (a
k,b
v)forall a. a -> [a] -> [a]
:[(a, b)]
kvs)

instance (Rangeable (Cm a B.Inlines), Rangeable (Cm a B.Blocks))
     => HasFootnote (Cm a B.Inlines) (Cm a B.Blocks) where
  footnote :: Int -> Text -> Cm a Blocks -> Cm a Blocks
footnote Int
_num Text
_lab Cm a Blocks
_x = forall a. Monoid a => a
mempty
  footnoteList :: [Cm a Blocks] -> Cm a Blocks
footnoteList [Cm a Blocks]
_xs = forall a. Monoid a => a
mempty
  footnoteRef :: Text -> Text -> Cm a Blocks -> Cm a Inlines
footnoteRef Text
_num Text
_lab Cm a Blocks
contents = Blocks -> Inlines
B.note forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cm a Blocks
contents

illegalCodePoint :: T.Text -> Bool
illegalCodePoint :: Text -> Bool
illegalCodePoint Text
t =
  Text
"&#" Text -> Text -> Bool
`T.isPrefixOf` Text
t Bool -> Bool -> Bool
&&
  let t' :: Text
t' = Int -> Text -> Text
T.drop Int
2 forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.filter (forall a. Eq a => a -> a -> Bool
/=Char
';') Text
t
      badvalue :: (Integer, Text) -> Bool
badvalue (Integer
n, Text
r) = Bool -> Bool
not (Text -> Bool
T.null Text
r) Bool -> Bool -> Bool
||
                        Integer
n forall a. Ord a => a -> a -> Bool
< Integer
1 Bool -> Bool -> Bool
||
                        Integer
n forall a. Ord a => a -> a -> Bool
> (Integer
0x10FFFF :: Integer)
  in
  case Text -> Maybe (Char, Text)
T.uncons Text
t' of
       Maybe (Char, Text)
Nothing -> Bool
True
       Just (Char
x, Text
rest)
         | Char
x forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
'X'
           -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Bool
True) (Integer, Text) -> Bool
badvalue (forall a. Integral a => Reader a
TR.hexadecimal Text
rest)
         | Bool
otherwise
           -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Bool
True) (Integer, Text) -> Bool
badvalue (forall a. Integral a => Reader a
TR.decimal Text
t')

stringify :: Walkable Inline a => a -> T.Text
stringify :: forall a. Walkable Inline a => a -> Text
stringify = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Text
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Walkable a b => (a -> a) -> b -> b
walk (Inline -> Inline
deNote forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Inline
deQuote)
  where go :: Inline -> T.Text
        go :: Inline -> Text
go Inline
Space                                         = Text
" "
        go Inline
SoftBreak                                     = Text
" "
        go (Str Text
x)                                       = Text
x
        go (Code (Text, [Text], Attributes)
_ Text
x)                                    = Text
x
        go (Math MathType
_ Text
x)                                    = Text
x
        go (RawInline (B.Format Text
"html") Text
t)
           | Text
"<br" Text -> Text -> Bool
`T.isPrefixOf` Text
t                      = Text
" "
        go Inline
LineBreak                                     = Text
" "
        go Inline
_                                             = forall a. Monoid a => a
mempty

deNote :: Inline -> Inline
deNote :: Inline -> Inline
deNote (Note [Block]
_) = Text -> Inline
Str Text
""
deNote Inline
x        = Inline
x

deQuote :: Inline -> Inline
deQuote :: Inline -> Inline
deQuote (Quoted QuoteType
SingleQuote [Inline]
xs) =
  (Text, [Text], Attributes) -> [Inline] -> Inline
Span (Text
"",[],[]) (Text -> Inline
Str Text
"\8216" forall a. a -> [a] -> [a]
: [Inline]
xs forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
"\8217"])
deQuote (Quoted QuoteType
DoubleQuote [Inline]
xs) =
  (Text, [Text], Attributes) -> [Inline] -> Inline
Span (Text
"",[],[]) (Text -> Inline
Str Text
"\8220" forall a. a -> [a] -> [a]
: [Inline]
xs forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
"\8221"])
deQuote Inline
x = Inline
x