{-# 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
, 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)
import qualified Data.Text.Foreign as TF
import qualified Data.ByteString as B
import Data.Text.Encoding (encodeUtf8)
import Control.Applicative ((<$>), (<*>))
commonmarkToHtml :: [CMarkOption] -> Text -> Text
commonmarkToHtml opts = commonmarkToX render_html opts Nothing
where render_html n o _ = c_cmark_render_html n o
commonmarkToXml :: [CMarkOption] -> Text -> Text
commonmarkToXml opts = commonmarkToX render_xml opts Nothing
where render_xml n o _ = c_cmark_render_xml n o
commonmarkToMan :: [CMarkOption] -> Maybe Int -> Text -> Text
commonmarkToMan = commonmarkToX c_cmark_render_man
commonmarkToLaTeX :: [CMarkOption] -> Maybe Int -> Text -> Text
commonmarkToLaTeX = commonmarkToX c_cmark_render_latex
commonmarkToNode :: [CMarkOption] -> Text -> Node
commonmarkToNode opts s = Unsafe.unsafePerformIO $ do
nptr <- TF.withCStringLen s $! \(ptr, len) ->
c_cmark_parse_document ptr len (combineOptions opts)
fptr <- newForeignPtr c_cmark_node_free nptr
withForeignPtr fptr toNode
nodeToHtml :: [CMarkOption] -> Node -> Text
nodeToHtml opts = nodeToX render_html opts Nothing
where render_html n o _ = c_cmark_render_html n o
nodeToXml :: [CMarkOption] -> Node -> Text
nodeToXml opts = nodeToX render_xml opts Nothing
where render_xml n o _ = c_cmark_render_xml n o
nodeToMan :: [CMarkOption] -> Maybe Int -> Node -> Text
nodeToMan = nodeToX c_cmark_render_man
nodeToLaTeX :: [CMarkOption] -> Maybe Int -> Node -> Text
nodeToLaTeX = nodeToX c_cmark_render_latex
nodeToCommonmark :: [CMarkOption] -> Maybe Int -> Node -> Text
nodeToCommonmark = nodeToX c_cmark_render_commonmark
type Renderer = NodePtr -> CInt -> Int -> IO CString
nodeToX :: Renderer -> [CMarkOption] -> Maybe Int -> Node -> Text
nodeToX renderer opts mbWidth node = Unsafe.unsafePerformIO $ do
nptr <- fromNode node
fptr <- newForeignPtr c_cmark_node_free nptr
withForeignPtr fptr $ \ptr -> do
cstr <- renderer ptr (combineOptions opts) (fromMaybe 0 mbWidth)
TF.peekCStringLen (cstr, c_strlen cstr)
commonmarkToX :: Renderer
-> [CMarkOption]
-> Maybe Int
-> Text
-> Text
commonmarkToX renderer opts mbWidth s = Unsafe.unsafePerformIO $
TF.withCStringLen s $ \(ptr, len) -> do
let opts' = combineOptions opts
nptr <- c_cmark_parse_document ptr len opts'
fptr <- newForeignPtr c_cmark_node_free nptr
withForeignPtr fptr $ \p -> do
str <- renderer p opts' (fromMaybe 0 mbWidth)
t <- TF.peekCStringLen $! (str, c_strlen str)
return t
type NodePtr = Ptr ()
data Node = Node (Maybe PosInfo) NodeType [Node]
deriving (Show, Read, Eq, Ord, Typeable, Data, Generic)
data DelimType =
PERIOD_DELIM
| PAREN_DELIM
deriving (Show, Read, Eq, Ord, Typeable, Data, Generic)
data ListType =
BULLET_LIST
| ORDERED_LIST
deriving (Show, Read, Eq, Ord, Typeable, Data, Generic)
data ListAttributes = ListAttributes{
listType :: ListType
, listTight :: Bool
, listStart :: Int
, listDelim :: DelimType
} deriving (Show, Read, Eq, Ord, Typeable, Data, 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 (Show, Read, Eq, Ord, Typeable, Data, Generic)
data PosInfo = PosInfo{ startLine :: Int
, startColumn :: Int
, endLine :: Int
, endColumn :: Int
}
deriving (Show, Read, Eq, Ord, Typeable, Data, Generic)
newtype CMarkOption = CMarkOption { unCMarkOption :: CInt }
combineOptions :: [CMarkOption] -> CInt
combineOptions = foldr ((.|.) . unCMarkOption) 0
optSourcePos :: CMarkOption
optSourcePos = CMarkOption 2
{-# LINE 195 "CMark.hsc" #-}
optHardBreaks :: CMarkOption
optHardBreaks = CMarkOption 4
{-# LINE 199 "CMark.hsc" #-}
optNormalize :: CMarkOption
optNormalize = CMarkOption 256
{-# LINE 203 "CMark.hsc" #-}
optSmart :: CMarkOption
optSmart = CMarkOption 1024
{-# LINE 207 "CMark.hsc" #-}
optSafe :: CMarkOption
optSafe = CMarkOption 8
{-# LINE 212 "CMark.hsc" #-}
ptrToNodeType :: NodePtr -> IO NodeType
ptrToNodeType ptr = do
nodeType <- c_cmark_node_get_type ptr
case nodeType of
1
{-# LINE 218 "CMark.hsc" #-}
-> return DOCUMENT
10
{-# LINE 220 "CMark.hsc" #-}
-> return THEMATIC_BREAK
8
{-# LINE 222 "CMark.hsc" #-}
-> return PARAGRAPH
2
{-# LINE 224 "CMark.hsc" #-}
-> return BLOCK_QUOTE
6
{-# LINE 226 "CMark.hsc" #-}
-> HTML_BLOCK <$> literal
7
{-# LINE 228 "CMark.hsc" #-}
-> CUSTOM_BLOCK <$> onEnter <*> onExit
5
{-# LINE 230 "CMark.hsc" #-}
-> CODE_BLOCK <$> info
<*> literal
3
{-# LINE 233 "CMark.hsc" #-}
-> LIST <$> listAttr
4
{-# LINE 235 "CMark.hsc" #-}
-> return ITEM
9
{-# LINE 237 "CMark.hsc" #-}
-> HEADING <$> level
17
{-# LINE 239 "CMark.hsc" #-}
-> return EMPH
18
{-# LINE 241 "CMark.hsc" #-}
-> return STRONG
19
{-# LINE 243 "CMark.hsc" #-}
-> LINK <$> url <*> title
20
{-# LINE 245 "CMark.hsc" #-}
-> IMAGE <$> url <*> title
11
{-# LINE 247 "CMark.hsc" #-}
-> TEXT <$> literal
14
{-# LINE 249 "CMark.hsc" #-}
-> CODE <$> literal
15
{-# LINE 251 "CMark.hsc" #-}
-> HTML_INLINE <$> literal
16
{-# LINE 253 "CMark.hsc" #-}
-> CUSTOM_INLINE <$> onEnter <*> onExit
12
{-# LINE 255 "CMark.hsc" #-}
-> return SOFTBREAK
13
{-# LINE 257 "CMark.hsc" #-}
-> return LINEBREAK
_ -> error "Unknown node type"
where literal = c_cmark_node_get_literal ptr >>= totext
level = c_cmark_node_get_heading_level ptr
onEnter = c_cmark_node_get_on_enter ptr >>= totext
onExit = c_cmark_node_get_on_exit ptr >>= totext
listAttr = do
listtype <- c_cmark_node_get_list_type ptr
listdelim <- c_cmark_node_get_list_delim ptr
tight <- c_cmark_node_get_list_tight ptr
start <- c_cmark_node_get_list_start ptr
return ListAttributes{
listType = case listtype of
(2) -> ORDERED_LIST
{-# LINE 271 "CMark.hsc" #-}
(1) -> BULLET_LIST
{-# LINE 272 "CMark.hsc" #-}
_ -> BULLET_LIST
, listDelim = case listdelim of
(1) -> PERIOD_DELIM
{-# LINE 275 "CMark.hsc" #-}
(2) -> PAREN_DELIM
{-# LINE 276 "CMark.hsc" #-}
_ -> PERIOD_DELIM
, listTight = tight
, listStart = start
}
url = c_cmark_node_get_url ptr >>= totext
title = c_cmark_node_get_title ptr >>= totext
info = c_cmark_node_get_fence_info ptr >>= totext
getPosInfo :: NodePtr -> IO (Maybe PosInfo)
getPosInfo ptr = do
startline <- c_cmark_node_get_start_line ptr
endline <- c_cmark_node_get_end_line ptr
startcol <- c_cmark_node_get_start_column ptr
endcol <- c_cmark_node_get_end_column ptr
if startline + endline + startcol + endcol == 0
then return Nothing
else return $ Just PosInfo{ startLine = startline
, startColumn = startcol
, endLine = endline
, endColumn = endcol }
toNode :: NodePtr -> IO Node
toNode ptr = do
let handleNodes ptr' =
if ptr' == nullPtr
then return []
else do
x <- toNode ptr'
xs <- c_cmark_node_next ptr' >>= handleNodes
return $! (x:xs)
nodeType <- ptrToNodeType ptr
children <- c_cmark_node_first_child ptr >>= handleNodes
posinfo <- getPosInfo ptr
return $! Node posinfo nodeType children
fromNode :: Node -> IO NodePtr
fromNode (Node _ nodeType children) = do
node <- case nodeType of
DOCUMENT -> c_cmark_node_new (1)
{-# LINE 315 "CMark.hsc" #-}
THEMATIC_BREAK -> c_cmark_node_new (10)
{-# LINE 316 "CMark.hsc" #-}
PARAGRAPH -> c_cmark_node_new (8)
{-# LINE 317 "CMark.hsc" #-}
BLOCK_QUOTE -> c_cmark_node_new (2)
{-# LINE 318 "CMark.hsc" #-}
HTML_BLOCK literal -> do
n <- c_cmark_node_new (6)
{-# LINE 320 "CMark.hsc" #-}
c_cmark_node_set_literal n =<< fromtext literal
return n
CUSTOM_BLOCK onEnter onExit -> do
n <- c_cmark_node_new (7)
{-# LINE 324 "CMark.hsc" #-}
c_cmark_node_set_on_enter n =<< fromtext onEnter
c_cmark_node_set_on_exit n =<< fromtext onExit
return n
CODE_BLOCK info literal -> do
n <- c_cmark_node_new (5)
{-# LINE 329 "CMark.hsc" #-}
c_cmark_node_set_literal n =<< fromtext literal
c_cmark_node_set_fence_info n =<< fromtext info
return n
LIST attr -> do
n <- c_cmark_node_new (3)
{-# LINE 334 "CMark.hsc" #-}
c_cmark_node_set_list_type n $ case listType attr of
ORDERED_LIST -> 2
{-# LINE 336 "CMark.hsc" #-}
BULLET_LIST -> 1
{-# LINE 337 "CMark.hsc" #-}
c_cmark_node_set_list_delim n $ case listDelim attr of
PERIOD_DELIM -> 1
{-# LINE 339 "CMark.hsc" #-}
PAREN_DELIM -> 2
{-# LINE 340 "CMark.hsc" #-}
c_cmark_node_set_list_tight n $ listTight attr
c_cmark_node_set_list_start n $ listStart attr
return n
ITEM -> c_cmark_node_new (4)
{-# LINE 344 "CMark.hsc" #-}
HEADING lev -> do
n <- c_cmark_node_new (9)
{-# LINE 346 "CMark.hsc" #-}
c_cmark_node_set_heading_level n lev
return n
EMPH -> c_cmark_node_new (17)
{-# LINE 349 "CMark.hsc" #-}
STRONG -> c_cmark_node_new (18)
{-# LINE 350 "CMark.hsc" #-}
LINK url title -> do
n <- c_cmark_node_new (19)
{-# LINE 352 "CMark.hsc" #-}
c_cmark_node_set_url n =<< fromtext url
c_cmark_node_set_title n =<< fromtext title
return n
IMAGE url title -> do
n <- c_cmark_node_new (20)
{-# LINE 357 "CMark.hsc" #-}
c_cmark_node_set_url n =<< fromtext url
c_cmark_node_set_title n =<< fromtext title
return n
TEXT literal -> do
n <- c_cmark_node_new (11)
{-# LINE 362 "CMark.hsc" #-}
c_cmark_node_set_literal n =<< fromtext literal
return n
CODE literal -> do
n <- c_cmark_node_new (14)
{-# LINE 366 "CMark.hsc" #-}
c_cmark_node_set_literal n =<< fromtext literal
return n
HTML_INLINE literal -> do
n <- c_cmark_node_new (15)
{-# LINE 370 "CMark.hsc" #-}
c_cmark_node_set_literal n =<< fromtext literal
return n
CUSTOM_INLINE onEnter onExit -> do
n <- c_cmark_node_new (16)
{-# LINE 374 "CMark.hsc" #-}
c_cmark_node_set_on_enter n =<< fromtext onEnter
c_cmark_node_set_on_exit n =<< fromtext onExit
return n
SOFTBREAK -> c_cmark_node_new (12)
{-# LINE 378 "CMark.hsc" #-}
LINEBREAK -> c_cmark_node_new (13)
{-# LINE 379 "CMark.hsc" #-}
mapM_ (\child -> fromNode child >>= c_cmark_node_append_child node) children
return node
totext :: CString -> IO Text
totext str
| str == nullPtr = return empty
| otherwise = TF.peekCStringLen (str, c_strlen str)
fromtext :: Text -> IO CString
fromtext t = B.useAsCString (encodeUtf8 t) return
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 ())