{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Text.Pandoc.Filter.Plot.Parse (
plotToolkit
, parseFigureSpec
, captionReader
) where
import Control.Monad (join, when)
import Data.Char (isSpace)
import Data.Default (def)
import Data.List (intersperse)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe, listToMaybe, isJust, fromJust)
import Data.String (fromString)
import Data.Text (Text, pack, unpack)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Data.Version (showVersion)
import Paths_pandoc_plot (version)
import System.FilePath (makeValid, normalise)
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.Monad
tshow :: Show a => a -> Text
tshow = pack . show
parseFigureSpec :: Block -> PlotM (Maybe FigureSpec)
parseFigureSpec block@(CodeBlock (id', classes, attrs) _) =
sequence $ fmap figureSpec
$ plotToolkit block >>= hasToolkit
where
hasToolkit = \tk -> if cls tk `elem` classes then return tk else Nothing
attrs' = Map.fromList attrs
preamblePath = unpack <$> Map.lookup (tshow PreambleK) attrs'
figureSpec :: Toolkit -> PlotM FigureSpec
figureSpec toolkit = do
conf <- asks envConfig
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
content <- parseContent block
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', filter (/= cls toolkit) classes, filteredAttrs)
let blockDependencies = parseFileDependencies $ fromMaybe mempty $ Map.lookup (tshow DependenciesK) attrs'
dependencies = (defaultDependencies conf) <> blockDependencies
let saveFormatSupported = saveFormat `elem` (supportedSaveFormats toolkit)
when (not saveFormatSupported) $ do
let msg = pack $ mconcat ["Save format ", show saveFormat, " not supported by ", show toolkit ]
err msg
return FigureSpec{..}
parseFigureSpec _ = return Nothing
parseContent :: Block -> PlotM Script
parseContent (CodeBlock (_, _, attrs) content) = do
let attrs' = Map.fromList attrs
mfile = normalise . unpack <$> Map.lookup (tshow FileK) attrs'
when (content /= mempty && isJust mfile) $ do
err $ mconcat [
"Figure refers to a file (", pack $ fromJust mfile
, ") but also has content in the document.\nThe file content will be preferred."
]
let loadFromFile fp = do
info $ "Loading figure content from " <> pack fp
liftIO $ TIO.readFile fp
maybe (return content) loadFromFile mfile
parseContent _ = return mempty
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 = errorWithoutStackTrace $ unpack $ mconcat ["Could not parse '", s, "' into a boolean. Please use 'True' or 'False'"]
parseFileDependencies :: Text -> [FilePath]
parseFileDependencies t
| t == mempty = mempty
| otherwise = fmap normalise
. fmap unpack
. fmap (T.dropAround isSpace)
. T.splitOn ","
. T.dropAround (\c -> c `elem` ['[', ']']) $ t