module CMark (
commonmarkToHtml
, commonmarkToXml
, commonmarkToMan
, commonmarkToNode
, nodeToCommonmark
, optSourcePos
, optNormalize
, optHardBreaks
, optSmart
, 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 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 = commonmarkToX c_cmark_render_html
commonmarkToXml :: [CMarkOption] -> Text -> Text
commonmarkToXml = commonmarkToX c_cmark_render_xml
commonmarkToMan :: [CMarkOption] -> Text -> Text
commonmarkToMan = commonmarkToX c_cmark_render_man
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
nodeToCommonmark :: [CMarkOption] -> Int -> Node -> Text
nodeToCommonmark opts width node = Unsafe.unsafePerformIO $ do
nptr <- fromNode node
fptr <- newForeignPtr c_cmark_node_free nptr
withForeignPtr fptr $ \ptr -> do
cstr <- c_cmark_render_commonmark ptr (combineOptions opts) width
TF.peekCStringLen (cstr, c_strlen cstr)
commonmarkToX :: (NodePtr -> CInt -> IO CString)
-> [CMarkOption]
-> Text
-> Text
commonmarkToX renderer opts 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'
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
data NodeType =
DOCUMENT
| HRULE
| PARAGRAPH
| BLOCK_QUOTE
| HTML Text
| CODE_BLOCK Info Text
| HEADER Level
| LIST ListAttributes
| ITEM
| TEXT Text
| SOFTBREAK
| LINEBREAK
| INLINE_HTML Text
| 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 1
optHardBreaks :: CMarkOption
optHardBreaks = CMarkOption 2
optNormalize :: CMarkOption
optNormalize = CMarkOption 4
optSmart :: CMarkOption
optSmart = CMarkOption 8
ptrToNodeType :: NodePtr -> IO NodeType
ptrToNodeType ptr = do
nodeType <- c_cmark_node_get_type ptr
case nodeType of
1
-> return DOCUMENT
9
-> return HRULE
7
-> return PARAGRAPH
2
-> return BLOCK_QUOTE
6
-> HTML <$> literal
5
-> CODE_BLOCK <$> info
<*> literal
3
-> LIST <$> listAttr
4
-> return ITEM
8
-> HEADER <$> level
15
-> return EMPH
16
-> return STRONG
17
-> LINK <$> url <*> title
18
-> IMAGE <$> url <*> title
10
-> TEXT <$> literal
13
-> CODE <$> literal
14
-> INLINE_HTML <$> literal
11
-> return SOFTBREAK
12
-> return LINEBREAK
_ -> error "Unknown node type"
where literal = c_cmark_node_get_literal ptr >>= totext
level = c_cmark_node_get_header_level ptr
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
(1) -> BULLET_LIST
_ -> BULLET_LIST
, listDelim = case listdelim of
(1) -> PERIOD_DELIM
(2) -> PAREN_DELIM
_ -> 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)
HRULE -> c_cmark_node_new (9)
PARAGRAPH -> c_cmark_node_new (7)
BLOCK_QUOTE -> c_cmark_node_new (2)
HTML literal -> do
n <- c_cmark_node_new (6)
c_cmark_node_set_literal n =<< fromtext literal
return n
CODE_BLOCK info literal -> do
n <- c_cmark_node_new (5)
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)
c_cmark_node_set_list_type n $ case listType attr of
ORDERED_LIST -> 2
BULLET_LIST -> 1
c_cmark_node_set_list_delim n $ case listDelim attr of
PERIOD_DELIM -> 1
PAREN_DELIM -> 2
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)
HEADER lev -> do
n <- c_cmark_node_new (8)
c_cmark_node_set_header_level n lev
return n
EMPH -> c_cmark_node_new (15)
STRONG -> c_cmark_node_new (16)
LINK url title -> do
n <- c_cmark_node_new (17)
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 (18)
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 (10)
c_cmark_node_set_literal n =<< fromtext literal
return n
CODE literal -> do
n <- c_cmark_node_new (13)
c_cmark_node_set_literal n =<< fromtext literal
return n
INLINE_HTML literal -> do
n <- c_cmark_node_new (14)
c_cmark_node_set_literal n =<< fromtext literal
return n
SOFTBREAK -> c_cmark_node_new (11)
LINEBREAK -> c_cmark_node_new (12)
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 -> 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_header_level"
c_cmark_node_get_header_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_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_header_level"
c_cmark_node_set_header_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_free"
c_cmark_node_free :: FunPtr (NodePtr -> IO ())