{-# 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.Smart
import Data.Char (isSpace)
import Data.Coerce (coerce)

newtype Cm b a = Cm { Cm b a -> a
unCm :: a }
  deriving (Int -> Cm b a -> ShowS
[Cm b a] -> ShowS
Cm b a -> String
(Int -> Cm b a -> ShowS)
-> (Cm b a -> String) -> ([Cm b a] -> ShowS) -> Show (Cm b a)
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, b -> Cm b a -> Cm b a
NonEmpty (Cm b a) -> Cm b a
Cm b a -> Cm b a -> Cm b a
(Cm b a -> Cm b a -> Cm b a)
-> (NonEmpty (Cm b a) -> Cm b a)
-> (forall b. Integral b => b -> Cm b a -> Cm b a)
-> Semigroup (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 :: 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, Semigroup (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] -> Cm b a)
-> Monoid (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
$cp1Monoid :: forall b a. Monoid a => Semigroup (Cm b a)
Monoid)

instance Functor (Cm b) where
  fmap :: (a -> b) -> Cm b a -> Cm b b
fmap a -> b
f (Cm a
x) = b -> Cm b b
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 = Inlines -> Cm b Inlines
forall b a. a -> Cm b a
Cm Inlines
B.linebreak
  softBreak :: Cm b Inlines
softBreak = Inlines -> Cm b Inlines
forall b a. a -> Cm b a
Cm Inlines
B.softbreak
  str :: Text -> Cm b Inlines
str Text
t = Inlines -> Cm b Inlines
forall b a. a -> Cm b a
Cm (Inlines -> Cm b Inlines) -> Inlines -> Cm b Inlines
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 = Inlines -> Cm b Inlines
forall b a. a -> Cm b a
Cm (Inlines -> Cm b Inlines) -> Inlines -> Cm b Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.str Text
"\xFFFD"
    | Bool
otherwise = Inlines -> Cm b Inlines
forall b a. a -> Cm b a
Cm (Inlines -> Cm b Inlines) -> Inlines -> Cm b Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
t (Maybe Text -> Text) -> Maybe Text -> Text
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 = Inlines -> Cm b Inlines
forall b a. a -> Cm b a
Cm (Inlines -> Cm b Inlines) -> Inlines -> Cm b Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.str (Text -> Inlines) -> Text -> Inlines
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 (Inlines -> Inlines) -> Cm b Inlines -> Cm b Inlines
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 (Inlines -> Inlines) -> Cm b Inlines -> Cm b Inlines
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 (Inlines -> Inlines) -> Cm b Inlines -> Cm b Inlines
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 (Inlines -> Inlines) -> Cm b Inlines -> Cm b Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cm b Inlines
ils
  code :: Text -> Cm b Inlines
code Text
t = Inlines -> Cm b Inlines
forall b a. a -> Cm b a
Cm (Inlines -> Cm b Inlines) -> Inlines -> Cm b Inlines
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 = Inlines -> Cm b Inlines
forall b a. a -> Cm b a
Cm (Inlines -> Cm b Inlines) -> Inlines -> Cm b Inlines
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 = Attributes -> Cm SourceRange Inlines -> Cm SourceRange Inlines
forall a. HasAttributes a => Attributes -> a -> a
addAttributes [(Text
"data-pos", String -> Text
T.pack (SourceRange -> String
forall a. Show a => a -> String
show SourceRange
r))]

instance Walkable Inline b => ToPlainText (Cm a b) where
  toPlainText :: Cm a b -> Text
toPlainText = b -> Text
forall a. Walkable Inline a => a -> Text
stringify (b -> Text) -> (Cm a b -> b) -> Cm a b -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline) -> b -> b
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
unemoji (b -> b) -> (Cm a b -> b) -> Cm a b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cm a b -> b
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
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
alias Text -> Text -> Text
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 = Blocks -> Cm a Blocks
forall b a. a -> Cm b a
Cm (Blocks -> Cm a Blocks) -> Blocks -> Cm a Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Cm a Inlines -> Inlines
forall b a. Cm b a -> a
unCm Cm a Inlines
ils
  plain :: Cm a Inlines -> Cm a Blocks
plain Cm a Inlines
ils = Blocks -> Cm a Blocks
forall b a. a -> Cm b a
Cm (Blocks -> Cm a Blocks) -> Blocks -> Cm a Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.plain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Cm a Inlines -> Inlines
forall b a. Cm b a -> a
unCm Cm a Inlines
ils
  thematicBreak :: Cm a Blocks
thematicBreak = Blocks -> Cm a Blocks
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 (Blocks -> Blocks) -> Cm a Blocks -> Cm a Blocks
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 =
    Blocks -> Cm a Blocks
forall b a. a -> Cm b a
Cm (Blocks -> Cm a Blocks) -> Blocks -> Cm a Blocks
forall a b. (a -> b) -> a -> b
$ (Text, [Text], Attributes) -> Text -> Blocks
B.codeBlockWith (Text, [Text], Attributes)
forall a. (Text, [Text], [a])
attr (Text -> Blocks) -> Text -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
t (Maybe Text -> Text) -> Maybe Text -> Text
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 (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
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 = Blocks -> Cm a Blocks
forall b a. a -> Cm b a
Cm (Blocks -> Cm a Blocks) -> Blocks -> Cm a Blocks
forall a b. (a -> b) -> a -> b
$ Int -> Inlines -> Blocks
B.header Int
level (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Cm a Inlines -> Inlines
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 = Blocks -> Cm a Blocks
forall b a. a -> Cm b a
Cm (Blocks -> Cm a Blocks) -> Blocks -> Cm a Blocks
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)
_ = Blocks -> Cm a Blocks
forall b a. a -> Cm b a
Cm Blocks
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 =
    Blocks -> Cm a Blocks
forall b a. a -> Cm b a
Cm (Blocks -> Cm a Blocks)
-> ([Cm a Blocks] -> Blocks) -> [Cm a Blocks] -> Cm a Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
B.bulletList ([Blocks] -> Blocks)
-> ([Cm a Blocks] -> [Blocks]) -> [Cm a Blocks] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListSpacing -> [Blocks] -> [Blocks]
handleSpacing ListSpacing
lSpacing ([Blocks] -> [Blocks])
-> ([Cm a Blocks] -> [Blocks]) -> [Cm a Blocks] -> [Blocks]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cm a Blocks -> Blocks) -> [Cm a Blocks] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map Cm a Blocks -> Blocks
forall b a. Cm b a -> a
unCm ([Cm a Blocks] -> Cm a Blocks) -> [Cm a Blocks] -> Cm a Blocks
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 =
    Blocks -> Cm a Blocks
forall b a. a -> Cm b a
Cm (Blocks -> Cm a Blocks)
-> ([Cm a Blocks] -> Blocks) -> [Cm a Blocks] -> Cm a Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListAttributes -> [Blocks] -> Blocks
B.orderedListWith ListAttributes
attr ([Blocks] -> Blocks)
-> ([Cm a Blocks] -> [Blocks]) -> [Cm a Blocks] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListSpacing -> [Blocks] -> [Blocks]
handleSpacing ListSpacing
lSpacing ([Blocks] -> [Blocks])
-> ([Cm a Blocks] -> [Blocks]) -> [Cm a Blocks] -> [Blocks]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cm a Blocks -> Blocks) -> [Cm a Blocks] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map Cm a Blocks -> Blocks
forall b a. Cm b a -> a
unCm ([Cm a Blocks] -> Cm a Blocks) -> [Cm a Blocks] -> Cm a Blocks
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 = Attributes -> Cm SourceRange Blocks -> Cm SourceRange Blocks
forall a. HasAttributes a => Attributes -> a -> a
addAttributes [(Text
"data-pos", String -> Text
T.pack (SourceRange -> String
forall a. Show a => a -> String
show SourceRange
r))]

instance HasMath (Cm b B.Inlines) where
  inlineMath :: Text -> Cm b Inlines
inlineMath Text
t = Inlines -> Cm b Inlines
forall b a. a -> Cm b a
Cm (Inlines -> Cm b Inlines) -> Inlines -> Cm b Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.math Text
t
  displayMath :: Text -> Cm b Inlines
displayMath Text
t = Inlines -> Cm b Inlines
forall b a. a -> Cm b a
Cm (Inlines -> Cm b Inlines) -> Inlines -> Cm b Inlines
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 (Inlines -> Inlines) -> Cm b Inlines -> Cm b Inlines
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 (Inlines -> Inlines) -> Cm b Inlines -> Cm b Inlines
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 = Inlines -> Cm b Inlines
forall b a. a -> Cm b a
Cm (Inlines -> Cm b Inlines) -> Inlines -> Cm b Inlines
forall a b. (a -> b) -> a -> b
$ (Text, [Text], Attributes) -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"emoji"],[(Text
"data-emoji",Text
kw)])
                  (Inlines -> Inlines) -> Inlines -> Inlines
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 = Inlines -> Cm b Inlines
forall b a. a -> Cm b a
Cm (Inlines -> Cm b Inlines) -> Inlines -> Cm b Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
B.link Text
t Text
"wikilink" (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Cm b Inlines -> Inlines
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 =
    Blocks -> Cm a Blocks
forall b a. a -> Cm b a
Cm (Blocks -> Cm a Blocks) -> Blocks -> Cm a Blocks
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 ([Cm a Inlines] -> [Row]
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 [] ([Row] -> TableBody) -> [Row] -> TableBody
forall a b. (a -> b) -> a -> b
$ ([Cm a Inlines] -> Row) -> [[Cm a Inlines]] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map [Cm a Inlines] -> Row
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
       | [Cm b Inlines] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Cm b Inlines]
cells  = []
       | Bool
otherwise   = [[Cm b Inlines] -> Row
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 ([Cell] -> Row)
-> ([Cm b Inlines] -> [Cell]) -> [Cm b Inlines] -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cm b Inlines -> Cell) -> [Cm b Inlines] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map (Blocks -> Cell
B.simpleCell (Blocks -> Cell)
-> (Cm b Inlines -> Blocks) -> Cm b Inlines -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Blocks
B.plain (Inlines -> Blocks)
-> (Cm b Inlines -> Inlines) -> Cm b Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cm b Inlines -> Inlines
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 = (ColAlignment -> ColSpec) -> [ColAlignment] -> [ColSpec]
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 =
    Blocks -> Cm a Blocks
forall b a. a -> Cm b a
Cm (Blocks -> Cm a Blocks) -> Blocks -> Cm a Blocks
forall a b. (a -> b) -> a -> b
$ [(Inlines, [Blocks])] -> Blocks
B.definitionList ([(Inlines, [Blocks])] -> Blocks)
-> [(Inlines, [Blocks])] -> Blocks
forall a b. (a -> b) -> a -> b
$ ((Cm a Inlines, [Cm a Blocks]) -> (Inlines, [Blocks]))
-> [(Cm a Inlines, [Cm a Blocks])] -> [(Inlines, [Blocks])]
forall a b. (a -> b) -> [a] -> [b]
map (Cm a Inlines, [Cm a Blocks]) -> (Inlines, [Blocks])
coerce [(Cm a Inlines, [Cm a Blocks])]
items

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 =
    Blocks -> Cm a Blocks
forall b a. a -> Cm b a
Cm (Blocks -> Cm a Blocks) -> Blocks -> Cm a Blocks
forall a b. (a -> b) -> a -> b
$ [Blocks] -> Blocks
B.bulletList ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall a b. (a -> b) -> a -> b
$ ListSpacing -> [Blocks] -> [Blocks]
handleSpacing ListSpacing
spacing ([Blocks] -> [Blocks]) -> [Blocks] -> [Blocks]
forall a b. (a -> b) -> a -> b
$ ((Bool, Cm a Blocks) -> Blocks)
-> [(Bool, Cm a Blocks)] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Cm a Blocks) -> Blocks
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 = (Blocks -> Blocks) -> [Blocks] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map ([Block] -> Blocks
forall a. [a] -> Many a
B.fromList ([Block] -> Blocks) -> (Blocks -> [Block]) -> Blocks -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
paraToPlain ([Block] -> [Block]) -> (Blocks -> [Block]) -> Blocks -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> [Block]
forall a. Many a -> [a]
B.toList)
handleSpacing ListSpacing
LooseList = [Blocks] -> [Blocks]
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 :: (Bool, Cm a Blocks) -> Blocks
toTaskListItem (Bool
checked, Cm a Blocks
item) = [Block] -> Blocks
forall a. [a] -> Many a
B.fromList ([Block] -> Blocks) -> [Block] -> Blocks
forall a b. (a -> b) -> a -> b
$
  case Blocks -> [Block]
forall a. Many a -> [a]
B.toList (Blocks -> [Block]) -> Blocks -> [Block]
forall a b. (a -> b) -> a -> b
$ Cm a Blocks -> Blocks
coerce Cm a Blocks
item of
    (Plain [Inline]
ils : [Block]
rest) -> [Inline] -> Block
Plain (Inline
checkbox Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest
    (Para  [Inline]
ils : [Block]
rest) -> [Inline] -> Block
Para  (Inline
checkbox Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest
    [Block]
bs                 -> [Inline] -> Block
Plain [Inline
checkbox] Block -> [Block] -> [Block]
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 (Blocks -> Blocks) -> Cm a Blocks -> Cm a Blocks
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 (Inlines -> Inlines) -> Cm a Inlines -> Cm a Inlines
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 (Inlines -> Inlines) -> Cm a Inlines -> Cm a Inlines
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 (Inlines -> Inlines) -> Cm a Inlines -> Cm a Inlines
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) (Inlines -> Inlines) -> Cm a Inlines -> Cm a Inlines
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 = (Block -> Block) -> Blocks -> Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attributes -> Block -> Block
addBlockAttrs Attributes
attrs) (Blocks -> Blocks) -> Cm a Blocks -> Cm a Blocks
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 = (Inline -> Inline) -> Inlines -> Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attributes -> Inline -> Inline
addInlineAttrs Attributes
attrs) (Inlines -> Inlines) -> Cm a Inlines -> Cm a Inlines
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 = ((Text, Text)
 -> (Text, [Text], Attributes) -> (Text, [Text], Attributes))
-> (Text, [Text], Attributes)
-> Attributes
-> (Text, [Text], Attributes)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text, Text)
-> (Text, [Text], Attributes) -> (Text, [Text], Attributes)
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
vb -> [b] -> [b]
forall 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)(a, b) -> [(a, b)] -> [(a, b)]
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 = Cm a Blocks
forall a. Monoid a => a
mempty
  footnoteList :: [Cm a Blocks] -> Cm a Blocks
footnoteList [Cm a Blocks]
_xs = Cm a Blocks
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 (Blocks -> Inlines) -> Cm a Blocks -> Cm a Inlines
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 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
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 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
1 Bool -> Bool -> Bool
||
                        Integer
n Integer -> Integer -> Bool
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'X'
           -> (String -> Bool)
-> ((Integer, Text) -> Bool)
-> Either String (Integer, Text)
-> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
True) (Integer, Text) -> Bool
badvalue (Reader Integer
forall a. Integral a => Reader a
TR.hexadecimal Text
rest)
         | Bool
otherwise
           -> (String -> Bool)
-> ((Integer, Text) -> Bool)
-> Either String (Integer, Text)
-> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
True) (Integer, Text) -> Bool
badvalue (Reader Integer
forall a. Integral a => Reader a
TR.decimal Text
t')

stringify :: Walkable Inline a => a -> T.Text
stringify :: a -> Text
stringify = (Inline -> Text) -> a -> Text
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Text
go (a -> Text) -> (a -> a) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline) -> a -> a
forall a b. Walkable a b => (a -> a) -> b -> b
walk (Inline -> Inline
deNote (Inline -> Inline) -> (Inline -> Inline) -> Inline -> Inline
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
_                                             = Text
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" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs [Inline] -> [Inline] -> [Inline]
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" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
"\8221"])
deQuote Inline
x = Inline
x