{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
module Main where
import Text.Pandoc.JSON
import Text.Pandoc.Walk (walk)
import Text.Pandoc.Definition ()
import Data.String (IsString)
import Data.Maybe (fromMaybe)
import qualified Data.Map as Map
import Data.Text(Text)
import qualified Data.Text as T
import qualified Token.Haskell (tokenizer)
import Filter (renderBlock, renderInline)
import FindColumns (findColumns)
import Alignment (Processed)
data Options = Options {
inlineSyntax :: Text
}
main :: IO ()
main = toJSONFilter runner
-- | Main body of Pandoc filter.
-- Reads format option, metadata,
-- and calls `walk` with `blockFormatter`.
runner :: Maybe Format -> Pandoc -> Pandoc
runner (fromMaybe (Format "text") -> format) input@(Pandoc (Meta meta) _) =
walk (blockFormatter opts format) input
where
opts = case Map.lookup "inline-code" meta of
Nothing -> Options "haskell" -- default
Just (MetaString s) -> Options s -- never needed?
Just (MetaInlines [Str s]) -> Options s
Just otherValue -> error $ "inline-code: meta should be a string but is: " <> show otherValue
-- | Select the desired format output then process it.
-- Run tokenizer, analysis, and formatter.
--
-- For non-CodeBlocks it runs `inlineFormatter`.
-- Fallback to original input, if failed to tokenize.
blockFormatter :: Options
-> Format -- ^ Output format, defaults to "plain" if not found
-> Block
-> Block
blockFormatter _opts format (CodeBlock attrs content) =
case fmap findColumns $ getTokenizer attrs content of
Just processed -> renderBlock format attrs processed
Nothing -> CodeBlock attrs content -- fallback
-- Do not touch other blocks than 'CodeBock'
blockFormatter opts format x =
walk (inlineFormatter opts format) x
-- | Select the desired format output then process it.
-- Run tokenizer, and inline formatter.
-- Fallback to original input, if failed to tokenize.
inlineFormatter :: Options
-> Format -- ^ Output format, defaults to "plain" if not found
-> Inline
-> Inline
inlineFormatter Options {inlineSyntax} format (Code attrs txt) =
case getTokenizer attrs txt of
Just processed -> renderInline format attrs $ map discardLoc processed
Nothing -> Code attrs txt -- fallback
where
discardLoc (a, _, b) = (a, b)
addClass (a, classes, b) | inlineSyntax /= "" = (a, inlineSyntax:classes, b)
addClass o = o
inlineFormatter _opts _ x = x
-- | Pick tokenizer depending on options.
getTokenizer attrs | isHaskell attrs = Token.Haskell.tokenizer
| otherwise = \_ -> Nothing
-- | Check if the code block is tagged as Haskell.
isHaskell :: (Foldable t, Eq a1, IsString a1) =>
(a2, t a1, c) -> Bool
isHaskell (_, classes, _) = "haskell" `elem` classes