module Anansi.HsColour.LaTeX (loomLaTeX) where
import Control.Monad (forM_)
import Control.Monad.Reader (asks)
import Control.Monad.Writer (tell)
import qualified Data.ByteString.Char8 as ByteString
import Data.ByteString.Char8 (ByteString)
import Data.Monoid (mappend, mconcat)
import qualified Data.Text
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Anansi hiding (loomLaTeX)
import qualified Language.Haskell.HsColour as HsColour
import Language.Haskell.HsColour.Colourise (defaultColourPrefs)
loomLaTeX :: Loom
loomLaTeX = mapM_ putBlock . documentBlocks where
putBlock b = case b of
BlockText text -> tell (encodeUtf8 text)
BlockFile path content -> do
epath <- escape path
let label = mconcat ["{\\bf\\(\\gg\\) ", epath, "}\n"]
putContent label content
BlockDefine name content -> do
ename <- escape name
let label = mconcat ["{\\bf\\(\\ll\\) ", ename, "\\(\\gg\\)}\n"]
putContent label content
putContent label cs = do
tell "\\begin{quotation}\n"
tell "\\noindent{}"
tell label
tell "\n\n"
forM_ cs $ \c -> case c of
ContentText _ text -> do
expanded <- expandTabs text
tell "\\noindent{}"
tell (colorize (expanded `mappend` "\n"))
ContentMacro _ indent name -> do
tell "\\noindent{}"
formatMacro indent name >>= tell
tell "\n"
tell "\\end{quotation}\n"
formatMacro indent name = do
escIndent <- escape indent
escName <- escape name
return (mconcat [escIndent, "$|$\\emph{", escName, "}$|$\n"])
escape :: Text -> LoomM ByteString
escape text = do
tabSize <- asks loomOptionTabSize
return $ encodeUtf8 $ Data.Text.concatMap (\c -> case c of
'\t' -> Data.Text.replicate (fromInteger tabSize) " "
'\\' -> "\\textbackslash{}"
'{' -> "\\{"
'}' -> "\\}"
'_' -> "\\_"
_ -> Data.Text.singleton c) text
expandTabs :: Text -> LoomM Text
expandTabs txt = do
tabSize <- asks loomOptionTabSize
return $ Data.Text.concatMap (\c -> case c of
'\t' -> Data.Text.replicate (fromInteger tabSize) " "
_ -> Data.Text.singleton c) txt
colorize :: Text -> ByteString
colorize = ByteString.pack
. HsColour.hscolour HsColour.LaTeX defaultColourPrefs False True "" False
. ByteString.unpack
. encodeUtf8