{-# LINE 1 "src/Text/Sundown/Foreign.hsc" #-}
{-# Language EmptyDataDecls #-}
{-# LINE 2 "src/Text/Sundown/Foreign.hsc" #-}
{-# Language ForeignFunctionInterface #-}
module Text.Sundown.Foreign
    ( Extensions (..)
    , noExtensions
    , allExtensions
    , Callbacks
    , sd_markdown_new
    , sd_markdown_render
    , sd_markdown_free
    ) where

import Foreign
import Foreign.C.String
import Foreign.C.Types

import Text.Sundown.Buffer.Foreign
import Text.Sundown.Flag


{-# LINE 21 "src/Text/Sundown/Foreign.hsc" #-}

-- | A set of switches to enable or disable markdown features.
data Extensions = Extensions
    { extNoIntraEmphasis :: Bool
      -- ^ Turn off underscores insode a word does designating emphasis.
    , extTables          :: Bool
    , extFencedCode      :: Bool
    -- ^ Turns on a non-indentation form of code-blocks, by blocking off a
    --   regionwith ~ or \`.
    , extAutolink        :: Bool
    -- ^ Turn things that look like URLs and email addresses into links
    , extStrikethrough   :: Bool
    -- ^ Surround text with `~` to designate it as struck through
    , extSpaceHeaders    :: Bool
    , extSuperscript     :: Bool
    , extLaxSpacing      :: Bool
    -- ^ Allow blocks inside of paragraphs, instead requireing tags to be on
    --   separate lines
    }

-- | All 'Extensions' disabled
noExtensions :: Extensions
noExtensions = Extensions False False False False False False False False

-- | All 'Extensions' enabled
allExtensions :: Extensions
allExtensions = Extensions True True True True True True True True

instance Flag Extensions where
    flagIndexes exts =
        [ (1, extNoIntraEmphasis exts)
{-# LINE 52 "src/Text/Sundown/Foreign.hsc" #-}
        , (2,            extTables exts)
{-# LINE 53 "src/Text/Sundown/Foreign.hsc" #-}
        , (4,       extFencedCode exts)
{-# LINE 54 "src/Text/Sundown/Foreign.hsc" #-}
        , (8,          extAutolink exts)
{-# LINE 55 "src/Text/Sundown/Foreign.hsc" #-}
        , (16,     extStrikethrough exts)
{-# LINE 56 "src/Text/Sundown/Foreign.hsc" #-}
        , (64,     extSpaceHeaders exts)
{-# LINE 57 "src/Text/Sundown/Foreign.hsc" #-}
        , (128,       extSuperscript exts)
{-# LINE 58 "src/Text/Sundown/Foreign.hsc" #-}
        , (256,       extLaxSpacing exts)
{-# LINE 59 "src/Text/Sundown/Foreign.hsc" #-}
        ]

data Callbacks

instance Storable Callbacks where
    sizeOf _    = (208)
{-# LINE 65 "src/Text/Sundown/Foreign.hsc" #-}
    alignment _ = alignment (undefined :: Ptr ())
    peek _      = error "Callbacks.peek is not implemented"
    poke _ _    = error "Callbacks.poke is not implemented"

data Markdown

instance Storable Markdown where
    sizeOf _    = error "Markdown.sizeOf is not implemented"
    alignment _ = alignment (undefined :: Ptr ())
    peek _      = error "Markdown.peek is not implemented"
    poke _      = error "Markdown.poke is not implemented"

sd_markdown_new
    :: Extensions -> CSize -> Ptr Callbacks -> Ptr () -> IO (Ptr Markdown)
sd_markdown_new extensions max_nesting callbacks opaque =
    sd_markdown_new' (toCUInt extensions) max_nesting callbacks opaque
foreign import ccall "markdown.h sd_markdown_new"
    sd_markdown_new'
        :: CUInt -> CSize -> Ptr Callbacks -> Ptr () -> IO (Ptr Markdown)

foreign import ccall "markdown.h sd_markdown_render"
    sd_markdown_render
        :: Ptr Buffer -> CString -> CSize -> Ptr Markdown -> IO ()

foreign import ccall "markdown.h sd_markdown_free"
    sd_markdown_free :: Ptr Markdown -> IO ()