{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
module Text.Pandoc.Legacy.Definition
( D.Pandoc(..)
, D.Meta
, pattern Meta
, unMeta
, D.MetaValue ( D.MetaList
, D.MetaBool
, D.MetaInlines
, D.MetaBlocks
)
, pattern MetaMap
, pattern MetaString
, D.nullMeta
, D.isNullMeta
, lookupMeta
, D.docTitle
, D.docAuthors
, D.docDate
, D.Block ( D.Plain
, D.Para
, D.LineBlock
, D.BlockQuote
, D.OrderedList
, D.BulletList
, D.DefinitionList
, D.HorizontalRule
, D.Table
, D.Null
)
, pattern CodeBlock
, pattern RawBlock
, pattern Header
, pattern Div
, D.Inline ( D.Emph
, D.Strong
, D.Strikeout
, D.Superscript
, D.Subscript
, D.SmallCaps
, D.Quoted
, D.Cite
, D.Space
, D.SoftBreak
, D.LineBreak
, D.Note
)
, pattern Str
, pattern Code
, pattern Math
, pattern RawInline
, pattern Link
, pattern Image
, pattern Span
, D.Alignment(..)
, D.ListAttributes
, D.ListNumberStyle(..)
, D.ListNumberDelim(..)
, D.Format
, pattern Format
, Attr
, nullAttr
, D.TableCell
, D.QuoteType(..)
, Target
, D.MathType(..)
, D.Citation
, pattern Citation
, citationId
, citationPrefix
, citationSuffix
, citationMode
, citationNoteNum
, citationHash
, D.CitationMode(..)
, D.pandocTypesVersion
) where
import qualified Text.Pandoc.Definition as D
import qualified Data.Map as M
import qualified Data.Text as T
unpack2 :: (T.Text, T.Text) -> (String, String)
unpack2 :: (Text, Text) -> (String, String)
unpack2 (Text
x, Text
y) = (Text -> String
T.unpack Text
x, Text -> String
T.unpack Text
y)
pack2 :: (String, String) -> (T.Text, T.Text)
pack2 :: (String, String) -> (Text, Text)
pack2 (String
x, String
y) = (String -> Text
T.pack String
x, String -> Text
T.pack String
y)
toLegacyMap :: M.Map T.Text a -> M.Map String a
toLegacyMap :: Map Text a -> Map String a
toLegacyMap = (Text -> String) -> Map Text a -> Map String a
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys Text -> String
T.unpack
fromLegacyMap :: M.Map String a -> M.Map T.Text a
fromLegacyMap :: Map String a -> Map Text a
fromLegacyMap = (String -> Text) -> Map String a -> Map Text a
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys String -> Text
T.pack
toLegacyAttr :: D.Attr -> Attr
toLegacyAttr :: Attr -> Attr
toLegacyAttr (Text
a, [Text]
b, [(Text, Text)]
c) = (Text -> String
T.unpack Text
a, (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack [Text]
b, ((Text, Text) -> (String, String))
-> [(Text, Text)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> (String, String)
unpack2 [(Text, Text)]
c)
fromLegacyAttr :: Attr -> D.Attr
fromLegacyAttr :: Attr -> Attr
fromLegacyAttr (String
a, [String]
b, [(String, String)]
c) = (String -> Text
T.pack String
a, (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
b, ((String, String) -> (Text, Text))
-> [(String, String)] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> (Text, Text)
pack2 [(String, String)]
c)
pattern Meta :: M.Map String D.MetaValue -> D.Meta
pattern $bMeta :: Map String MetaValue -> Meta
$mMeta :: forall r. Meta -> (Map String MetaValue -> r) -> (Void# -> r) -> r
Meta {Meta -> Map String MetaValue
unMeta} <- D.Meta (toLegacyMap -> unMeta)
where
Meta = Map Text MetaValue -> Meta
D.Meta (Map Text MetaValue -> Meta)
-> (Map String MetaValue -> Map Text MetaValue)
-> Map String MetaValue
-> Meta
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String MetaValue -> Map Text MetaValue
forall a. Map String a -> Map Text a
fromLegacyMap
pattern MetaMap :: M.Map String D.MetaValue -> D.MetaValue
pattern $bMetaMap :: Map String MetaValue -> MetaValue
$mMetaMap :: forall r.
MetaValue -> (Map String MetaValue -> r) -> (Void# -> r) -> r
MetaMap x <- D.MetaMap (toLegacyMap -> x)
where
MetaMap = Map Text MetaValue -> MetaValue
D.MetaMap (Map Text MetaValue -> MetaValue)
-> (Map String MetaValue -> Map Text MetaValue)
-> Map String MetaValue
-> MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String MetaValue -> Map Text MetaValue
forall a. Map String a -> Map Text a
fromLegacyMap
pattern MetaString :: String -> D.MetaValue
pattern $bMetaString :: String -> MetaValue
$mMetaString :: forall r. MetaValue -> (String -> r) -> (Void# -> r) -> r
MetaString x <- D.MetaString (T.unpack -> x)
where
MetaString = Text -> MetaValue
D.MetaString (Text -> MetaValue) -> (String -> Text) -> String -> MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
lookupMeta :: String -> D.Meta -> Maybe D.MetaValue
lookupMeta :: String -> Meta -> Maybe MetaValue
lookupMeta = Text -> Meta -> Maybe MetaValue
D.lookupMeta (Text -> Meta -> Maybe MetaValue)
-> (String -> Text) -> String -> Meta -> Maybe MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
pattern CodeBlock :: Attr -> String -> D.Block
pattern $bCodeBlock :: Attr -> String -> Block
$mCodeBlock :: forall r. Block -> (Attr -> String -> r) -> (Void# -> r) -> r
CodeBlock a s <- D.CodeBlock (toLegacyAttr -> a) (T.unpack -> s)
where
CodeBlock Attr
a = Attr -> Text -> Block
D.CodeBlock (Attr -> Attr
fromLegacyAttr Attr
a) (Text -> Block) -> (String -> Text) -> String -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
pattern RawBlock :: D.Format -> String -> D.Block
pattern $bRawBlock :: Format -> String -> Block
$mRawBlock :: forall r. Block -> (Format -> String -> r) -> (Void# -> r) -> r
RawBlock f s <- D.RawBlock f (T.unpack -> s)
where
RawBlock Format
f = Format -> Text -> Block
D.RawBlock Format
f (Text -> Block) -> (String -> Text) -> String -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
pattern Header :: Int -> Attr -> [D.Inline] -> D.Block
pattern n a i <- D.Header n (toLegacyAttr -> a) i
where
Header Int
n = Int -> Attr -> [Inline] -> Block
D.Header Int
n (Attr -> [Inline] -> Block)
-> (Attr -> Attr) -> Attr -> [Inline] -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Attr
fromLegacyAttr
pattern Div :: Attr -> [D.Block] -> D.Block
pattern $bDiv :: Attr -> [Block] -> Block
$mDiv :: forall r. Block -> (Attr -> [Block] -> r) -> (Void# -> r) -> r
Div a b <- D.Div (toLegacyAttr -> a) b
where
Div = Attr -> [Block] -> Block
D.Div (Attr -> [Block] -> Block)
-> (Attr -> Attr) -> Attr -> [Block] -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Attr
fromLegacyAttr
pattern Str :: String -> D.Inline
pattern $bStr :: String -> Inline
$mStr :: forall r. Inline -> (String -> r) -> (Void# -> r) -> r
Str s <- D.Str (T.unpack -> s)
where
Str = Text -> Inline
D.Str (Text -> Inline) -> (String -> Text) -> String -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
pattern Code :: Attr -> String -> D.Inline
pattern $bCode :: Attr -> String -> Inline
$mCode :: forall r. Inline -> (Attr -> String -> r) -> (Void# -> r) -> r
Code a s <- D.Code (toLegacyAttr -> a) (T.unpack -> s)
where
Code Attr
a = Attr -> Text -> Inline
D.Code (Attr -> Attr
fromLegacyAttr Attr
a) (Text -> Inline) -> (String -> Text) -> String -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
pattern Math :: D.MathType -> String -> D.Inline
pattern $bMath :: MathType -> String -> Inline
$mMath :: forall r. Inline -> (MathType -> String -> r) -> (Void# -> r) -> r
Math m s <- D.Math m (T.unpack -> s)
where
Math MathType
m = MathType -> Text -> Inline
D.Math MathType
m (Text -> Inline) -> (String -> Text) -> String -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
pattern RawInline :: D.Format -> String -> D.Inline
pattern $bRawInline :: Format -> String -> Inline
$mRawInline :: forall r. Inline -> (Format -> String -> r) -> (Void# -> r) -> r
RawInline f s <- D.RawInline f (T.unpack -> s)
where
RawInline Format
f = Format -> Text -> Inline
D.RawInline Format
f (Text -> Inline) -> (String -> Text) -> String -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
pattern Link :: Attr -> [D.Inline] -> Target -> D.Inline
pattern $bLink :: Attr -> [Inline] -> (String, String) -> Inline
$mLink :: forall r.
Inline
-> (Attr -> [Inline] -> (String, String) -> r) -> (Void# -> r) -> r
Link a i t <- D.Link (toLegacyAttr -> a) i (unpack2 -> t)
where
Link Attr
a [Inline]
i = Attr -> [Inline] -> (Text, Text) -> Inline
D.Link (Attr -> Attr
fromLegacyAttr Attr
a) [Inline]
i ((Text, Text) -> Inline)
-> ((String, String) -> (Text, Text)) -> (String, String) -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> (Text, Text)
pack2
pattern Image :: Attr -> [D.Inline] -> Target -> D.Inline
pattern $bImage :: Attr -> [Inline] -> (String, String) -> Inline
$mImage :: forall r.
Inline
-> (Attr -> [Inline] -> (String, String) -> r) -> (Void# -> r) -> r
Image a i t <- D.Image (toLegacyAttr -> a) i (unpack2 -> t)
where
Image Attr
a [Inline]
i = Attr -> [Inline] -> (Text, Text) -> Inline
D.Image (Attr -> Attr
fromLegacyAttr Attr
a) [Inline]
i ((Text, Text) -> Inline)
-> ((String, String) -> (Text, Text)) -> (String, String) -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> (Text, Text)
pack2
pattern Span :: Attr -> [D.Inline] -> D.Inline
pattern $bSpan :: Attr -> [Inline] -> Inline
$mSpan :: forall r. Inline -> (Attr -> [Inline] -> r) -> (Void# -> r) -> r
Span a i <- D.Span (toLegacyAttr -> a) i
where
Span = Attr -> [Inline] -> Inline
D.Span (Attr -> [Inline] -> Inline)
-> (Attr -> Attr) -> Attr -> [Inline] -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Attr
fromLegacyAttr
pattern Format :: String -> D.Format
pattern $bFormat :: String -> Format
$mFormat :: forall r. Format -> (String -> r) -> (Void# -> r) -> r
Format x <- D.Format (T.unpack -> x)
where
Format String
x = Text -> Format
D.Format (Text -> Format) -> Text -> Format
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x
type Attr = (String, [String], [(String, String)])
nullAttr :: Attr
nullAttr :: Attr
nullAttr = (String
"", [], [])
type Target = (String, String)
pattern Citation
:: String
-> [D.Inline]
-> [D.Inline]
-> D.CitationMode
-> Int
-> Int
-> D.Citation
pattern $bCitation :: String
-> [Inline] -> [Inline] -> CitationMode -> Int -> Int -> Citation
$mCitation :: forall r.
Citation
-> (String
-> [Inline] -> [Inline] -> CitationMode -> Int -> Int -> r)
-> (Void# -> r)
-> r
Citation
{ Citation -> String
citationId
, Citation -> [Inline]
citationPrefix
, Citation -> [Inline]
citationSuffix
, Citation -> CitationMode
citationMode
, Citation -> Int
citationNoteNum
, Citation -> Int
citationHash } <- D.Citation (T.unpack -> citationId)
citationPrefix
citationSuffix
citationMode
citationNoteNum
citationHash
where
Citation = Text
-> [Inline] -> [Inline] -> CitationMode -> Int -> Int -> Citation
D.Citation (Text
-> [Inline] -> [Inline] -> CitationMode -> Int -> Int -> Citation)
-> (String -> Text)
-> String
-> [Inline]
-> [Inline]
-> CitationMode
-> Int
-> Int
-> Citation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack