{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Text.Pandoc.Filter.Plot.Parse (
plotToolkit
, parseFigureSpec
, captionReader
, defaultReaderOptions
) where
import Control.Monad (join, when)
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.Extensions (emptyExtensions)
import Text.Pandoc.Options (ReaderOptions (..), TrackChanges(..))
import Text.Pandoc.Readers (getReader, Reader(..))
import Text.Pandoc.Filter.Plot.Renderers
import Text.Pandoc.Filter.Plot.Monad
tshow :: Show a => a -> Text
tshow :: a -> Text
tshow = String -> Text
pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
parseFigureSpec :: Block -> PlotM (Maybe FigureSpec)
parseFigureSpec :: Block -> PlotM (Maybe FigureSpec)
parseFigureSpec block :: Block
block@(CodeBlock (id' :: Text
id', classes :: [Text]
classes, attrs :: [(Text, Text)]
attrs) content :: Text
content) = do
let toolkit :: Maybe Toolkit
toolkit = Block -> Maybe Toolkit
plotToolkit Block
block
case Maybe Toolkit
toolkit of
Nothing -> Maybe FigureSpec -> PlotM (Maybe FigureSpec)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FigureSpec
forall a. Maybe a
Nothing
Just tk :: Toolkit
tk -> do
if Bool -> Bool
not (Toolkit -> Text
cls Toolkit
tk Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes)
then Maybe FigureSpec -> PlotM (Maybe FigureSpec)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FigureSpec
forall a. Maybe a
Nothing
else FigureSpec -> Maybe FigureSpec
forall a. a -> Maybe a
Just (FigureSpec -> Maybe FigureSpec)
-> ReaderT Configuration LoggingM FigureSpec
-> PlotM (Maybe FigureSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Toolkit -> ReaderT Configuration LoggingM FigureSpec
figureSpec Toolkit
tk
where
attrs' :: Map Text Text
attrs' = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Text)]
attrs
preamblePath :: Maybe String
preamblePath = Text -> String
unpack (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (InclusionKey -> Text
forall a. Show a => a -> Text
tshow InclusionKey
PreambleK) Map Text Text
attrs'
figureSpec :: Toolkit -> PlotM FigureSpec
figureSpec :: Toolkit -> ReaderT Configuration LoggingM FigureSpec
figureSpec toolkit :: Toolkit
toolkit = do
Configuration
conf <- ReaderT Configuration LoggingM Configuration
forall r (m :: * -> *). MonadReader r m => m r
ask
let extraAttrs' :: Map Text Text
extraAttrs' = Toolkit -> Map Text Text -> Map Text Text
parseExtraAttrs Toolkit
toolkit Map Text Text
attrs'
header :: Text
header = Toolkit -> Text -> Text
comment Toolkit
toolkit (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ "Generated by pandoc-plot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ((String -> Text
pack (String -> Text) -> (Version -> String) -> Version -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
showVersion) Version
version)
defaultPreamble :: Text
defaultPreamble = Toolkit -> Configuration -> Text
preambleSelector Toolkit
toolkit Configuration
conf
Text
includeScript <- ReaderT Configuration LoggingM Text
-> Maybe (ReaderT Configuration LoggingM Text)
-> ReaderT Configuration LoggingM Text
forall a. a -> Maybe a -> a
fromMaybe
(Text -> ReaderT Configuration LoggingM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
defaultPreamble)
((IO Text -> ReaderT Configuration LoggingM Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> ReaderT Configuration LoggingM Text)
-> (String -> IO Text)
-> String
-> ReaderT Configuration LoggingM Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Text
TIO.readFile) (String -> ReaderT Configuration LoggingM Text)
-> Maybe String -> Maybe (ReaderT Configuration LoggingM Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
preamblePath)
let
filteredAttrs :: [(Text, Text)]
filteredAttrs = ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(k :: Text
k, _) -> Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (InclusionKey -> Text
forall a. Show a => a -> Text
tshow (InclusionKey -> Text) -> [InclusionKey] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [InclusionKey]
inclusionKeys)) [(Text, Text)]
attrs
defWithSource :: Bool
defWithSource = Configuration -> Bool
defaultWithSource Configuration
conf
defSaveFmt :: SaveFormat
defSaveFmt = Configuration -> SaveFormat
defaultSaveFormat Configuration
conf
defDPI :: Int
defDPI = Configuration -> Int
defaultDPI Configuration
conf
let caption :: Text
caption = Text -> Text -> Map Text Text -> Text
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Text
forall a. Monoid a => a
mempty (InclusionKey -> Text
forall a. Show a => a -> Text
tshow InclusionKey
CaptionK) Map Text Text
attrs'
withSource :: Bool
withSource = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
defWithSource (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
readBool (Text -> Bool) -> Maybe Text -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (InclusionKey -> Text
forall a. Show a => a -> Text
tshow InclusionKey
WithSourceK) Map Text Text
attrs'
script :: Text
script = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse "\n" [Text
header, Text
includeScript, Text
content]
saveFormat :: SaveFormat
saveFormat = SaveFormat -> Maybe SaveFormat -> SaveFormat
forall a. a -> Maybe a -> a
fromMaybe SaveFormat
defSaveFmt (Maybe SaveFormat -> SaveFormat) -> Maybe SaveFormat -> SaveFormat
forall a b. (a -> b) -> a -> b
$ (String -> SaveFormat
forall a. IsString a => String -> a
fromString (String -> SaveFormat) -> (Text -> String) -> Text -> SaveFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack) (Text -> SaveFormat) -> Maybe Text -> Maybe SaveFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (InclusionKey -> Text
forall a. Show a => a -> Text
tshow InclusionKey
SaveFormatK) Map Text Text
attrs'
directory :: String
directory = String -> String
makeValid (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Map Text Text -> Text
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Configuration -> String
defaultDirectory Configuration
conf) (InclusionKey -> Text
forall a. Show a => a -> Text
tshow InclusionKey
DirectoryK) Map Text Text
attrs'
dpi :: Int
dpi = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
defDPI (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> (Text -> String) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack) (Text -> Int) -> Maybe Text -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (InclusionKey -> Text
forall a. Show a => a -> Text
tshow InclusionKey
DpiK) Map Text Text
attrs'
extraAttrs :: [(Text, Text)]
extraAttrs = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
extraAttrs'
blockAttrs :: (Text, [Text], [(Text, Text)])
blockAttrs = (Text
id', [Text]
classes, [(Text, Text)]
filteredAttrs)
let saveFormatSupported :: Bool
saveFormatSupported = SaveFormat
saveFormat SaveFormat -> [SaveFormat] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Toolkit -> [SaveFormat]
supportedSaveFormats Toolkit
toolkit)
Bool
-> ReaderT Configuration LoggingM ()
-> ReaderT Configuration LoggingM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
saveFormatSupported) (ReaderT Configuration LoggingM ()
-> ReaderT Configuration LoggingM ())
-> ReaderT Configuration LoggingM ()
-> ReaderT Configuration LoggingM ()
forall a b. (a -> b) -> a -> b
$ do
let msg :: Text
msg = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat ["Save format ", SaveFormat -> String
forall a. Show a => a -> String
show SaveFormat
saveFormat, " not supported by ", Toolkit -> String
forall a. Show a => a -> String
show Toolkit
toolkit ]
Text -> ReaderT Configuration LoggingM ()
err Text
msg
FigureSpec -> ReaderT Configuration LoggingM FigureSpec
forall (m :: * -> *) a. Monad m => a -> m a
return $WFigureSpec :: Toolkit
-> Text
-> Bool
-> Text
-> SaveFormat
-> String
-> Int
-> [(Text, Text)]
-> (Text, [Text], [(Text, Text)])
-> FigureSpec
FigureSpec{..}
parseFigureSpec _ = Maybe FigureSpec -> PlotM (Maybe FigureSpec)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FigureSpec
forall a. Maybe a
Nothing
plotToolkit :: Block -> Maybe Toolkit
plotToolkit :: Block -> Maybe Toolkit
plotToolkit (CodeBlock (_, classes :: [Text]
classes, _) _) =
[Toolkit] -> Maybe Toolkit
forall a. [a] -> Maybe a
listToMaybe ([Toolkit] -> Maybe Toolkit) -> [Toolkit] -> Maybe Toolkit
forall a b. (a -> b) -> a -> b
$ (Toolkit -> Bool) -> [Toolkit] -> [Toolkit]
forall a. (a -> Bool) -> [a] -> [a]
filter (\tk :: Toolkit
tk->Toolkit -> Text
cls Toolkit
tk Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes) [Toolkit]
toolkits
plotToolkit _ = Maybe Toolkit
forall a. Maybe a
Nothing
captionReader :: Format -> Text -> Maybe [Inline]
captionReader :: Format -> Text -> Maybe [Inline]
captionReader (Format f :: Text
f) t :: Text
t = (PandocError -> Maybe [Inline])
-> (Pandoc -> Maybe [Inline])
-> Either PandocError Pandoc
-> Maybe [Inline]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe [Inline] -> PandocError -> Maybe [Inline]
forall a b. a -> b -> a
const Maybe [Inline]
forall a. Maybe a
Nothing) ([Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just ([Inline] -> Maybe [Inline])
-> (Pandoc -> [Inline]) -> Pandoc -> Maybe [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pandoc -> [Inline]
extractFromBlocks) (Either PandocError Pandoc -> Maybe [Inline])
-> Either PandocError Pandoc -> Maybe [Inline]
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> PandocPure Pandoc -> Either PandocError Pandoc
forall a b. (a -> b) -> a -> b
$ do
(reader :: Reader PandocPure
reader, exts :: Extensions
exts) <- Text -> PandocPure (Reader PandocPure, Extensions)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (Reader m, Extensions)
getReader Text
f
let readerOpts :: ReaderOptions
readerOpts = ReaderOptions
defaultReaderOptions {readerExtensions :: Extensions
readerExtensions = Extensions
exts}
case Reader PandocPure
reader of
TextReader fct :: ReaderOptions -> Text -> PandocPure Pandoc
fct -> ReaderOptions -> Text -> PandocPure Pandoc
fct ReaderOptions
readerOpts Text
t
_ -> Pandoc -> PandocPure Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
forall a. Monoid a => a
mempty
where
extractFromBlocks :: Pandoc -> [Inline]
extractFromBlocks (Pandoc _ blocks :: [Block]
blocks) = [[Inline]] -> [Inline]
forall a. Monoid a => [a] -> a
mconcat ([[Inline]] -> [Inline]) -> [[Inline]] -> [Inline]
forall a b. (a -> b) -> a -> b
$ Block -> [Inline]
extractInlines (Block -> [Inline]) -> [Block] -> [[Inline]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block]
blocks
extractInlines :: Block -> [Inline]
extractInlines (Plain inlines :: [Inline]
inlines) = [Inline]
inlines
extractInlines (Para inlines :: [Inline]
inlines) = [Inline]
inlines
extractInlines (LineBlock multiinlines :: [[Inline]]
multiinlines) = [[Inline]] -> [Inline]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [[Inline]]
multiinlines
extractInlines _ = []
readBool :: Text -> Bool
readBool :: Text -> Bool
readBool s :: Text
s | Text
s Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["True", "true", "'True'", "'true'", "1"] = Bool
True
| Text
s Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["False", "false", "'False'", "'false'", "0"] = Bool
False
| Bool
otherwise = String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ["Could not parse '", Text
s, "' into a boolean. Please use 'True' or 'False'"]
defaultReaderOptions :: ReaderOptions
defaultReaderOptions :: ReaderOptions
defaultReaderOptions =
ReaderOptions :: Extensions
-> Bool
-> Int
-> Int
-> [Text]
-> Set Text
-> Text
-> TrackChanges
-> Bool
-> ReaderOptions
ReaderOptions
{ readerExtensions :: Extensions
readerExtensions = Extensions
emptyExtensions
, readerStandalone :: Bool
readerStandalone = Bool
False
, readerColumns :: Int
readerColumns = 80
, readerTabStop :: Int
readerTabStop = 4
, readerIndentedCodeClasses :: [Text]
readerIndentedCodeClasses = []
, readerAbbreviations :: Set Text
readerAbbreviations = Set Text
forall a. Monoid a => a
mempty
, readerDefaultImageExtension :: Text
readerDefaultImageExtension = ""
, readerTrackChanges :: TrackChanges
readerTrackChanges = TrackChanges
AcceptChanges
, readerStripComments :: Bool
readerStripComments = Bool
False
}