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

module CMark (
    commonmarkToHtml
  , commonmarkToXml
  , commonmarkToMan
  , commonmarkToNode
  , 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


{-# LINE 37 "CMark.hsc" #-}

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 }

-- | Combine a list of options into a single option, using bitwise or.
combineOptions :: [CMarkOption] -> CInt
combineOptions = foldr ((.|.) . unCMarkOption) 0

-- Include a @data-sourcepos@ attribute on block elements.
optSourcePos :: CMarkOption
optSourcePos = CMarkOption 1
{-# LINE 105 "CMark.hsc" #-}

-- Render @softbreak@ elements as hard line breaks.
optHardBreaks :: CMarkOption
optHardBreaks = CMarkOption 2
{-# LINE 109 "CMark.hsc" #-}

-- Normalize the document by consolidating adjacent text nodes.
optNormalize :: CMarkOption
optNormalize = CMarkOption 4
{-# LINE 113 "CMark.hsc" #-}

-- Convert straight quotes to curly, @---@ to em-dash, @--@ to en-dash.
optSmart :: CMarkOption
optSmart = CMarkOption 8
{-# LINE 117 "CMark.hsc" #-}

ptrToNodeType :: NodePtr -> NodeType
ptrToNodeType ptr =
  case (c_cmark_node_get_type ptr) of
             1
{-# LINE 122 "CMark.hsc" #-}
               -> DOCUMENT
             9
{-# LINE 124 "CMark.hsc" #-}
               -> HRULE
             7
{-# LINE 126 "CMark.hsc" #-}
               -> PARAGRAPH
             2
{-# LINE 128 "CMark.hsc" #-}
               -> BLOCK_QUOTE
             6
{-# LINE 130 "CMark.hsc" #-}
               -> HTML literal
             5
{-# LINE 132 "CMark.hsc" #-}
               -> CODE_BLOCK info literal
             3
{-# LINE 134 "CMark.hsc" #-}
               -> LIST listAttr
             4
{-# LINE 136 "CMark.hsc" #-}
               -> ITEM
             8
{-# LINE 138 "CMark.hsc" #-}
               -> HEADER level
             15
{-# LINE 140 "CMark.hsc" #-}
               -> EMPH
             16
{-# LINE 142 "CMark.hsc" #-}
               -> STRONG
             17
{-# LINE 144 "CMark.hsc" #-}
               -> LINK url title
             18
{-# LINE 146 "CMark.hsc" #-}
               -> IMAGE url title
             10
{-# LINE 148 "CMark.hsc" #-}
               -> TEXT literal
             13
{-# LINE 150 "CMark.hsc" #-}
               -> CODE literal
             14
{-# LINE 152 "CMark.hsc" #-}
               -> INLINE_HTML literal
             11
{-# LINE 154 "CMark.hsc" #-}
               -> SOFTBREAK
             12
{-# LINE 156 "CMark.hsc" #-}
               -> LINEBREAK
             _ -> error "Unknown node type"
  where literal   = peekCString $ c_cmark_node_get_literal ptr
        level     = c_cmark_node_get_header_level ptr
        listAttr  = ListAttributes{
            listType  = case c_cmark_node_get_list_type ptr of
                             (2) -> ORDERED_LIST
{-# LINE 163 "CMark.hsc" #-}
                             (1)  -> BULLET_LIST
{-# LINE 164 "CMark.hsc" #-}
                             _                           -> BULLET_LIST
          , listDelim  = case c_cmark_node_get_list_delim ptr of
                             (1) -> PERIOD_DELIM
{-# LINE 167 "CMark.hsc" #-}
                             (2)  -> PAREN_DELIM
{-# LINE 168 "CMark.hsc" #-}
                             _                           -> PERIOD_DELIM
          , listTight  = c_cmark_node_get_list_tight ptr == 1
          , listStart  = c_cmark_node_get_list_start ptr
          }
        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_start"
    c_cmark_node_get_list_start :: 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

-- | Convert CommonMark formatted text to Html, using cmark's
-- built-in renderer.
commonmarkToHtml :: [CMarkOption] -> Text -> Text
commonmarkToHtml opts s = io $
  TF.withCStringLen s $ \(ptr, len) ->
    return (peekCString $ c_cmark_markdown_to_html ptr len (combineOptions opts))

-- | Convert CommonMark formatted text to CommonMark XML, using cmark's
-- built-in renderer.
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')

-- | Convert CommonMark formatted text to groff man, using cmark's
-- built-in renderer.
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')

-- | Convert CommonMark formatted text to a structured 'Node' tree,
-- which can be transformed or rendered using Haskell code.
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)