{-# LINE 1 "CMark.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface, GeneralizedNewtypeDeriving,
    DeriveGeneric, DeriveDataTypeable, FlexibleContexts #-}

module CMark (
    commonmarkToHtml
  , commonmarkToXml
  , commonmarkToMan
  , commonmarkToLaTeX
  , commonmarkToNode
  , nodeToHtml
  , nodeToXml
  , nodeToMan
  , nodeToLaTeX
  , nodeToCommonmark
  , optSourcePos
  , optNormalize
  , optHardBreaks
  , optSmart
  , optSafe
  , optUnsafe
  , Node(..)
  , NodeType(..)
  , PosInfo(..)
  , DelimType(..)
  , ListType(..)
  , ListAttributes(..)
  , Url
  , Title
  , Level
  , Info
  , CMarkOption
  ) where

import Foreign
import Foreign.C.Types
import Foreign.C.String (CString)
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 ((<$>), (<*>))



-- | Convert CommonMark formatted text to Html, using cmark's
-- built-in renderer.
commonmarkToHtml :: [CMarkOption] -> Text -> Text
commonmarkToHtml :: [CMarkOption] -> Text -> Text
commonmarkToHtml [CMarkOption]
opts = Renderer -> [CMarkOption] -> Maybe Int -> Text -> Text
commonmarkToX Renderer
forall {p}. NodePtr -> CInt -> p -> IO CString
render_html [CMarkOption]
opts Maybe Int
forall a. Maybe a
Nothing
  where render_html :: NodePtr -> CInt -> p -> IO CString
render_html NodePtr
n CInt
o p
_ = NodePtr -> CInt -> IO CString
c_cmark_render_html NodePtr
n CInt
o

-- | Convert CommonMark formatted text to CommonMark XML, using cmark's
-- built-in renderer.
commonmarkToXml :: [CMarkOption] -> Text -> Text
commonmarkToXml :: [CMarkOption] -> Text -> Text
commonmarkToXml [CMarkOption]
opts = Renderer -> [CMarkOption] -> Maybe Int -> Text -> Text
commonmarkToX 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

-- | Convert CommonMark formatted text to groff man, using cmark's
-- built-in renderer.
commonmarkToMan :: [CMarkOption] -> Maybe Int -> Text -> Text
commonmarkToMan :: [CMarkOption] -> Maybe Int -> Text -> Text
commonmarkToMan = Renderer -> [CMarkOption] -> Maybe Int -> Text -> Text
commonmarkToX Renderer
c_cmark_render_man

-- | Convert CommonMark formatted text to latex, using cmark's
-- built-in renderer.
commonmarkToLaTeX :: [CMarkOption] -> Maybe Int -> Text -> Text
commonmarkToLaTeX :: [CMarkOption] -> Maybe Int -> Text -> Text
commonmarkToLaTeX = Renderer -> [CMarkOption] -> Maybe Int -> Text -> Text
commonmarkToX Renderer
c_cmark_render_latex

-- | Convert CommonMark formatted text to a structured 'Node' tree,
-- which can be transformed or rendered using Haskell code.
commonmarkToNode :: [CMarkOption] -> Text -> Node
commonmarkToNode :: [CMarkOption] -> Text -> Node
commonmarkToNode [CMarkOption]
opts 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
  NodePtr
nptr <- Text -> (CStringLen -> IO NodePtr) -> IO NodePtr
forall a. Text -> (CStringLen -> IO a) -> IO a
TF.withCStringLen Text
s ((CStringLen -> IO NodePtr) -> IO NodePtr)
-> (CStringLen -> IO NodePtr) -> IO NodePtr
forall a b. (a -> b) -> a -> b
$! \(CString
ptr, Int
len) ->
             CString -> Int -> CInt -> IO NodePtr
c_cmark_parse_document CString
ptr Int
len ([CMarkOption] -> CInt
combineOptions [CMarkOption]
opts)
  ForeignPtr ()
fptr <- FinalizerPtr () -> NodePtr -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
c_cmark_node_free NodePtr
nptr
  ForeignPtr () -> (NodePtr -> IO Node) -> IO Node
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr NodePtr -> IO Node
toNode

nodeToHtml :: [CMarkOption] -> Node -> Text
nodeToHtml :: [CMarkOption] -> Node -> Text
nodeToHtml [CMarkOption]
opts = 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 render_html :: NodePtr -> CInt -> p -> IO CString
render_html NodePtr
n CInt
o p
_ = NodePtr -> CInt -> IO CString
c_cmark_render_html NodePtr
n CInt
o

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 ()
fptr <- FinalizerPtr () -> NodePtr -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
c_cmark_node_free NodePtr
nptr
  ForeignPtr () -> (NodePtr -> IO Text) -> IO Text
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
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]
              -> Maybe Int
              -> Text
              -> Text
commonmarkToX :: Renderer -> [CMarkOption] -> Maybe Int -> Text -> Text
commonmarkToX Renderer
renderer [CMarkOption]
opts 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
    NodePtr
nptr <- CString -> Int -> CInt -> IO NodePtr
c_cmark_parse_document CString
ptr Int
len CInt
opts'
    ForeignPtr ()
fptr <- FinalizerPtr () -> NodePtr -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
c_cmark_node_free NodePtr
nptr
    ForeignPtr () -> (NodePtr -> IO Text) -> IO Text
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
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

type NodePtr = Ptr ()

data Node = Node (Maybe PosInfo) NodeType [Node]
     deriving (Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Node -> ShowS
showsPrec :: Int -> Node -> ShowS
$cshow :: Node -> String
show :: Node -> String
$cshowList :: [Node] -> ShowS
showList :: [Node] -> ShowS
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 -> ShowS
[DelimType] -> ShowS
DelimType -> String
(Int -> DelimType -> ShowS)
-> (DelimType -> String)
-> ([DelimType] -> ShowS)
-> Show DelimType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DelimType -> ShowS
showsPrec :: Int -> DelimType -> ShowS
$cshow :: DelimType -> String
show :: DelimType -> String
$cshowList :: [DelimType] -> ShowS
showList :: [DelimType] -> ShowS
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 -> ShowS
[ListType] -> ShowS
ListType -> String
(Int -> ListType -> ShowS)
-> (ListType -> String) -> ([ListType] -> ShowS) -> Show ListType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListType -> ShowS
showsPrec :: Int -> ListType -> ShowS
$cshow :: ListType -> String
show :: ListType -> String
$cshowList :: [ListType] -> ShowS
showList :: [ListType] -> ShowS
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 -> ShowS
[ListAttributes] -> ShowS
ListAttributes -> String
(Int -> ListAttributes -> ShowS)
-> (ListAttributes -> String)
-> ([ListAttributes] -> ShowS)
-> Show ListAttributes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListAttributes -> ShowS
showsPrec :: Int -> ListAttributes -> ShowS
$cshow :: ListAttributes -> String
show :: ListAttributes -> String
$cshowList :: [ListAttributes] -> ShowS
showList :: [ListAttributes] -> ShowS
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 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
  deriving (Int -> NodeType -> ShowS
[NodeType] -> ShowS
NodeType -> String
(Int -> NodeType -> ShowS)
-> (NodeType -> String) -> ([NodeType] -> ShowS) -> Show NodeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeType -> ShowS
showsPrec :: Int -> NodeType -> ShowS
$cshow :: NodeType -> String
show :: NodeType -> String
$cshowList :: [NodeType] -> ShowS
showList :: [NodeType] -> ShowS
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 -> ShowS
[PosInfo] -> ShowS
PosInfo -> String
(Int -> PosInfo -> ShowS)
-> (PosInfo -> String) -> ([PosInfo] -> ShowS) -> Show PosInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PosInfo -> ShowS
showsPrec :: Int -> PosInfo -> ShowS
$cshow :: PosInfo -> String
show :: PosInfo -> String
$cshowList :: [PosInfo] -> ShowS
showList :: [PosInfo] -> ShowS
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 }

-- | Combine a list of options into a single option, using bitwise or.
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

-- | Include a @data-sourcepos@ attribute on block elements.
optSourcePos :: CMarkOption
optSourcePos :: CMarkOption
optSourcePos = CInt -> CMarkOption
CMarkOption CInt
2
{-# LINE 195 "CMark.hsc" #-}

-- | Render @softbreak@ elements as hard line breaks.
optHardBreaks :: CMarkOption
optHardBreaks :: CMarkOption
optHardBreaks = CInt -> CMarkOption
CMarkOption CInt
4
{-# LINE 199 "CMark.hsc" #-}

-- | Normalize the document by consolidating adjacent text nodes.
optNormalize :: CMarkOption
optNormalize :: CMarkOption
optNormalize = CInt -> CMarkOption
CMarkOption CInt
256
{-# LINE 203 "CMark.hsc" #-}

-- | Convert straight quotes to curly, @---@ to em-dash, @--@ to en-dash.
optSmart :: CMarkOption
optSmart :: CMarkOption
optSmart = CInt -> CMarkOption
CMarkOption CInt
1024
{-# LINE 207 "CMark.hsc" #-}

-- | Suppress rendering of raw HTML and potentially dangerous URLs in links
-- and images.
optSafe :: CMarkOption
optSafe :: CMarkOption
optSafe = CInt -> CMarkOption
CMarkOption CInt
8
{-# LINE 212 "CMark.hsc" #-}

-- | Allow rendering of raw HTML and potentially dangerous URLs in links
-- and images.
optUnsafe :: CMarkOption
optUnsafe :: CMarkOption
optUnsafe = CInt -> CMarkOption
CMarkOption CInt
131072
{-# LINE 217 "CMark.hsc" #-}

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
1
{-# LINE 223 "CMark.hsc" #-}
         -> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
DOCUMENT
       Int
10
{-# LINE 225 "CMark.hsc" #-}
         -> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
THEMATIC_BREAK
       Int
8
{-# LINE 227 "CMark.hsc" #-}
         -> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
PARAGRAPH
       Int
2
{-# LINE 229 "CMark.hsc" #-}
         -> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
BLOCK_QUOTE
       Int
6
{-# LINE 231 "CMark.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
7
{-# LINE 233 "CMark.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
5
{-# LINE 235 "CMark.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
3
{-# LINE 238 "CMark.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
4
{-# LINE 240 "CMark.hsc" #-}
         -> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
ITEM
       Int
9
{-# LINE 242 "CMark.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
17
{-# LINE 244 "CMark.hsc" #-}
         -> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
EMPH
       Int
18
{-# LINE 246 "CMark.hsc" #-}
         -> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
STRONG
       Int
19
{-# LINE 248 "CMark.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
20
{-# LINE 250 "CMark.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
11
{-# LINE 252 "CMark.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
14
{-# LINE 254 "CMark.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
15
{-# LINE 256 "CMark.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
16
{-# LINE 258 "CMark.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
12
{-# LINE 260 "CMark.hsc" #-}
         -> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
SOFTBREAK
       Int
13
{-# LINE 262 "CMark.hsc" #-}
         -> NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
LINEBREAK
       Int
_ -> 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 -> ShowS
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 276 "CMark.hsc" #-}
                             (1)  -> BULLET_LIST
{-# LINE 277 "CMark.hsc" #-}
                             _                           -> BULLET_LIST
          , listDelim :: DelimType
listDelim  = case Int
listdelim of
                             (Int
1) -> DelimType
PERIOD_DELIM
{-# LINE 280 "CMark.hsc" #-}
                             (2)  -> PAREN_DELIM
{-# LINE 281 "CMark.hsc" #-}
                             _                           -> 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

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
1)
{-# LINE 320 "CMark.hsc" #-}
            NodeType
THEMATIC_BREAK -> Int -> IO NodePtr
c_cmark_node_new (Int
10)
{-# LINE 321 "CMark.hsc" #-}
            NodeType
PARAGRAPH   -> Int -> IO NodePtr
c_cmark_node_new (Int
8)
{-# LINE 322 "CMark.hsc" #-}
            NodeType
BLOCK_QUOTE -> Int -> IO NodePtr
c_cmark_node_new (Int
2)
{-# LINE 323 "CMark.hsc" #-}
            HTML_BLOCK Text
literal -> do
                     NodePtr
n <- Int -> IO NodePtr
c_cmark_node_new (Int
6)
{-# LINE 325 "CMark.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
7)
{-# LINE 329 "CMark.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
5)
{-# LINE 334 "CMark.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
3)
{-# LINE 339 "CMark.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 341 "CMark.hsc" #-}
                         ListType
BULLET_LIST  -> Int
1
{-# LINE 342 "CMark.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 344 "CMark.hsc" #-}
                         DelimType
PAREN_DELIM  -> Int
2
{-# LINE 345 "CMark.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
4)
{-# LINE 349 "CMark.hsc" #-}
            HEADING Int
lev  -> do
                     NodePtr
n <- Int -> IO NodePtr
c_cmark_node_new (Int
9)
{-# LINE 351 "CMark.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
17)
{-# LINE 354 "CMark.hsc" #-}
            NodeType
STRONG      -> Int -> IO NodePtr
c_cmark_node_new (Int
18)
{-# LINE 355 "CMark.hsc" #-}
            LINK Text
url Text
title -> do
                     NodePtr
n <- Int -> IO NodePtr
c_cmark_node_new (Int
19)
{-# LINE 357 "CMark.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
20)
{-# LINE 362 "CMark.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
11)
{-# LINE 367 "CMark.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
14)
{-# LINE 371 "CMark.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
15)
{-# LINE 375 "CMark.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
16)
{-# LINE 379 "CMark.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
12)
{-# LINE 383 "CMark.hsc" #-}
            NodeType
LINEBREAK   -> Int -> IO NodePtr
c_cmark_node_new (Int
13)
{-# LINE 384 "CMark.hsc" #-}
  mapM_ (\child -> fromNode child >>= c_cmark_node_append_child 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.h cmark_node_new"
    c_cmark_node_new :: Int -> IO NodePtr

foreign import ccall "cmark.h cmark_render_html"
    c_cmark_render_html :: NodePtr -> CInt -> IO CString

foreign import ccall "cmark.h cmark_render_xml"
    c_cmark_render_xml :: NodePtr -> CInt -> IO CString

foreign import ccall "cmark.h cmark_render_man"
    c_cmark_render_man :: NodePtr -> CInt -> Int -> IO CString

foreign import ccall "cmark.h cmark_render_latex"
    c_cmark_render_latex :: NodePtr -> CInt -> Int -> IO CString

foreign import ccall "cmark.h cmark_render_commonmark"
    c_cmark_render_commonmark :: NodePtr -> CInt -> Int -> IO CString

foreign import ccall "cmark.h cmark_parse_document"
    c_cmark_parse_document :: CString -> Int -> CInt -> IO NodePtr

foreign import ccall "cmark.h cmark_node_get_type"
    c_cmark_node_get_type :: NodePtr -> IO Int

foreign import ccall "cmark.h cmark_node_first_child"
    c_cmark_node_first_child :: NodePtr -> IO NodePtr

foreign import ccall "cmark.h cmark_node_next"
    c_cmark_node_next :: NodePtr -> IO NodePtr

foreign import ccall "cmark.h cmark_node_get_literal"
    c_cmark_node_get_literal :: NodePtr -> IO CString

foreign import ccall "cmark.h cmark_node_get_url"
    c_cmark_node_get_url :: NodePtr -> IO CString

foreign import ccall "cmark.h cmark_node_get_title"
    c_cmark_node_get_title :: NodePtr -> IO CString

foreign import ccall "cmark.h cmark_node_get_heading_level"
    c_cmark_node_get_heading_level :: NodePtr -> IO Int

foreign import ccall "cmark.h cmark_node_get_list_type"
    c_cmark_node_get_list_type :: NodePtr -> IO Int

foreign import ccall "cmark.h cmark_node_get_list_tight"
    c_cmark_node_get_list_tight :: NodePtr -> IO Bool

foreign import ccall "cmark.h cmark_node_get_list_start"
    c_cmark_node_get_list_start :: NodePtr -> IO Int

foreign import ccall "cmark.h cmark_node_get_list_delim"
    c_cmark_node_get_list_delim :: NodePtr -> IO Int

foreign import ccall "cmark.h cmark_node_get_fence_info"
    c_cmark_node_get_fence_info :: NodePtr -> IO CString

foreign import ccall "cmark.h cmark_node_get_start_line"
    c_cmark_node_get_start_line :: NodePtr -> IO Int

foreign import ccall "cmark.h cmark_node_get_start_column"
    c_cmark_node_get_start_column :: NodePtr -> IO Int

foreign import ccall "cmark.h cmark_node_get_end_line"
    c_cmark_node_get_end_line :: NodePtr -> IO Int

foreign import ccall "cmark.h cmark_node_get_end_column"
    c_cmark_node_get_end_column :: NodePtr -> IO Int

foreign import ccall "cmark.h cmark_node_get_on_enter"
    c_cmark_node_get_on_enter :: NodePtr -> IO CString

foreign import ccall "cmark.h cmark_node_get_on_exit"
    c_cmark_node_get_on_exit :: NodePtr -> IO CString

foreign import ccall "cmark.h cmark_node_append_child"
    c_cmark_node_append_child :: NodePtr -> NodePtr -> IO Int

foreign import ccall "cmark.h cmark_node_set_literal"
    c_cmark_node_set_literal :: NodePtr -> CString -> IO Int

foreign import ccall "cmark.h cmark_node_set_url"
    c_cmark_node_set_url :: NodePtr -> CString -> IO Int

foreign import ccall "cmark.h cmark_node_set_title"
    c_cmark_node_set_title :: NodePtr -> CString -> IO Int

foreign import ccall "cmark.h cmark_node_set_heading_level"
    c_cmark_node_set_heading_level :: NodePtr -> Int -> IO Int

foreign import ccall "cmark.h cmark_node_set_list_type"
    c_cmark_node_set_list_type :: NodePtr -> Int -> IO Int

foreign import ccall "cmark.h cmark_node_set_list_tight"
    c_cmark_node_set_list_tight :: NodePtr -> Bool -> IO Int

foreign import ccall "cmark.h cmark_node_set_list_start"
    c_cmark_node_set_list_start :: NodePtr -> Int -> IO Int

foreign import ccall "cmark.h cmark_node_set_list_delim"
    c_cmark_node_set_list_delim :: NodePtr -> Int -> IO Int

foreign import ccall "cmark.h cmark_node_set_fence_info"
    c_cmark_node_set_fence_info :: NodePtr -> CString -> IO Int

foreign import ccall "cmark.h cmark_node_set_on_enter"
    c_cmark_node_set_on_enter :: NodePtr -> CString -> IO Int

foreign import ccall "cmark.h cmark_node_set_on_exit"
    c_cmark_node_set_on_exit :: NodePtr -> CString -> IO Int

foreign import ccall "cmark.h &cmark_node_free"
    c_cmark_node_free :: FunPtr (NodePtr -> IO ())