{-# LINE 1 "Text/Discount.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LINE 2 "Text/Discount.hsc" #-}
-- | This module is a thin wrapper around the discount
-- Markdown-processing library, by David Parsons
-- <http://www.pell.portland.or.us/~orc/Code/discount/>. It exposes
-- options that can be passed to the parser, as well as 'ByteString'
-- and 'Text' interfaces to the parser itself.

module Text.Discount (
    DiscountOption
  , module Text.Discount
  ) where


{-# LINE 14 "Text/Discount.hsc" #-}

import Data.ByteString
import Data.Text
import Data.Text.Encoding
import Foreign hiding (unsafePerformIO)
import System.IO.Unsafe (unsafePerformIO)
import Text.Discount.Internal


{-# LINE 23 "Text/Discount.hsc" #-}

-- * Parser interface
-- | Convert the ByteString String input into well-formed HTML
-- output. Note that an empty set of flags will not enable "strict"
-- markdown behavior; instead, use 'compatOptions', which will cause
-- discount to pass the markdown tests.
parseMarkdown :: [DiscountOption] -> ByteString -> ByteString
parseMarkdown opts markdown = unsafePerformIO . alloca $ \out_buf -> useAsCStringLen markdown $ \(markdown_c, len) -> do
  mmioptr <- mkd_string markdown_c (toEnum len) flag
  mkd_compile mmioptr flag
  mkd_document mmioptr out_buf
  result <- peek out_buf >>= packCString
  mkd_cleanup mmioptr
  return result

  where flag = unDiscountOption $ combineOptions opts

-- | As 'parseMarkdown', but taking 'Text' values instead. Uses UTF-8 internally.
parseMarkdownUtf8 :: [DiscountOption] -> Text -> Text
parseMarkdownUtf8 opts = decodeUtf8 . parseMarkdown opts . encodeUtf8

-- * Parser options
-- | Disables processing of links. Note that this will produce invalid
-- HTML due to a bug in discount!
noLinks:: DiscountOption;
noLinks = DiscountOption 1
{-# LINE 48 "Text/Discount.hsc" #-}

-- | Disables image processing. Note that this will produce invalid
-- HTML due to a bug in discount!
noImages:: DiscountOption;
noImages = DiscountOption 2
{-# LINE 52 "Text/Discount.hsc" #-}

-- | Disables SmartyPants processing. SmartyPants replaces quotes with
-- curly quotes (except in code blocks), replaces @(tm)@, @(r)@, and
-- @(c)@ with the relevant symbols, and replaces ellipses and
-- em/en-dashes with the appropriate symbols.
noSmartyPants:: DiscountOption;
noSmartyPants = DiscountOption 4
{-# LINE 58 "Text/Discount.hsc" #-}

-- | Disables raw HTML. Note that this will produce invalid HTML due
-- to a bug in discount!
noHtml:: DiscountOption;
noHtml = DiscountOption 8
{-# LINE 62 "Text/Discount.hsc" #-}

-- | Disables both superscript and relaxed emphasis (see 'noRelaxedEmphasis').
strict:: DiscountOption;
strict = DiscountOption 16
{-# LINE 65 "Text/Discount.hsc" #-}

-- | Disable pseudoprotocol wrapping. If this is not enabled, then
-- links of the form @[foo bar](class:glarch)@ will be replaced by
-- @\<span class=\"glarch\"\>foo bar\</span\>@, and similarly for
-- @abbr:desc@ (uses @\<abbr title=\"desc\"\>@) and @id:name@ (uses @\<a
-- id=\"name\"\>@)
noPseudoProtocols:: DiscountOption;
noPseudoProtocols = DiscountOption 64
{-# LINE 72 "Text/Discount.hsc" #-}

-- | Disables converstion of @A^B@ into @A\<sup\>B\</sup\>@.
noSuperscripts:: DiscountOption;
noSuperscripts = DiscountOption 256
{-# LINE 75 "Text/Discount.hsc" #-}

-- | Disables relaxed emphasis, allowing underscores to indicate
-- emphasis in the middle of a word. With relaxed emphasis on
-- (i.e. without this option) @foo_bar_@ will parse as
-- @foo_bar_@. With it off, it parses as @foo\<em\>bar\</em\>@.
noRelaxedEmphasis:: DiscountOption;
noRelaxedEmphasis = DiscountOption 512
{-# LINE 81 "Text/Discount.hsc" #-}

-- | Disables PHP Markdown Extra-style tables. See the documentation
-- on PHP Markdown Extra at
-- <http://michelf.com/projects/php-markdown/extra/#table>.
noTables:: DiscountOption;
noTables = DiscountOption 1024
{-# LINE 86 "Text/Discount.hsc" #-}

-- | Disables @~~strikethrough~~@.
noStrikethrough:: DiscountOption;
noStrikethrough = DiscountOption 2048
{-# LINE 89 "Text/Discount.hsc" #-}


-- | Disables Pandoc-style header processing. This does not disable
-- headers like
--
-- > This
-- > ====
-- > # or this

noHeaders:: DiscountOption;
noHeaders = DiscountOption 65536
{-# LINE 99 "Text/Discount.hsc" #-}

-- | Disables div-style quotes. Div-style quotes translates
--
-- > > %class%
-- > > foo
--
-- as @\<div class=\"class\"\>foo\</div\>@.
noDivQuotes:: DiscountOption;
noDivQuotes = DiscountOption 262144
{-# LINE 107 "Text/Discount.hsc" #-}

-- | Disables alphanumeric-ordered lists.
noAlphaLists:: DiscountOption;
noAlphaLists = DiscountOption 524288
{-# LINE 110 "Text/Discount.hsc" #-}


-- | Disables definition lists.
noDefinitionLists:: DiscountOption;
noDefinitionLists = DiscountOption 1048576
{-# LINE 114 "Text/Discount.hsc" #-}

-- | Process Markdown even inside an HTML tag.
tagText:: DiscountOption;
tagText = DiscountOption 32
{-# LINE 117 "Text/Discount.hsc" #-}

-- | Only allow links that are local or that point to @http@, @https@,
-- @news@, or @ftp@ schemes.
safeLinks:: DiscountOption;
safeLinks = DiscountOption 32768
{-# LINE 121 "Text/Discount.hsc" #-}

-- | Expand tabs to 4 spaces.
tabStop:: DiscountOption;
tabStop = DiscountOption 131072
{-# LINE 124 "Text/Discount.hsc" #-}

-- | Enable Markdown Extra style footnotes. See
-- <http://michelf.com/projects/php-markdown/extra/#footnotes>. For example:
--
-- > Here's some text with a footnote.[^1]
-- >
-- > [^1]: Here's a footnote with some text.
--
-- Footnotes have backlinks to their parent.
footnotes:: DiscountOption;
footnotes = DiscountOption 2097152
{-# LINE 134 "Text/Discount.hsc" #-}

-- | Disables all discount features not in the original Markdown spec:
-- SmartyPants, relaxed emphasis, pseudo-protocols, strikethrough,
-- headers, alphabetical lists, definition lists, superscripts, and
-- tables.
compatOptions :: [DiscountOption]
compatOptions = [noSmartyPants, noRelaxedEmphasis, noPseudoProtocols, noStrikethrough, noHeaders, noAlphaLists, noDefinitionLists, noSuperscripts, noTables]