@@ -0,0 +1,233 @@
1+{-# LANGUAGE NoImplicitPrelude #-}
2+{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE ScopedTypeVariables #-}
5+{-
6+Copyright (C) 2019 John MacFarlane <jgm@berkeley.edu>
7+
8+This program is free software; you can redistribute it and/or modify
9+it under the terms of the GNU General Public License as published by
10+the Free Software Foundation; either version 2 of the License, or
11+(at your option) any later version.
12+
13+This program is distributed in the hope that it will be useful,
14+but WITHOUT ANY WARRANTY; without even the implied warranty of
15+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16+GNU General Public License for more details.
17+
18+You should have received a copy of the GNU General Public License
19+along with this program; if not, write to the Free Software
20+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21+-}
22+
23+{- |
24+ Module : Text.Pandoc.Writers.Ipynb
25+ Copyright : Copyright (C) 2019 John MacFarlane
26+ License : GNU GPL, version 2 or above
27+
28+ Maintainer : John MacFarlane <jgm@berkeley.edu>
29+ Stability : alpha
30+ Portability : portable
31+
32+Ipynb (Jupyter notebook JSON format) writer for pandoc.
33+
34+-}
35+module Text.Pandoc.Writers.Ipynb ( writeIpynb )
36+where
37+import Prelude
38+import Control.Monad (foldM)
39+import Control.Monad.State
40+import qualified Data.Map as M
41+import Data.Maybe (catMaybes, fromMaybe)
42+import Text.Pandoc.Options
43+import Text.Pandoc.Definition
44+import Data.Ipynb as Ipynb
45+import Text.Pandoc.Walk (walkM)
46+import qualified Text.Pandoc.Builder as B
47+import Text.Pandoc.Class
48+import Text.Pandoc.Logging
49+import Data.Text (Text)
50+import qualified Data.Text as T
51+import Data.Aeson as Aeson
52+import qualified Text.Pandoc.UTF8 as UTF8
53+import Text.Pandoc.Shared (safeRead)
54+import Text.Pandoc.Writers.Shared (metaToJSON')
55+import Text.Pandoc.Writers.Markdown (writeMarkdown)
56+import qualified Data.Text.Encoding as TE
57+import qualified Data.ByteString.Lazy as BL
58+import Data.Aeson.Encode.Pretty (Config(..), defConfig,
59+ encodePretty', keyOrder, Indent(Spaces))
60+
61+writeIpynb :: PandocMonad m => WriterOptions -> Pandoc -> m Text
62+writeIpynb opts d = do
63+ notebook <- pandocToNotebook opts d
64+ return $ TE.decodeUtf8 . BL.toStrict . encodePretty' defConfig{
65+ confIndent = Spaces 1,
66+ confCompare = keyOrder
67+ [ "cells", "nbformat", "nbformat_minor",
68+ "cell_type", "output_type",
69+ "execution_count", "metadata",
70+ "outputs", "source",
71+ "data", "name", "text" ] }
72+ $ notebook
73+
74+pandocToNotebook :: PandocMonad m
75+ => WriterOptions -> Pandoc -> m (Notebook NbV4)
76+pandocToNotebook opts (Pandoc meta blocks) = do
77+ let blockWriter bs = writeMarkdown
78+ opts{ writerTemplate = Nothing } (Pandoc nullMeta bs)
79+ let inlineWriter ils = T.stripEnd <$> writeMarkdown
80+ opts{ writerTemplate = Nothing } (Pandoc nullMeta [Plain ils])
81+ metadata' <- metaToJSON' blockWriter inlineWriter $
82+ B.deleteMeta "nbformat" $
83+ B.deleteMeta "nbformat_minor" $ meta
84+ let metadata = case fromJSON metadata' of
85+ Error _ -> mempty -- TODO warning here? shouldn't happen
86+ Success x -> x
87+ cells <- extractCells opts blocks
88+ return $ Notebook{
89+ notebookMetadata = metadata
90+ , notebookFormat = (4, 5)
91+ , notebookCells = cells }
92+
93+addAttachment :: PandocMonad m
94+ => Inline
95+ -> StateT (M.Map Text MimeBundle) m Inline
96+addAttachment (Image attr lab (src,tit)) = do
97+ (img, mbmt) <- fetchItem src
98+ let mt = maybe "application/octet-stream" (T.pack) mbmt
99+ modify $ M.insert (T.pack src)
100+ (MimeBundle (M.insert mt (BinaryData img) mempty))
101+ return $ Image attr lab ("attachment:" <> src, tit)
102+addAttachment x = return x
103+
104+extractCells :: PandocMonad m => WriterOptions -> [Block] -> m [Cell a]
105+extractCells _ [] = return []
106+extractCells opts (Div (_id,classes,kvs) xs : bs)
107+ | "cell" `elem` classes
108+ , "markdown" `elem` classes = do
109+ let meta = pairsToJSONMeta kvs
110+ (newdoc, attachments) <-
111+ runStateT (walkM addAttachment (Pandoc nullMeta xs)) mempty
112+ source <- writeMarkdown opts{ writerTemplate = Nothing } newdoc
113+ (Cell{
114+ cellType = Markdown
115+ , cellSource = Source $ breakLines source
116+ , cellMetadata = meta
117+ , cellAttachments = if M.null attachments
118+ then Nothing
119+ else Just attachments } :)
120+ <$> extractCells opts bs
121+ | "cell" `elem` classes
122+ , "code" `elem` classes = do
123+ let (codeContent, rest) =
124+ case xs of
125+ (CodeBlock _ t : ys) -> (T.pack t, ys)
126+ ys -> (mempty, ys)
127+ let meta = pairsToJSONMeta kvs
128+ outputs <- catMaybes <$> mapM blockToOutput rest
129+ let exeCount = lookup "execution_count" kvs >>= safeRead
130+ (Cell{
131+ cellType = Ipynb.Code {
132+ codeExecutionCount = exeCount
133+ , codeOutputs = outputs
134+ }
135+ , cellSource = Source $ breakLines codeContent
136+ , cellMetadata = meta
137+ , cellAttachments = Nothing } :) <$> extractCells opts bs
138+ | "cell" `elem` classes
139+ , "raw" `elem` classes =
140+ case xs of
141+ [RawBlock (Format f) raw] -> do
142+ let format' =
143+ case f of
144+ "html" -> "text/html"
145+ "revealjs" -> "text/html"
146+ "latex" -> "text/latex"
147+ "markdown" -> "text/markdown"
148+ "rst" -> "text/x-rst"
149+ _ -> f
150+ (Cell{
151+ cellType = Raw
152+ , cellSource = Source $ breakLines $ T.pack raw
153+ , cellMetadata = M.insert "format"
154+ (Aeson.String $ T.pack format') mempty
155+ , cellAttachments = Nothing } :) <$> extractCells opts bs
156+ _ -> extractCells opts bs
157+extractCells opts (CodeBlock (_id,classes,kvs) raw : bs)
158+ | "code" `elem` classes = do
159+ let meta = pairsToJSONMeta kvs
160+ let exeCount = lookup "execution_count" kvs >>= safeRead
161+ (Cell{
162+ cellType = Ipynb.Code {
163+ codeExecutionCount = exeCount
164+ , codeOutputs = []
165+ }
166+ , cellSource = Source $ breakLines $ T.pack raw
167+ , cellMetadata = meta
168+ , cellAttachments = Nothing } :) <$> extractCells opts bs
169+extractCells opts (b:bs) = do
170+ let isCodeOrDiv (CodeBlock (_,cl,_) _) = "code" `elem` cl
171+ isCodeOrDiv (Div (_,cl,_) _) = "cell" `elem` cl
172+ isCodeOrDiv _ = False
173+ let (mds, rest) = break (isCodeOrDiv) bs
174+ extractCells opts (Div ("",["cell","markdown"],[]) (b:mds) : rest)
175+
176+blockToOutput :: PandocMonad m => Block -> m (Maybe (Output a))
177+blockToOutput (Div (_,["output","stream",sname],_) (CodeBlock _ t:_)) =
178+ return $ Just
179+ $ Stream{ streamName = T.pack sname
180+ , streamText = Source (breakLines $ T.pack t) }
181+blockToOutput (Div (_,["output","error"],kvs) (CodeBlock _ t:_)) =
182+ return $ Just
183+ $ Err{ errName = maybe mempty T.pack (lookup "ename" kvs)
184+ , errValue = maybe mempty T.pack (lookup "evalue" kvs)
185+ , errTraceback = breakLines $ T.pack t }
186+blockToOutput (Div (_,["output","execute_result"],kvs) bs) = do
187+ (data', metadata') <- extractData bs
188+ return $ Just
189+ $ ExecuteResult{ executeCount = fromMaybe 0 $
190+ lookup "execution_count" kvs >>= safeRead
191+ , executeData = data'
192+ , executeMetadata = pairsToJSONMeta kvs <> metadata'}
193+blockToOutput (Div (_,["output","display_data"],kvs) bs) = do
194+ (data', metadata') <- extractData bs
195+ return $ Just
196+ $ DisplayData { displayData = data'
197+ , displayMetadata = pairsToJSONMeta kvs <> metadata'}
198+blockToOutput _ = return Nothing
199+
200+extractData :: PandocMonad m => [Block] -> m (MimeBundle, JSONMeta)
201+extractData bs = do
202+ (mmap, meta) <- foldM go mempty bs
203+ return (MimeBundle mmap, meta)
204+ where
205+ go (mmap, meta) b@(Para [Image (_,_,kvs) _ (src,_)]) = do
206+ (img, mbmt) <- fetchItem src
207+ case mbmt of
208+ Just mt -> return
209+ (M.insert (T.pack mt) (BinaryData img) mmap,
210+ meta <> pairsToJSONMeta kvs)
211+ Nothing -> (mmap, meta) <$ report (BlockNotRendered b)
212+ go (mmap, meta) b@(CodeBlock (_,["json"],_) code) =
213+ case decode (UTF8.fromStringLazy code) of
214+ Just v -> return
215+ (M.insert "application/json" (JsonData v) mmap, meta)
216+ Nothing -> (mmap, meta) <$ report (BlockNotRendered b)
217+ go (mmap, meta) (CodeBlock ("",[],[]) code) =
218+ return (M.insert "text/plain" (TextualData (T.pack code)) mmap, meta)
219+ go (mmap, meta) (RawBlock (Format "html") raw) =
220+ return (M.insert "text/html" (TextualData (T.pack raw)) mmap, meta)
221+ go (mmap, meta) (RawBlock (Format "latex") raw) =
222+ return (M.insert "text/latex" (TextualData (T.pack raw)) mmap, meta)
223+ go (mmap, meta) b = (mmap, meta) <$ report (BlockNotRendered b)
224+
225+pairsToJSONMeta :: [(String, String)] -> JSONMeta
226+pairsToJSONMeta kvs =
227+ M.fromList [(T.pack k, case v of
228+ "true" -> Bool True
229+ "false" -> Bool False
230+ _ -> case safeRead v of
231+ Just n -> Number n
232+ _ -> String (T.pack v))
233+ | (k,v) <- kvs , k /= "execution_count" ]