{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Text.Pandoc.Filter.Plot.Parse (
plotToolkit
, parseFigureSpec
, captionReader
) where
import Control.Monad (join, when)
import Control.Monad.Reader (asks, liftIO)
import Data.Default.Class (def)
import Data.List (intersperse)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe, listToMaybe)
import Data.String (fromString)
import Data.Text (Text, pack, unpack)
import qualified Data.Text.IO as TIO
import Data.Version (showVersion)
import Paths_pandoc_plot (version)
import System.FilePath (makeValid)
import Text.Pandoc.Definition (Block (..), Inline,
Pandoc (..), Format(..))
import Text.Pandoc.Class (runPure)
import Text.Pandoc.Options (ReaderOptions (..))
import Text.Pandoc.Readers (getReader, Reader(..))
import Text.Pandoc.Filter.Plot.Renderers
import Text.Pandoc.Filter.Plot.Types
tshow :: Show a => a -> Text
tshow = pack . show
parseFigureSpec :: Block -> PlotM (Maybe FigureSpec)
parseFigureSpec (CodeBlock (id', classes, attrs) content) = do
toolkit <- asks toolkit
if not (cls toolkit `elem` classes)
then return Nothing
else Just <$> figureSpec
where
attrs' = Map.fromList attrs
preamblePath = unpack <$> Map.lookup (tshow PreambleK) attrs'
figureSpec :: PlotM FigureSpec
figureSpec = do
conf <- asks config
toolkit <- asks toolkit
let extraAttrs' = parseExtraAttrs toolkit attrs'
header = comment toolkit $ "Generated by pandoc-plot " <> ((pack . showVersion) version)
defaultPreamble = preambleSelector toolkit conf
includeScript <- fromMaybe
(return defaultPreamble)
((liftIO . TIO.readFile) <$> preamblePath)
let
filteredAttrs = filter (\(k, _) -> k `notElem` (tshow <$> inclusionKeys)) attrs
defWithSource = defaultWithSource conf
defSaveFmt = defaultSaveFormat conf
defDPI = defaultDPI conf
let caption = Map.findWithDefault mempty (tshow CaptionK) attrs'
withSource = fromMaybe defWithSource $ readBool <$> Map.lookup (tshow WithSourceK) attrs'
script = mconcat $ intersperse "\n" [header, includeScript, content]
saveFormat = fromMaybe defSaveFmt $ (fromString . unpack) <$> Map.lookup (tshow SaveFormatK) attrs'
directory = makeValid $ unpack $ Map.findWithDefault (pack $ defaultDirectory conf) (tshow DirectoryK) attrs'
dpi = fromMaybe defDPI $ (read . unpack) <$> Map.lookup (tshow DpiK) attrs'
extraAttrs = Map.toList extraAttrs'
blockAttrs = (id', classes, filteredAttrs)
let saveFormatSupported = saveFormat `elem` (supportedSaveFormats toolkit)
when (not saveFormatSupported) $ do
(error $ mconcat ["Save format ", show saveFormat, " not supported by ", show toolkit ])
return FigureSpec{..}
parseFigureSpec _ = return Nothing
plotToolkit :: Block -> Maybe Toolkit
plotToolkit (CodeBlock (_, classes, _) _) =
listToMaybe $ filter (\tk->cls tk `elem` classes) toolkits
plotToolkit _ = Nothing
captionReader :: Format -> Text -> Maybe [Inline]
captionReader (Format f) t = either (const Nothing) (Just . extractFromBlocks) $ runPure $ do
(reader, exts) <- getReader f
let readerOpts = def {readerExtensions = exts}
case reader of
TextReader fct -> fct readerOpts t
_ -> return mempty
where
extractFromBlocks (Pandoc _ blocks) = mconcat $ extractInlines <$> blocks
extractInlines (Plain inlines) = inlines
extractInlines (Para inlines) = inlines
extractInlines (LineBlock multiinlines) = join multiinlines
extractInlines _ = []
readBool :: Text -> Bool
readBool s | s `elem` ["True", "true", "'True'", "'true'", "1"] = True
| s `elem` ["False", "false", "'False'", "'false'", "0"] = False
| otherwise = error $ unpack $ mconcat ["Could not parse '", s, "' into a boolean. Please use 'True' or 'False'"]