{-# LINE 1 "src/Text/Sundown/Html/Foreign.hsc" #-}
{-# Language EmptyDataDecls #-}
{-# LINE 2 "src/Text/Sundown/Html/Foreign.hsc" #-}
{-# Language ForeignFunctionInterface #-}
module Text.Sundown.Html.Foreign
    ( HtmlRenderMode (..)
    , sdhtml_renderer
    , 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.Foreign


{-# LINE 18 "src/Text/Sundown/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 35 "src/Text/Sundown/Html/Foreign.hsc" #-}
                       , (2,  htmlSkipStyle mode)
{-# LINE 36 "src/Text/Sundown/Html/Foreign.hsc" #-}
                       , (4, htmlSkipImages mode)
{-# LINE 37 "src/Text/Sundown/Html/Foreign.hsc" #-}
                       , (8,  htmlSkipLinks mode)
{-# LINE 38 "src/Text/Sundown/Html/Foreign.hsc" #-}
                       , (16, htmlExpandTabs mode)
{-# LINE 39 "src/Text/Sundown/Html/Foreign.hsc" #-}
                       , (32,    htmlSafelink mode)
{-# LINE 40 "src/Text/Sundown/Html/Foreign.hsc" #-}
                       , (64,         htmlToc mode)
{-# LINE 41 "src/Text/Sundown/Html/Foreign.hsc" #-}
                       , (128,   htmlHardWrap mode)
{-# LINE 42 "src/Text/Sundown/Html/Foreign.hsc" #-}
                       , (256,   htmlUseXhtml mode)
{-# LINE 43 "src/Text/Sundown/Html/Foreign.hsc" #-}
                       , (512,      htmlEscape mode)
{-# LINE 44 "src/Text/Sundown/Html/Foreign.hsc" #-}
                       ]

data HtmlRenderOptions

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

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

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