{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Text.Pandoc.Writers.Ipynb ( writeIpynb )
where
import Control.Monad (foldM)
import Control.Monad.State ( StateT(runStateT), modify )
import qualified Data.Map as M
import Data.Maybe (catMaybes, fromMaybe)
import Text.Pandoc.Options
import Text.Pandoc.Definition
import Data.Ipynb as Ipynb
import Text.Pandoc.Walk (walkM)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad
import Text.Pandoc.Logging
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Aeson as Aeson
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Shared (safeRead)
import Text.Pandoc.URI (isURI)
import Text.Pandoc.Writers.Shared (metaToContext')
import Text.Pandoc.Writers.Markdown (writePlain, writeMarkdown)
import qualified Data.Text.Encoding as TE
import qualified Data.ByteString.Lazy as BL
import Data.Aeson.Encode.Pretty (Config(..), defConfig,
encodePretty', keyOrder, Indent(Spaces))
import Text.DocLayout (literal)
import Text.Pandoc.UUID (getRandomUUID)
import Data.Char (isAscii, isAlphaNum)
writeIpynb :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeIpynb :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeIpynb WriterOptions
opts Pandoc
d = do
notebook <- WriterOptions -> Pandoc -> m (Notebook NbV4)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m (Notebook NbV4)
pandocToNotebook WriterOptions
opts Pandoc
d
return $ TE.decodeUtf8 . BL.toStrict . encodePretty' defConfig{
confIndent = Spaces 1,
confTrailingNewline = True,
confCompare = keyOrder
[ "cells", "nbformat", "nbformat_minor",
"cell_type", "output_type",
"execution_count", "metadata",
"outputs", "source",
"data", "name", "text" ] <> compare }
$ notebook
pandocToNotebook :: PandocMonad m
=> WriterOptions -> Pandoc -> m (Notebook NbV4)
pandocToNotebook :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m (Notebook NbV4)
pandocToNotebook WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
let blockWriter :: [Block] -> f (Doc Text)
blockWriter [Block]
bs = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> f Text -> f (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> Pandoc -> f Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writePlain WriterOptions
forall a. Default a => a
def (Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [Block]
bs)
let inlineWriter :: [Inline] -> f (Doc Text)
inlineWriter [Inline]
ils = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Text -> Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.stripEnd (Text -> Doc Text) -> f Text -> f (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> Pandoc -> f Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writePlain WriterOptions
forall a. Default a => a
def (Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [[Inline] -> Block
Plain [Inline]
ils])
let jupyterMeta :: Meta
jupyterMeta =
case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"jupyter" Meta
meta of
Just (MetaMap Map Text MetaValue
m) -> Map Text MetaValue -> Meta
Meta Map Text MetaValue
m
Maybe MetaValue
_ -> Meta
forall a. Monoid a => a
mempty
let nbformat :: (Int, Int)
nbformat =
case (Text -> Meta -> Maybe MetaValue
lookupMeta Text
"nbformat" Meta
jupyterMeta,
Text -> Meta -> Maybe MetaValue
lookupMeta Text
"nbformat_minor" Meta
jupyterMeta) of
(Just (MetaInlines [Str Text
"4"]), Just (MetaInlines [Str Text
y])) ->
case Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
y of
Just Int
z -> (Int
4, Int
z)
Maybe Int
Nothing -> (Int
4, Int
5)
(Maybe MetaValue, Maybe MetaValue)
_ -> (Int
4, Int
5)
metadata' <- Context Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Context Text -> Value) -> m (Context Text) -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> m (Doc Text))
-> ([Inline] -> m (Doc Text)) -> Meta -> m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a)) -> Meta -> m (Context a)
metaToContext' [Block] -> m (Doc Text)
forall {f :: * -> *}. PandocMonad f => [Block] -> f (Doc Text)
blockWriter [Inline] -> m (Doc Text)
forall {f :: * -> *}. PandocMonad f => [Inline] -> f (Doc Text)
inlineWriter
(Text -> Meta -> Meta
forall a. HasMeta a => Text -> a -> a
B.deleteMeta Text
"nbformat" (Meta -> Meta) -> (Meta -> Meta) -> Meta -> Meta
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Meta -> Meta
forall a. HasMeta a => Text -> a -> a
B.deleteMeta Text
"nbformat_minor" (Meta -> Meta) -> Meta -> Meta
forall a b. (a -> b) -> a -> b
$
Meta
jupyterMeta)
let metadata = case Value -> Result JSONMeta
forall a. FromJSON a => Value -> Result a
fromJSON Value
metadata' of
Error String
_ -> JSONMeta
forall a. Monoid a => a
mempty
Success JSONMeta
x -> JSONMeta
x
cells <- extractCells nbformat opts blocks
return $ Notebook{
notebookMetadata = metadata
, notebookFormat = nbformat
, notebookCells = cells }
addAttachment :: PandocMonad m
=> Inline
-> StateT (M.Map Text MimeBundle) m Inline
addAttachment :: forall (m :: * -> *).
PandocMonad m =>
Inline -> StateT (Map Text MimeBundle) m Inline
addAttachment (Image Attr
attr [Inline]
lab (Text
src,Text
tit))
| Bool -> Bool
not (Text -> Bool
isURI Text
src) = do
(img, mbmt) <- Text -> StateT (Map Text MimeBundle) m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
src
let mt = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"application/octet-stream" Maybe Text
mbmt
modify $ M.insert src
(MimeBundle (M.insert mt (BinaryData img) mempty))
return $ Image attr lab ("attachment:" <> src, tit)
addAttachment Inline
x = Inline -> StateT (Map Text MimeBundle) m Inline
forall a. a -> StateT (Map Text MimeBundle) m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x
extractCells :: PandocMonad m
=> (Int, Int) -> WriterOptions -> [Block] -> m [Ipynb.Cell a]
(Int, Int)
_ WriterOptions
_ [] = [Cell a] -> m [Cell a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
extractCells (Int, Int)
nbformat WriterOptions
opts (Div (Text
ident,[Text]
classes,[(Text, Text)]
kvs) [Block]
xs : [Block]
bs)
| Text
"cell" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
, Text
"markdown" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes = do
let meta :: JSONMeta
meta = [(Text, Text)] -> JSONMeta
pairsToJSONMeta [(Text, Text)]
kvs
(newdoc, attachments) <-
StateT (Map Text MimeBundle) m Pandoc
-> Map Text MimeBundle -> m (Pandoc, Map Text MimeBundle)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ((Inline -> StateT (Map Text MimeBundle) m Inline)
-> Pandoc -> StateT (Map Text MimeBundle) m Pandoc
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Inline -> m Inline) -> Pandoc -> m Pandoc
walkM Inline -> StateT (Map Text MimeBundle) m Inline
forall (m :: * -> *).
PandocMonad m =>
Inline -> StateT (Map Text MimeBundle) m Inline
addAttachment (Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [Block]
xs)) Map Text MimeBundle
forall a. Monoid a => a
mempty
source <- writeMarkdown opts{ writerTemplate = Nothing } newdoc
uuid <- uuidFrom nbformat ident
(Ipynb.Cell{
cellType = Markdown
, cellId = uuid
, cellSource = Source $ breakLines $ T.stripEnd source
, cellMetadata = meta
, cellAttachments = if M.null attachments
then Nothing
else Just $ MimeAttachments attachments } :)
<$> extractCells nbformat opts bs
| Text
"cell" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
, Text
"code" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes = do
let (Text
codeContent, [Block]
rest) =
case [Block]
xs of
(CodeBlock Attr
_ Text
t : [Block]
ys) -> (Text
t, [Block]
ys)
[Block]
ys -> (Text
forall a. Monoid a => a
mempty, [Block]
ys)
let meta :: JSONMeta
meta = [(Text, Text)] -> JSONMeta
pairsToJSONMeta [(Text, Text)]
kvs
outputs <- [Maybe (Output a)] -> [Output a]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Output a)] -> [Output a])
-> m [Maybe (Output a)] -> m [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> m (Maybe (Output a))) -> [Block] -> m [Maybe (Output a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Block -> m (Maybe (Output a))
forall (m :: * -> *) a.
PandocMonad m =>
Block -> m (Maybe (Output a))
blockToOutput [Block]
rest
let exeCount = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"execution_count" [(Text, Text)]
kvs Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
uuid <- uuidFrom nbformat ident
(Ipynb.Cell{
cellType = Ipynb.Code {
codeExecutionCount = exeCount
, codeOutputs = outputs
}
, cellId = uuid
, cellSource = Source $ breakLines codeContent
, cellMetadata = meta
, cellAttachments = Nothing } :) <$> extractCells nbformat opts bs
| Text
"cell" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
, Text
"raw" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes =
case [Block] -> [Block]
consolidateAdjacentRawBlocks [Block]
xs of
[RawBlock (Format Text
f) Text
raw] -> do
let format' :: Text
format' =
case Text -> Text
T.toLower Text
f of
Text
"html" -> Text
"text/html"
Text
"html4" -> Text
"text/html"
Text
"html5" -> Text
"text/html"
Text
"s5" -> Text
"text/html"
Text
"slidy" -> Text
"text/html"
Text
"slideous" -> Text
"text/html"
Text
"dzslides" -> Text
"text/html"
Text
"revealjs" -> Text
"text/html"
Text
"latex" -> Text
"text/latex"
Text
"markdown" -> Text
"text/markdown"
Text
"rst" -> Text
"text/restructuredtext"
Text
"asciidoc" -> Text
"text/asciidoc"
Text
_ -> Text
f
uuid <- (Int, Int) -> Text -> m (Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
(Int, Int) -> Text -> m (Maybe Text)
uuidFrom (Int, Int)
nbformat Text
ident
(Ipynb.Cell{
cellType = Raw
, cellId = uuid
, cellSource = Source $ breakLines raw
, cellMetadata = if format' == "ipynb"
then mempty
else JSONMeta $ M.insert "raw_mimetype"
(Aeson.String format') mempty
, cellAttachments = Nothing } :) <$> extractCells nbformat opts bs
[Block]
_ -> (Int, Int) -> WriterOptions -> [Block] -> m [Cell a]
forall (m :: * -> *) a.
PandocMonad m =>
(Int, Int) -> WriterOptions -> [Block] -> m [Cell a]
extractCells (Int, Int)
nbformat WriterOptions
opts [Block]
bs
extractCells (Int, Int)
nbformat WriterOptions
opts (CodeBlock (Text
ident,[Text]
classes,[(Text, Text)]
kvs) Text
raw : [Block]
bs)
| Text
"code" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes = do
let meta :: JSONMeta
meta = [(Text, Text)] -> JSONMeta
pairsToJSONMeta [(Text, Text)]
kvs
let exeCount :: Maybe Int
exeCount = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"execution_count" [(Text, Text)]
kvs Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
uuid <- (Int, Int) -> Text -> m (Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
(Int, Int) -> Text -> m (Maybe Text)
uuidFrom (Int, Int)
nbformat Text
ident
(Ipynb.Cell{
cellType = Ipynb.Code {
codeExecutionCount = exeCount
, codeOutputs = []
}
, cellId = uuid
, cellSource = Source $ breakLines raw
, cellMetadata = meta
, cellAttachments = Nothing } :) <$> extractCells nbformat opts bs
extractCells (Int, Int)
nbformat WriterOptions
opts (Block
b:[Block]
bs) = do
let isCodeOrDiv :: Block -> Bool
isCodeOrDiv (CodeBlock (Text
_,[Text]
cl,[(Text, Text)]
_) Text
_) = Text
"code" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cl
isCodeOrDiv (Div (Text
_,[Text]
cl,[(Text, Text)]
_) [Block]
_) = Text
"cell" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cl
isCodeOrDiv Block
_ = Bool
False
let ([Block]
mds, [Block]
rest) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
isCodeOrDiv [Block]
bs
(Int, Int) -> WriterOptions -> [Block] -> m [Cell a]
forall (m :: * -> *) a.
PandocMonad m =>
(Int, Int) -> WriterOptions -> [Block] -> m [Cell a]
extractCells (Int, Int)
nbformat WriterOptions
opts
(Attr -> [Block] -> Block
Div (Text
"",[Text
"cell",Text
"markdown"],[]) (Block
bBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
mds) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest)
uuidFrom :: PandocMonad m => (Int, Int) -> Text -> m (Maybe Text)
uuidFrom :: forall (m :: * -> *).
PandocMonad m =>
(Int, Int) -> Text -> m (Maybe Text)
uuidFrom (Int, Int)
nbformat Text
ident =
if (Int, Int)
nbformat (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
4,Int
5)
then
if Text -> Bool
isValidUUID Text
ident
then Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> m (Maybe Text)) -> Maybe Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ident
else Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (UUID -> Text) -> UUID -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (UUID -> String) -> UUID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
9 (String -> String) -> (UUID -> String) -> UUID -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
forall a. Show a => a -> String
show (UUID -> Maybe Text) -> m UUID -> m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UUID
forall (m :: * -> *). PandocMonad m => m UUID
getRandomUUID
else Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
where
isValidUUID :: Text -> Bool
isValidUUID Text
t = Bool -> Bool
not (Text -> Bool
T.null Text
t) Bool -> Bool -> Bool
&& Text -> Int
T.length Text
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
64 Bool -> Bool -> Bool
&&
(Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isValidUUIDChar Text
t
isValidUUIDChar :: Char -> Bool
isValidUUIDChar Char
c = Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& (Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
blockToOutput :: PandocMonad m => Block -> m (Maybe (Output a))
blockToOutput :: forall (m :: * -> *) a.
PandocMonad m =>
Block -> m (Maybe (Output a))
blockToOutput (Div (Text
_,[Text
"output",Text
"stream",Text
sname],[(Text, Text)]
_) (CodeBlock Attr
_ Text
t:[Block]
_)) =
Maybe (Output a) -> m (Maybe (Output a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Output a) -> m (Maybe (Output a)))
-> Maybe (Output a) -> m (Maybe (Output a))
forall a b. (a -> b) -> a -> b
$ Output a -> Maybe (Output a)
forall a. a -> Maybe a
Just
(Output a -> Maybe (Output a)) -> Output a -> Maybe (Output a)
forall a b. (a -> b) -> a -> b
$ Stream{ streamName :: Text
streamName = Text
sname
, streamText :: Source
streamText = [Text] -> Source
Source (Text -> [Text]
breakLines Text
t) }
blockToOutput (Div (Text
_,[Text
"output",Text
"error"],[(Text, Text)]
kvs) (CodeBlock Attr
_ Text
t:[Block]
_)) =
Maybe (Output a) -> m (Maybe (Output a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Output a) -> m (Maybe (Output a)))
-> Maybe (Output a) -> m (Maybe (Output a))
forall a b. (a -> b) -> a -> b
$ Output a -> Maybe (Output a)
forall a. a -> Maybe a
Just
(Output a -> Maybe (Output a)) -> Output a -> Maybe (Output a)
forall a b. (a -> b) -> a -> b
$ Err{ errName :: Text
errName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"ename" [(Text, Text)]
kvs)
, errValue :: Text
errValue = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"evalue" [(Text, Text)]
kvs)
, errTraceback :: [Text]
errTraceback = Text -> [Text]
breakLines Text
t }
blockToOutput (Div (Text
_,[Text
"output",Text
"execute_result"],[(Text, Text)]
kvs) [Block]
bs) = do
(data', metadata') <- [Block] -> m (MimeBundle, JSONMeta)
forall (m :: * -> *).
PandocMonad m =>
[Block] -> m (MimeBundle, JSONMeta)
extractData [Block]
bs
return $ Just
$ ExecuteResult{ executeCount = fromMaybe 0 $
lookup "execution_count" kvs >>= safeRead
, executeData = data'
, executeMetadata = pairsToJSONMeta kvs <> metadata'}
blockToOutput (Div (Text
_,[Text
"output",Text
"display_data"],[(Text, Text)]
kvs) [Block]
bs) = do
(data', metadata') <- [Block] -> m (MimeBundle, JSONMeta)
forall (m :: * -> *).
PandocMonad m =>
[Block] -> m (MimeBundle, JSONMeta)
extractData [Block]
bs
return $ Just
$ DisplayData { displayData = data'
, displayMetadata = pairsToJSONMeta kvs <> metadata'}
blockToOutput Block
_ = Maybe (Output a) -> m (Maybe (Output a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Output a)
forall a. Maybe a
Nothing
extractData :: PandocMonad m => [Block] -> m (MimeBundle, JSONMeta)
[Block]
bs = do
(mmap, meta) <- ((Map Text MimeData, JSONMeta)
-> Block -> m (Map Text MimeData, JSONMeta))
-> (Map Text MimeData, JSONMeta)
-> [Block]
-> m (Map Text MimeData, JSONMeta)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Map Text MimeData, JSONMeta)
-> Block -> m (Map Text MimeData, JSONMeta)
forall {m :: * -> *}.
PandocMonad m =>
(Map Text MimeData, JSONMeta)
-> Block -> m (Map Text MimeData, JSONMeta)
go (Map Text MimeData, JSONMeta)
forall a. Monoid a => a
mempty ([Block] -> m (Map Text MimeData, JSONMeta))
-> [Block] -> m (Map Text MimeData, JSONMeta)
forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
consolidateAdjacentRawBlocks [Block]
bs
return (MimeBundle mmap, meta)
where
go :: (Map Text MimeData, JSONMeta)
-> Block -> m (Map Text MimeData, JSONMeta)
go (Map Text MimeData
mmap, JSONMeta
meta) b :: Block
b@(Para [Image (Text
_,[Text]
_,[(Text, Text)]
kvs) [Inline]
_ (Text
src,Text
_)]) = do
(img, mbmt) <- Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
src
case mbmt of
Just Text
mt -> (Map Text MimeData, JSONMeta) -> m (Map Text MimeData, JSONMeta)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
(Text -> MimeData -> Map Text MimeData -> Map Text MimeData
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
mt (ByteString -> MimeData
BinaryData ByteString
img) Map Text MimeData
mmap,
JSONMeta
meta JSONMeta -> JSONMeta -> JSONMeta
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)] -> JSONMeta
pairsToJSONMeta [(Text, Text)]
kvs)
Maybe Text
Nothing -> (Map Text MimeData
mmap, JSONMeta
meta) (Map Text MimeData, JSONMeta)
-> m () -> m (Map Text MimeData, JSONMeta)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Block -> LogMessage
BlockNotRendered Block
b)
go (Map Text MimeData
mmap, JSONMeta
meta) b :: Block
b@(CodeBlock (Text
_,[Text
"json"],[(Text, Text)]
_) Text
code) =
case LazyByteString -> Maybe Value
forall a. FromJSON a => LazyByteString -> Maybe a
decode (Text -> LazyByteString
UTF8.fromTextLazy (Text -> LazyByteString) -> Text -> LazyByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
code) of
Just Value
v -> (Map Text MimeData, JSONMeta) -> m (Map Text MimeData, JSONMeta)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
(Text -> MimeData -> Map Text MimeData -> Map Text MimeData
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"application/json" (Value -> MimeData
JsonData Value
v) Map Text MimeData
mmap, JSONMeta
meta)
Maybe Value
Nothing -> (Map Text MimeData
mmap, JSONMeta
meta) (Map Text MimeData, JSONMeta)
-> m () -> m (Map Text MimeData, JSONMeta)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Block -> LogMessage
BlockNotRendered Block
b)
go (Map Text MimeData
mmap, JSONMeta
meta) (CodeBlock (Text
"",[],[]) Text
code) =
(Map Text MimeData, JSONMeta) -> m (Map Text MimeData, JSONMeta)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MimeData -> Map Text MimeData -> Map Text MimeData
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"text/plain" (Text -> MimeData
TextualData Text
code) Map Text MimeData
mmap, JSONMeta
meta)
go (Map Text MimeData
mmap, JSONMeta
meta) (RawBlock (Format Text
"html") Text
raw) =
(Map Text MimeData, JSONMeta) -> m (Map Text MimeData, JSONMeta)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MimeData -> Map Text MimeData -> Map Text MimeData
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"text/html" (Text -> MimeData
TextualData Text
raw) Map Text MimeData
mmap, JSONMeta
meta)
go (Map Text MimeData
mmap, JSONMeta
meta) (RawBlock (Format Text
"latex") Text
raw) =
(Map Text MimeData, JSONMeta) -> m (Map Text MimeData, JSONMeta)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MimeData -> Map Text MimeData -> Map Text MimeData
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"text/latex" (Text -> MimeData
TextualData Text
raw) Map Text MimeData
mmap, JSONMeta
meta)
go (Map Text MimeData
mmap, JSONMeta
meta) (RawBlock (Format Text
"markdown") Text
raw) =
(Map Text MimeData, JSONMeta) -> m (Map Text MimeData, JSONMeta)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MimeData -> Map Text MimeData -> Map Text MimeData
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"text/markdown" (Text -> MimeData
TextualData Text
raw) Map Text MimeData
mmap, JSONMeta
meta)
go (Map Text MimeData
mmap, JSONMeta
meta) (Div Attr
_ [Block]
bs') = ((Map Text MimeData, JSONMeta)
-> Block -> m (Map Text MimeData, JSONMeta))
-> (Map Text MimeData, JSONMeta)
-> [Block]
-> m (Map Text MimeData, JSONMeta)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Map Text MimeData, JSONMeta)
-> Block -> m (Map Text MimeData, JSONMeta)
go (Map Text MimeData
mmap, JSONMeta
meta) [Block]
bs'
go (Map Text MimeData
mmap, JSONMeta
meta) Block
b = (Map Text MimeData
mmap, JSONMeta
meta) (Map Text MimeData, JSONMeta)
-> m () -> m (Map Text MimeData, JSONMeta)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Block -> LogMessage
BlockNotRendered Block
b)
pairsToJSONMeta :: [(Text, Text)] -> JSONMeta
pairsToJSONMeta :: [(Text, Text)] -> JSONMeta
pairsToJSONMeta [(Text, Text)]
kvs = Map Text Value -> JSONMeta
JSONMeta (Map Text Value -> JSONMeta) -> Map Text Value -> JSONMeta
forall a b. (a -> b) -> a -> b
$
[(Text, Value)] -> Map Text Value
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text
k, case LazyByteString -> Maybe Value
forall a. FromJSON a => LazyByteString -> Maybe a
Aeson.decode (Text -> LazyByteString
UTF8.fromTextLazy (Text -> LazyByteString) -> Text -> LazyByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
v) of
Just Value
val -> Value
val
Maybe Value
Nothing -> Text -> Value
String Text
v)
| (Text
k,Text
v) <- [(Text, Text)]
kvs
, Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"execution_count"
]
consolidateAdjacentRawBlocks :: [Block] -> [Block]
consolidateAdjacentRawBlocks :: [Block] -> [Block]
consolidateAdjacentRawBlocks [] = []
consolidateAdjacentRawBlocks (RawBlock Format
f1 Text
x : RawBlock Format
f2 Text
y : [Block]
xs)
| Format
f1 Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
f2
= [Block] -> [Block]
consolidateAdjacentRawBlocks (Format -> Text -> Block
RawBlock Format
f1 (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
xs)
consolidateAdjacentRawBlocks (Block
x : [Block]
xs) =
Block
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
consolidateAdjacentRawBlocks [Block]
xs