{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Text.Pandoc.Writers.Ipynb ( writeIpynb )
where
import Prelude
import Control.Monad.State
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
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, isURI)
import Text.Pandoc.Writers.Shared (metaToContext')
import Text.Pandoc.Writers.Markdown (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)
writeIpynb :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeIpynb :: WriterOptions -> Pandoc -> m Text
writeIpynb opts :: WriterOptions
opts d :: Pandoc
d = do
Notebook NbV4
notebook <- WriterOptions -> Pandoc -> m (Notebook NbV4)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m (Notebook NbV4)
pandocToNotebook WriterOptions
opts Pandoc
d
Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (Notebook NbV4 -> ByteString) -> Notebook NbV4 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (Notebook NbV4 -> ByteString) -> Notebook NbV4 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Notebook NbV4 -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
encodePretty' Config
defConfig{
confIndent :: Indent
confIndent = Int -> Indent
Spaces 1,
confTrailingNewline :: Bool
confTrailingNewline = Bool
True,
confCompare :: Text -> Text -> Ordering
confCompare = [Text] -> Text -> Text -> Ordering
keyOrder
[ "cells", "nbformat", "nbformat_minor",
"cell_type", "output_type",
"execution_count", "metadata",
"outputs", "source",
"data", "name", "text" ] }
(Notebook NbV4 -> Text) -> Notebook NbV4 -> Text
forall a b. (a -> b) -> a -> b
$ Notebook NbV4
notebook
pandocToNotebook :: PandocMonad m
=> WriterOptions -> Pandoc -> m (Notebook NbV4)
pandocToNotebook :: WriterOptions -> Pandoc -> m (Notebook NbV4)
pandocToNotebook opts :: WriterOptions
opts (Pandoc meta :: Meta
meta blocks :: [Block]
blocks) = do
let blockWriter :: [Block] -> f (Doc Text)
blockWriter bs :: [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
writeMarkdown
WriterOptions
opts{ writerTemplate :: Maybe (Template Text)
writerTemplate = Maybe (Template Text)
forall a. Maybe a
Nothing } (Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [Block]
bs)
let inlineWriter :: [Inline] -> f (Doc Text)
inlineWriter ils :: [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
writeMarkdown
WriterOptions
opts{ writerTemplate :: Maybe (Template Text)
writerTemplate = Maybe (Template Text)
forall a. Maybe a
Nothing } (Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [[Inline] -> Block
Plain [Inline]
ils])
let jupyterMeta :: Meta
jupyterMeta =
case Text -> Meta -> Maybe MetaValue
lookupMeta "jupyter" Meta
meta of
Just (MetaMap m :: Map Text MetaValue
m) -> Map Text MetaValue -> Meta
Meta Map Text MetaValue
m
_ -> Meta
forall a. Monoid a => a
mempty
let nbformat :: (Int, Int)
nbformat =
case (Text -> Meta -> Maybe MetaValue
lookupMeta "nbformat" Meta
jupyterMeta,
Text -> Meta -> Maybe MetaValue
lookupMeta "nbformat_minor" Meta
jupyterMeta) of
(Just (MetaInlines [Str "4"]), Just (MetaInlines [Str y :: Text
y])) ->
case Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
y of
Just z :: Int
z -> (4, Int
z)
Nothing -> (4, 5)
_ -> (4, 5)
Value
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 "nbformat" (Meta -> Meta) -> Meta -> Meta
forall a b. (a -> b) -> a -> b
$
Text -> Meta -> Meta
forall a. HasMeta a => Text -> a -> a
B.deleteMeta "nbformat_minor" (Meta -> Meta) -> Meta -> Meta
forall a b. (a -> b) -> a -> b
$
Meta
jupyterMeta)
let metadata :: JSONMeta
metadata = case Value -> Result JSONMeta
forall a. FromJSON a => Value -> Result a
fromJSON Value
metadata' of
Error _ -> JSONMeta
forall a. Monoid a => a
mempty
Success x :: JSONMeta
x -> JSONMeta
x
[Cell NbV4]
cells <- WriterOptions -> [Block] -> m [Cell NbV4]
forall (m :: * -> *) a.
PandocMonad m =>
WriterOptions -> [Block] -> m [Cell a]
extractCells WriterOptions
opts [Block]
blocks
Notebook NbV4 -> m (Notebook NbV4)
forall (m :: * -> *) a. Monad m => a -> m a
return (Notebook NbV4 -> m (Notebook NbV4))
-> Notebook NbV4 -> m (Notebook NbV4)
forall a b. (a -> b) -> a -> b
$ Notebook :: forall a. JSONMeta -> (Int, Int) -> [Cell a] -> Notebook a
Notebook{
notebookMetadata :: JSONMeta
notebookMetadata = JSONMeta
metadata
, notebookFormat :: (Int, Int)
notebookFormat = (Int, Int)
nbformat
, notebookCells :: [Cell NbV4]
notebookCells = [Cell NbV4]
cells }
addAttachment :: PandocMonad m
=> Inline
-> StateT (M.Map Text MimeBundle) m Inline
addAttachment :: Inline -> StateT (Map Text MimeBundle) m Inline
addAttachment (Image attr :: Attr
attr lab :: [Inline]
lab (src :: Text
src,tit :: Text
tit))
| Bool -> Bool
not (Text -> Bool
isURI Text
src) = do
(img :: ByteString
img, mbmt :: Maybe Text
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
mt = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "application/octet-stream" Maybe Text
mbmt
(Map Text MimeBundle -> Map Text MimeBundle)
-> StateT (Map Text MimeBundle) m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map Text MimeBundle -> Map Text MimeBundle)
-> StateT (Map Text MimeBundle) m ())
-> (Map Text MimeBundle -> Map Text MimeBundle)
-> StateT (Map Text MimeBundle) m ()
forall a b. (a -> b) -> a -> b
$ Text -> MimeBundle -> Map Text MimeBundle -> Map Text MimeBundle
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
src
(Map Text MimeData -> MimeBundle
MimeBundle (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
forall a. Monoid a => a
mempty))
Inline -> StateT (Map Text MimeBundle) m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> StateT (Map Text MimeBundle) m Inline)
-> Inline -> StateT (Map Text MimeBundle) m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Target -> Inline
Image Attr
attr [Inline]
lab ("attachment:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src, Text
tit)
addAttachment x :: Inline
x = Inline -> StateT (Map Text MimeBundle) m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x
extractCells :: PandocMonad m => WriterOptions -> [Block] -> m [Cell a]
_ [] = [Cell a] -> m [Cell a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
extractCells opts :: WriterOptions
opts (Div (_id :: Text
_id,classes :: [Text]
classes,kvs :: [Target]
kvs) xs :: [Block]
xs : bs :: [Block]
bs)
| "cell" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
, "markdown" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes = do
let meta :: JSONMeta
meta = [Target] -> JSONMeta
pairsToJSONMeta [Target]
kvs
(newdoc :: Pandoc
newdoc, attachments :: Map Text MimeBundle
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
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
Text
source <- WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeMarkdown WriterOptions
opts{ writerTemplate :: Maybe (Template Text)
writerTemplate = Maybe (Template Text)
forall a. Maybe a
Nothing } Pandoc
newdoc
(Cell :: forall a.
CellType a
-> Source -> JSONMeta -> Maybe (Map Text MimeBundle) -> Cell a
Cell{
cellType :: CellType a
cellType = CellType a
forall a. CellType a
Markdown
, cellSource :: Source
cellSource = [Text] -> Source
Source ([Text] -> Source) -> [Text] -> Source
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
breakLines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.stripEnd Text
source
, cellMetadata :: JSONMeta
cellMetadata = JSONMeta
meta
, cellAttachments :: Maybe (Map Text MimeBundle)
cellAttachments = if Map Text MimeBundle -> Bool
forall k a. Map k a -> Bool
M.null Map Text MimeBundle
attachments
then Maybe (Map Text MimeBundle)
forall a. Maybe a
Nothing
else Map Text MimeBundle -> Maybe (Map Text MimeBundle)
forall a. a -> Maybe a
Just Map Text MimeBundle
attachments } Cell a -> [Cell a] -> [Cell a]
forall a. a -> [a] -> [a]
:)
([Cell a] -> [Cell a]) -> m [Cell a] -> m [Cell a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> m [Cell a]
forall (m :: * -> *) a.
PandocMonad m =>
WriterOptions -> [Block] -> m [Cell a]
extractCells WriterOptions
opts [Block]
bs
| "cell" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
, "code" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes = do
let (codeContent :: Text
codeContent, rest :: [Block]
rest) =
case [Block]
xs of
(CodeBlock _ t :: Text
t : ys :: [Block]
ys) -> (Text
t, [Block]
ys)
ys :: [Block]
ys -> (Text
forall a. Monoid a => a
mempty, [Block]
ys)
let meta :: JSONMeta
meta = [Target] -> JSONMeta
pairsToJSONMeta [Target]
kvs
[Output a]
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)
mapM Block -> m (Maybe (Output a))
forall (m :: * -> *) a.
PandocMonad m =>
Block -> m (Maybe (Output a))
blockToOutput [Block]
rest
let exeCount :: Maybe Int
exeCount = Text -> [Target] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "execution_count" [Target]
kvs Maybe Text -> (Text -> Maybe Int) -> Maybe Int
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
(Cell :: forall a.
CellType a
-> Source -> JSONMeta -> Maybe (Map Text MimeBundle) -> Cell a
Cell{
cellType :: CellType a
cellType = Code :: forall a. Maybe Int -> [Output a] -> CellType a
Ipynb.Code {
codeExecutionCount :: Maybe Int
codeExecutionCount = Maybe Int
exeCount
, codeOutputs :: [Output a]
codeOutputs = [Output a]
outputs
}
, cellSource :: Source
cellSource = [Text] -> Source
Source ([Text] -> Source) -> [Text] -> Source
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
breakLines Text
codeContent
, cellMetadata :: JSONMeta
cellMetadata = JSONMeta
meta
, cellAttachments :: Maybe (Map Text MimeBundle)
cellAttachments = Maybe (Map Text MimeBundle)
forall a. Maybe a
Nothing } Cell a -> [Cell a] -> [Cell a]
forall a. a -> [a] -> [a]
:) ([Cell a] -> [Cell a]) -> m [Cell a] -> m [Cell a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> m [Cell a]
forall (m :: * -> *) a.
PandocMonad m =>
WriterOptions -> [Block] -> m [Cell a]
extractCells WriterOptions
opts [Block]
bs
| "cell" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
, "raw" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes =
case [Block] -> [Block]
consolidateAdjacentRawBlocks [Block]
xs of
[RawBlock (Format f :: Text
f) raw :: Text
raw] -> do
let format' :: Text
format' =
case Text -> Text
T.toLower Text
f of
"html" -> "text/html"
"revealjs" -> "text/html"
"latex" -> "text/latex"
"markdown" -> "text/markdown"
"rst" -> "text/x-rst"
_ -> Text
f
(Cell :: forall a.
CellType a
-> Source -> JSONMeta -> Maybe (Map Text MimeBundle) -> Cell a
Cell{
cellType :: CellType a
cellType = CellType a
forall a. CellType a
Raw
, cellSource :: Source
cellSource = [Text] -> Source
Source ([Text] -> Source) -> [Text] -> Source
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
breakLines Text
raw
, cellMetadata :: JSONMeta
cellMetadata = if Text
format' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "ipynb"
then JSONMeta
forall a. Monoid a => a
mempty
else Text -> Value -> JSONMeta -> JSONMeta
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert "format"
(Text -> Value
Aeson.String Text
format') JSONMeta
forall a. Monoid a => a
mempty
, cellAttachments :: Maybe (Map Text MimeBundle)
cellAttachments = Maybe (Map Text MimeBundle)
forall a. Maybe a
Nothing } Cell a -> [Cell a] -> [Cell a]
forall a. a -> [a] -> [a]
:) ([Cell a] -> [Cell a]) -> m [Cell a] -> m [Cell a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> m [Cell a]
forall (m :: * -> *) a.
PandocMonad m =>
WriterOptions -> [Block] -> m [Cell a]
extractCells WriterOptions
opts [Block]
bs
_ -> WriterOptions -> [Block] -> m [Cell a]
forall (m :: * -> *) a.
PandocMonad m =>
WriterOptions -> [Block] -> m [Cell a]
extractCells WriterOptions
opts [Block]
bs
extractCells opts :: WriterOptions
opts (CodeBlock (_id :: Text
_id,classes :: [Text]
classes,kvs :: [Target]
kvs) raw :: Text
raw : bs :: [Block]
bs)
| "code" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes = do
let meta :: JSONMeta
meta = [Target] -> JSONMeta
pairsToJSONMeta [Target]
kvs
let exeCount :: Maybe Int
exeCount = Text -> [Target] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "execution_count" [Target]
kvs Maybe Text -> (Text -> Maybe Int) -> Maybe Int
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
(Cell :: forall a.
CellType a
-> Source -> JSONMeta -> Maybe (Map Text MimeBundle) -> Cell a
Cell{
cellType :: CellType a
cellType = Code :: forall a. Maybe Int -> [Output a] -> CellType a
Ipynb.Code {
codeExecutionCount :: Maybe Int
codeExecutionCount = Maybe Int
exeCount
, codeOutputs :: [Output a]
codeOutputs = []
}
, cellSource :: Source
cellSource = [Text] -> Source
Source ([Text] -> Source) -> [Text] -> Source
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
breakLines Text
raw
, cellMetadata :: JSONMeta
cellMetadata = JSONMeta
meta
, cellAttachments :: Maybe (Map Text MimeBundle)
cellAttachments = Maybe (Map Text MimeBundle)
forall a. Maybe a
Nothing } Cell a -> [Cell a] -> [Cell a]
forall a. a -> [a] -> [a]
:) ([Cell a] -> [Cell a]) -> m [Cell a] -> m [Cell a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> m [Cell a]
forall (m :: * -> *) a.
PandocMonad m =>
WriterOptions -> [Block] -> m [Cell a]
extractCells WriterOptions
opts [Block]
bs
extractCells opts :: WriterOptions
opts (b :: Block
b:bs :: [Block]
bs) = do
let isCodeOrDiv :: Block -> Bool
isCodeOrDiv (CodeBlock (_,cl :: [Text]
cl,_) _) = "code" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cl
isCodeOrDiv (Div (_,cl :: [Text]
cl,_) _) = "cell" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cl
isCodeOrDiv _ = Bool
False
let (mds :: [Block]
mds, rest :: [Block]
rest) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Block -> Bool
isCodeOrDiv) [Block]
bs
WriterOptions -> [Block] -> m [Cell a]
forall (m :: * -> *) a.
PandocMonad m =>
WriterOptions -> [Block] -> m [Cell a]
extractCells WriterOptions
opts (Attr -> [Block] -> Block
Div ("",["cell","markdown"],[]) (Block
bBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
mds) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest)
blockToOutput :: PandocMonad m => Block -> m (Maybe (Output a))
blockToOutput :: Block -> m (Maybe (Output a))
blockToOutput (Div (_,["output","stream",sname :: Text
sname],_) (CodeBlock _ t :: Text
t:_)) =
Maybe (Output a) -> m (Maybe (Output 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 :: forall a. Text -> Source -> Output a
Stream{ streamName :: Text
streamName = Text
sname
, streamText :: Source
streamText = [Text] -> Source
Source (Text -> [Text]
breakLines Text
t) }
blockToOutput (Div (_,["output","error"],kvs :: [Target]
kvs) (CodeBlock _ t :: Text
t:_)) =
Maybe (Output a) -> m (Maybe (Output 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 :: forall a. Text -> Text -> [Text] -> Output a
Err{ errName :: Text
errName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty (Text -> [Target] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "ename" [Target]
kvs)
, errValue :: Text
errValue = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty (Text -> [Target] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "evalue" [Target]
kvs)
, errTraceback :: [Text]
errTraceback = Text -> [Text]
breakLines Text
t }
blockToOutput (Div (_,["output","execute_result"],kvs :: [Target]
kvs) bs :: [Block]
bs) = do
(data' :: MimeBundle
data', metadata' :: JSONMeta
metadata') <- [Block] -> m (MimeBundle, JSONMeta)
forall (m :: * -> *).
PandocMonad m =>
[Block] -> m (MimeBundle, JSONMeta)
extractData [Block]
bs
Maybe (Output a) -> m (Maybe (Output 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
$ ExecuteResult :: forall a. Int -> MimeBundle -> JSONMeta -> Output a
ExecuteResult{ executeCount :: Int
executeCount = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$
Text -> [Target] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "execution_count" [Target]
kvs Maybe Text -> (Text -> Maybe Int) -> Maybe Int
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
, executeData :: MimeBundle
executeData = MimeBundle
data'
, executeMetadata :: JSONMeta
executeMetadata = [Target] -> JSONMeta
pairsToJSONMeta [Target]
kvs JSONMeta -> JSONMeta -> JSONMeta
forall a. Semigroup a => a -> a -> a
<> JSONMeta
metadata'}
blockToOutput (Div (_,["output","display_data"],kvs :: [Target]
kvs) bs :: [Block]
bs) = do
(data' :: MimeBundle
data', metadata' :: JSONMeta
metadata') <- [Block] -> m (MimeBundle, JSONMeta)
forall (m :: * -> *).
PandocMonad m =>
[Block] -> m (MimeBundle, JSONMeta)
extractData [Block]
bs
Maybe (Output a) -> m (Maybe (Output 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
$ DisplayData :: forall a. MimeBundle -> JSONMeta -> Output a
DisplayData { displayData :: MimeBundle
displayData = MimeBundle
data'
, displayMetadata :: JSONMeta
displayMetadata = [Target] -> JSONMeta
pairsToJSONMeta [Target]
kvs JSONMeta -> JSONMeta -> JSONMeta
forall a. Semigroup a => a -> a -> a
<> JSONMeta
metadata'}
blockToOutput _ = Maybe (Output a) -> m (Maybe (Output 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)
bs :: [Block]
bs = do
(mmap :: Map Text MimeData
mmap, meta :: JSONMeta
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
(MimeBundle, JSONMeta) -> m (MimeBundle, JSONMeta)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text MimeData -> MimeBundle
MimeBundle Map Text MimeData
mmap, JSONMeta
meta)
where
go :: (Map Text MimeData, JSONMeta)
-> Block -> m (Map Text MimeData, JSONMeta)
go (mmap :: Map Text MimeData
mmap, meta :: JSONMeta
meta) b :: Block
b@(Para [Image (_,_,kvs :: [Target]
kvs) _ (src :: Text
src,_)]) = do
(img :: ByteString
img, mbmt :: Maybe Text
mbmt) <- Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
src
case Maybe Text
mbmt of
Just mt :: Text
mt -> (Map Text MimeData, JSONMeta) -> m (Map Text MimeData, JSONMeta)
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
<> [Target] -> JSONMeta
pairsToJSONMeta [Target]
kvs)
Nothing -> (Map Text MimeData
mmap, JSONMeta
meta) (Map Text MimeData, JSONMeta)
-> m () -> m (Map Text MimeData, JSONMeta)
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 (mmap :: Map Text MimeData
mmap, meta :: JSONMeta
meta) b :: Block
b@(CodeBlock (_,["json"],_) code :: Text
code) =
case ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode (Text -> ByteString
UTF8.fromTextLazy (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
code) of
Just v :: Value
v -> (Map Text MimeData, JSONMeta) -> m (Map Text MimeData, JSONMeta)
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 "application/json" (Value -> MimeData
JsonData Value
v) Map Text MimeData
mmap, JSONMeta
meta)
Nothing -> (Map Text MimeData
mmap, JSONMeta
meta) (Map Text MimeData, JSONMeta)
-> m () -> m (Map Text MimeData, JSONMeta)
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 (mmap :: Map Text MimeData
mmap, meta :: JSONMeta
meta) (CodeBlock ("",[],[]) code :: Text
code) =
(Map Text MimeData, JSONMeta) -> m (Map Text MimeData, JSONMeta)
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/plain" (Text -> MimeData
TextualData Text
code) Map Text MimeData
mmap, JSONMeta
meta)
go (mmap :: Map Text MimeData
mmap, meta :: JSONMeta
meta) (RawBlock (Format "html") raw :: Text
raw) =
(Map Text MimeData, JSONMeta) -> m (Map Text MimeData, JSONMeta)
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/html" (Text -> MimeData
TextualData Text
raw) Map Text MimeData
mmap, JSONMeta
meta)
go (mmap :: Map Text MimeData
mmap, meta :: JSONMeta
meta) (RawBlock (Format "latex") raw :: Text
raw) =
(Map Text MimeData, JSONMeta) -> m (Map Text MimeData, JSONMeta)
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/latex" (Text -> MimeData
TextualData Text
raw) Map Text MimeData
mmap, JSONMeta
meta)
go (mmap :: Map Text MimeData
mmap, meta :: JSONMeta
meta) (Div _ bs' :: [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 (mmap :: Map Text MimeData
mmap, meta :: JSONMeta
meta) b :: Block
b = (Map Text MimeData
mmap, JSONMeta
meta) (Map Text MimeData, JSONMeta)
-> m () -> m (Map Text MimeData, JSONMeta)
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 :: [Target] -> JSONMeta
pairsToJSONMeta kvs :: [Target]
kvs =
[(Text, Value)] -> JSONMeta
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text
k, case ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode (Text -> ByteString
UTF8.fromTextLazy (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
v) of
Just val :: Value
val -> Value
val
Nothing -> Text -> Value
String Text
v)
| (k :: Text
k,v :: Text
v) <- [Target]
kvs
, Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= "execution_count"
]
consolidateAdjacentRawBlocks :: [Block] -> [Block]
consolidateAdjacentRawBlocks :: [Block] -> [Block]
consolidateAdjacentRawBlocks [] = []
consolidateAdjacentRawBlocks (RawBlock f1 :: Format
f1 x :: Text
x : RawBlock f2 :: Format
f2 y :: Text
y : xs :: [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
<> "\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
xs)
consolidateAdjacentRawBlocks (x :: Block
x : xs :: [Block]
xs) =
Block
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
consolidateAdjacentRawBlocks [Block]
xs