{-# LANGUAGE CPP #-} {-# 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.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) #if !MIN_VERSION_base(4,11,0) import Data.Semigroup (Semigroup, (<>)) #endif 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 f :: a -> b f (Cm x :: 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 t :: 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 t :: 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 "\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 1 Text t) escapedChar :: Char -> Cm b Inlines escapedChar c :: 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 ils :: 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 ils :: 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 target :: Text target title :: Text title ils :: 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 target :: Text target title :: Text title ils :: 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 t :: 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 f :: Text f) t :: 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 _r :: SourceRange _r x :: Cm () Inlines x = Cm () Inlines x instance Rangeable (Cm SourceRange B.Inlines) where ranged :: SourceRange -> Cm SourceRange Inlines -> Cm SourceRange Inlines ranged r :: SourceRange r = Attributes -> Cm SourceRange Inlines -> Cm SourceRange Inlines forall a. HasAttributes a => Attributes -> a -> a addAttributes [("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 ("",["emoji"],[("data-emoji",alias :: Text alias)]) _) = Text -> Inline Str (":" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text alias Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ":") unemoji x :: 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 ils :: 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 ils :: 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 bs :: 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 info :: Text info t :: 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 $ Attr -> Text -> Blocks B.codeBlockWith Attr 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 "\n" Text t where attr :: (Text, [Text], [a]) attr = ("", [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 level :: Int level ils :: 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 f :: Text f) t :: 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 _ _ = 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 _) lSpacing :: ListSpacing lSpacing items :: [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 startnum :: Int startnum enumtype :: EnumeratorType enumtype delimtype :: DelimiterType delimtype) lSpacing :: ListSpacing lSpacing items :: [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 C.Decimal -> ListNumberStyle B.Decimal C.UpperAlpha -> ListNumberStyle B.UpperAlpha C.LowerAlpha -> ListNumberStyle B.LowerAlpha C.UpperRoman -> ListNumberStyle B.UpperRoman C.LowerRoman -> ListNumberStyle B.LowerRoman delim :: ListNumberDelim delim = case DelimiterType delimtype of C.Period -> ListNumberDelim B.Period C.OneParen -> ListNumberDelim B.OneParen 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 _r :: SourceRange _r x :: Cm () Blocks x = Cm () Blocks x instance Rangeable (Cm SourceRange B.Blocks) where ranged :: SourceRange -> Cm SourceRange Blocks -> Cm SourceRange Blocks ranged r :: SourceRange r x :: Cm SourceRange Blocks x = Attr -> Blocks -> Blocks B.divWith ("",[],[("data-pos",String -> Text T.pack (SourceRange -> String forall a. Show a => a -> String show SourceRange r))]) (Blocks -> Blocks) -> Cm SourceRange Blocks -> Cm SourceRange Blocks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Cm SourceRange Blocks x instance HasMath (Cm b B.Inlines) where inlineMath :: Text -> Cm b Inlines inlineMath t :: 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 t :: 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 x :: 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 x :: 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 kw :: Text kw t :: 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 $ Attr -> Inlines -> Inlines B.spanWith ("",["emoji"],[("data-emoji",Text kw)]) (Inlines -> Inlines) -> Inlines -> Inlines forall a b. (a -> b) -> a -> b $ Text -> Inlines B.text Text t instance HasPipeTable (Cm a B.Inlines) (Cm a B.Blocks) where pipeTable :: [ColAlignment] -> [Cm a Inlines] -> [[Cm a Inlines]] -> Cm a Blocks pipeTable aligns :: [ColAlignment] aligns headerCells :: [Cm a Inlines] headerCells rows :: [[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 (Attr -> [Row] -> TableHead TableHead Attr nullAttr ([Cm a Inlines] -> [Row] forall b. [Cm b Inlines] -> [Row] toHeaderRow [Cm a Inlines] headerCells)) [Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody TableBody Attr nullAttr 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] (Attr -> [Row] -> TableFoot TableFoot Attr nullAttr []) where toHeaderRow :: [Cm b Inlines] -> [Row] toHeaderRow cells :: [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 = Attr -> [Cell] -> Row Row Attr 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 LeftAlignedCol = Alignment AlignLeft toPandocAlignment CenterAlignedCol = Alignment AlignCenter toPandocAlignment RightAlignedCol = Alignment AlignRight toPandocAlignment DefaultAlignedCol = Alignment AlignDefault colspecs :: [ColSpec] colspecs = (ColAlignment -> ColSpec) -> [ColAlignment] -> [ColSpec] forall a b. (a -> b) -> [a] -> [b] map (\al :: 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 _ items :: [(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]) 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 _ spacing :: ListSpacing spacing items :: [(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 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 LooseList = [Blocks] -> [Blocks] forall a. a -> a id paraToPlain :: Block -> Block paraToPlain :: Block -> Block paraToPlain (Para xs :: [Inline] xs) = [Inline] -> Block Plain [Inline] xs paraToPlain x :: Block x = Block x toTaskListItem :: (Bool, Cm a B.Blocks) -> B.Blocks toTaskListItem :: (Bool, Cm a Blocks) -> Blocks toTaskListItem (checked :: Bool checked, item :: 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 forall a b. Coercible a b => a -> b coerce Cm a Blocks item of (Plain ils :: [Inline] ils : rest :: [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 ils :: [Inline] ils : rest :: [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 bs :: [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 "\9746" else "\9744") instance Rangeable (Cm a B.Blocks) => HasDiv (Cm a B.Blocks) where div_ :: Cm a Blocks -> Cm a Blocks div_ bs :: Cm a Blocks bs = Attr -> Blocks -> Blocks B.divWith Attr 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 ils :: 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 ils :: 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 ils :: 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 attrs :: Attributes attrs ils :: Cm a Inlines ils = Attr -> Inlines -> Inlines B.spanWith (Attributes -> Attr -> Attr addToPandocAttr Attributes attrs Attr 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 attrs :: Attributes attrs b :: 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 attrs :: Attributes attrs il :: 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 attrs :: Attributes attrs (Header n :: Int n curattrs :: Attr curattrs ils :: [Inline] ils) = Int -> Attr -> [Inline] -> Block Header Int n (Attributes -> Attr -> Attr addToPandocAttr Attributes attrs Attr curattrs) [Inline] ils addBlockAttrs attrs :: Attributes attrs (CodeBlock curattrs :: Attr curattrs s :: Text s) = Attr -> Text -> Block CodeBlock (Attributes -> Attr -> Attr addToPandocAttr Attributes attrs Attr curattrs) Text s addBlockAttrs attrs :: Attributes attrs (Table curattrs :: Attr curattrs capt :: Caption capt colspecs :: [ColSpec] colspecs thead :: TableHead thead tbody :: [TableBody] tbody tfoot :: TableFoot tfoot) = Attr -> Caption -> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Block Table (Attributes -> Attr -> Attr addToPandocAttr Attributes attrs Attr curattrs) Caption capt [ColSpec] colspecs TableHead thead [TableBody] tbody TableFoot tfoot addBlockAttrs attrs :: Attributes attrs (Div curattrs :: Attr curattrs bs :: [Block] bs) = Attr -> [Block] -> Block Div (Attributes -> Attr -> Attr addToPandocAttr Attributes attrs Attr curattrs) [Block] bs addBlockAttrs attrs :: Attributes attrs x :: Block x = Attr -> [Block] -> Block Div (Attributes -> Attr -> Attr addToPandocAttr Attributes attrs Attr nullAttr) [Block x] addInlineAttrs :: [(T.Text, T.Text)] -> Inline -> Inline addInlineAttrs :: Attributes -> Inline -> Inline addInlineAttrs attrs :: Attributes attrs (Link curattrs :: Attr curattrs ils :: [Inline] ils target :: (Text, Text) target) = Attr -> [Inline] -> (Text, Text) -> Inline Link (Attributes -> Attr -> Attr addToPandocAttr Attributes attrs Attr curattrs) [Inline] ils (Text, Text) target addInlineAttrs attrs :: Attributes attrs (Image curattrs :: Attr curattrs ils :: [Inline] ils target :: (Text, Text) target) = Attr -> [Inline] -> (Text, Text) -> Inline Image (Attributes -> Attr -> Attr addToPandocAttr Attributes attrs Attr curattrs) [Inline] ils (Text, Text) target addInlineAttrs attrs :: Attributes attrs (Span curattrs :: Attr curattrs ils :: [Inline] ils) = Attr -> [Inline] -> Inline Span (Attributes -> Attr -> Attr addToPandocAttr Attributes attrs Attr curattrs) [Inline] ils addInlineAttrs attrs :: Attributes attrs (Code curattrs :: Attr curattrs s :: Text s) = Attr -> Text -> Inline Code (Attributes -> Attr -> Attr addToPandocAttr Attributes attrs Attr curattrs) Text s addInlineAttrs attrs :: Attributes attrs x :: Inline x = Attr -> [Inline] -> Inline Span (Attributes -> Attr -> Attr addToPandocAttr Attributes attrs Attr nullAttr) [Inline x] addToPandocAttr :: Attributes -> Attr -> Attr addToPandocAttr :: Attributes -> Attr -> Attr addToPandocAttr attrs :: Attributes attrs attr :: Attr attr = ((Text, Text) -> Attr -> Attr) -> Attr -> Attributes -> Attr forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr (Text, Text) -> Attr -> Attr forall a b. (Eq a, IsString a) => (a, b) -> (b, [b], [(a, b)]) -> (b, [b], [(a, b)]) go Attr attr Attributes attrs where go :: (a, b) -> (b, [b], [(a, b)]) -> (b, [b], [(a, b)]) go ("id", v :: b v) (_, cls :: [b] cls, kvs :: [(a, b)] kvs) = (b v, [b] cls, [(a, b)] kvs) go ("class", v :: b v) (ident :: b ident, cls :: [b] cls, kvs :: [(a, b)] kvs) = (b ident, b vb -> [b] -> [b] forall a. a -> [a] -> [a] :[b] cls, [(a, b)] kvs) go (k :: a k, v :: b v) (ident :: b ident, cls :: [b] cls, kvs :: [(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 _num :: Int _num _lab :: Text _lab _x :: Cm a Blocks _x = Cm a Blocks forall a. Monoid a => a mempty footnoteList :: [Cm a Blocks] -> Cm a Blocks footnoteList _xs :: [Cm a Blocks] _xs = Cm a Blocks forall a. Monoid a => a mempty footnoteRef :: Text -> Text -> Cm a Blocks -> Cm a Inlines footnoteRef _num :: Text _num _lab :: Text _lab contents :: 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 t :: Text t = "&#" Text -> Text -> Bool `T.isPrefixOf` Text t Bool -> Bool -> Bool && let t' :: Text t' = Int -> Text -> Text T.drop 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 /=';') Text t badvalue :: (Integer, Text) -> Bool badvalue (n :: Integer n, r :: 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 < 1 Bool -> Bool -> Bool || Integer n Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool > (0x10FFFF :: Integer) in case Text -> Maybe (Char, Text) T.uncons Text t' of Nothing -> Bool True Just (x :: Char x, rest :: Text rest) | Char x Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == 'x' Bool -> Bool -> Bool || Char x Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == '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 Space = " " go SoftBreak = " " go (Str x :: Text x) = Text x go (Code _ x :: Text x) = Text x go (Math _ x :: Text x) = Text x go (RawInline (B.Format "html") t :: Text t) | "<br" Text -> Text -> Bool `T.isPrefixOf` Text t = " " go LineBreak = " " go _ = Text forall a. Monoid a => a mempty deNote :: Inline -> Inline deNote :: Inline -> Inline deNote (Note _) = Text -> Inline Str "" deNote x :: Inline x = Inline x deQuote :: Inline -> Inline deQuote :: Inline -> Inline deQuote (Quoted SingleQuote xs :: [Inline] xs) = Attr -> [Inline] -> Inline Span ("",[],[]) (Text -> Inline Str "\8216" Inline -> [Inline] -> [Inline] forall a. a -> [a] -> [a] : [Inline] xs [Inline] -> [Inline] -> [Inline] forall a. [a] -> [a] -> [a] ++ [Text -> Inline Str "\8217"]) deQuote (Quoted DoubleQuote xs :: [Inline] xs) = Attr -> [Inline] -> Inline Span ("",[],[]) (Text -> Inline Str "\8220" Inline -> [Inline] -> [Inline] forall a. a -> [a] -> [a] : [Inline] xs [Inline] -> [Inline] -> [Inline] forall a. [a] -> [a] -> [a] ++ [Text -> Inline Str "\8221"]) deQuote x :: Inline x = Inline x