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

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

Ipynb (Jupyter notebook JSON format) reader for pandoc.
-}
module Text.Pandoc.Readers.Ipynb ( readIpynb )
where
import Data.Char (isDigit)
import Data.Maybe (fromMaybe)
import Data.Digest.Pure.SHA (sha1, showDigest)
import Text.Pandoc.Options
import Control.Applicative ((<|>))
import qualified Data.Scientific as Scientific
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Logging
import Text.Pandoc.Definition
import Data.Ipynb as Ipynb
import Text.Pandoc.Class.PandocMonad
import Text.Pandoc.MIME (extensionFromMimeType)
import Text.Pandoc.Shared (tshow)
import Text.Pandoc.UTF8
import Text.Pandoc.Walk (walk)
import Text.Pandoc.Error
import Data.Text (Text)
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.ByteString.Lazy as BL
import Data.Aeson as Aeson
import Control.Monad.Except (throwError)
import Text.Pandoc.Readers.Markdown (readMarkdown)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Sources (ToSources(..), sourcesToText)

readIpynb :: (PandocMonad m, ToSources a)
          => ReaderOptions -> a -> m Pandoc
readIpynb :: ReaderOptions -> a -> m Pandoc
readIpynb ReaderOptions
opts a
x = do
  let src :: ByteString
src = ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> (Sources -> ByteString) -> Sources -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> (Sources -> Text) -> Sources -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sources -> Text
sourcesToText (Sources -> ByteString) -> Sources -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> Sources
forall a. ToSources a => a -> Sources
toSources a
x
  case ByteString -> Either String (Notebook NbV4)
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
src of
    Right (Notebook NbV4
notebook4 :: Notebook NbV4) -> ReaderOptions -> Notebook NbV4 -> m Pandoc
forall (m :: * -> *) a.
PandocMonad m =>
ReaderOptions -> Notebook a -> m Pandoc
notebookToPandoc ReaderOptions
opts Notebook NbV4
notebook4
    Left String
_ ->
      case ByteString -> Either String (Notebook NbV3)
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
src of
        Right (Notebook NbV3
notebook3 :: Notebook NbV3) -> ReaderOptions -> Notebook NbV3 -> m Pandoc
forall (m :: * -> *) a.
PandocMonad m =>
ReaderOptions -> Notebook a -> m Pandoc
notebookToPandoc ReaderOptions
opts Notebook NbV3
notebook3
        Left String
err -> PandocError -> m Pandoc
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Pandoc) -> PandocError -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocIpynbDecodingError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err

notebookToPandoc :: PandocMonad m
                 => ReaderOptions -> Notebook a -> m Pandoc
notebookToPandoc :: ReaderOptions -> Notebook a -> m Pandoc
notebookToPandoc ReaderOptions
opts Notebook a
notebook = do
  let cells :: [Cell a]
cells = Notebook a -> [Cell a]
forall a. Notebook a -> [Cell a]
notebookCells Notebook a
notebook
  let (Int
fmt,Int
fmtminor) = Notebook a -> (Int, Int)
forall a. Notebook a -> (Int, Int)
notebookFormat Notebook a
notebook
  let m :: Map Text MetaValue
m = Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"nbformat" (Text -> MetaValue
MetaString (Text -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
fmt) (Map Text MetaValue -> Map Text MetaValue)
-> Map Text MetaValue -> Map Text MetaValue
forall a b. (a -> b) -> a -> b
$
          Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"nbformat_minor" (Text -> MetaValue
MetaString (Text -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
fmtminor) (Map Text MetaValue -> Map Text MetaValue)
-> Map Text MetaValue -> Map Text MetaValue
forall a b. (a -> b) -> a -> b
$
          JSONMeta -> Map Text MetaValue
jsonMetaToMeta (Notebook a -> JSONMeta
forall a. Notebook a -> JSONMeta
notebookMetadata Notebook a
notebook)
  let lang :: Text
lang = case Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"kernelspec" Map Text MetaValue
m of
                   Just (MetaMap Map Text MetaValue
ks) ->
                      case Text -> Map Text MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"language" Map Text MetaValue
ks of
                         Just (MetaString Text
l) -> Text
l
                         Maybe MetaValue
_ -> Text
"python"
                   Maybe MetaValue
_ -> Text
"python"
  Blocks
bs <- [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> m [Blocks] -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cell a -> m Blocks) -> [Cell a] -> m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ReaderOptions -> Text -> Cell a -> m Blocks
forall (m :: * -> *) a.
PandocMonad m =>
ReaderOptions -> Text -> Cell a -> m Blocks
cellToBlocks ReaderOptions
opts Text
lang) [Cell a]
cells
  let Pandoc Meta
_ [Block]
blocks = Blocks -> Pandoc
B.doc Blocks
bs
  Pandoc -> m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> m Pandoc) -> Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc (Map Text MetaValue -> Meta
Meta (Map Text MetaValue -> Meta) -> Map Text MetaValue -> Meta
forall a b. (a -> b) -> a -> b
$ Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"jupyter" (Map Text MetaValue -> MetaValue
MetaMap Map Text MetaValue
m) Map Text MetaValue
forall a. Monoid a => a
mempty) [Block]
blocks

cellToBlocks :: PandocMonad m
             => ReaderOptions -> Text -> Ipynb.Cell a -> m B.Blocks
cellToBlocks :: ReaderOptions -> Text -> Cell a -> m Blocks
cellToBlocks ReaderOptions
opts Text
lang Cell a
c = do
  let Source [Text]
ts = Cell a -> Source
forall a. Cell a -> Source
cellSource Cell a
c
  let source :: Text
source = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text]
ts
  let kvs :: [(Text, Text)]
kvs = JSONMeta -> [(Text, Text)]
jsonMetaToPairs (Cell a -> JSONMeta
forall a. Cell a -> JSONMeta
cellMetadata Cell a
c)
  let attachments :: [(Text, MimeBundle)]
attachments = [(Text, MimeBundle)]
-> (Map Text MimeBundle -> [(Text, MimeBundle)])
-> Maybe (Map Text MimeBundle)
-> [(Text, MimeBundle)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(Text, MimeBundle)]
forall a. Monoid a => a
mempty Map Text MimeBundle -> [(Text, MimeBundle)]
forall k a. Map k a -> [(k, a)]
M.toList (Maybe (Map Text MimeBundle) -> [(Text, MimeBundle)])
-> Maybe (Map Text MimeBundle) -> [(Text, MimeBundle)]
forall a b. (a -> b) -> a -> b
$ Cell a -> Maybe (Map Text MimeBundle)
forall a. Cell a -> Maybe (Map Text MimeBundle)
cellAttachments Cell a
c
  ((Text, MimeBundle) -> m ()) -> [(Text, MimeBundle)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text, MimeBundle) -> m ()
forall (m :: * -> *). PandocMonad m => (Text, MimeBundle) -> m ()
addAttachment [(Text, MimeBundle)]
attachments
  case Cell a -> CellType a
forall a. Cell a -> CellType a
cellType Cell a
c of
    CellType a
Ipynb.Markdown -> do
      [Block]
bs <- if Extension -> ReaderOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_markdown ReaderOptions
opts
               then [Block] -> m [Block]
forall (m :: * -> *) a. Monad m => a -> m a
return [Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"markdown") Text
source]
               else do
                 Pandoc Meta
_ [Block]
bs <- (Inline -> Inline) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
fixImage (Pandoc -> Pandoc) -> m Pandoc -> m Pandoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderOptions -> Text -> m Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readMarkdown ReaderOptions
opts Text
source
                 [Block] -> m [Block]
forall (m :: * -> *) a. Monad m => a -> m a
return [Block]
bs
      Blocks -> m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"cell",Text
"markdown"],[(Text, Text)]
kvs)
             (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ [Block] -> Blocks
forall a. [a] -> Many a
B.fromList [Block]
bs
    Ipynb.Heading Int
lev -> do
      Pandoc Meta
_ [Block]
bs <- ReaderOptions -> Text -> m Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readMarkdown ReaderOptions
opts
        (Int -> Text -> Text
T.replicate Int
lev Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
source)
      Blocks -> m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"cell",Text
"markdown"],[(Text, Text)]
kvs)
             (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ [Block] -> Blocks
forall a. [a] -> Many a
B.fromList [Block]
bs
    CellType a
Ipynb.Raw -> do
      -- we use ipynb to indicate no format given (a wildcard in nbformat)
      let format :: Text
format = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"ipynb" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"raw_mimetype" [(Text, Text)]
kvs Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"format" [(Text, Text)]
kvs
      let format' :: Text
format' =
            case Text
format of
              Text
"text/html"             -> Text
"html"
              Text
"slides"                -> Text
"html"
              Text
"text/latex"            -> Text
"latex"
              Text
"application/pdf"       -> Text
"latex"
              Text
"pdf"                   -> Text
"latex"
              Text
"text/markdown"         -> Text
"markdown"
              Text
"text/x-rst"            -> Text
"rst"
              Text
"text/restructuredtext" -> Text
"rst"
              Text
"text/asciidoc"         -> Text
"asciidoc"
              Text
_                       -> Text
format
      Blocks -> m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"cell",Text
"raw"],[(Text, Text)]
kvs) (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Blocks
B.rawBlock Text
format' Text
source
    Ipynb.Code{ codeOutputs :: forall a. CellType a -> [Output a]
codeOutputs = [Output a]
outputs, codeExecutionCount :: forall a. CellType a -> Maybe Int
codeExecutionCount = Maybe Int
ec } -> do
      Blocks
outputBlocks <- [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> m [Blocks] -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Output a -> m Blocks) -> [Output a] -> m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Output a -> m Blocks
forall (m :: * -> *) a. PandocMonad m => Output a -> m Blocks
outputToBlock [Output a]
outputs
      let kvs' :: [(Text, Text)]
kvs' = [(Text, Text)]
-> (Int -> [(Text, Text)]) -> Maybe Int -> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(Text, Text)]
kvs (\Int
x -> (Text
"execution_count", Int -> Text
forall a. Show a => a -> Text
tshow Int
x)(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[(Text, Text)]
kvs) Maybe Int
ec
      Blocks -> m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"cell",Text
"code"],[(Text, Text)]
kvs') (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$
        Attr -> Text -> Blocks
B.codeBlockWith (Text
"",[Text
lang],[]) Text
source
        Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
outputBlocks

-- Remove attachment: prefix from images...
fixImage :: Inline -> Inline
fixImage :: Inline -> Inline
fixImage (Image Attr
attr [Inline]
lab (Text
src,Text
tit))
  | Text
"attachment:" Text -> Text -> Bool
`T.isPrefixOf` Text
src = Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
lab (Int -> Text -> Text
T.drop Int
11 Text
src, Text
tit)
fixImage Inline
x = Inline
x

addAttachment :: PandocMonad m => (Text, MimeBundle) -> m ()
addAttachment :: (Text, MimeBundle) -> m ()
addAttachment (Text
fname, MimeBundle
mimeBundle) = do
  let fp :: String
fp = Text -> String
T.unpack Text
fname
  case Map Text MimeData -> [(Text, MimeData)]
forall k a. Map k a -> [(k, a)]
M.toList (MimeBundle -> Map Text MimeData
unMimeBundle MimeBundle
mimeBundle) of
    (Text
mimeType, BinaryData ByteString
bs):[(Text, MimeData)]
_ ->
      String -> Maybe Text -> ByteString -> m ()
forall (m :: * -> *).
PandocMonad m =>
String -> Maybe Text -> ByteString -> m ()
insertMedia String
fp (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
mimeType) (ByteString -> ByteString
BL.fromStrict ByteString
bs)
    (Text
mimeType, TextualData Text
t):[(Text, MimeData)]
_ ->
      String -> Maybe Text -> ByteString -> m ()
forall (m :: * -> *).
PandocMonad m =>
String -> Maybe Text -> ByteString -> m ()
insertMedia String
fp (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
mimeType)
          (ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
t)
    (Text
mimeType, JsonData Value
v):[(Text, MimeData)]
_ ->
      String -> Maybe Text -> ByteString -> m ()
forall (m :: * -> *).
PandocMonad m =>
String -> Maybe Text -> ByteString -> m ()
insertMedia String
fp (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
mimeType) (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
v)
    [] -> LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
fname Text
"no attachment"

outputToBlock :: PandocMonad m => Output a -> m B.Blocks
outputToBlock :: Output a -> m Blocks
outputToBlock Stream{ streamName :: forall a. Output a -> Text
streamName = Text
sName,
                      streamText :: forall a. Output a -> Source
streamText = Source [Text]
text } =
  Blocks -> m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"output",Text
"stream",Text
sName],[])
         (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Blocks
B.codeBlock (Text -> Blocks) -> Text -> Blocks
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text]
text
outputToBlock DisplayData{ displayData :: forall a. Output a -> MimeBundle
displayData = MimeBundle
data',
                            displayMetadata :: forall a. Output a -> JSONMeta
displayMetadata = JSONMeta
metadata' } =
  Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"output", Text
"display_data"],[]) (Blocks -> Blocks) -> m Blocks -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    JSONMeta -> MimeBundle -> m Blocks
forall (m :: * -> *).
PandocMonad m =>
JSONMeta -> MimeBundle -> m Blocks
handleData JSONMeta
metadata' MimeBundle
data'
outputToBlock ExecuteResult{ executeCount :: forall a. Output a -> Int
executeCount = Int
ec,
                              executeData :: forall a. Output a -> MimeBundle
executeData = MimeBundle
data',
                              executeMetadata :: forall a. Output a -> JSONMeta
executeMetadata = JSONMeta
metadata' } =
  Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"output", Text
"execute_result"],[(Text
"execution_count",Int -> Text
forall a. Show a => a -> Text
tshow Int
ec)])
    (Blocks -> Blocks) -> m Blocks -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSONMeta -> MimeBundle -> m Blocks
forall (m :: * -> *).
PandocMonad m =>
JSONMeta -> MimeBundle -> m Blocks
handleData JSONMeta
metadata' MimeBundle
data'
outputToBlock Err{ errName :: forall a. Output a -> Text
errName = Text
ename,
                   errValue :: forall a. Output a -> Text
errValue = Text
evalue,
                   errTraceback :: forall a. Output a -> [Text]
errTraceback = [Text]
traceback } =
  Blocks -> m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"output",Text
"error"],
                         [(Text
"ename",Text
ename),
                          (Text
"evalue",Text
evalue)])
         (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Blocks
B.codeBlock (Text -> Blocks) -> Text -> Blocks
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [Text]
traceback

-- We want to display the richest output possible given
-- the output format.
handleData :: PandocMonad m
           => JSONMeta -> MimeBundle -> m B.Blocks
handleData :: JSONMeta -> MimeBundle -> m Blocks
handleData JSONMeta
metadata (MimeBundle Map Text MimeData
mb) =
  [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> m [Blocks] -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, MimeData) -> m Blocks) -> [(Text, MimeData)] -> m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, MimeData) -> m Blocks
forall (m :: * -> *). PandocMonad m => (Text, MimeData) -> m Blocks
dataBlock (Map Text MimeData -> [(Text, MimeData)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text MimeData
mb)

  where

    dataBlock :: PandocMonad m => (MimeType, MimeData) -> m B.Blocks
    dataBlock :: (Text, MimeData) -> m Blocks
dataBlock (Text
mt, MimeData
d)
     | Text
"image/" Text -> Text -> Bool
`T.isPrefixOf` Text
mt Bool -> Bool -> Bool
|| Text
mt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"application/pdf"
      = do
      -- normally metadata maps from mime types to key-value map;
      -- but not always...
      let meta :: JSONMeta
meta = case Text -> JSONMeta -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
mt JSONMeta
metadata of
                   Just v :: Value
v@Object{} ->
                     case Value -> Result JSONMeta
forall a. FromJSON a => Value -> Result a
fromJSON Value
v of
                       Success JSONMeta
m' -> JSONMeta
m'
                       Error String
_   -> JSONMeta
forall a. Monoid a => a
mempty
                   Maybe Value
_ -> JSONMeta
forall a. Monoid a => a
mempty
      let metaPairs :: [(Text, Text)]
metaPairs = JSONMeta -> [(Text, Text)]
jsonMetaToPairs JSONMeta
meta
      let bl :: ByteString
bl = case MimeData
d of
                 BinaryData ByteString
bs  -> ByteString -> ByteString
BL.fromStrict ByteString
bs
                 TextualData Text
t  -> ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
UTF8.fromText Text
t
                 JsonData Value
v     -> Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
v
      -- SHA1 hash for filename
      let fname :: Text
fname = String -> Text
T.pack (Digest SHA1State -> String
forall t. Digest t -> String
showDigest (ByteString -> Digest SHA1State
sha1 ByteString
bl)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            case Text -> Maybe Text
extensionFromMimeType Text
mt of
              Maybe Text
Nothing  -> Text
""
              Just Text
ext -> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ext
      String -> Maybe Text -> ByteString -> m ()
forall (m :: * -> *).
PandocMonad m =>
String -> Maybe Text -> ByteString -> m ()
insertMedia (Text -> String
T.unpack Text
fname) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
mt) ByteString
bl
      Blocks -> m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
B.imageWith (Text
"",[],[(Text, Text)]
metaPairs) Text
fname Text
"" Inlines
forall a. Monoid a => a
mempty

    dataBlock (Text
"text/html", TextualData Text
t)
      = Blocks -> m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Blocks
B.rawBlock Text
"html" Text
t

    dataBlock (Text
"text/latex", TextualData Text
t)
      = Blocks -> m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Blocks
B.rawBlock Text
"latex" Text
t

    dataBlock (Text
"text/markdown", TextualData Text
t)
      = Blocks -> m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Blocks
B.rawBlock Text
"markdown" Text
t

    dataBlock (Text
"text/plain", TextualData Text
t) =
      Blocks -> m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Blocks
B.codeBlock Text
t

    dataBlock (Text
_, JsonData Value
v) =
      Blocks -> m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Blocks
B.codeBlockWith (Text
"",[Text
"json"],[]) (Text -> Blocks) -> Text -> Blocks
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
toStringLazy (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
v

    dataBlock (Text, MimeData)
_ = Blocks -> m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty

jsonMetaToMeta :: JSONMeta -> M.Map Text MetaValue
jsonMetaToMeta :: JSONMeta -> Map Text MetaValue
jsonMetaToMeta = (Value -> MetaValue) -> JSONMeta -> Map Text MetaValue
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Value -> MetaValue
valueToMetaValue
  where
    valueToMetaValue :: Value -> MetaValue
    valueToMetaValue :: Value -> MetaValue
valueToMetaValue x :: Value
x@Object{} =
      case Value -> Result JSONMeta
forall a. FromJSON a => Value -> Result a
fromJSON Value
x of
        Error String
s -> Text -> MetaValue
MetaString (Text -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
        Success JSONMeta
jm' -> Map Text MetaValue -> MetaValue
MetaMap (Map Text MetaValue -> MetaValue)
-> Map Text MetaValue -> MetaValue
forall a b. (a -> b) -> a -> b
$ JSONMeta -> Map Text MetaValue
jsonMetaToMeta JSONMeta
jm'
    valueToMetaValue x :: Value
x@Array{} =
      case Value -> Result [Value]
forall a. FromJSON a => Value -> Result a
fromJSON Value
x of
        Error String
s -> Text -> MetaValue
MetaString (Text -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
        Success [Value]
xs -> [MetaValue] -> MetaValue
MetaList ([MetaValue] -> MetaValue) -> [MetaValue] -> MetaValue
forall a b. (a -> b) -> a -> b
$ (Value -> MetaValue) -> [Value] -> [MetaValue]
forall a b. (a -> b) -> [a] -> [b]
map Value -> MetaValue
valueToMetaValue [Value]
xs
    valueToMetaValue (Bool Bool
b) = Bool -> MetaValue
MetaBool Bool
b
    valueToMetaValue (String Text
t) = Text -> MetaValue
MetaString Text
t
    valueToMetaValue (Number Scientific
n)
      | Scientific -> Bool
Scientific.isInteger Scientific
n = Text -> MetaValue
MetaString (Integer -> Text
forall a. Show a => a -> Text
tshow (Scientific -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor Scientific
n :: Integer))
      | Bool
otherwise              = Text -> MetaValue
MetaString (Scientific -> Text
forall a. Show a => a -> Text
tshow Scientific
n)
    valueToMetaValue Value
Aeson.Null = Text -> MetaValue
MetaString Text
""

jsonMetaToPairs :: JSONMeta -> [(Text, Text)]
jsonMetaToPairs :: JSONMeta -> [(Text, Text)]
jsonMetaToPairs = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Text Text -> [(Text, Text)])
-> (JSONMeta -> Map Text Text) -> JSONMeta -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Text) -> JSONMeta -> Map Text Text
forall a b k. (a -> b) -> Map k a -> Map k b
M.map
  (\case
      String Text
t
        | Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
t)
        , Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"true"
        , Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"false"
                 -> Text
t
      Value
x          -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
UTF8.toStringLazy (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode Value
x)