{-# LINE 1 "CMarkGFM.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface, GeneralizedNewtypeDeriving,
DeriveGeneric, DeriveDataTypeable, FlexibleContexts #-}
module CMarkGFM (
commonmarkToHtml
, commonmarkToXml
, commonmarkToMan
, commonmarkToLaTeX
, commonmarkToNode
, nodeToHtml
, nodeToXml
, nodeToMan
, nodeToLaTeX
, nodeToCommonmark
, optSourcePos
, optHardBreaks
, optSmart
, optSafe
, optUnsafe
, optFootnotes
, extStrikethrough
, extTable
, extAutolink
, extTagfilter
, extTaskList
, Node(..)
, NodeType(..)
, PosInfo(..)
, DelimType(..)
, ListType(..)
, ListAttributes(..)
, Url
, Title
, Level
, Info
, TableCellAlignment(..)
, CMarkOption
, CMarkExtension
) where
import Foreign
import Foreign.C.Types
import Foreign.C.String (CString, withCString)
import qualified System.IO.Unsafe as Unsafe
import Data.Maybe (fromMaybe)
import GHC.Generics (Generic)
import Data.Data (Data)
import Data.Typeable (Typeable)
import Data.Text (Text, empty, snoc)
import qualified Data.Text.Foreign as TF
import Data.ByteString.Unsafe (unsafePackMallocCString)
import Data.Text.Encoding (decodeUtf8)
import Control.Applicative ((<$>), (<*>))
ensurePluginsRegistered :: IO ()
ensurePluginsRegistered :: IO ()
ensurePluginsRegistered = IO ()
c_cmark_gfm_core_extensions_ensure_registered
freeLlist :: LlistPtr a -> IO ()
freeLlist :: forall a. LlistPtr a -> IO ()
freeLlist = MemPtr -> LlistPtr a -> IO ()
forall a. MemPtr -> LlistPtr a -> IO ()
c_cmark_llist_free MemPtr
c_cmark_mem
extsToLlist :: [ExtensionPtr] -> IO (LlistPtr ExtensionPtr)
extsToLlist :: [ExtensionPtr] -> IO (LlistPtr ExtensionPtr)
extsToLlist [] = LlistPtr ExtensionPtr -> IO (LlistPtr ExtensionPtr)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LlistPtr ExtensionPtr
forall a. Ptr a
nullPtr
extsToLlist (ExtensionPtr
h:[ExtensionPtr]
t) = do
LlistPtr ExtensionPtr
t' <- [ExtensionPtr] -> IO (LlistPtr ExtensionPtr)
extsToLlist [ExtensionPtr]
t
MemPtr
-> LlistPtr ExtensionPtr -> Ptr () -> IO (LlistPtr ExtensionPtr)
forall a. MemPtr -> LlistPtr a -> Ptr () -> IO (LlistPtr a)
c_cmark_llist_append MemPtr
c_cmark_mem LlistPtr ExtensionPtr
t' (ExtensionPtr -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr ExtensionPtr
h)
resolveExts :: [CMarkExtension] -> IO [ExtensionPtr]
resolveExts :: [CMarkExtension] -> IO [ExtensionPtr]
resolveExts [CMarkExtension]
exts = do
IO ()
ensurePluginsRegistered
(CMarkExtension -> IO ExtensionPtr)
-> [CMarkExtension] -> IO [ExtensionPtr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CMarkExtension -> IO ExtensionPtr
resolveExt [CMarkExtension]
exts
where resolveExt :: CMarkExtension -> IO ExtensionPtr
resolveExt CMarkExtension
ext = do ExtensionPtr
p <- String -> (CString -> IO ExtensionPtr) -> IO ExtensionPtr
forall a. String -> (CString -> IO a) -> IO a
withCString (CMarkExtension -> String
unCMarkExtension CMarkExtension
ext) CString -> IO ExtensionPtr
c_cmark_find_syntax_extension
if ExtensionPtr
p ExtensionPtr -> ExtensionPtr -> Bool
forall a. Eq a => a -> a -> Bool
== ExtensionPtr
forall a. Ptr a
nullPtr then
String -> IO ExtensionPtr
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ExtensionPtr) -> String -> IO ExtensionPtr
forall a b. (a -> b) -> a -> b
$ String
"could not load extension " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CMarkExtension -> String
unCMarkExtension CMarkExtension
ext
else
ExtensionPtr -> IO ExtensionPtr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ExtensionPtr
p
commonmarkToHtml :: [CMarkOption] -> [CMarkExtension] -> Text -> Text
commonmarkToHtml :: [CMarkOption] -> [CMarkExtension] -> Text -> Text
commonmarkToHtml [CMarkOption]
opts [CMarkExtension]
exts =
Renderer
-> [CMarkOption] -> [CMarkExtension] -> Maybe Int -> Text -> Text
commonmarkToX Renderer
forall {p}. NodePtr -> CInt -> p -> IO CString
render_html [CMarkOption]
opts [CMarkExtension]
exts Maybe Int
forall a. Maybe a
Nothing
where exts' :: [ExtensionPtr]
exts' = IO [ExtensionPtr] -> [ExtensionPtr]
forall a. IO a -> a
Unsafe.unsafePerformIO (IO [ExtensionPtr] -> [ExtensionPtr])
-> IO [ExtensionPtr] -> [ExtensionPtr]
forall a b. (a -> b) -> a -> b
$ [CMarkExtension] -> IO [ExtensionPtr]
resolveExts [CMarkExtension]
exts
render_html :: NodePtr -> CInt -> p -> IO CString
render_html NodePtr
n CInt
o p
_ = do
LlistPtr ExtensionPtr
llist <- [ExtensionPtr] -> IO (LlistPtr ExtensionPtr)
extsToLlist [ExtensionPtr]
exts'
CString
r <- NodePtr -> CInt -> LlistPtr ExtensionPtr -> IO CString
c_cmark_render_html NodePtr
n CInt
o LlistPtr ExtensionPtr
llist
LlistPtr ExtensionPtr -> IO ()
forall a. LlistPtr a -> IO ()
freeLlist LlistPtr ExtensionPtr
llist
CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
r
commonmarkToXml :: [CMarkOption] -> [CMarkExtension] -> Text -> Text
commonmarkToXml :: [CMarkOption] -> [CMarkExtension] -> Text -> Text
commonmarkToXml [CMarkOption]
opts [CMarkExtension]
exts = Renderer
-> [CMarkOption] -> [CMarkExtension] -> Maybe Int -> Text -> Text
commonmarkToX Renderer
forall {p}. NodePtr -> CInt -> p -> IO CString
render_xml [CMarkOption]
opts [CMarkExtension]
exts Maybe Int
forall a. Maybe a
Nothing
where render_xml :: NodePtr -> CInt -> p -> IO CString
render_xml NodePtr
n CInt
o p
_ = NodePtr -> CInt -> IO CString
c_cmark_render_xml NodePtr
n CInt
o
commonmarkToMan :: [CMarkOption] -> [CMarkExtension] -> Maybe Int -> Text -> Text
commonmarkToMan :: [CMarkOption] -> [CMarkExtension] -> Maybe Int -> Text -> Text
commonmarkToMan = Renderer
-> [CMarkOption] -> [CMarkExtension] -> Maybe Int -> Text -> Text
commonmarkToX Renderer
c_cmark_render_man
commonmarkToLaTeX :: [CMarkOption] -> [CMarkExtension] -> Maybe Int -> Text -> Text
commonmarkToLaTeX :: [CMarkOption] -> [CMarkExtension] -> Maybe Int -> Text -> Text
commonmarkToLaTeX = Renderer
-> [CMarkOption] -> [CMarkExtension] -> Maybe Int -> Text -> Text
commonmarkToX Renderer
c_cmark_render_latex
commonmarkToNode :: [CMarkOption] -> [CMarkExtension] -> Text -> Node
commonmarkToNode :: [CMarkOption] -> [CMarkExtension] -> Text -> Node
commonmarkToNode [CMarkOption]
opts [CMarkExtension]
exts Text
s = IO Node -> Node
forall a. IO a -> a
Unsafe.unsafePerformIO (IO Node -> Node) -> IO Node -> Node
forall a b. (a -> b) -> a -> b
$ do
[ExtensionPtr]
exts' <- [CMarkExtension] -> IO [ExtensionPtr]
resolveExts [CMarkExtension]
exts
ParserPtr
parser <- CInt -> IO ParserPtr
c_cmark_parser_new ([CMarkOption] -> CInt
combineOptions [CMarkOption]
opts)
(ExtensionPtr -> IO ()) -> [ExtensionPtr] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ParserPtr -> ExtensionPtr -> IO ()
c_cmark_parser_attach_syntax_extension ParserPtr
parser) [ExtensionPtr]
exts'
Text -> (CStringLen -> IO ()) -> IO ()
forall a. Text -> (CStringLen -> IO a) -> IO a
TF.withCStringLen Text
s ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$! \(CString
ptr, Int
len) ->
ParserPtr -> CString -> Int -> IO ()
c_cmark_parser_feed ParserPtr
parser CString
ptr Int
len
NodePtr
nptr <- ParserPtr -> IO NodePtr
c_cmark_parser_finish ParserPtr
parser
ParserPtr -> IO ()
c_cmark_parser_free ParserPtr
parser
ForeignPtr NodePhantom
fptr <- FinalizerPtr NodePhantom -> NodePtr -> IO (ForeignPtr NodePhantom)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr NodePhantom
c_cmark_node_free NodePtr
nptr
ForeignPtr NodePhantom -> (NodePtr -> IO Node) -> IO Node
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr NodePhantom
fptr NodePtr -> IO Node
toNode
nodeToHtml :: [CMarkOption] -> [CMarkExtension] -> Node -> Text
nodeToHtml :: [CMarkOption] -> [CMarkExtension] -> Node -> Text
nodeToHtml [CMarkOption]
opts [CMarkExtension]
exts =
Renderer -> [CMarkOption] -> Maybe Int -> Node -> Text
nodeToX Renderer
forall {p}. NodePtr -> CInt -> p -> IO CString
render_html [CMarkOption]
opts Maybe Int
forall a. Maybe a
Nothing
where exts' :: [ExtensionPtr]
exts' = IO [ExtensionPtr] -> [ExtensionPtr]
forall a. IO a -> a
Unsafe.unsafePerformIO (IO [ExtensionPtr] -> [ExtensionPtr])
-> IO [ExtensionPtr] -> [ExtensionPtr]
forall a b. (a -> b) -> a -> b
$ [CMarkExtension] -> IO [ExtensionPtr]
resolveExts [CMarkExtension]
exts
render_html :: NodePtr -> CInt -> p -> IO CString
render_html NodePtr
n CInt
o p
_ = do
LlistPtr ExtensionPtr
llist <- [ExtensionPtr] -> IO (LlistPtr ExtensionPtr)
extsToLlist [ExtensionPtr]
exts'
CString
r <- NodePtr -> CInt -> LlistPtr ExtensionPtr -> IO CString
c_cmark_render_html NodePtr
n CInt
o LlistPtr ExtensionPtr
llist
LlistPtr ExtensionPtr -> IO ()
forall a. LlistPtr a -> IO ()
freeLlist LlistPtr ExtensionPtr
llist
CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
r
nodeToXml :: [CMarkOption] -> Node -> Text
nodeToXml :: [CMarkOption] -> Node -> Text
nodeToXml [CMarkOption]
opts = Renderer -> [CMarkOption] -> Maybe Int -> Node -> Text
nodeToX Renderer
forall {p}. NodePtr -> CInt -> p -> IO CString
render_xml [CMarkOption]
opts Maybe Int
forall a. Maybe a
Nothing
where render_xml :: NodePtr -> CInt -> p -> IO CString
render_xml NodePtr
n CInt
o p
_ = NodePtr -> CInt -> IO CString
c_cmark_render_xml NodePtr
n CInt
o
nodeToMan :: [CMarkOption] -> Maybe Int -> Node -> Text
nodeToMan :: [CMarkOption] -> Maybe Int -> Node -> Text
nodeToMan = Renderer -> [CMarkOption] -> Maybe Int -> Node -> Text
nodeToX Renderer
c_cmark_render_man
nodeToLaTeX :: [CMarkOption] -> Maybe Int -> Node -> Text
nodeToLaTeX :: [CMarkOption] -> Maybe Int -> Node -> Text
nodeToLaTeX = Renderer -> [CMarkOption] -> Maybe Int -> Node -> Text
nodeToX Renderer
c_cmark_render_latex
nodeToCommonmark :: [CMarkOption] -> Maybe Int -> Node -> Text
nodeToCommonmark :: [CMarkOption] -> Maybe Int -> Node -> Text
nodeToCommonmark = Renderer -> [CMarkOption] -> Maybe Int -> Node -> Text
nodeToX Renderer
c_cmark_render_commonmark
type Renderer = NodePtr -> CInt -> Int -> IO CString
nodeToX :: Renderer -> [CMarkOption] -> Maybe Int -> Node -> Text
nodeToX :: Renderer -> [CMarkOption] -> Maybe Int -> Node -> Text
nodeToX Renderer
renderer [CMarkOption]
opts Maybe Int
mbWidth Node
node = IO Text -> Text
forall a. IO a -> a
Unsafe.unsafePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$ do
NodePtr
nptr <- Node -> IO NodePtr
fromNode Node
node
ForeignPtr NodePhantom
fptr <- FinalizerPtr NodePhantom -> NodePtr -> IO (ForeignPtr NodePhantom)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr NodePhantom
c_cmark_node_free NodePtr
nptr
ForeignPtr NodePhantom -> (NodePtr -> IO Text) -> IO Text
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr NodePhantom
fptr ((NodePtr -> IO Text) -> IO Text)
-> (NodePtr -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \NodePtr
ptr -> do
CString
cstr <- Renderer
renderer NodePtr
ptr ([CMarkOption] -> CInt
combineOptions [CMarkOption]
opts) (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
mbWidth)
ByteString -> Text
decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
unsafePackMallocCString CString
cstr
commonmarkToX :: Renderer
-> [CMarkOption]
-> [CMarkExtension]
-> Maybe Int
-> Text
-> Text
commonmarkToX :: Renderer
-> [CMarkOption] -> [CMarkExtension] -> Maybe Int -> Text -> Text
commonmarkToX Renderer
renderer [CMarkOption]
opts [CMarkExtension]
exts Maybe Int
mbWidth Text
s = IO Text -> Text
forall a. IO a -> a
Unsafe.unsafePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$
Text -> (CStringLen -> IO Text) -> IO Text
forall a. Text -> (CStringLen -> IO a) -> IO a
TF.withCStringLen Text
s ((CStringLen -> IO Text) -> IO Text)
-> (CStringLen -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \(CString
ptr, Int
len) -> do
let opts' :: CInt
opts' = [CMarkOption] -> CInt
combineOptions [CMarkOption]
opts
[ExtensionPtr]
exts' <- [CMarkExtension] -> IO [ExtensionPtr]
resolveExts [CMarkExtension]
exts
ParserPtr
parser <- CInt -> IO ParserPtr
c_cmark_parser_new CInt
opts'
(ExtensionPtr -> IO ()) -> [ExtensionPtr] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ParserPtr -> ExtensionPtr -> IO ()
c_cmark_parser_attach_syntax_extension ParserPtr
parser) [ExtensionPtr]
exts'
ParserPtr -> CString -> Int -> IO ()
c_cmark_parser_feed ParserPtr
parser CString
ptr Int
len
NodePtr
nptr <- ParserPtr -> IO NodePtr
c_cmark_parser_finish ParserPtr
parser
ParserPtr -> IO ()
c_cmark_parser_free ParserPtr
parser
ForeignPtr NodePhantom
fptr <- FinalizerPtr NodePhantom -> NodePtr -> IO (ForeignPtr NodePhantom)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr NodePhantom
c_cmark_node_free NodePtr
nptr
ForeignPtr NodePhantom -> (NodePtr -> IO Text) -> IO Text
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr NodePhantom
fptr ((NodePtr -> IO Text) -> IO Text)
-> (NodePtr -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \NodePtr
p -> do
CString
str <- Renderer
renderer NodePtr
p CInt
opts' (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
mbWidth)
ByteString -> Text
decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
unsafePackMallocCString CString
str
data ParserPhantom
type ParserPtr = Ptr ParserPhantom
data NodePhantom
type NodePtr = Ptr NodePhantom
data LlistPhantom a
type LlistPtr a = Ptr (LlistPhantom a)
data MemPhantom
type MemPtr = Ptr MemPhantom
data ExtensionPhantom
type ExtensionPtr = Ptr ExtensionPhantom
data Node = Node (Maybe PosInfo) NodeType [Node]
deriving (Int -> Node -> String -> String
[Node] -> String -> String
Node -> String
(Int -> Node -> String -> String)
-> (Node -> String) -> ([Node] -> String -> String) -> Show Node
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Node -> String -> String
showsPrec :: Int -> Node -> String -> String
$cshow :: Node -> String
show :: Node -> String
$cshowList :: [Node] -> String -> String
showList :: [Node] -> String -> String
Show, ReadPrec [Node]
ReadPrec Node
Int -> ReadS Node
ReadS [Node]
(Int -> ReadS Node)
-> ReadS [Node] -> ReadPrec Node -> ReadPrec [Node] -> Read Node
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Node
readsPrec :: Int -> ReadS Node
$creadList :: ReadS [Node]
readList :: ReadS [Node]
$creadPrec :: ReadPrec Node
readPrec :: ReadPrec Node
$creadListPrec :: ReadPrec [Node]
readListPrec :: ReadPrec [Node]
Read, Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
/= :: Node -> Node -> Bool
Eq, Eq Node
Eq Node =>
(Node -> Node -> Ordering)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Node)
-> (Node -> Node -> Node)
-> Ord Node
Node -> Node -> Bool
Node -> Node -> Ordering
Node -> Node -> Node
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Node -> Node -> Ordering
compare :: Node -> Node -> Ordering
$c< :: Node -> Node -> Bool
< :: Node -> Node -> Bool
$c<= :: Node -> Node -> Bool
<= :: Node -> Node -> Bool
$c> :: Node -> Node -> Bool
> :: Node -> Node -> Bool
$c>= :: Node -> Node -> Bool
>= :: Node -> Node -> Bool
$cmax :: Node -> Node -> Node
max :: Node -> Node -> Node
$cmin :: Node -> Node -> Node
min :: Node -> Node -> Node
Ord, Typeable, Typeable Node
Typeable Node =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node -> c Node)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Node)
-> (Node -> Constr)
-> (Node -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Node))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Node))
-> ((forall b. Data b => b -> b) -> Node -> Node)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r)
-> (forall u. (forall d. Data d => d -> u) -> Node -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Node -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Node -> m Node)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node)
-> Data Node
Node -> Constr
Node -> DataType
(forall b. Data b => b -> b) -> Node -> Node
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Node -> u
forall u. (forall d. Data d => d -> u) -> Node -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Node -> m Node
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Node
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node -> c Node
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Node)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Node)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node -> c Node
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node -> c Node
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Node
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Node
$ctoConstr :: Node -> Constr
toConstr :: Node -> Constr
$cdataTypeOf :: Node -> DataType
dataTypeOf :: Node -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Node)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Node)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Node)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Node)
$cgmapT :: (forall b. Data b => b -> b) -> Node -> Node
gmapT :: (forall b. Data b => b -> b) -> Node -> Node
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Node -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Node -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Node -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Node -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Node -> m Node
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Node -> m Node
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
Data, (forall x. Node -> Rep Node x)
-> (forall x. Rep Node x -> Node) -> Generic Node
forall x. Rep Node x -> Node
forall x. Node -> Rep Node x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Node -> Rep Node x
from :: forall x. Node -> Rep Node x
$cto :: forall x. Rep Node x -> Node
to :: forall x. Rep Node x -> Node
Generic)
data DelimType =
PERIOD_DELIM
| PAREN_DELIM
deriving (Int -> DelimType -> String -> String
[DelimType] -> String -> String
DelimType -> String
(Int -> DelimType -> String -> String)
-> (DelimType -> String)
-> ([DelimType] -> String -> String)
-> Show DelimType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> DelimType -> String -> String
showsPrec :: Int -> DelimType -> String -> String
$cshow :: DelimType -> String
show :: DelimType -> String
$cshowList :: [DelimType] -> String -> String
showList :: [DelimType] -> String -> String
Show, ReadPrec [DelimType]
ReadPrec DelimType
Int -> ReadS DelimType
ReadS [DelimType]
(Int -> ReadS DelimType)
-> ReadS [DelimType]
-> ReadPrec DelimType
-> ReadPrec [DelimType]
-> Read DelimType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DelimType
readsPrec :: Int -> ReadS DelimType
$creadList :: ReadS [DelimType]
readList :: ReadS [DelimType]
$creadPrec :: ReadPrec DelimType
readPrec :: ReadPrec DelimType
$creadListPrec :: ReadPrec [DelimType]
readListPrec :: ReadPrec [DelimType]
Read, DelimType -> DelimType -> Bool
(DelimType -> DelimType -> Bool)
-> (DelimType -> DelimType -> Bool) -> Eq DelimType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DelimType -> DelimType -> Bool
== :: DelimType -> DelimType -> Bool
$c/= :: DelimType -> DelimType -> Bool
/= :: DelimType -> DelimType -> Bool
Eq, Eq DelimType
Eq DelimType =>
(DelimType -> DelimType -> Ordering)
-> (DelimType -> DelimType -> Bool)
-> (DelimType -> DelimType -> Bool)
-> (DelimType -> DelimType -> Bool)
-> (DelimType -> DelimType -> Bool)
-> (DelimType -> DelimType -> DelimType)
-> (DelimType -> DelimType -> DelimType)
-> Ord DelimType
DelimType -> DelimType -> Bool
DelimType -> DelimType -> Ordering
DelimType -> DelimType -> DelimType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DelimType -> DelimType -> Ordering
compare :: DelimType -> DelimType -> Ordering
$c< :: DelimType -> DelimType -> Bool
< :: DelimType -> DelimType -> Bool
$c<= :: DelimType -> DelimType -> Bool
<= :: DelimType -> DelimType -> Bool
$c> :: DelimType -> DelimType -> Bool
> :: DelimType -> DelimType -> Bool
$c>= :: DelimType -> DelimType -> Bool
>= :: DelimType -> DelimType -> Bool
$cmax :: DelimType -> DelimType -> DelimType
max :: DelimType -> DelimType -> DelimType
$cmin :: DelimType -> DelimType -> DelimType
min :: DelimType -> DelimType -> DelimType
Ord, Typeable, Typeable DelimType
Typeable DelimType =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DelimType -> c DelimType)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DelimType)
-> (DelimType -> Constr)
-> (DelimType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DelimType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DelimType))
-> ((forall b. Data b => b -> b) -> DelimType -> DelimType)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DelimType -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DelimType -> r)
-> (forall u. (forall d. Data d => d -> u) -> DelimType -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> DelimType -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DelimType -> m DelimType)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DelimType -> m DelimType)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DelimType -> m DelimType)
-> Data DelimType
DelimType -> Constr
DelimType -> DataType
(forall b. Data b => b -> b) -> DelimType -> DelimType
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DelimType -> u
forall u. (forall d. Data d => d -> u) -> DelimType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DelimType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DelimType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DelimType -> m DelimType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DelimType -> m DelimType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DelimType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DelimType -> c DelimType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DelimType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DelimType)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DelimType -> c DelimType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DelimType -> c DelimType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DelimType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DelimType
$ctoConstr :: DelimType -> Constr
toConstr :: DelimType -> Constr
$cdataTypeOf :: DelimType -> DataType
dataTypeOf :: DelimType -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DelimType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DelimType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DelimType)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DelimType)
$cgmapT :: (forall b. Data b => b -> b) -> DelimType -> DelimType
gmapT :: (forall b. Data b => b -> b) -> DelimType -> DelimType
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DelimType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DelimType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DelimType -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DelimType -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DelimType -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> DelimType -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DelimType -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DelimType -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DelimType -> m DelimType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DelimType -> m DelimType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DelimType -> m DelimType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DelimType -> m DelimType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DelimType -> m DelimType
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DelimType -> m DelimType
Data, (forall x. DelimType -> Rep DelimType x)
-> (forall x. Rep DelimType x -> DelimType) -> Generic DelimType
forall x. Rep DelimType x -> DelimType
forall x. DelimType -> Rep DelimType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DelimType -> Rep DelimType x
from :: forall x. DelimType -> Rep DelimType x
$cto :: forall x. Rep DelimType x -> DelimType
to :: forall x. Rep DelimType x -> DelimType
Generic)
data ListType =
BULLET_LIST
| ORDERED_LIST
deriving (Int -> ListType -> String -> String
[ListType] -> String -> String
ListType -> String
(Int -> ListType -> String -> String)
-> (ListType -> String)
-> ([ListType] -> String -> String)
-> Show ListType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ListType -> String -> String
showsPrec :: Int -> ListType -> String -> String
$cshow :: ListType -> String
show :: ListType -> String
$cshowList :: [ListType] -> String -> String
showList :: [ListType] -> String -> String
Show, ReadPrec [ListType]
ReadPrec ListType
Int -> ReadS ListType
ReadS [ListType]
(Int -> ReadS ListType)
-> ReadS [ListType]
-> ReadPrec ListType
-> ReadPrec [ListType]
-> Read ListType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ListType
readsPrec :: Int -> ReadS ListType
$creadList :: ReadS [ListType]
readList :: ReadS [ListType]
$creadPrec :: ReadPrec ListType
readPrec :: ReadPrec ListType
$creadListPrec :: ReadPrec [ListType]
readListPrec :: ReadPrec [ListType]
Read, ListType -> ListType -> Bool
(ListType -> ListType -> Bool)
-> (ListType -> ListType -> Bool) -> Eq ListType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListType -> ListType -> Bool
== :: ListType -> ListType -> Bool
$c/= :: ListType -> ListType -> Bool
/= :: ListType -> ListType -> Bool
Eq, Eq ListType
Eq ListType =>
(ListType -> ListType -> Ordering)
-> (ListType -> ListType -> Bool)
-> (ListType -> ListType -> Bool)
-> (ListType -> ListType -> Bool)
-> (ListType -> ListType -> Bool)
-> (ListType -> ListType -> ListType)
-> (ListType -> ListType -> ListType)
-> Ord ListType
ListType -> ListType -> Bool
ListType -> ListType -> Ordering
ListType -> ListType -> ListType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ListType -> ListType -> Ordering
compare :: ListType -> ListType -> Ordering
$c< :: ListType -> ListType -> Bool
< :: ListType -> ListType -> Bool
$c<= :: ListType -> ListType -> Bool
<= :: ListType -> ListType -> Bool
$c> :: ListType -> ListType -> Bool
> :: ListType -> ListType -> Bool
$c>= :: ListType -> ListType -> Bool
>= :: ListType -> ListType -> Bool
$cmax :: ListType -> ListType -> ListType
max :: ListType -> ListType -> ListType
$cmin :: ListType -> ListType -> ListType
min :: ListType -> ListType -> ListType
Ord, Typeable, Typeable ListType
Typeable ListType =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListType -> c ListType)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListType)
-> (ListType -> Constr)
-> (ListType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ListType))
-> ((forall b. Data b => b -> b) -> ListType -> ListType)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r)
-> (forall u. (forall d. Data d => d -> u) -> ListType -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ListType -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType)
-> Data ListType
ListType -> Constr
ListType -> DataType
(forall b. Data b => b -> b) -> ListType -> ListType
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ListType -> u
forall u. (forall d. Data d => d -> u) -> ListType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListType -> c ListType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ListType)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListType -> c ListType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListType -> c ListType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListType
$ctoConstr :: ListType -> Constr
toConstr :: ListType -> Constr
$cdataTypeOf :: ListType -> DataType
dataTypeOf :: ListType -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ListType)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ListType)
$cgmapT :: (forall b. Data b => b -> b) -> ListType -> ListType
gmapT :: (forall b. Data b => b -> b) -> ListType -> ListType
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ListType -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ListType -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ListType -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ListType -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
Data, (forall x. ListType -> Rep ListType x)
-> (forall x. Rep ListType x -> ListType) -> Generic ListType
forall x. Rep ListType x -> ListType
forall x. ListType -> Rep ListType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListType -> Rep ListType x
from :: forall x. ListType -> Rep ListType x
$cto :: forall x. Rep ListType x -> ListType
to :: forall x. Rep ListType x -> ListType
Generic)
data ListAttributes = ListAttributes{
ListAttributes -> ListType
listType :: ListType
, ListAttributes -> Bool
listTight :: Bool
, ListAttributes -> Int
listStart :: Int
, ListAttributes -> DelimType
listDelim :: DelimType
} deriving (Int -> ListAttributes -> String -> String
[ListAttributes] -> String -> String
ListAttributes -> String
(Int -> ListAttributes -> String -> String)
-> (ListAttributes -> String)
-> ([ListAttributes] -> String -> String)
-> Show ListAttributes
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ListAttributes -> String -> String
showsPrec :: Int -> ListAttributes -> String -> String
$cshow :: ListAttributes -> String
show :: ListAttributes -> String
$cshowList :: [ListAttributes] -> String -> String
showList :: [ListAttributes] -> String -> String
Show, ReadPrec [ListAttributes]
ReadPrec ListAttributes
Int -> ReadS ListAttributes
ReadS [ListAttributes]
(Int -> ReadS ListAttributes)
-> ReadS [ListAttributes]
-> ReadPrec ListAttributes
-> ReadPrec [ListAttributes]
-> Read ListAttributes
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ListAttributes
readsPrec :: Int -> ReadS ListAttributes
$creadList :: ReadS [ListAttributes]
readList :: ReadS [ListAttributes]
$creadPrec :: ReadPrec ListAttributes
readPrec :: ReadPrec ListAttributes
$creadListPrec :: ReadPrec [ListAttributes]
readListPrec :: ReadPrec [ListAttributes]
Read, ListAttributes -> ListAttributes -> Bool
(ListAttributes -> ListAttributes -> Bool)
-> (ListAttributes -> ListAttributes -> Bool) -> Eq ListAttributes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListAttributes -> ListAttributes -> Bool
== :: ListAttributes -> ListAttributes -> Bool
$c/= :: ListAttributes -> ListAttributes -> Bool
/= :: ListAttributes -> ListAttributes -> Bool
Eq, Eq ListAttributes
Eq ListAttributes =>
(ListAttributes -> ListAttributes -> Ordering)
-> (ListAttributes -> ListAttributes -> Bool)
-> (ListAttributes -> ListAttributes -> Bool)
-> (ListAttributes -> ListAttributes -> Bool)
-> (ListAttributes -> ListAttributes -> Bool)
-> (ListAttributes -> ListAttributes -> ListAttributes)
-> (ListAttributes -> ListAttributes -> ListAttributes)
-> Ord ListAttributes
ListAttributes -> ListAttributes -> Bool
ListAttributes -> ListAttributes -> Ordering
ListAttributes -> ListAttributes -> ListAttributes
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ListAttributes -> ListAttributes -> Ordering
compare :: ListAttributes -> ListAttributes -> Ordering
$c< :: ListAttributes -> ListAttributes -> Bool
< :: ListAttributes -> ListAttributes -> Bool
$c<= :: ListAttributes -> ListAttributes -> Bool
<= :: ListAttributes -> ListAttributes -> Bool
$c> :: ListAttributes -> ListAttributes -> Bool
> :: ListAttributes -> ListAttributes -> Bool
$c>= :: ListAttributes -> ListAttributes -> Bool
>= :: ListAttributes -> ListAttributes -> Bool
$cmax :: ListAttributes -> ListAttributes -> ListAttributes
max :: ListAttributes -> ListAttributes -> ListAttributes
$cmin :: ListAttributes -> ListAttributes -> ListAttributes
min :: ListAttributes -> ListAttributes -> ListAttributes
Ord, Typeable, Typeable ListAttributes
Typeable ListAttributes =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListAttributes -> c ListAttributes)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListAttributes)
-> (ListAttributes -> Constr)
-> (ListAttributes -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListAttributes))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListAttributes))
-> ((forall b. Data b => b -> b)
-> ListAttributes -> ListAttributes)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListAttributes -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListAttributes -> r)
-> (forall u.
(forall d. Data d => d -> u) -> ListAttributes -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> ListAttributes -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListAttributes -> m ListAttributes)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListAttributes -> m ListAttributes)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListAttributes -> m ListAttributes)
-> Data ListAttributes
ListAttributes -> Constr
ListAttributes -> DataType
(forall b. Data b => b -> b) -> ListAttributes -> ListAttributes
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ListAttributes -> u
forall u. (forall d. Data d => d -> u) -> ListAttributes -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListAttributes -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListAttributes -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListAttributes -> m ListAttributes
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListAttributes -> m ListAttributes
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListAttributes
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListAttributes -> c ListAttributes
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListAttributes)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListAttributes)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListAttributes -> c ListAttributes
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListAttributes -> c ListAttributes
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListAttributes
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListAttributes
$ctoConstr :: ListAttributes -> Constr
toConstr :: ListAttributes -> Constr
$cdataTypeOf :: ListAttributes -> DataType
dataTypeOf :: ListAttributes -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListAttributes)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListAttributes)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListAttributes)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListAttributes)
$cgmapT :: (forall b. Data b => b -> b) -> ListAttributes -> ListAttributes
gmapT :: (forall b. Data b => b -> b) -> ListAttributes -> ListAttributes
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListAttributes -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListAttributes -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListAttributes -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListAttributes -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ListAttributes -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ListAttributes -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ListAttributes -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ListAttributes -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListAttributes -> m ListAttributes
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ListAttributes -> m ListAttributes
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListAttributes -> m ListAttributes
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListAttributes -> m ListAttributes
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListAttributes -> m ListAttributes
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ListAttributes -> m ListAttributes
Data, (forall x. ListAttributes -> Rep ListAttributes x)
-> (forall x. Rep ListAttributes x -> ListAttributes)
-> Generic ListAttributes
forall x. Rep ListAttributes x -> ListAttributes
forall x. ListAttributes -> Rep ListAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListAttributes -> Rep ListAttributes x
from :: forall x. ListAttributes -> Rep ListAttributes x
$cto :: forall x. Rep ListAttributes x -> ListAttributes
to :: forall x. Rep ListAttributes x -> ListAttributes
Generic)
type Url = Text
type Title = Text
type Level = Int
type Info = Text
type OnEnter = Text
type OnExit = Text
data TableCellAlignment = NoAlignment | LeftAligned | CenterAligned | RightAligned
deriving (Int -> TableCellAlignment -> String -> String
[TableCellAlignment] -> String -> String
TableCellAlignment -> String
(Int -> TableCellAlignment -> String -> String)
-> (TableCellAlignment -> String)
-> ([TableCellAlignment] -> String -> String)
-> Show TableCellAlignment
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TableCellAlignment -> String -> String
showsPrec :: Int -> TableCellAlignment -> String -> String
$cshow :: TableCellAlignment -> String
show :: TableCellAlignment -> String
$cshowList :: [TableCellAlignment] -> String -> String
showList :: [TableCellAlignment] -> String -> String
Show, ReadPrec [TableCellAlignment]
ReadPrec TableCellAlignment
Int -> ReadS TableCellAlignment
ReadS [TableCellAlignment]
(Int -> ReadS TableCellAlignment)
-> ReadS [TableCellAlignment]
-> ReadPrec TableCellAlignment
-> ReadPrec [TableCellAlignment]
-> Read TableCellAlignment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TableCellAlignment
readsPrec :: Int -> ReadS TableCellAlignment
$creadList :: ReadS [TableCellAlignment]
readList :: ReadS [TableCellAlignment]
$creadPrec :: ReadPrec TableCellAlignment
readPrec :: ReadPrec TableCellAlignment
$creadListPrec :: ReadPrec [TableCellAlignment]
readListPrec :: ReadPrec [TableCellAlignment]
Read, TableCellAlignment -> TableCellAlignment -> Bool
(TableCellAlignment -> TableCellAlignment -> Bool)
-> (TableCellAlignment -> TableCellAlignment -> Bool)
-> Eq TableCellAlignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableCellAlignment -> TableCellAlignment -> Bool
== :: TableCellAlignment -> TableCellAlignment -> Bool
$c/= :: TableCellAlignment -> TableCellAlignment -> Bool
/= :: TableCellAlignment -> TableCellAlignment -> Bool
Eq, Eq TableCellAlignment
Eq TableCellAlignment =>
(TableCellAlignment -> TableCellAlignment -> Ordering)
-> (TableCellAlignment -> TableCellAlignment -> Bool)
-> (TableCellAlignment -> TableCellAlignment -> Bool)
-> (TableCellAlignment -> TableCellAlignment -> Bool)
-> (TableCellAlignment -> TableCellAlignment -> Bool)
-> (TableCellAlignment -> TableCellAlignment -> TableCellAlignment)
-> (TableCellAlignment -> TableCellAlignment -> TableCellAlignment)
-> Ord TableCellAlignment
TableCellAlignment -> TableCellAlignment -> Bool
TableCellAlignment -> TableCellAlignment -> Ordering
TableCellAlignment -> TableCellAlignment -> TableCellAlignment
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TableCellAlignment -> TableCellAlignment -> Ordering
compare :: TableCellAlignment -> TableCellAlignment -> Ordering
$c< :: TableCellAlignment -> TableCellAlignment -> Bool
< :: TableCellAlignment -> TableCellAlignment -> Bool
$c<= :: TableCellAlignment -> TableCellAlignment -> Bool
<= :: TableCellAlignment -> TableCellAlignment -> Bool
$c> :: TableCellAlignment -> TableCellAlignment -> Bool
> :: TableCellAlignment -> TableCellAlignment -> Bool
$c>= :: TableCellAlignment -> TableCellAlignment -> Bool
>= :: TableCellAlignment -> TableCellAlignment -> Bool
$cmax :: TableCellAlignment -> TableCellAlignment -> TableCellAlignment
max :: TableCellAlignment -> TableCellAlignment -> TableCellAlignment
$cmin :: TableCellAlignment -> TableCellAlignment -> TableCellAlignment
min :: TableCellAlignment -> TableCellAlignment -> TableCellAlignment
Ord, Typeable, Typeable TableCellAlignment
Typeable TableCellAlignment =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> TableCellAlignment
-> c TableCellAlignment)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableCellAlignment)
-> (TableCellAlignment -> Constr)
-> (TableCellAlignment -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableCellAlignment))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TableCellAlignment))
-> ((forall b. Data b => b -> b)
-> TableCellAlignment -> TableCellAlignment)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableCellAlignment -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableCellAlignment -> r)
-> (forall u.
(forall d. Data d => d -> u) -> TableCellAlignment -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> TableCellAlignment -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TableCellAlignment -> m TableCellAlignment)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TableCellAlignment -> m TableCellAlignment)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TableCellAlignment -> m TableCellAlignment)
-> Data TableCellAlignment
TableCellAlignment -> Constr
TableCellAlignment -> DataType
(forall b. Data b => b -> b)
-> TableCellAlignment -> TableCellAlignment
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> TableCellAlignment -> u
forall u. (forall d. Data d => d -> u) -> TableCellAlignment -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableCellAlignment -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableCellAlignment -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TableCellAlignment -> m TableCellAlignment
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TableCellAlignment -> m TableCellAlignment
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableCellAlignment
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> TableCellAlignment
-> c TableCellAlignment
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableCellAlignment)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TableCellAlignment)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> TableCellAlignment
-> c TableCellAlignment
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> TableCellAlignment
-> c TableCellAlignment
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableCellAlignment
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TableCellAlignment
$ctoConstr :: TableCellAlignment -> Constr
toConstr :: TableCellAlignment -> Constr
$cdataTypeOf :: TableCellAlignment -> DataType
dataTypeOf :: TableCellAlignment -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableCellAlignment)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TableCellAlignment)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TableCellAlignment)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TableCellAlignment)
$cgmapT :: (forall b. Data b => b -> b)
-> TableCellAlignment -> TableCellAlignment
gmapT :: (forall b. Data b => b -> b)
-> TableCellAlignment -> TableCellAlignment
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableCellAlignment -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TableCellAlignment -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableCellAlignment -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TableCellAlignment -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TableCellAlignment -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TableCellAlignment -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TableCellAlignment -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TableCellAlignment -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TableCellAlignment -> m TableCellAlignment
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TableCellAlignment -> m TableCellAlignment
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TableCellAlignment -> m TableCellAlignment
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TableCellAlignment -> m TableCellAlignment
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TableCellAlignment -> m TableCellAlignment
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TableCellAlignment -> m TableCellAlignment
Data, (forall x. TableCellAlignment -> Rep TableCellAlignment x)
-> (forall x. Rep TableCellAlignment x -> TableCellAlignment)
-> Generic TableCellAlignment
forall x. Rep TableCellAlignment x -> TableCellAlignment
forall x. TableCellAlignment -> Rep TableCellAlignment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TableCellAlignment -> Rep TableCellAlignment x
from :: forall x. TableCellAlignment -> Rep TableCellAlignment x
$cto :: forall x. Rep TableCellAlignment x -> TableCellAlignment
to :: forall x. Rep TableCellAlignment x -> TableCellAlignment
Generic)
data NodeType =
DOCUMENT
| THEMATIC_BREAK
| PARAGRAPH
| BLOCK_QUOTE
| HTML_BLOCK Text
| CUSTOM_BLOCK OnEnter OnExit
| CODE_BLOCK Info Text
| HEADING Level
| LIST ListAttributes
| ITEM
| TEXT Text
| SOFTBREAK
| LINEBREAK
| HTML_INLINE Text
| CUSTOM_INLINE OnEnter OnExit
| CODE Text
| EMPH
| STRONG
| LINK Url Title
| IMAGE Url Title
| STRIKETHROUGH
| TABLE [TableCellAlignment]
| TABLE_ROW
| TABLE_CELL
|
|
deriving (Int -> NodeType -> String -> String
[NodeType] -> String -> String
NodeType -> String
(Int -> NodeType -> String -> String)
-> (NodeType -> String)
-> ([NodeType] -> String -> String)
-> Show NodeType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> NodeType -> String -> String
showsPrec :: Int -> NodeType -> String -> String
$cshow :: NodeType -> String
show :: NodeType -> String
$cshowList :: [NodeType] -> String -> String
showList :: [NodeType] -> String -> String
Show, ReadPrec [NodeType]
ReadPrec NodeType
Int -> ReadS NodeType
ReadS [NodeType]
(Int -> ReadS NodeType)
-> ReadS [NodeType]
-> ReadPrec NodeType
-> ReadPrec [NodeType]
-> Read NodeType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NodeType
readsPrec :: Int -> ReadS NodeType
$creadList :: ReadS [NodeType]
readList :: ReadS [NodeType]
$creadPrec :: ReadPrec NodeType
readPrec :: ReadPrec NodeType
$creadListPrec :: ReadPrec [NodeType]
readListPrec :: ReadPrec [NodeType]
Read, NodeType -> NodeType -> Bool
(NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> Bool) -> Eq NodeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeType -> NodeType -> Bool
== :: NodeType -> NodeType -> Bool
$c/= :: NodeType -> NodeType -> Bool
/= :: NodeType -> NodeType -> Bool
Eq, Eq NodeType
Eq NodeType =>
(NodeType -> NodeType -> Ordering)
-> (NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> NodeType)
-> (NodeType -> NodeType -> NodeType)
-> Ord NodeType
NodeType -> NodeType -> Bool
NodeType -> NodeType -> Ordering
NodeType -> NodeType -> NodeType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NodeType -> NodeType -> Ordering
compare :: NodeType -> NodeType -> Ordering
$c< :: NodeType -> NodeType -> Bool
< :: NodeType -> NodeType -> Bool
$c<= :: NodeType -> NodeType -> Bool
<= :: NodeType -> NodeType -> Bool
$c> :: NodeType -> NodeType -> Bool
> :: NodeType -> NodeType -> Bool
$c>= :: NodeType -> NodeType -> Bool
>= :: NodeType -> NodeType -> Bool
$cmax :: NodeType -> NodeType -> NodeType
max :: NodeType -> NodeType -> NodeType
$cmin :: NodeType -> NodeType -> NodeType
min :: NodeType -> NodeType -> NodeType
Ord, Typeable, Typeable NodeType
Typeable NodeType =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NodeType -> c NodeType)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NodeType)
-> (NodeType -> Constr)
-> (NodeType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NodeType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NodeType))
-> ((forall b. Data b => b -> b) -> NodeType -> NodeType)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NodeType -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NodeType -> r)
-> (forall u. (forall d. Data d => d -> u) -> NodeType -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> NodeType -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NodeType -> m NodeType)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeType -> m NodeType)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeType -> m NodeType)
-> Data NodeType
NodeType -> Constr
NodeType -> DataType
(forall b. Data b => b -> b) -> NodeType -> NodeType
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> NodeType -> u
forall u. (forall d. Data d => d -> u) -> NodeType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NodeType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NodeType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NodeType -> m NodeType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeType -> m NodeType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NodeType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NodeType -> c NodeType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NodeType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NodeType)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NodeType -> c NodeType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NodeType -> c NodeType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NodeType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NodeType
$ctoConstr :: NodeType -> Constr
toConstr :: NodeType -> Constr
$cdataTypeOf :: NodeType -> DataType
dataTypeOf :: NodeType -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NodeType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NodeType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NodeType)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NodeType)
$cgmapT :: (forall b. Data b => b -> b) -> NodeType -> NodeType
gmapT :: (forall b. Data b => b -> b) -> NodeType -> NodeType
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NodeType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NodeType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NodeType -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NodeType -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NodeType -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> NodeType -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NodeType -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NodeType -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NodeType -> m NodeType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NodeType -> m NodeType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeType -> m NodeType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeType -> m NodeType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeType -> m NodeType
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeType -> m NodeType
Data, (forall x. NodeType -> Rep NodeType x)
-> (forall x. Rep NodeType x -> NodeType) -> Generic NodeType
forall x. Rep NodeType x -> NodeType
forall x. NodeType -> Rep NodeType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NodeType -> Rep NodeType x
from :: forall x. NodeType -> Rep NodeType x
$cto :: forall x. Rep NodeType x -> NodeType
to :: forall x. Rep NodeType x -> NodeType
Generic)
data PosInfo = PosInfo{ PosInfo -> Int
startLine :: Int
, PosInfo -> Int
startColumn :: Int
, PosInfo -> Int
endLine :: Int
, PosInfo -> Int
endColumn :: Int
}
deriving (Int -> PosInfo -> String -> String
[PosInfo] -> String -> String
PosInfo -> String
(Int -> PosInfo -> String -> String)
-> (PosInfo -> String)
-> ([PosInfo] -> String -> String)
-> Show PosInfo
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PosInfo -> String -> String
showsPrec :: Int -> PosInfo -> String -> String
$cshow :: PosInfo -> String
show :: PosInfo -> String
$cshowList :: [PosInfo] -> String -> String
showList :: [PosInfo] -> String -> String
Show, ReadPrec [PosInfo]
ReadPrec PosInfo
Int -> ReadS PosInfo
ReadS [PosInfo]
(Int -> ReadS PosInfo)
-> ReadS [PosInfo]
-> ReadPrec PosInfo
-> ReadPrec [PosInfo]
-> Read PosInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PosInfo
readsPrec :: Int -> ReadS PosInfo
$creadList :: ReadS [PosInfo]
readList :: ReadS [PosInfo]
$creadPrec :: ReadPrec PosInfo
readPrec :: ReadPrec PosInfo
$creadListPrec :: ReadPrec [PosInfo]
readListPrec :: ReadPrec [PosInfo]
Read, PosInfo -> PosInfo -> Bool
(PosInfo -> PosInfo -> Bool)
-> (PosInfo -> PosInfo -> Bool) -> Eq PosInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PosInfo -> PosInfo -> Bool
== :: PosInfo -> PosInfo -> Bool
$c/= :: PosInfo -> PosInfo -> Bool
/= :: PosInfo -> PosInfo -> Bool
Eq, Eq PosInfo
Eq PosInfo =>
(PosInfo -> PosInfo -> Ordering)
-> (PosInfo -> PosInfo -> Bool)
-> (PosInfo -> PosInfo -> Bool)
-> (PosInfo -> PosInfo -> Bool)
-> (PosInfo -> PosInfo -> Bool)
-> (PosInfo -> PosInfo -> PosInfo)
-> (PosInfo -> PosInfo -> PosInfo)
-> Ord PosInfo
PosInfo -> PosInfo -> Bool
PosInfo -> PosInfo -> Ordering
PosInfo -> PosInfo -> PosInfo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PosInfo -> PosInfo -> Ordering
compare :: PosInfo -> PosInfo -> Ordering
$c< :: PosInfo -> PosInfo -> Bool
< :: PosInfo -> PosInfo -> Bool
$c<= :: PosInfo -> PosInfo -> Bool
<= :: PosInfo -> PosInfo -> Bool
$c> :: PosInfo -> PosInfo -> Bool
> :: PosInfo -> PosInfo -> Bool
$c>= :: PosInfo -> PosInfo -> Bool
>= :: PosInfo -> PosInfo -> Bool
$cmax :: PosInfo -> PosInfo -> PosInfo
max :: PosInfo -> PosInfo -> PosInfo
$cmin :: PosInfo -> PosInfo -> PosInfo
min :: PosInfo -> PosInfo -> PosInfo
Ord, Typeable, Typeable PosInfo
Typeable PosInfo =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PosInfo -> c PosInfo)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PosInfo)
-> (PosInfo -> Constr)
-> (PosInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PosInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PosInfo))
-> ((forall b. Data b => b -> b) -> PosInfo -> PosInfo)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PosInfo -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PosInfo -> r)
-> (forall u. (forall d. Data d => d -> u) -> PosInfo -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> PosInfo -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PosInfo -> m PosInfo)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PosInfo -> m PosInfo)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PosInfo -> m PosInfo)
-> Data PosInfo
PosInfo -> Constr
PosInfo -> DataType
(forall b. Data b => b -> b) -> PosInfo -> PosInfo
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PosInfo -> u
forall u. (forall d. Data d => d -> u) -> PosInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PosInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PosInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PosInfo -> m PosInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PosInfo -> m PosInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PosInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PosInfo -> c PosInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PosInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PosInfo)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PosInfo -> c PosInfo
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PosInfo -> c PosInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PosInfo
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PosInfo
$ctoConstr :: PosInfo -> Constr
toConstr :: PosInfo -> Constr
$cdataTypeOf :: PosInfo -> DataType
dataTypeOf :: PosInfo -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PosInfo)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PosInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PosInfo)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PosInfo)
$cgmapT :: (forall b. Data b => b -> b) -> PosInfo -> PosInfo
gmapT :: (forall b. Data b => b -> b) -> PosInfo -> PosInfo
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PosInfo -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PosInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PosInfo -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PosInfo -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PosInfo -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PosInfo -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PosInfo -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PosInfo -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PosInfo -> m PosInfo
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PosInfo -> m PosInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PosInfo -> m PosInfo
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PosInfo -> m PosInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PosInfo -> m PosInfo
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PosInfo -> m PosInfo
Data, (forall x. PosInfo -> Rep PosInfo x)
-> (forall x. Rep PosInfo x -> PosInfo) -> Generic PosInfo
forall x. Rep PosInfo x -> PosInfo
forall x. PosInfo -> Rep PosInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PosInfo -> Rep PosInfo x
from :: forall x. PosInfo -> Rep PosInfo x
$cto :: forall x. Rep PosInfo x -> PosInfo
to :: forall x. Rep PosInfo x -> PosInfo
Generic)
newtype CMarkOption = CMarkOption { CMarkOption -> CInt
unCMarkOption :: CInt }
combineOptions :: [CMarkOption] -> CInt
combineOptions :: [CMarkOption] -> CInt
combineOptions = (CMarkOption -> CInt -> CInt) -> CInt -> [CMarkOption] -> CInt
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
(.|.) (CInt -> CInt -> CInt)
-> (CMarkOption -> CInt) -> CMarkOption -> CInt -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMarkOption -> CInt
unCMarkOption) CInt
0
optSourcePos :: CMarkOption
optSourcePos :: CMarkOption
optSourcePos = CInt -> CMarkOption
CMarkOption CInt
2
{-# LINE 276 "CMarkGFM.hsc" #-}
optHardBreaks :: CMarkOption
optHardBreaks :: CMarkOption
optHardBreaks = CInt -> CMarkOption
CMarkOption CInt
4
{-# LINE 280 "CMarkGFM.hsc" #-}
optSmart :: CMarkOption
optSmart :: CMarkOption
optSmart = CInt -> CMarkOption
CMarkOption CInt
1024
{-# LINE 284 "CMarkGFM.hsc" #-}
optSafe :: CMarkOption
optSafe :: CMarkOption
optSafe = CInt -> CMarkOption
CMarkOption CInt
8
{-# LINE 289 "CMarkGFM.hsc" #-}
optUnsafe :: CMarkOption
optUnsafe :: CMarkOption
optUnsafe = CInt -> CMarkOption
CMarkOption CInt
131072
{-# LINE 294 "CMarkGFM.hsc" #-}
optFootnotes :: CMarkOption
= CInt -> CMarkOption
CMarkOption CInt
8192
{-# LINE 298 "CMarkGFM.hsc" #-}
newtype CMarkExtension = CMarkExtension { CMarkExtension -> String
unCMarkExtension :: String }
extStrikethrough :: CMarkExtension
extStrikethrough :: CMarkExtension
extStrikethrough = String -> CMarkExtension
CMarkExtension String
"strikethrough"
extTable :: CMarkExtension
extTable :: CMarkExtension
extTable = String -> CMarkExtension
CMarkExtension String
"table"
extAutolink :: CMarkExtension
extAutolink :: CMarkExtension
extAutolink = String -> CMarkExtension
CMarkExtension String
"autolink"
extTagfilter :: CMarkExtension
extTagfilter :: CMarkExtension
extTagfilter = String -> CMarkExtension
CMarkExtension String
"tagfilter"
extTaskList :: CMarkExtension
extTaskList :: CMarkExtension
extTaskList = String -> CMarkExtension
CMarkExtension String
"tasklist"
ptrToNodeType :: NodePtr -> IO NodeType
ptrToNodeType :: NodePtr -> IO NodeType
ptrToNodeType NodePtr
ptr = do
Int
nodeType <- NodePtr -> IO Int
c_cmark_node_get_type NodePtr
ptr
case Int
nodeType of
Int
32769
{-# LINE 321 "CMarkGFM.hsc" #-}
-> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
DOCUMENT
Int
32778
{-# LINE 323 "CMarkGFM.hsc" #-}
-> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
THEMATIC_BREAK
Int
32776
{-# LINE 325 "CMarkGFM.hsc" #-}
-> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
PARAGRAPH
Int
32770
{-# LINE 327 "CMarkGFM.hsc" #-}
-> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
BLOCK_QUOTE
Int
32774
{-# LINE 329 "CMarkGFM.hsc" #-}
-> Text -> NodeType
HTML_BLOCK (Text -> NodeType) -> IO Text -> IO NodeType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
literal
Int
32775
{-# LINE 331 "CMarkGFM.hsc" #-}
-> Text -> Text -> NodeType
CUSTOM_BLOCK (Text -> Text -> NodeType) -> IO Text -> IO (Text -> NodeType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
onEnter IO (Text -> NodeType) -> IO Text -> IO NodeType
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Text
onExit
Int
32773
{-# LINE 333 "CMarkGFM.hsc" #-}
-> Text -> Text -> NodeType
CODE_BLOCK (Text -> Text -> NodeType) -> IO Text -> IO (Text -> NodeType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
info
IO (Text -> NodeType) -> IO Text -> IO NodeType
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Text
literal
Int
32771
{-# LINE 336 "CMarkGFM.hsc" #-}
-> ListAttributes -> NodeType
LIST (ListAttributes -> NodeType) -> IO ListAttributes -> IO NodeType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ListAttributes
listAttr
Int
32772
{-# LINE 338 "CMarkGFM.hsc" #-}
-> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
ITEM
Int
32777
{-# LINE 340 "CMarkGFM.hsc" #-}
-> Int -> NodeType
HEADING (Int -> NodeType) -> IO Int -> IO NodeType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int
level
Int
49159
{-# LINE 342 "CMarkGFM.hsc" #-}
-> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
EMPH
Int
49160
{-# LINE 344 "CMarkGFM.hsc" #-}
-> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
STRONG
Int
49161
{-# LINE 346 "CMarkGFM.hsc" #-}
-> Text -> Text -> NodeType
LINK (Text -> Text -> NodeType) -> IO Text -> IO (Text -> NodeType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
url IO (Text -> NodeType) -> IO Text -> IO NodeType
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Text
title
Int
49162
{-# LINE 348 "CMarkGFM.hsc" #-}
-> Text -> Text -> NodeType
IMAGE (Text -> Text -> NodeType) -> IO Text -> IO (Text -> NodeType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
url IO (Text -> NodeType) -> IO Text -> IO NodeType
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Text
title
Int
49153
{-# LINE 350 "CMarkGFM.hsc" #-}
-> Text -> NodeType
TEXT (Text -> NodeType) -> IO Text -> IO NodeType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
literal
Int
49156
{-# LINE 352 "CMarkGFM.hsc" #-}
-> Text -> NodeType
CODE (Text -> NodeType) -> IO Text -> IO NodeType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
literal
Int
49157
{-# LINE 354 "CMarkGFM.hsc" #-}
-> Text -> NodeType
HTML_INLINE (Text -> NodeType) -> IO Text -> IO NodeType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
literal
Int
49158
{-# LINE 356 "CMarkGFM.hsc" #-}
-> Text -> Text -> NodeType
CUSTOM_INLINE (Text -> Text -> NodeType) -> IO Text -> IO (Text -> NodeType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
onEnter IO (Text -> NodeType) -> IO Text -> IO NodeType
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Text
onExit
Int
49154
{-# LINE 358 "CMarkGFM.hsc" #-}
-> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
SOFTBREAK
Int
49155
{-# LINE 360 "CMarkGFM.hsc" #-}
-> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
LINEBREAK
Int
32779
{-# LINE 362 "CMarkGFM.hsc" #-}
-> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
FOOTNOTE_DEFINITION
Int
49163
{-# LINE 364 "CMarkGFM.hsc" #-}
-> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
FOOTNOTE_REFERENCE
Int
_ -> if Int
nodeType Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Word32 -> Word32
forall a. IO a -> a
Unsafe.unsafePerformIO (IO Word32 -> Word32) -> IO Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
c_CMARK_NODE_STRIKETHROUGH) then
NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
STRIKETHROUGH
else if Int
nodeType Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Word32 -> Word32
forall a. IO a -> a
Unsafe.unsafePerformIO (IO Word32 -> Word32) -> IO Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
c_CMARK_NODE_TABLE) then
[TableCellAlignment] -> NodeType
TABLE ([TableCellAlignment] -> NodeType)
-> IO [TableCellAlignment] -> IO NodeType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [TableCellAlignment]
alignments
else if Int
nodeType Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Word32 -> Word32
forall a. IO a -> a
Unsafe.unsafePerformIO (IO Word32 -> Word32) -> IO Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
c_CMARK_NODE_TABLE_ROW) then
NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
TABLE_ROW
else if Int
nodeType Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Word32 -> Word32
forall a. IO a -> a
Unsafe.unsafePerformIO (IO Word32 -> Word32) -> IO Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
c_CMARK_NODE_TABLE_CELL) then
NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
TABLE_CELL
else
String -> IO NodeType
forall a. HasCallStack => String -> a
error (String -> IO NodeType) -> String -> IO NodeType
forall a b. (a -> b) -> a -> b
$ String
"Unknown node type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
nodeType)
where literal :: IO Text
literal = NodePtr -> IO CString
c_cmark_node_get_literal NodePtr
ptr IO CString -> (CString -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO Text
totext
level :: IO Int
level = NodePtr -> IO Int
c_cmark_node_get_heading_level NodePtr
ptr
onEnter :: IO Text
onEnter = NodePtr -> IO CString
c_cmark_node_get_on_enter NodePtr
ptr IO CString -> (CString -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO Text
totext
onExit :: IO Text
onExit = NodePtr -> IO CString
c_cmark_node_get_on_exit NodePtr
ptr IO CString -> (CString -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO Text
totext
listAttr :: IO ListAttributes
listAttr = do
Int
listtype <- NodePtr -> IO Int
c_cmark_node_get_list_type NodePtr
ptr
Int
listdelim <- NodePtr -> IO Int
c_cmark_node_get_list_delim NodePtr
ptr
Bool
tight <- NodePtr -> IO Bool
c_cmark_node_get_list_tight NodePtr
ptr
Int
start <- NodePtr -> IO Int
c_cmark_node_get_list_start NodePtr
ptr
ListAttributes -> IO ListAttributes
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListAttributes{
listType :: ListType
listType = case Int
listtype of
(Int
2) -> ListType
ORDERED_LIST
{-# LINE 387 "CMarkGFM.hsc" #-}
(Int
1) -> ListType
BULLET_LIST
{-# LINE 388 "CMarkGFM.hsc" #-}
Int
_ -> ListType
BULLET_LIST
, listDelim :: DelimType
listDelim = case Int
listdelim of
(Int
1) -> DelimType
PERIOD_DELIM
{-# LINE 391 "CMarkGFM.hsc" #-}
(Int
2) -> DelimType
PAREN_DELIM
{-# LINE 392 "CMarkGFM.hsc" #-}
Int
_ -> DelimType
PERIOD_DELIM
, listTight :: Bool
listTight = Bool
tight
, listStart :: Int
listStart = Int
start
}
url :: IO Text
url = NodePtr -> IO CString
c_cmark_node_get_url NodePtr
ptr IO CString -> (CString -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO Text
totext
title :: IO Text
title = NodePtr -> IO CString
c_cmark_node_get_title NodePtr
ptr IO CString -> (CString -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO Text
totext
info :: IO Text
info = NodePtr -> IO CString
c_cmark_node_get_fence_info NodePtr
ptr IO CString -> (CString -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO Text
totext
alignments :: IO [TableCellAlignment]
alignments = do
CUShort
ncols <- NodePtr -> IO CUShort
c_cmark_gfm_extensions_get_table_columns NodePtr
ptr
Ptr CUChar
cols <- NodePtr -> IO (Ptr CUChar)
c_cmark_gfm_extensions_get_table_alignments NodePtr
ptr
(Int -> IO TableCellAlignment) -> [Int] -> IO [TableCellAlignment]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((CUChar -> TableCellAlignment)
-> IO CUChar -> IO TableCellAlignment
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUChar -> TableCellAlignment
ucharToAlignment (IO CUChar -> IO TableCellAlignment)
-> (Int -> IO CUChar) -> Int -> IO TableCellAlignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CUChar -> Int -> IO CUChar
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CUChar
cols) [Int
0..(CUShort -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUShort
ncols) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
ucharToAlignment :: CUChar -> TableCellAlignment
ucharToAlignment (CUChar Word8
108) = TableCellAlignment
LeftAligned
ucharToAlignment (CUChar Word8
99) = TableCellAlignment
CenterAligned
ucharToAlignment (CUChar Word8
114) = TableCellAlignment
RightAligned
ucharToAlignment CUChar
_ = TableCellAlignment
NoAlignment
getPosInfo :: NodePtr -> IO (Maybe PosInfo)
getPosInfo :: NodePtr -> IO (Maybe PosInfo)
getPosInfo NodePtr
ptr = do
Int
startline <- NodePtr -> IO Int
c_cmark_node_get_start_line NodePtr
ptr
Int
endline <- NodePtr -> IO Int
c_cmark_node_get_end_line NodePtr
ptr
Int
startcol <- NodePtr -> IO Int
c_cmark_node_get_start_column NodePtr
ptr
Int
endcol <- NodePtr -> IO Int
c_cmark_node_get_end_column NodePtr
ptr
if Int
startline Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
endline Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
startcol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
endcol Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Maybe PosInfo -> IO (Maybe PosInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PosInfo
forall a. Maybe a
Nothing
else Maybe PosInfo -> IO (Maybe PosInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PosInfo -> IO (Maybe PosInfo))
-> Maybe PosInfo -> IO (Maybe PosInfo)
forall a b. (a -> b) -> a -> b
$ PosInfo -> Maybe PosInfo
forall a. a -> Maybe a
Just PosInfo{ startLine :: Int
startLine = Int
startline
, startColumn :: Int
startColumn = Int
startcol
, endLine :: Int
endLine = Int
endline
, endColumn :: Int
endColumn = Int
endcol }
toNode :: NodePtr -> IO Node
toNode :: NodePtr -> IO Node
toNode NodePtr
ptr = do
let handleNodes :: NodePtr -> IO [Node]
handleNodes NodePtr
ptr' =
if NodePtr
ptr' NodePtr -> NodePtr -> Bool
forall a. Eq a => a -> a -> Bool
== NodePtr
forall a. Ptr a
nullPtr
then [Node] -> IO [Node]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do
Node
x <- NodePtr -> IO Node
toNode NodePtr
ptr'
[Node]
xs <- NodePtr -> IO NodePtr
c_cmark_node_next NodePtr
ptr' IO NodePtr -> (NodePtr -> IO [Node]) -> IO [Node]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NodePtr -> IO [Node]
handleNodes
[Node] -> IO [Node]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Node] -> IO [Node]) -> [Node] -> IO [Node]
forall a b. (a -> b) -> a -> b
$! (Node
xNode -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:[Node]
xs)
NodeType
nodeType <- NodePtr -> IO NodeType
ptrToNodeType NodePtr
ptr
[Node]
children <- NodePtr -> IO NodePtr
c_cmark_node_first_child NodePtr
ptr IO NodePtr -> (NodePtr -> IO [Node]) -> IO [Node]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NodePtr -> IO [Node]
handleNodes
Maybe PosInfo
posinfo <- NodePtr -> IO (Maybe PosInfo)
getPosInfo NodePtr
ptr
Node -> IO Node
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Node -> IO Node) -> Node -> IO Node
forall a b. (a -> b) -> a -> b
$! Maybe PosInfo -> NodeType -> [Node] -> Node
Node Maybe PosInfo
posinfo NodeType
nodeType [Node]
children
fromNode :: Node -> IO NodePtr
fromNode :: Node -> IO NodePtr
fromNode (Node Maybe PosInfo
_ NodeType
nodeType [Node]
children) = do
NodePtr
node <- case NodeType
nodeType of
NodeType
DOCUMENT -> Int -> IO NodePtr
c_cmark_node_new (Int
32769)
{-# LINE 439 "CMarkGFM.hsc" #-}
NodeType
THEMATIC_BREAK -> Int -> IO NodePtr
c_cmark_node_new (Int
32778)
{-# LINE 440 "CMarkGFM.hsc" #-}
NodeType
PARAGRAPH -> Int -> IO NodePtr
c_cmark_node_new (Int
32776)
{-# LINE 441 "CMarkGFM.hsc" #-}
NodeType
BLOCK_QUOTE -> Int -> IO NodePtr
c_cmark_node_new (Int
32770)
{-# LINE 442 "CMarkGFM.hsc" #-}
HTML_BLOCK Text
literal -> do
NodePtr
n <- Int -> IO NodePtr
c_cmark_node_new (Int
32774)
{-# LINE 444 "CMarkGFM.hsc" #-}
Text -> (CString -> IO Int) -> IO Int
forall a. Text -> (CString -> IO a) -> IO a
withtext Text
literal (NodePtr -> CString -> IO Int
c_cmark_node_set_literal NodePtr
n)
NodePtr -> IO NodePtr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodePtr
n
CUSTOM_BLOCK Text
onEnter Text
onExit -> do
NodePtr
n <- Int -> IO NodePtr
c_cmark_node_new (Int
32775)
{-# LINE 448 "CMarkGFM.hsc" #-}
Text -> (CString -> IO Int) -> IO Int
forall a. Text -> (CString -> IO a) -> IO a
withtext Text
onEnter (NodePtr -> CString -> IO Int
c_cmark_node_set_on_enter NodePtr
n)
Text -> (CString -> IO Int) -> IO Int
forall a. Text -> (CString -> IO a) -> IO a
withtext Text
onExit (NodePtr -> CString -> IO Int
c_cmark_node_set_on_exit NodePtr
n)
NodePtr -> IO NodePtr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodePtr
n
CODE_BLOCK Text
info Text
literal -> do
NodePtr
n <- Int -> IO NodePtr
c_cmark_node_new (Int
32773)
{-# LINE 453 "CMarkGFM.hsc" #-}
Text -> (CString -> IO Int) -> IO Int
forall a. Text -> (CString -> IO a) -> IO a
withtext Text
literal (NodePtr -> CString -> IO Int
c_cmark_node_set_literal NodePtr
n)
Text -> (CString -> IO Int) -> IO Int
forall a. Text -> (CString -> IO a) -> IO a
withtext Text
info (NodePtr -> CString -> IO Int
c_cmark_node_set_fence_info NodePtr
n)
NodePtr -> IO NodePtr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodePtr
n
LIST ListAttributes
attr -> do
NodePtr
n <- Int -> IO NodePtr
c_cmark_node_new (Int
32771)
{-# LINE 458 "CMarkGFM.hsc" #-}
NodePtr -> Int -> IO Int
c_cmark_node_set_list_type NodePtr
n (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ case ListAttributes -> ListType
listType ListAttributes
attr of
ListType
ORDERED_LIST -> Int
2
{-# LINE 460 "CMarkGFM.hsc" #-}
ListType
BULLET_LIST -> Int
1
{-# LINE 461 "CMarkGFM.hsc" #-}
NodePtr -> Int -> IO Int
c_cmark_node_set_list_delim NodePtr
n (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ case ListAttributes -> DelimType
listDelim ListAttributes
attr of
DelimType
PERIOD_DELIM -> Int
1
{-# LINE 463 "CMarkGFM.hsc" #-}
DelimType
PAREN_DELIM -> Int
2
{-# LINE 464 "CMarkGFM.hsc" #-}
NodePtr -> Bool -> IO Int
c_cmark_node_set_list_tight NodePtr
n (Bool -> IO Int) -> Bool -> IO Int
forall a b. (a -> b) -> a -> b
$ ListAttributes -> Bool
listTight ListAttributes
attr
NodePtr -> Int -> IO Int
c_cmark_node_set_list_start NodePtr
n (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ ListAttributes -> Int
listStart ListAttributes
attr
NodePtr -> IO NodePtr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodePtr
n
NodeType
ITEM -> Int -> IO NodePtr
c_cmark_node_new (Int
32772)
{-# LINE 468 "CMarkGFM.hsc" #-}
HEADING Int
lev -> do
NodePtr
n <- Int -> IO NodePtr
c_cmark_node_new (Int
32777)
{-# LINE 470 "CMarkGFM.hsc" #-}
NodePtr -> Int -> IO Int
c_cmark_node_set_heading_level NodePtr
n Int
lev
NodePtr -> IO NodePtr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodePtr
n
NodeType
EMPH -> Int -> IO NodePtr
c_cmark_node_new (Int
49159)
{-# LINE 473 "CMarkGFM.hsc" #-}
NodeType
STRONG -> Int -> IO NodePtr
c_cmark_node_new (Int
49160)
{-# LINE 474 "CMarkGFM.hsc" #-}
LINK Text
url Text
title -> do
NodePtr
n <- Int -> IO NodePtr
c_cmark_node_new (Int
49161)
{-# LINE 476 "CMarkGFM.hsc" #-}
Text -> (CString -> IO Int) -> IO Int
forall a. Text -> (CString -> IO a) -> IO a
withtext Text
url (NodePtr -> CString -> IO Int
c_cmark_node_set_url NodePtr
n)
Text -> (CString -> IO Int) -> IO Int
forall a. Text -> (CString -> IO a) -> IO a
withtext Text
title (NodePtr -> CString -> IO Int
c_cmark_node_set_title NodePtr
n)
NodePtr -> IO NodePtr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodePtr
n
IMAGE Text
url Text
title -> do
NodePtr
n <- Int -> IO NodePtr
c_cmark_node_new (Int
49162)
{-# LINE 481 "CMarkGFM.hsc" #-}
Text -> (CString -> IO Int) -> IO Int
forall a. Text -> (CString -> IO a) -> IO a
withtext Text
url (NodePtr -> CString -> IO Int
c_cmark_node_set_url NodePtr
n)
Text -> (CString -> IO Int) -> IO Int
forall a. Text -> (CString -> IO a) -> IO a
withtext Text
title (NodePtr -> CString -> IO Int
c_cmark_node_set_title NodePtr
n)
NodePtr -> IO NodePtr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodePtr
n
TEXT Text
literal -> do
NodePtr
n <- Int -> IO NodePtr
c_cmark_node_new (Int
49153)
{-# LINE 486 "CMarkGFM.hsc" #-}
Text -> (CString -> IO Int) -> IO Int
forall a. Text -> (CString -> IO a) -> IO a
withtext Text
literal (NodePtr -> CString -> IO Int
c_cmark_node_set_literal NodePtr
n)
NodePtr -> IO NodePtr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodePtr
n
CODE Text
literal -> do
NodePtr
n <- Int -> IO NodePtr
c_cmark_node_new (Int
49156)
{-# LINE 490 "CMarkGFM.hsc" #-}
Text -> (CString -> IO Int) -> IO Int
forall a. Text -> (CString -> IO a) -> IO a
withtext Text
literal (NodePtr -> CString -> IO Int
c_cmark_node_set_literal NodePtr
n)
NodePtr -> IO NodePtr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodePtr
n
HTML_INLINE Text
literal -> do
NodePtr
n <- Int -> IO NodePtr
c_cmark_node_new (Int
49157)
{-# LINE 494 "CMarkGFM.hsc" #-}
Text -> (CString -> IO Int) -> IO Int
forall a. Text -> (CString -> IO a) -> IO a
withtext Text
literal (NodePtr -> CString -> IO Int
c_cmark_node_set_literal NodePtr
n)
NodePtr -> IO NodePtr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodePtr
n
CUSTOM_INLINE Text
onEnter Text
onExit -> do
NodePtr
n <- Int -> IO NodePtr
c_cmark_node_new (Int
49158)
{-# LINE 498 "CMarkGFM.hsc" #-}
Text -> (CString -> IO Int) -> IO Int
forall a. Text -> (CString -> IO a) -> IO a
withtext Text
onEnter (NodePtr -> CString -> IO Int
c_cmark_node_set_on_enter NodePtr
n)
Text -> (CString -> IO Int) -> IO Int
forall a. Text -> (CString -> IO a) -> IO a
withtext Text
onExit (NodePtr -> CString -> IO Int
c_cmark_node_set_on_exit NodePtr
n)
NodePtr -> IO NodePtr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodePtr
n
NodeType
SOFTBREAK -> Int -> IO NodePtr
c_cmark_node_new (Int
49154)
{-# LINE 502 "CMarkGFM.hsc" #-}
NodeType
LINEBREAK -> Int -> IO NodePtr
c_cmark_node_new (Int
49155)
{-# LINE 503 "CMarkGFM.hsc" #-}
NodeType
STRIKETHROUGH -> Int -> IO NodePtr
c_cmark_node_new (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> (IO Word32 -> Word32) -> IO Word32 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Word32 -> Word32
forall a. IO a -> a
Unsafe.unsafePerformIO (IO Word32 -> Int) -> IO Word32 -> Int
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
c_CMARK_NODE_STRIKETHROUGH)
TABLE [TableCellAlignment]
_ -> String -> IO NodePtr
forall a. HasCallStack => String -> a
error String
"constructing table not supported"
NodeType
TABLE_ROW -> String -> IO NodePtr
forall a. HasCallStack => String -> a
error String
"constructing table row not supported"
NodeType
TABLE_CELL -> String -> IO NodePtr
forall a. HasCallStack => String -> a
error String
"constructing table cell not supported"
NodeType
FOOTNOTE_DEFINITION -> String -> IO NodePtr
forall a. HasCallStack => String -> a
error String
"constructing footnotes not supported"
NodeType
FOOTNOTE_REFERENCE -> String -> IO NodePtr
forall a. HasCallStack => String -> a
error String
"constructing footnotes not supported"
(Node -> IO Int) -> [Node] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Node
child -> Node -> IO NodePtr
fromNode Node
child IO NodePtr -> (NodePtr -> IO Int) -> IO Int
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NodePtr -> NodePtr -> IO Int
c_cmark_node_append_child NodePtr
node) [Node]
children
NodePtr -> IO NodePtr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodePtr
node
totext :: CString -> IO Text
totext :: CString -> IO Text
totext CString
str
| CString
str CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr = Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
empty
| Bool
otherwise = CStringLen -> IO Text
TF.peekCStringLen (CString
str, CString -> Int
c_strlen CString
str)
withtext :: Text -> (CString -> IO a) -> IO a
withtext :: forall a. Text -> (CString -> IO a) -> IO a
withtext Text
t CString -> IO a
f = Text -> (CStringLen -> IO a) -> IO a
forall a. Text -> (CStringLen -> IO a) -> IO a
TF.withCStringLen (Text -> Char -> Text
snoc Text
t Char
'\0') (CString -> IO a
f (CString -> IO a) -> (CStringLen -> CString) -> CStringLen -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CStringLen -> CString
forall a b. (a, b) -> a
fst)
foreign import ccall "string.h strlen"
c_strlen :: CString -> Int
foreign import ccall "cmark-gfm.h cmark_node_new"
c_cmark_node_new :: Int -> IO NodePtr
foreign import ccall "cmark-gfm.h cmark_render_html"
c_cmark_render_html :: NodePtr -> CInt -> LlistPtr ExtensionPtr -> IO CString
foreign import ccall "cmark-gfm.h cmark_render_xml"
c_cmark_render_xml :: NodePtr -> CInt -> IO CString
foreign import ccall "cmark-gfm.h cmark_render_man"
c_cmark_render_man :: NodePtr -> CInt -> Int -> IO CString
foreign import ccall "cmark-gfm.h cmark_render_latex"
c_cmark_render_latex :: NodePtr -> CInt -> Int -> IO CString
foreign import ccall "cmark-gfm.h cmark_render_commonmark"
c_cmark_render_commonmark :: NodePtr -> CInt -> Int -> IO CString
foreign import ccall "cmark-gfm.h cmark_parser_new"
c_cmark_parser_new :: CInt -> IO ParserPtr
foreign import ccall "cmark-gfm.h cmark_parser_feed"
c_cmark_parser_feed :: ParserPtr -> CString -> Int -> IO ()
foreign import ccall "cmark-gfm.h cmark_parser_finish"
c_cmark_parser_finish :: ParserPtr -> IO NodePtr
foreign import ccall "cmark-gfm.h cmark_parser_free"
c_cmark_parser_free :: ParserPtr -> IO ()
foreign import ccall "cmark-gfm.h cmark_node_get_type"
c_cmark_node_get_type :: NodePtr -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_first_child"
c_cmark_node_first_child :: NodePtr -> IO NodePtr
foreign import ccall "cmark-gfm.h cmark_node_next"
c_cmark_node_next :: NodePtr -> IO NodePtr
foreign import ccall "cmark-gfm.h cmark_node_get_literal"
c_cmark_node_get_literal :: NodePtr -> IO CString
foreign import ccall "cmark-gfm.h cmark_node_get_url"
c_cmark_node_get_url :: NodePtr -> IO CString
foreign import ccall "cmark-gfm.h cmark_node_get_title"
c_cmark_node_get_title :: NodePtr -> IO CString
foreign import ccall "cmark-gfm.h cmark_node_get_heading_level"
c_cmark_node_get_heading_level :: NodePtr -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_get_list_type"
c_cmark_node_get_list_type :: NodePtr -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_get_list_tight"
c_cmark_node_get_list_tight :: NodePtr -> IO Bool
foreign import ccall "cmark-gfm.h cmark_node_get_list_start"
c_cmark_node_get_list_start :: NodePtr -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_get_list_delim"
c_cmark_node_get_list_delim :: NodePtr -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_get_fence_info"
c_cmark_node_get_fence_info :: NodePtr -> IO CString
foreign import ccall "cmark-gfm.h cmark_node_get_start_line"
c_cmark_node_get_start_line :: NodePtr -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_get_start_column"
c_cmark_node_get_start_column :: NodePtr -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_get_end_line"
c_cmark_node_get_end_line :: NodePtr -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_get_end_column"
c_cmark_node_get_end_column :: NodePtr -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_get_on_enter"
c_cmark_node_get_on_enter :: NodePtr -> IO CString
foreign import ccall "cmark-gfm.h cmark_node_get_on_exit"
c_cmark_node_get_on_exit :: NodePtr -> IO CString
foreign import ccall "cmark-gfm.h cmark_node_append_child"
c_cmark_node_append_child :: NodePtr -> NodePtr -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_set_literal"
c_cmark_node_set_literal :: NodePtr -> CString -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_set_url"
c_cmark_node_set_url :: NodePtr -> CString -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_set_title"
c_cmark_node_set_title :: NodePtr -> CString -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_set_heading_level"
c_cmark_node_set_heading_level :: NodePtr -> Int -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_set_list_type"
c_cmark_node_set_list_type :: NodePtr -> Int -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_set_list_tight"
c_cmark_node_set_list_tight :: NodePtr -> Bool -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_set_list_start"
c_cmark_node_set_list_start :: NodePtr -> Int -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_set_list_delim"
c_cmark_node_set_list_delim :: NodePtr -> Int -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_set_fence_info"
c_cmark_node_set_fence_info :: NodePtr -> CString -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_set_on_enter"
c_cmark_node_set_on_enter :: NodePtr -> CString -> IO Int
foreign import ccall "cmark-gfm.h cmark_node_set_on_exit"
c_cmark_node_set_on_exit :: NodePtr -> CString -> IO Int
foreign import ccall "cmark-gfm.h &cmark_node_free"
c_cmark_node_free :: FunPtr (NodePtr -> IO ())
foreign import ccall "cmark-gfm-core-extensions.h cmark_gfm_core_extensions_ensure_registered"
c_cmark_gfm_core_extensions_ensure_registered :: IO ()
foreign import ccall "cmark-gfm-extension_api.h cmark_find_syntax_extension"
c_cmark_find_syntax_extension :: CString -> IO ExtensionPtr
foreign import ccall "cmark-gfm.h cmark_llist_append"
c_cmark_llist_append :: MemPtr -> LlistPtr a -> Ptr () -> IO (LlistPtr a)
foreign import ccall "cmark-gfm.h cmark_llist_free"
c_cmark_llist_free :: MemPtr -> LlistPtr a -> IO ()
foreign import ccall "cmark-gfm.h cmark_get_default_mem_allocator"
c_cmark_mem :: MemPtr
foreign import ccall "cmark-gfm-extension_api.h cmark_parser_attach_syntax_extension"
c_cmark_parser_attach_syntax_extension :: ParserPtr -> ExtensionPtr -> IO ()
foreign import ccall "strikethrough.h &CMARK_NODE_STRIKETHROUGH"
c_CMARK_NODE_STRIKETHROUGH :: Ptr Word32
{-# LINE 668 "CMarkGFM.hsc" #-}
foreign import ccall "table.h &CMARK_NODE_TABLE"
c_CMARK_NODE_TABLE :: Ptr Word32
{-# LINE 671 "CMarkGFM.hsc" #-}
foreign import ccall "table.h &CMARK_NODE_TABLE_ROW"
c_CMARK_NODE_TABLE_ROW :: Ptr Word32
{-# LINE 674 "CMarkGFM.hsc" #-}
foreign import ccall "table.h &CMARK_NODE_TABLE_CELL"
c_CMARK_NODE_TABLE_CELL :: Ptr Word32
{-# LINE 677 "CMarkGFM.hsc" #-}
foreign import ccall "cmark-gfm-core-extensions.h cmark_gfm_extensions_get_table_columns"
c_cmark_gfm_extensions_get_table_columns :: NodePtr -> IO CUShort
foreign import ccall "cmark-gfm-core-extensions.h cmark_gfm_extensions_get_table_alignments"
c_cmark_gfm_extensions_get_table_alignments :: NodePtr -> IO (Ptr CUChar)