{-# LINE 1 "src/Text/Sundown/Renderers/Html/Foreign.hsc" #-}
{-# Language ForeignFunctionInterface #-}
{-# LINE 2 "src/Text/Sundown/Renderers/Html/Foreign.hsc" #-}

module Text.Sundown.Renderers.Html.Foreign
       ( HtmlRenderMode (..)
       , c_sdhtml_renderer
       , c_sdhtml_toc_renderer
       , c_sdhtml_smartypants
       ) where

import Foreign
import Foreign.C.String
import Foreign.C.Types
import Text.Sundown.Buffer.Foreign
import Text.Sundown.Flag
import Text.Sundown.Markdown.Foreign


{-# LINE 18 "src/Text/Sundown/Renderers/Html/Foreign.hsc" #-}

data HtmlRenderMode = HtmlRenderMode { htmlSkipHtml :: Bool -- ^ Drop in-line HTML tags from the
                                                           -- output
                                     , htmlSkipStyle :: Bool -- ^ Don't add any style tags to the
                                                            -- output
                                     , htmlSkipImages :: Bool -- ^ Don't include images in the output
                                     , htmlSkipLinks :: Bool -- ^ Don't include links in the output
                                     , htmlExpandTabs :: Bool
                                     , htmlSafelink :: Bool -- ^ Sanity check links for known URL
                                                           -- schemes
                                     , htmlToc :: Bool -- ^ Include a table of contents in the output
                                     , htmlHardWrap :: Bool
                                     , htmlUseXhtml :: Bool -- ^ Produce XHTML output instead of HTML
                                     , htmlEscape :: Bool
                                     }


instance Flag HtmlRenderMode where
  flagIndexes mode = [ (1, htmlSkipHtml mode)
{-# LINE 37 "src/Text/Sundown/Renderers/Html/Foreign.hsc" #-}
                     , (2, htmlSkipStyle mode)
{-# LINE 38 "src/Text/Sundown/Renderers/Html/Foreign.hsc" #-}
                     , (4, htmlSkipImages mode)
{-# LINE 39 "src/Text/Sundown/Renderers/Html/Foreign.hsc" #-}
                     , (8, htmlSkipLinks mode)
{-# LINE 40 "src/Text/Sundown/Renderers/Html/Foreign.hsc" #-}
                     , (16, htmlExpandTabs mode)
{-# LINE 41 "src/Text/Sundown/Renderers/Html/Foreign.hsc" #-}
                     , (32, htmlSafelink mode)
{-# LINE 42 "src/Text/Sundown/Renderers/Html/Foreign.hsc" #-}
                     , (64, htmlToc mode)
{-# LINE 43 "src/Text/Sundown/Renderers/Html/Foreign.hsc" #-}
                     , (128, htmlHardWrap mode)
{-# LINE 44 "src/Text/Sundown/Renderers/Html/Foreign.hsc" #-}
                     , (256, htmlUseXhtml mode)
{-# LINE 45 "src/Text/Sundown/Renderers/Html/Foreign.hsc" #-}
                     , (512, htmlEscape mode)
{-# LINE 46 "src/Text/Sundown/Renderers/Html/Foreign.hsc" #-}
                     ]

data HtmlRenderOptions

instance Storable HtmlRenderOptions where
  sizeOf _ = ((16))
{-# LINE 52 "src/Text/Sundown/Renderers/Html/Foreign.hsc" #-}
  alignment _ = alignment (undefined :: Ptr ())
  peek _ = error "HtmlRenderopt.peek is not implemented"
  poke _ = error "HtmlRenderopt.poke is not implemented"

c_sdhtml_renderer :: Ptr Callbacks -> Ptr HtmlRenderOptions -> HtmlRenderMode -> IO ()
c_sdhtml_renderer rndr options mode = c_sdhtml_renderer' rndr options (toCUInt mode)
foreign import ccall "html.h sdhtml_renderer"
  c_sdhtml_renderer' :: Ptr Callbacks -> Ptr HtmlRenderOptions -> CUInt -> IO ()

foreign import ccall "html.h sdhtml_toc_renderer"
  c_sdhtml_toc_renderer :: Ptr Callbacks -> Ptr HtmlRenderOptions -> IO ()

foreign import ccall "html.h sdhtml_smartypants"
  c_sdhtml_smartypants :: Ptr Buffer -> CString -> CSize -> IO ()