{-# 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 { 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)) => 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