{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
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 :: forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
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 a. PandocError -> m a
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 :: forall (m :: * -> *) a.
PandocMonad m =>
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> m a
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 :: forall (m :: * -> *) a.
PandocMonad m =>
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 = case Cell a -> Maybe MimeAttachments
forall a. Cell a -> Maybe MimeAttachments
cellAttachments Cell a
c of
Maybe MimeAttachments
Nothing -> [(Text, MimeBundle)]
forall a. Monoid a => a
mempty
Just (MimeAttachments Map Text MimeBundle
m) -> Map Text MimeBundle -> [(Text, MimeBundle)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text MimeBundle
m
let ident :: Text
ident = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Cell a -> Maybe Text
forall a. Cell a -> Maybe Text
cellId 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_ (Maybe Text -> (Text, MimeBundle) -> m ()
forall (m :: * -> *).
PandocMonad m =>
Maybe Text -> (Text, MimeBundle) -> m ()
addAttachment (Cell a -> Maybe Text
forall a. Cell a -> Maybe Text
cellId Cell a
c)) [(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 a. a -> m a
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 (Maybe Text -> Inline -> Inline
fixImage (Cell a -> Maybe Text
forall a. Cell a -> Maybe Text
cellId Cell a
c)) (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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Block]
bs
Blocks -> m Blocks
forall a. a -> m a
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
ident,[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 a. a -> m a
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
ident,[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
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 a. Maybe a -> Maybe a -> Maybe a
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 a. a -> m a
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
ident,[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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> m a
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
ident,[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
fixImage :: Maybe Text -> Inline -> Inline
fixImage :: Maybe Text -> Inline -> Inline
fixImage Maybe Text
mbident (Image Attr
attr [Inline]
lab (Text
src,Text
tit))
| Text
"attachment:" Text -> Text -> Bool
`T.isPrefixOf` Text
src =
let src' :: Text
src' = Int -> Text -> Text
T.drop Int
11 Text
src
qualifiedSrc :: Text
qualifiedSrc = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
src' (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src')) Maybe Text
mbident
in Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
lab (Text
qualifiedSrc, Text
tit)
fixImage Maybe Text
_ Inline
x = Inline
x
addAttachment :: PandocMonad m => Maybe Text -> (Text, MimeBundle) -> m ()
addAttachment :: forall (m :: * -> *).
PandocMonad m =>
Maybe Text -> (Text, MimeBundle) -> m ()
addAttachment Maybe Text
mbident (Text
fname, MimeBundle
mimeBundle) = do
let fp :: String
fp = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
fname (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname)) Maybe Text
mbident
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 :: forall (m :: * -> *) a. PandocMonad m => 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 a. a -> m a
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 a. a -> m a
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
handleData :: PandocMonad m
=> JSONMeta -> MimeBundle -> m B.Blocks
handleData :: forall (m :: * -> *).
PandocMonad m =>
JSONMeta -> MimeBundle -> m Blocks
handleData (JSONMeta Map Text Value
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 :: forall (m :: * -> *). PandocMonad m => (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
let meta :: JSONMeta
meta = case Text -> Map Text Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
mt Map Text Value
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
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 a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 (JSONMeta Map Text Value
m) = (Value -> MetaValue) -> Map Text Value -> Map Text MetaValue
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Value -> MetaValue
valueToMetaValue Map Text Value
m
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 b. Integral b => Scientific -> b
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 (JSONMeta Map Text Value
m) = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Text Text -> [(Text, Text)])
-> (Map Text Value -> Map Text Text)
-> Map Text Value
-> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Text) -> Map Text Value -> 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) (Map Text Value -> [(Text, Text)])
-> Map Text Value -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ Map Text Value
m