{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
   Module      : Text.Pandoc.Writers.Ipynb
   Copyright   : Copyright (C) 2019-2023 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Ipynb (Jupyter notebook JSON format) writer for pandoc.

-}
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 NbV4
notebook <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m (Notebook NbV4)
pandocToNotebook WriterOptions
opts Pandoc
d
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => Config -> a -> ByteString
encodePretty' Config
defConfig{
             confIndent :: Indent
confIndent  = Int -> Indent
Spaces Int
1,
             confTrailingNewline :: Bool
confTrailingNewline = Bool
True,
             confCompare :: Text -> Text -> Ordering
confCompare = [Text] -> Text -> Text -> Ordering
keyOrder
               [ Text
"cells", Text
"nbformat", Text
"nbformat_minor",
                 Text
"cell_type", Text
"output_type",
                 Text
"execution_count", Text
"metadata",
                 Text
"outputs", Text
"source",
                 Text
"data", Text
"name", Text
"text" ] forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => a -> a -> Ordering
compare }
         forall a b. (a -> b) -> a -> b
$ Notebook NbV4
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
  -- we use writePlain w/ default options because e.g. we don't want
  -- to add backslash escapes or convert en dashes, see #7928
  let blockWriter :: [Block] -> f (Doc Text)
blockWriter [Block]
bs = forall a. HasChars a => a -> Doc a
literal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writePlain forall a. Default a => a
def (Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [Block]
bs)
  let inlineWriter :: [Inline] -> f (Doc Text)
inlineWriter [Inline]
ils = forall a. HasChars a => a -> Doc a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.stripEnd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                            forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writePlain 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
_ -> 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 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) -- write as v4.5
  Value
metadata' <- forall a. ToJSON a => a -> Value
toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a)) -> Meta -> m (Context a)
metaToContext' forall {f :: * -> *}. PandocMonad f => [Block] -> f (Doc Text)
blockWriter forall {f :: * -> *}. PandocMonad f => [Inline] -> f (Doc Text)
inlineWriter
                 (forall a. HasMeta a => Text -> a -> a
B.deleteMeta Text
"nbformat" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  forall a. HasMeta a => Text -> a -> a
B.deleteMeta Text
"nbformat_minor" forall a b. (a -> b) -> a -> b
$
                  Meta
jupyterMeta)
  -- convert from a Value (JSON object) to a M.Map Text Value:
  let metadata :: JSONMeta
metadata = case forall a. FromJSON a => Value -> Result a
fromJSON Value
metadata' of
                   Error String
_ -> forall a. Monoid a => a
mempty -- TODO warning here? shouldn't happen
                   Success JSONMeta
x -> JSONMeta
x
  [Cell NbV4]
cells <- forall (m :: * -> *) a.
PandocMonad m =>
(Int, Int) -> WriterOptions -> [Block] -> m [Cell a]
extractCells (Int, Int)
nbformat WriterOptions
opts [Block]
blocks
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 :: 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
  (ByteString
img, Maybe Text
mbmt) <- forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
src
  let mt :: Text
mt = forall a. a -> Maybe a -> a
fromMaybe Text
"application/octet-stream" Maybe Text
mbmt
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
src
          (Map Text MimeData -> MimeBundle
MimeBundle (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
mt (ByteString -> MimeData
BinaryData ByteString
img) forall a. Monoid a => a
mempty))
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
lab (Text
"attachment:" forall a. Semigroup a => a -> a -> a
<> Text
src, Text
tit)
addAttachment Inline
x = forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x

extractCells :: PandocMonad m
             => (Int, Int) -> WriterOptions -> [Block] -> m [Ipynb.Cell a]
extractCells :: forall (m :: * -> *) a.
PandocMonad m =>
(Int, Int) -> WriterOptions -> [Block] -> m [Cell a]
extractCells (Int, Int)
_ WriterOptions
_ [] = 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" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
  , Text
"markdown" 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
      (Pandoc
newdoc, Map Text MimeBundle
attachments) <-
        forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM forall (m :: * -> *).
PandocMonad m =>
Inline -> StateT (Map Text MimeBundle) m Inline
addAttachment (Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [Block]
xs)) forall a. Monoid a => a
mempty
      Text
source <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeMarkdown WriterOptions
opts{ writerTemplate :: Maybe (Template Text)
writerTemplate = forall a. Maybe a
Nothing } Pandoc
newdoc
      Maybe Text
uuid <- forall (m :: * -> *).
PandocMonad m =>
(Int, Int) -> Text -> m (Maybe Text)
uuidFrom (Int, Int)
nbformat Text
ident
      (Ipynb.Cell{
          cellType :: CellType a
cellType = forall a. CellType a
Markdown
        , cellId :: Maybe Text
cellId = Maybe Text
uuid
        , cellSource :: Source
cellSource = [Text] -> Source
Source forall a b. (a -> b) -> a -> b
$ Text -> [Text]
breakLines forall a b. (a -> b) -> a -> b
$ Text -> Text
T.stripEnd Text
source
        , cellMetadata :: JSONMeta
cellMetadata = JSONMeta
meta
        , cellAttachments :: Maybe MimeAttachments
cellAttachments = if forall k a. Map k a -> Bool
M.null Map Text MimeBundle
attachments
                               then forall a. Maybe a
Nothing
                               else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Map Text MimeBundle -> MimeAttachments
MimeAttachments Map Text MimeBundle
attachments } forall a. a -> [a] -> [a]
:)
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
PandocMonad m =>
(Int, Int) -> WriterOptions -> [Block] -> m [Cell a]
extractCells (Int, Int)
nbformat WriterOptions
opts [Block]
bs
  | Text
"cell" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
  , Text
"code" 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                   -> (forall a. Monoid a => a
mempty, [Block]
ys)
      let meta :: JSONMeta
meta = [(Text, Text)] -> JSONMeta
pairsToJSONMeta [(Text, Text)]
kvs
      [Output a]
outputs <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *) a.
PandocMonad m =>
Block -> m (Maybe (Output a))
blockToOutput [Block]
rest
      let exeCount :: Maybe Int
exeCount = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"execution_count" [(Text, Text)]
kvs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
      Maybe Text
uuid <- forall (m :: * -> *).
PandocMonad m =>
(Int, Int) -> Text -> m (Maybe Text)
uuidFrom (Int, Int)
nbformat Text
ident
      (Ipynb.Cell{
          cellType :: CellType a
cellType = Ipynb.Code {
                codeExecutionCount :: Maybe Int
codeExecutionCount = Maybe Int
exeCount
              , codeOutputs :: [Output a]
codeOutputs = [Output a]
outputs
              }
        , cellId :: Maybe Text
cellId = Maybe Text
uuid
        , cellSource :: Source
cellSource = [Text] -> Source
Source forall a b. (a -> b) -> a -> b
$ Text -> [Text]
breakLines Text
codeContent
        , cellMetadata :: JSONMeta
cellMetadata = JSONMeta
meta
        , cellAttachments :: Maybe MimeAttachments
cellAttachments = forall a. Maybe a
Nothing } forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
PandocMonad m =>
(Int, Int) -> WriterOptions -> [Block] -> m [Cell a]
extractCells (Int, Int)
nbformat WriterOptions
opts [Block]
bs
  | Text
"cell" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
  , Text
"raw" 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
          Maybe Text
uuid <- forall (m :: * -> *).
PandocMonad m =>
(Int, Int) -> Text -> m (Maybe Text)
uuidFrom (Int, Int)
nbformat Text
ident
          (Ipynb.Cell{
              cellType :: CellType a
cellType = forall a. CellType a
Raw
            , cellId :: Maybe Text
cellId = Maybe Text
uuid
            , cellSource :: Source
cellSource = [Text] -> Source
Source forall a b. (a -> b) -> a -> b
$ Text -> [Text]
breakLines Text
raw
            , cellMetadata :: JSONMeta
cellMetadata = if Text
format' forall a. Eq a => a -> a -> Bool
== Text
"ipynb" -- means no format given
                                then forall a. Monoid a => a
mempty
                                else Map Text Value -> JSONMeta
JSONMeta forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"raw_mimetype"
                                       (Text -> Value
Aeson.String Text
format') forall a. Monoid a => a
mempty
            , cellAttachments :: Maybe MimeAttachments
cellAttachments = forall a. Maybe a
Nothing } forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
PandocMonad m =>
(Int, Int) -> WriterOptions -> [Block] -> m [Cell a]
extractCells (Int, Int)
nbformat WriterOptions
opts [Block]
bs
        [Block]
_ -> 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" 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 = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"execution_count" [(Text, Text)]
kvs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
      Maybe Text
uuid <- forall (m :: * -> *).
PandocMonad m =>
(Int, Int) -> Text -> m (Maybe Text)
uuidFrom (Int, Int)
nbformat Text
ident
      (Ipynb.Cell{
          cellType :: CellType a
cellType = Ipynb.Code {
                codeExecutionCount :: Maybe Int
codeExecutionCount = Maybe Int
exeCount
              , codeOutputs :: [Output a]
codeOutputs = []
              }
        , cellId :: Maybe Text
cellId = Maybe Text
uuid
        , cellSource :: Source
cellSource = [Text] -> Source
Source forall a b. (a -> b) -> a -> b
$ Text -> [Text]
breakLines Text
raw
        , cellMetadata :: JSONMeta
cellMetadata = JSONMeta
meta
        , cellAttachments :: Maybe MimeAttachments
cellAttachments = forall a. Maybe a
Nothing } forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (Block
b:[Block]
bs) = do
      let isCodeOrDiv :: Block -> Bool
isCodeOrDiv (CodeBlock (Text
_,[Text]
cl,[(Text, Text)]
_) Text
_) = Text
"code" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cl
          isCodeOrDiv (Div (Text
_,[Text]
cl,[(Text, Text)]
_) [Block]
_)       = Text
"cell" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cl
          isCodeOrDiv Block
_                      = Bool
False
      let ([Block]
mds, [Block]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
isCodeOrDiv [Block]
bs
      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
bforall a. a -> [a] -> [a]
:[Block]
mds) forall a. a -> [a] -> [a]
: [Block]
rest)

-- Return Nothing if nbformat < 4.5.
-- Otherwise construct a UUID, using the existing identifier
-- if it is a valid UUID, otherwise constructing a new one.
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 forall a. Ord a => a -> a -> Bool
>= (Int
4,Int
5)
     then
       if Text -> Bool
isValidUUID Text
ident
          then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
ident
          else forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
9 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => m UUID
getRandomUUID
     else forall (m :: * -> *) a. Monad m => a -> m a
return 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 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 forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c 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]
_)) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just
         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]
_)) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just
         forall a b. (a -> b) -> a -> b
$ Err{ errName :: Text
errName = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"ename" [(Text, Text)]
kvs)
              , errValue :: Text
errValue = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty (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
  (MimeBundle
data', JSONMeta
metadata') <- forall (m :: * -> *).
PandocMonad m =>
[Block] -> m (MimeBundle, JSONMeta)
extractData [Block]
bs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just
         forall a b. (a -> b) -> a -> b
$ ExecuteResult{ executeCount :: Int
executeCount = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall a b. (a -> b) -> a -> b
$
                          forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"execution_count" [(Text, Text)]
kvs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
                        , executeData :: MimeBundle
executeData = MimeBundle
data'
                        , executeMetadata :: JSONMeta
executeMetadata = [(Text, Text)] -> JSONMeta
pairsToJSONMeta [(Text, Text)]
kvs forall a. Semigroup a => a -> a -> a
<> JSONMeta
metadata'}
blockToOutput (Div (Text
_,[Text
"output",Text
"display_data"],[(Text, Text)]
kvs) [Block]
bs) = do
  (MimeBundle
data', JSONMeta
metadata') <- forall (m :: * -> *).
PandocMonad m =>
[Block] -> m (MimeBundle, JSONMeta)
extractData [Block]
bs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just
         forall a b. (a -> b) -> a -> b
$ DisplayData { displayData :: MimeBundle
displayData = MimeBundle
data'
                       , displayMetadata :: JSONMeta
displayMetadata = [(Text, Text)] -> JSONMeta
pairsToJSONMeta [(Text, Text)]
kvs forall a. Semigroup a => a -> a -> a
<> JSONMeta
metadata'}
blockToOutput Block
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

extractData :: PandocMonad m => [Block] -> m (MimeBundle, JSONMeta)
extractData :: forall (m :: * -> *).
PandocMonad m =>
[Block] -> m (MimeBundle, JSONMeta)
extractData [Block]
bs = do
  (Map Text MimeData
mmap, JSONMeta
meta) <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {m :: * -> *}.
PandocMonad m =>
(Map Text MimeData, JSONMeta)
-> Block -> m (Map Text MimeData, JSONMeta)
go forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
consolidateAdjacentRawBlocks [Block]
bs
  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 (Map Text MimeData
mmap, JSONMeta
meta) b :: Block
b@(Para [Image (Text
_,[Text]
_,[(Text, Text)]
kvs) [Inline]
_ (Text
src,Text
_)]) = do
      (ByteString
img, Maybe Text
mbmt) <- forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
src
      case Maybe Text
mbmt of
        Just Text
mt -> forall (m :: * -> *) a. Monad m => a -> m a
return
          (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 forall a. Semigroup a => a -> a -> a
<> [(Text, Text)] -> JSONMeta
pairsToJSONMeta [(Text, Text)]
kvs)
        Maybe Text
Nothing -> (Map Text MimeData
mmap, JSONMeta
meta) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ 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 forall a. FromJSON a => ByteString -> Maybe a
decode (Text -> ByteString
UTF8.fromTextLazy forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
code) of
        Just Value
v  -> forall (m :: * -> *) a. Monad m => a -> m a
return
                    (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) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Block -> LogMessage
BlockNotRendered Block
b)
    go (Map Text MimeData
mmap, JSONMeta
meta) (CodeBlock (Text
"",[],[]) Text
code) =
       forall (m :: * -> *) a. Monad m => a -> m a
return (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) =
       forall (m :: * -> *) a. Monad m => a -> m a
return (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) =
       forall (m :: * -> *) a. Monad m => a -> m a
return (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) =
       forall (m :: * -> *) a. Monad m => a -> m a
return (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') = 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) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ 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 forall a b. (a -> b) -> a -> b
$
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text
k, case forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode (Text -> ByteString
UTF8.fromTextLazy 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 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 forall a. Eq a => a -> a -> Bool
== Format
f2
  = [Block] -> [Block]
consolidateAdjacentRawBlocks (Format -> Text -> Block
RawBlock Format
f1 (Text
x forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> Text
y) forall a. a -> [a] -> [a]
: [Block]
xs)
consolidateAdjacentRawBlocks (Block
x : [Block]
xs) =
  Block
x forall a. a -> [a] -> [a]
: [Block] -> [Block]
consolidateAdjacentRawBlocks [Block]
xs