-----------------------------------------------------------------------------
-- |
-- Module      :  Text.BlogLiterately.LaTeX
-- Copyright   :  (c) 2012 Brent Yorgey
-- License     :  GPL (see LICENSE)
-- Maintainer  :  Brent Yorgey <byorgey@gmail.com>
--
-- Utilities for working with embedded LaTeX.
--
-----------------------------------------------------------------------------

{-# LANGUAGE OverloadedStrings #-}

module Text.BlogLiterately.LaTeX
    (
      rawTeXify
    , wpTeXify
    ) where

import           Data.Text   (Text)
import qualified Data.Text   as T
import           Text.Pandoc

bracket :: Text -> Text -> Text -> Text
bracket :: Text -> Text -> Text -> Text
bracket Text
l Text
r Text
t = Text -> Text -> Text
T.append Text
l (Text -> Text -> Text
T.append Text
t Text
r)

-- | Pass LaTeX through unchanged.
rawTeXify :: Pandoc -> Pandoc
rawTeXify :: Pandoc -> Pandoc
rawTeXify = forall a b. (Data a, Data b) => (a -> a) -> b -> b
bottomUp [Block] -> [Block]
formatDisplayTex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Data a, Data b) => (a -> a) -> b -> b
bottomUp [Inline] -> [Inline]
formatInlineTex
  where formatInlineTex :: [Inline] -> [Inline]
        formatInlineTex :: [Inline] -> [Inline]
formatInlineTex (Math MathType
InlineMath Text
tex : [Inline]
is)
          = (Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"html") (Text -> Text -> Text -> Text
bracket Text
"$" Text
"$" Text
tex)) forall a. a -> [a] -> [a]
: [Inline]
is
        formatInlineTex [Inline]
is = [Inline]
is

        formatDisplayTex :: [Block] -> [Block]
        formatDisplayTex :: [Block] -> [Block]
formatDisplayTex (Para [Math MathType
DisplayMath Text
tex] : [Block]
bs)
          = Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"html") (Text -> Text -> Text -> Text
bracket Text
"\n\\[" Text
"\\]\n" Text
tex)
          forall a. a -> [a] -> [a]
: [Block]
bs
        formatDisplayTex [Block]
bs = [Block]
bs

-- | WordPress can render LaTeX, but expects it in a special non-standard
--   format (@\$latex foo\$@).  The @wpTeXify@ function formats LaTeX code
--   using this format so that it can be processed by WordPress.
wpTeXify :: Pandoc -> Pandoc
wpTeXify :: Pandoc -> Pandoc
wpTeXify = forall a b. (Data a, Data b) => (a -> a) -> b -> b
bottomUp [Block] -> [Block]
formatDisplayTex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Data a, Data b) => (a -> a) -> b -> b
bottomUp [Inline] -> [Inline]
formatInlineTex
  where formatInlineTex :: [Inline] -> [Inline]
        formatInlineTex :: [Inline] -> [Inline]
formatInlineTex (Math MathType
InlineMath Text
tex : [Inline]
is)
          = (Text -> Inline
Str forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
bracket Text
"$latex " Text
"$" (Text -> Text -> Text
unPrefix Text
"latex" Text
tex)) forall a. a -> [a] -> [a]
: [Inline]
is
        formatInlineTex [Inline]
is = [Inline]
is

        formatDisplayTex :: [Block] -> [Block]
        formatDisplayTex :: [Block] -> [Block]
formatDisplayTex (Para [Math MathType
DisplayMath Text
tex] : [Block]
bs)
          = Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"html") Text
"<p><div style=\"text-align: center\">"
          forall a. a -> [a] -> [a]
: [Inline] -> Block
Plain [Text -> Inline
Str forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
bracket Text
"$latex \\displaystyle " Text
"$" (Text -> Text -> Text
unPrefix Text
"latex" Text
tex)]
          forall a. a -> [a] -> [a]
: Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"html") Text
"</div></p>"
          forall a. a -> [a] -> [a]
: [Block]
bs
        formatDisplayTex [Block]
bs = [Block]
bs

        unPrefix :: Text -> Text -> Text
unPrefix Text
pre Text
s
          | Text
pre Text -> Text -> Bool
`T.isPrefixOf` Text
s = Int -> Text -> Text
T.drop (Text -> Int
T.length Text
pre) Text
s
          | Bool
otherwise            = Text
s