module CMark (
commonmarkToHtml
, commonmarkToXml
, commonmarkToMan
, commonmarkToNode
, optSourcePos
, optNormalize
, optHardBreaks
, optSmart
, Node(..)
, NodeType(..)
, PosInfo(..)
, DelimType(..)
, ListType(..)
, Tightness
, 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.Generics (Data, Typeable)
import Data.Text (Text, empty)
import qualified Data.Text.Foreign as TF
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)
type Url = Text
type Title = Text
type Level = Int
type Info = Text
data Tightness = TIGHT | LOOSE
deriving (Show, Read, Eq, Ord, Typeable, Data, Generic)
data NodeType =
DOCUMENT
| HRULE
| PARAGRAPH
| BLOCK_QUOTE
| HTML Text
| CODE_BLOCK Info Text
| HEADER Level
| LIST ListType DelimType Tightness
| 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 -> NodeType
ptrToNodeType ptr =
case (c_cmark_node_get_type ptr) of
1
-> DOCUMENT
9
-> HRULE
7
-> PARAGRAPH
2
-> BLOCK_QUOTE
6
-> HTML literal
5
-> CODE_BLOCK info literal
3
-> LIST listType listDelim tightness
4
-> ITEM
8
-> HEADER level
15
-> EMPH
16
-> STRONG
17
-> LINK url title
18
-> IMAGE url title
10
-> TEXT literal
13
-> CODE literal
14
-> INLINE_HTML literal
11
-> SOFTBREAK
12
-> LINEBREAK
_ -> error "Unknown node type"
where literal = peekCString $ c_cmark_node_get_literal ptr
level = c_cmark_node_get_header_level ptr
listType = case c_cmark_node_get_list_type ptr of
(2) -> ORDERED_LIST
(1) -> BULLET_LIST
_ -> BULLET_LIST
listDelim = case c_cmark_node_get_list_delim ptr of
(1) -> PERIOD_DELIM
(2) -> PAREN_DELIM
_ -> PERIOD_DELIM
tightness = case c_cmark_node_get_list_tight ptr of
1 -> TIGHT
_ -> LOOSE
url = peekCString $ c_cmark_node_get_url ptr
title = peekCString $ c_cmark_node_get_title ptr
info = peekCString $ c_cmark_node_get_fence_info ptr
getPosInfo :: NodePtr -> Maybe PosInfo
getPosInfo ptr =
case (c_cmark_node_get_start_line ptr,
c_cmark_node_get_start_column ptr,
c_cmark_node_get_end_line ptr,
c_cmark_node_get_end_column ptr) of
(0, 0, 0, 0) -> Nothing
(sl, sc, el, ec) -> Just PosInfo{ startLine = sl
, startColumn = sc
, endLine = el
, endColumn = ec }
handleNode :: (Maybe PosInfo -> NodeType -> [a] -> a) -> NodePtr -> a
handleNode f ptr = f posinfo (ptrToNodeType ptr) children
where children = handleNodes f $ c_cmark_node_first_child ptr
posinfo = getPosInfo ptr
handleNodes f' ptr' =
if ptr' == nullPtr
then []
else handleNode f' ptr' : handleNodes f' (c_cmark_node_next ptr')
toNode :: NodePtr -> Node
toNode = handleNode Node
foreign import ccall "string.h strlen"
c_strlen :: CString -> Int
foreign import ccall "cmark.h cmark_markdown_to_html"
c_cmark_markdown_to_html :: CString -> Int -> CInt -> CString
foreign import ccall "cmark.h cmark_render_xml"
c_cmark_render_xml :: NodePtr -> CInt -> CString
foreign import ccall "cmark.h cmark_render_man"
c_cmark_render_man :: NodePtr -> CInt -> CString
foreign import ccall "cmark.h cmark_parse_document"
c_cmark_parse_document :: CString -> Int -> CInt -> NodePtr
foreign import ccall "cmark.h cmark_node_get_type"
c_cmark_node_get_type :: NodePtr -> Int
foreign import ccall "cmark.h cmark_node_first_child"
c_cmark_node_first_child :: NodePtr -> NodePtr
foreign import ccall "cmark.h cmark_node_next"
c_cmark_node_next :: NodePtr -> NodePtr
foreign import ccall "cmark.h cmark_node_get_literal"
c_cmark_node_get_literal :: NodePtr -> CString
foreign import ccall "cmark.h cmark_node_get_url"
c_cmark_node_get_url :: NodePtr -> CString
foreign import ccall "cmark.h cmark_node_get_title"
c_cmark_node_get_title :: NodePtr -> CString
foreign import ccall "cmark.h cmark_node_get_header_level"
c_cmark_node_get_header_level :: NodePtr -> Int
foreign import ccall "cmark.h cmark_node_get_list_type"
c_cmark_node_get_list_type :: NodePtr -> Int
foreign import ccall "cmark.h cmark_node_get_list_tight"
c_cmark_node_get_list_tight :: NodePtr -> Int
foreign import ccall "cmark.h cmark_node_get_list_delim"
c_cmark_node_get_list_delim :: NodePtr -> Int
foreign import ccall "cmark.h cmark_node_get_fence_info"
c_cmark_node_get_fence_info :: NodePtr -> CString
foreign import ccall "cmark.h cmark_node_get_start_line"
c_cmark_node_get_start_line :: NodePtr -> Int
foreign import ccall "cmark.h cmark_node_get_start_column"
c_cmark_node_get_start_column :: NodePtr -> Int
foreign import ccall "cmark.h cmark_node_get_end_line"
c_cmark_node_get_end_line :: NodePtr -> Int
foreign import ccall "cmark.h cmark_node_get_end_column"
c_cmark_node_get_end_column :: NodePtr -> Int
commonmarkToHtml :: [CMarkOption] -> Text -> Text
commonmarkToHtml opts s = io $
TF.withCStringLen s $ \(ptr, len) ->
return (peekCString $ c_cmark_markdown_to_html ptr len (combineOptions opts))
commonmarkToXml :: [CMarkOption] -> Text -> Text
commonmarkToXml opts s = io $
TF.withCStringLen s $ \(ptr, len) -> do
let opts' = combineOptions opts
let doc = c_cmark_parse_document ptr len opts'
return (peekCString $ c_cmark_render_xml doc opts')
commonmarkToMan :: [CMarkOption] -> Text -> Text
commonmarkToMan opts s = io $
TF.withCStringLen s $ \(ptr, len) -> do
let opts' = combineOptions opts
let doc = c_cmark_parse_document ptr len opts'
return (peekCString $ c_cmark_render_man doc opts')
commonmarkToNode :: [CMarkOption] -> Text -> Node
commonmarkToNode opts s = io $
TF.withCStringLen s $ \(ptr, len) ->
return $ toNode $ c_cmark_parse_document ptr len (combineOptions opts)
io :: IO a -> a
io = Unsafe.unsafePerformIO
peekCString :: CString -> Text
peekCString str
| str == nullPtr = empty
| otherwise = io $ TF.peekCStringLen (str, c_strlen str)