module CMark (
Node(..)
, NodeType(..)
, PosInfo(..)
, DelimType(..)
, ListType(..)
, Tightness
, Url
, Title
, Level
, Info
, CMarkOption
, markdownToHtml
, parseDocument
, optSourcePos
, optNormalize
, optHardBreaks
, optSmart
) 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.Bits ( (.|.) )
import Data.Text (Text, pack, 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 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 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
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
delimType = case c_cmark_node_get_list_delim ptr of
(1) -> PERIOD_DELIM
(2) -> PAREN_DELIM
_ -> PERIOD_DELIM
tightness = case c_cmark_node_get_list_type 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_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
markdownToHtml :: [CMarkOption] -> Text -> Text
markdownToHtml opts s = io $
TF.withCStringLen s $ \(ptr, len) ->
return (peekCString $ c_cmark_markdown_to_html ptr len (combineOptions opts))
parseDocument :: [CMarkOption] -> Text -> Node
parseDocument 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)