{-# 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 $bHeader :: Int -> Attr -> [Inline] -> Block
$mHeader :: forall r.
Block -> (Int -> Attr -> [Inline] -> r) -> (Void# -> r) -> r
Header 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