{-# 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.Monoid ((<>))
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'"]