{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{- |
   Module      : Data.Ipynb
   Copyright   : Copyright (C) 2019 John MacFarlane
   License     : BSD3

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

Data structure and JSON serializers for ipynb (Jupyter notebook) format.
Version 4 of the format is documented here:
<https://nbformat.readthedocs.io/en/latest/format_description.html>.

The library supports both version 4 ('Notebook NbV4') and version 3
('Notebook NbV3') of nbformat.  Note that this is a phantom type: the
`NbV3` or `NbV4` parameter only affects JSON serialization,
not the data structure itself.  So code that manipulates
notebooks can be polymorphic, operating on `Notebook a`.

-}
module Data.Ipynb ( Notebook(..)
                  , NbV3
                  , NbV4
                  , JSONMeta
                  , Cell(..)
                  , Source(..)
                  , CellType(..)
                  , Output(..)
                  , MimeType
                  , MimeData(..)
                  , MimeBundle(..)
                  , breakLines
                  )
where
import Control.Applicative ((<|>))
import Control.Monad (when)
import Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as Base64
import Data.Char (isSpace)
import Data.List (partition)
import qualified Data.Map as M
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import GHC.Generics
import Prelude
#if MIN_VERSION_base(4,11,0)
#else
import Data.Semigroup
#endif
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as KM
#else
import qualified Data.HashMap.Strict as KM
#endif
import Data.String
import qualified Data.Set as Set

-- | Indexes 'Notebook' for serialization as nbformat version 3.
data NbV3

-- | Indexes 'Notebook' for serialization as nbformat version 4.
data NbV4

-- | A Jupyter notebook.
data Notebook a = Notebook
  { Notebook a -> JSONMeta
notebookMetadata :: JSONMeta
  , Notebook a -> (Int, Int)
notebookFormat   :: (Int, Int)
  , Notebook a -> [Cell a]
notebookCells    :: [Cell a]
  } deriving (Int -> Notebook a -> ShowS
[Notebook a] -> ShowS
Notebook a -> String
(Int -> Notebook a -> ShowS)
-> (Notebook a -> String)
-> ([Notebook a] -> ShowS)
-> Show (Notebook a)
forall a. Int -> Notebook a -> ShowS
forall a. [Notebook a] -> ShowS
forall a. Notebook a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Notebook a] -> ShowS
$cshowList :: forall a. [Notebook a] -> ShowS
show :: Notebook a -> String
$cshow :: forall a. Notebook a -> String
showsPrec :: Int -> Notebook a -> ShowS
$cshowsPrec :: forall a. Int -> Notebook a -> ShowS
Show, Notebook a -> Notebook a -> Bool
(Notebook a -> Notebook a -> Bool)
-> (Notebook a -> Notebook a -> Bool) -> Eq (Notebook a)
forall a. Notebook a -> Notebook a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Notebook a -> Notebook a -> Bool
$c/= :: forall a. Notebook a -> Notebook a -> Bool
== :: Notebook a -> Notebook a -> Bool
$c== :: forall a. Notebook a -> Notebook a -> Bool
Eq, (forall x. Notebook a -> Rep (Notebook a) x)
-> (forall x. Rep (Notebook a) x -> Notebook a)
-> Generic (Notebook a)
forall x. Rep (Notebook a) x -> Notebook a
forall x. Notebook a -> Rep (Notebook a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Notebook a) x -> Notebook a
forall a x. Notebook a -> Rep (Notebook a) x
$cto :: forall a x. Rep (Notebook a) x -> Notebook a
$cfrom :: forall a x. Notebook a -> Rep (Notebook a) x
Generic)

instance Semigroup (Notebook a) where
  Notebook JSONMeta
m1 (Int, Int)
f1 [Cell a]
c1 <> :: Notebook a -> Notebook a -> Notebook a
<> Notebook JSONMeta
m2 (Int, Int)
f2 [Cell a]
c2 =
    JSONMeta -> (Int, Int) -> [Cell a] -> Notebook a
forall a. JSONMeta -> (Int, Int) -> [Cell a] -> Notebook a
Notebook (JSONMeta
m1 JSONMeta -> JSONMeta -> JSONMeta
forall a. Semigroup a => a -> a -> a
<> JSONMeta
m2) ((Int, Int) -> (Int, Int) -> (Int, Int)
forall a. Ord a => a -> a -> a
max (Int, Int)
f1 (Int, Int)
f2) ([Cell a]
c1 [Cell a] -> [Cell a] -> [Cell a]
forall a. Semigroup a => a -> a -> a
<> [Cell a]
c2)

instance Monoid (Notebook a) where
  mempty :: Notebook a
mempty = JSONMeta -> (Int, Int) -> [Cell a] -> Notebook a
forall a. JSONMeta -> (Int, Int) -> [Cell a] -> Notebook a
Notebook JSONMeta
forall a. Monoid a => a
mempty (Int
0, Int
0) [Cell a]
forall a. Monoid a => a
mempty
#if MIN_VERSION_base(4,11,0)
#else
  mappend = (<>)
#endif

instance FromJSON (Notebook NbV4) where
  parseJSON :: Value -> Parser (Notebook NbV4)
parseJSON = String
-> (Object -> Parser (Notebook NbV4))
-> Value
-> Parser (Notebook NbV4)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Notebook" ((Object -> Parser (Notebook NbV4))
 -> Value -> Parser (Notebook NbV4))
-> (Object -> Parser (Notebook NbV4))
-> Value
-> Parser (Notebook NbV4)
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Int
fmt <- Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"nbformat" Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
0
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
fmt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 Bool -> Bool -> Bool
|| Int
fmt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected nbformat == 4"
    Int
fmtminor <- Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"nbformat_minor" Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
0
    JSONMeta
metadata <- Object
v Object -> Key -> Parser (Maybe JSONMeta)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"metadata" Parser (Maybe JSONMeta) -> JSONMeta -> Parser JSONMeta
forall a. Parser (Maybe a) -> a -> Parser a
.!= JSONMeta
forall a. Monoid a => a
mempty
    [Cell NbV4]
cells <- Object
v Object -> Key -> Parser [Cell NbV4]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cells"
    Notebook NbV4 -> Parser (Notebook NbV4)
forall (m :: * -> *) a. Monad m => a -> m a
return
      Notebook :: forall a. JSONMeta -> (Int, Int) -> [Cell a] -> Notebook a
Notebook{ notebookMetadata :: JSONMeta
notebookMetadata = JSONMeta
metadata
              , notebookFormat :: (Int, Int)
notebookFormat = (Int
fmt, Int
fmtminor)
              , notebookCells :: [Cell NbV4]
notebookCells    = [Cell NbV4]
cells
              }

instance FromJSON (Notebook NbV3) where
  parseJSON :: Value -> Parser (Notebook NbV3)
parseJSON = String
-> (Object -> Parser (Notebook NbV3))
-> Value
-> Parser (Notebook NbV3)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Notebook" ((Object -> Parser (Notebook NbV3))
 -> Value -> Parser (Notebook NbV3))
-> (Object -> Parser (Notebook NbV3))
-> Value
-> Parser (Notebook NbV3)
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Int
fmt <- Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"nbformat" Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
0
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
fmt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
3) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected nbformat <= 3"
    Int
fmtminor <- Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"nbformat_minor" Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
0
    JSONMeta
metadata <- Object
v Object -> Key -> Parser (Maybe JSONMeta)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"metadata" Parser (Maybe JSONMeta) -> JSONMeta -> Parser JSONMeta
forall a. Parser (Maybe a) -> a -> Parser a
.!= JSONMeta
forall a. Monoid a => a
mempty
    [Object]
worksheets <- Object
v Object -> Key -> Parser [Object]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"worksheets"
    -- NOTE: we ignore metadata on worksheets: is this ever used?
    [Cell NbV3]
cells <- [[Cell NbV3]] -> [Cell NbV3]
forall a. Monoid a => [a] -> a
mconcat ([[Cell NbV3]] -> [Cell NbV3])
-> Parser [[Cell NbV3]] -> Parser [Cell NbV3]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object -> Parser [Cell NbV3]) -> [Object] -> Parser [[Cell NbV3]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Object -> Key -> Parser [Cell NbV3]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cells") [Object]
worksheets
    Notebook NbV3 -> Parser (Notebook NbV3)
forall (m :: * -> *) a. Monad m => a -> m a
return
      Notebook :: forall a. JSONMeta -> (Int, Int) -> [Cell a] -> Notebook a
Notebook{ notebookMetadata :: JSONMeta
notebookMetadata = JSONMeta
metadata
              , notebookFormat :: (Int, Int)
notebookFormat = (Int
fmt, Int
fmtminor)
              , notebookCells :: [Cell NbV3]
notebookCells = [Cell NbV3]
cells
              }

instance ToJSON (Notebook NbV4) where
 toJSON :: Notebook NbV4 -> Value
toJSON Notebook NbV4
n = [Pair] -> Value
object
   [ Key
"nbformat" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Notebook NbV4 -> (Int, Int)
forall a. Notebook a -> (Int, Int)
notebookFormat Notebook NbV4
n)
   , Key
"nbformat_minor" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Notebook NbV4 -> (Int, Int)
forall a. Notebook a -> (Int, Int)
notebookFormat Notebook NbV4
n)
   , Key
"metadata" Key -> JSONMeta -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Notebook NbV4 -> JSONMeta
forall a. Notebook a -> JSONMeta
notebookMetadata Notebook NbV4
n
   , Key
"cells" Key -> [Cell NbV4] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (if Notebook NbV4 -> (Int, Int)
forall a. Notebook a -> (Int, Int)
notebookFormat Notebook NbV4
n (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
4,Int
1)
                    then [Cell NbV4] -> [Cell NbV4]
forall a. a -> a
id
                    else (Cell NbV4 -> Cell NbV4) -> [Cell NbV4] -> [Cell NbV4]
forall a b. (a -> b) -> [a] -> [b]
map (\Cell NbV4
c -> Cell NbV4
c{ cellAttachments :: Maybe (Map Text MimeBundle)
cellAttachments = Maybe (Map Text MimeBundle)
forall a. Maybe a
Nothing }))
                (Notebook NbV4 -> [Cell NbV4]
forall a. Notebook a -> [Cell a]
notebookCells Notebook NbV4
n)
   ]

instance ToJSON (Notebook NbV3) where
 toJSON :: Notebook NbV3 -> Value
toJSON Notebook NbV3
n = [Pair] -> Value
object
   [ Key
"nbformat" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Notebook NbV3 -> (Int, Int)
forall a. Notebook a -> (Int, Int)
notebookFormat Notebook NbV3
n)
   , Key
"nbformat_minor" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Notebook NbV3 -> (Int, Int)
forall a. Notebook a -> (Int, Int)
notebookFormat Notebook NbV3
n)
   , Key
"metadata" Key -> JSONMeta -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Notebook NbV3 -> JSONMeta
forall a. Notebook a -> JSONMeta
notebookMetadata Notebook NbV3
n
   , Key
"worksheets" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
     [ [Pair] -> Value
object
       [ Key
"cells" Key -> [Cell NbV3] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (if Notebook NbV3 -> (Int, Int)
forall a. Notebook a -> (Int, Int)
notebookFormat Notebook NbV3
n (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
4,Int
1)
                        then [Cell NbV3] -> [Cell NbV3]
forall a. a -> a
id
                        else (Cell NbV3 -> Cell NbV3) -> [Cell NbV3] -> [Cell NbV3]
forall a b. (a -> b) -> [a] -> [b]
map (\Cell NbV3
c -> Cell NbV3
c{ cellAttachments :: Maybe (Map Text MimeBundle)
cellAttachments = Maybe (Map Text MimeBundle)
forall a. Maybe a
Nothing }))
                    (Notebook NbV3 -> [Cell NbV3]
forall a. Notebook a -> [Cell a]
notebookCells Notebook NbV3
n)
       , Key
"metadata" Key -> JSONMeta -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (JSONMeta
forall a. Monoid a => a
mempty :: JSONMeta) -- see above in FromJSON instance
       ]
     ]
   ]

type JSONMeta = M.Map Text Value

-- | A 'Source' is a textual content which may be
-- represented in JSON either as a single string
-- or as a list of strings (which are concatenated).
newtype Source = Source{ Source -> [Text]
unSource :: [Text] }
  deriving (Int -> Source -> ShowS
[Source] -> ShowS
Source -> String
(Int -> Source -> ShowS)
-> (Source -> String) -> ([Source] -> ShowS) -> Show Source
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Source] -> ShowS
$cshowList :: [Source] -> ShowS
show :: Source -> String
$cshow :: Source -> String
showsPrec :: Int -> Source -> ShowS
$cshowsPrec :: Int -> Source -> ShowS
Show, Source -> Source -> Bool
(Source -> Source -> Bool)
-> (Source -> Source -> Bool) -> Eq Source
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Source -> Source -> Bool
$c/= :: Source -> Source -> Bool
== :: Source -> Source -> Bool
$c== :: Source -> Source -> Bool
Eq, (forall x. Source -> Rep Source x)
-> (forall x. Rep Source x -> Source) -> Generic Source
forall x. Rep Source x -> Source
forall x. Source -> Rep Source x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Source x -> Source
$cfrom :: forall x. Source -> Rep Source x
Generic, b -> Source -> Source
NonEmpty Source -> Source
Source -> Source -> Source
(Source -> Source -> Source)
-> (NonEmpty Source -> Source)
-> (forall b. Integral b => b -> Source -> Source)
-> Semigroup Source
forall b. Integral b => b -> Source -> Source
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Source -> Source
$cstimes :: forall b. Integral b => b -> Source -> Source
sconcat :: NonEmpty Source -> Source
$csconcat :: NonEmpty Source -> Source
<> :: Source -> Source -> Source
$c<> :: Source -> Source -> Source
Semigroup, Semigroup Source
Source
Semigroup Source
-> Source
-> (Source -> Source -> Source)
-> ([Source] -> Source)
-> Monoid Source
[Source] -> Source
Source -> Source -> Source
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Source] -> Source
$cmconcat :: [Source] -> Source
mappend :: Source -> Source -> Source
$cmappend :: Source -> Source -> Source
mempty :: Source
$cmempty :: Source
$cp1Monoid :: Semigroup Source
Monoid)

instance FromJSON Source where
  parseJSON :: Value -> Parser Source
parseJSON Value
v = do
    [Text]
ts <- Value -> Parser [Text]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser [Text] -> Parser [Text] -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[]) (Text -> [Text]) -> Parser Text -> Parser [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Source -> Parser Source
forall (m :: * -> *) a. Monad m => a -> m a
return (Source -> Parser Source) -> Source -> Parser Source
forall a b. (a -> b) -> a -> b
$ [Text] -> Source
Source [Text]
ts

instance ToJSON Source where
  toJSON :: Source -> Value
toJSON (Source [Text]
ts) = [Text] -> Value
forall a. ToJSON a => a -> Value
toJSON [Text]
ts

-- | A Jupyter notebook cell.
data Cell a = Cell
  { Cell a -> CellType a
cellType        :: CellType a
  , Cell a -> Source
cellSource      :: Source
  , Cell a -> JSONMeta
cellMetadata    :: JSONMeta
  , Cell a -> Maybe (Map Text MimeBundle)
cellAttachments :: Maybe (M.Map Text MimeBundle)
} deriving (Int -> Cell a -> ShowS
[Cell a] -> ShowS
Cell a -> String
(Int -> Cell a -> ShowS)
-> (Cell a -> String) -> ([Cell a] -> ShowS) -> Show (Cell a)
forall a. Int -> Cell a -> ShowS
forall a. [Cell a] -> ShowS
forall a. Cell a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cell a] -> ShowS
$cshowList :: forall a. [Cell a] -> ShowS
show :: Cell a -> String
$cshow :: forall a. Cell a -> String
showsPrec :: Int -> Cell a -> ShowS
$cshowsPrec :: forall a. Int -> Cell a -> ShowS
Show, Cell a -> Cell a -> Bool
(Cell a -> Cell a -> Bool)
-> (Cell a -> Cell a -> Bool) -> Eq (Cell a)
forall a. Cell a -> Cell a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cell a -> Cell a -> Bool
$c/= :: forall a. Cell a -> Cell a -> Bool
== :: Cell a -> Cell a -> Bool
$c== :: forall a. Cell a -> Cell a -> Bool
Eq, (forall x. Cell a -> Rep (Cell a) x)
-> (forall x. Rep (Cell a) x -> Cell a) -> Generic (Cell a)
forall x. Rep (Cell a) x -> Cell a
forall x. Cell a -> Rep (Cell a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Cell a) x -> Cell a
forall a x. Cell a -> Rep (Cell a) x
$cto :: forall a x. Rep (Cell a) x -> Cell a
$cfrom :: forall a x. Cell a -> Rep (Cell a) x
Generic)

instance FromJSON (Cell NbV4) where
  parseJSON :: Value -> Parser (Cell NbV4)
parseJSON = String
-> (Object -> Parser (Cell NbV4)) -> Value -> Parser (Cell NbV4)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Cell" ((Object -> Parser (Cell NbV4)) -> Value -> Parser (Cell NbV4))
-> (Object -> Parser (Cell NbV4)) -> Value -> Parser (Cell NbV4)
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    String
ty <- Object
v Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cell_type"
    CellType NbV4
cell_type <-
      case String
ty of
        String
"markdown" -> CellType NbV4 -> Parser (CellType NbV4)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CellType NbV4
forall a. CellType a
Markdown
        String
"raw" -> CellType NbV4 -> Parser (CellType NbV4)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CellType NbV4
forall a. CellType a
Raw
        String
"code" ->
          Maybe Int -> [Output NbV4] -> CellType NbV4
forall a. Maybe Int -> [Output a] -> CellType a
Code
            (Maybe Int -> [Output NbV4] -> CellType NbV4)
-> Parser (Maybe Int) -> Parser ([Output NbV4] -> CellType NbV4)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"execution_count"
            Parser ([Output NbV4] -> CellType NbV4)
-> Parser [Output NbV4] -> Parser (CellType NbV4)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [Output NbV4]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"outputs"
        String
_ -> String -> Parser (CellType NbV4)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (CellType NbV4))
-> String -> Parser (CellType NbV4)
forall a b. (a -> b) -> a -> b
$ String
"Unknown cell_type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ty
    JSONMeta
metadata <- Object
v Object -> Key -> Parser JSONMeta
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"metadata"
    Maybe (Map Text MimeBundle)
attachments <- Object
v Object -> Key -> Parser (Maybe (Map Text MimeBundle))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"attachments"
    Source
source <- Object
v Object -> Key -> Parser Source
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source"
    Cell NbV4 -> Parser (Cell NbV4)
forall (m :: * -> *) a. Monad m => a -> m a
return
      Cell :: forall a.
CellType a
-> Source -> JSONMeta -> Maybe (Map Text MimeBundle) -> Cell a
Cell{ cellType :: CellType NbV4
cellType = CellType NbV4
cell_type
          , cellMetadata :: JSONMeta
cellMetadata = JSONMeta
metadata
          , cellAttachments :: Maybe (Map Text MimeBundle)
cellAttachments = Maybe (Map Text MimeBundle)
attachments
          , cellSource :: Source
cellSource = Source
source
          }

instance FromJSON (Cell NbV3) where
  parseJSON :: Value -> Parser (Cell NbV3)
parseJSON = String
-> (Object -> Parser (Cell NbV3)) -> Value -> Parser (Cell NbV3)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Cell" ((Object -> Parser (Cell NbV3)) -> Value -> Parser (Cell NbV3))
-> (Object -> Parser (Cell NbV3)) -> Value -> Parser (Cell NbV3)
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    String
ty <- Object
v Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cell_type"
    CellType NbV3
cell_type <-
      case String
ty of
        String
"markdown" -> CellType NbV3 -> Parser (CellType NbV3)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CellType NbV3
forall a. CellType a
Markdown
        String
"heading" -> Int -> CellType NbV3
forall a. Int -> CellType a
Heading (Int -> CellType NbV3) -> Parser Int -> Parser (CellType NbV3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"level"
        String
"raw" -> CellType NbV3 -> Parser (CellType NbV3)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CellType NbV3
forall a. CellType a
Raw
        String
"code" ->
          Maybe Int -> [Output NbV3] -> CellType NbV3
forall a. Maybe Int -> [Output a] -> CellType a
Code
            (Maybe Int -> [Output NbV3] -> CellType NbV3)
-> Parser (Maybe Int) -> Parser ([Output NbV3] -> CellType NbV3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prompt_number"
            Parser ([Output NbV3] -> CellType NbV3)
-> Parser [Output NbV3] -> Parser (CellType NbV3)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [Output NbV3]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"outputs"
        String
_ -> String -> Parser (CellType NbV3)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (CellType NbV3))
-> String -> Parser (CellType NbV3)
forall a b. (a -> b) -> a -> b
$ String
"Unknown cell_type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ty
    JSONMeta
metadata <- Object -> Parser JSONMeta
parseV3Metadata Object
v
    Source
source <- if String
ty String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"code"
                 then Object
v Object -> Key -> Parser Source
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"input"
                 else Object
v Object -> Key -> Parser Source
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source"
    Cell NbV3 -> Parser (Cell NbV3)
forall (m :: * -> *) a. Monad m => a -> m a
return
      Cell :: forall a.
CellType a
-> Source -> JSONMeta -> Maybe (Map Text MimeBundle) -> Cell a
Cell{ cellType :: CellType NbV3
cellType = CellType NbV3
cell_type
          , cellMetadata :: JSONMeta
cellMetadata = JSONMeta
metadata
          , cellAttachments :: Maybe (Map Text MimeBundle)
cellAttachments = Maybe (Map Text MimeBundle)
forall a. Maybe a
Nothing
          , cellSource :: Source
cellSource = Source
source
          }

-- note that execution_count can't be omitted!
instance ToJSON (Cell NbV4) where
 toJSON :: Cell NbV4 -> Value
toJSON Cell NbV4
c = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
   (Key
"metadata" Key -> JSONMeta -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Cell NbV4 -> JSONMeta
forall a. Cell a -> JSONMeta
cellMetadata Cell NbV4
c) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
:
   [Pair]
-> (Map Text MimeBundle -> [Pair])
-> Maybe (Map Text MimeBundle)
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Map Text MimeBundle
x -> [Key
"attachments" Key -> Map Text MimeBundle -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Text MimeBundle
x]) (Cell NbV4 -> Maybe (Map Text MimeBundle)
forall a. Cell a -> Maybe (Map Text MimeBundle)
cellAttachments Cell NbV4
c) [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
   case Cell NbV4 -> CellType NbV4
forall a. Cell a -> CellType a
cellType Cell NbV4
c of
     CellType NbV4
Markdown -> [ Key
"cell_type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"markdown" :: Text)
                 , Key
"source" Key -> Source -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Cell NbV4 -> Source
forall a. Cell a -> Source
cellSource Cell NbV4
c ]
     Heading Int
lev ->
                [ Key
"cell_type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"markdown" :: Text)
                , Key
"source" Key -> Source -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=
                     ([Text] -> Source
Source ([Text] -> Source) -> (Source -> [Text]) -> Source -> Source
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
breakLines (Text -> [Text]) -> (Source -> Text) -> Source -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      ((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 -> Text) -> (Source -> Text) -> Source -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> (Source -> [Text]) -> Source -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Source -> [Text]
unSource) (Cell NbV4 -> Source
forall a. Cell a -> Source
cellSource Cell NbV4
c)
                 ]
     CellType NbV4
Raw      -> [ Key
"cell_type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"raw" :: Text)
                 , Key
"source" Key -> Source -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Cell NbV4 -> Source
forall a. Cell a -> Source
cellSource Cell NbV4
c
                 ]
     Code{
         codeExecutionCount :: forall a. CellType a -> Maybe Int
codeExecutionCount = Maybe Int
ec
       , codeOutputs :: forall a. CellType a -> [Output a]
codeOutputs = [Output NbV4]
outs
       }      -> [ Key
"cell_type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"code" :: Text)
                 , Key
"execution_count" Key -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
ec
                 , Key
"outputs" Key -> [Output NbV4] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Output NbV4]
outs
                 , Key
"source" Key -> Source -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Cell NbV4 -> Source
forall a. Cell a -> Source
cellSource Cell NbV4
c
                 ]

instance ToJSON (Cell NbV3) where
 toJSON :: Cell NbV3 -> Value
toJSON Cell NbV3
c =
  [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
   JSONMeta -> [Pair]
metadataToV3Pairs (Cell NbV3 -> JSONMeta
forall a. Cell a -> JSONMeta
cellMetadata Cell NbV3
c) [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
   case Cell NbV3 -> CellType NbV3
forall a. Cell a -> CellType a
cellType Cell NbV3
c of
     CellType NbV3
Markdown    -> [ Key
"cell_type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"markdown" :: Text)
                    , Key
"source" Key -> Source -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Cell NbV3 -> Source
forall a. Cell a -> Source
cellSource Cell NbV3
c
                    ]
     Heading Int
lev -> [ Key
"cell_type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"heading" :: Text)
                    , Key
"level" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
lev
                    , Key
"source" Key -> Source -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Cell NbV3 -> Source
forall a. Cell a -> Source
cellSource Cell NbV3
c
                    ]
     CellType NbV3
Raw         -> [ Key
"cell_type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"raw" :: Text)
                    , Key
"source" Key -> Source -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Cell NbV3 -> Source
forall a. Cell a -> Source
cellSource Cell NbV3
c
                    ]
     Code{
         codeExecutionCount :: forall a. CellType a -> Maybe Int
codeExecutionCount = Maybe Int
ec
       , codeOutputs :: forall a. CellType a -> [Output a]
codeOutputs = [Output NbV3]
outs
       }      -> [ Key
"cell_type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"code" :: Text)
                 , Key
"input" Key -> Source -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Cell NbV3 -> Source
forall a. Cell a -> Source
cellSource Cell NbV3
c
                 , Key
"outputs" Key -> [Output NbV3] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Output NbV3]
outs
                 ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
                 [Pair] -> (Int -> [Pair]) -> Maybe Int -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Int
n -> [Key
"prompt_number" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
n]) Maybe Int
ec

-- in v3, certain metadata fields occur in the main cell object.
-- e.g. collapsed, language.
metadataToV3Pairs :: JSONMeta -> [Aeson.Pair]
metadataToV3Pairs :: JSONMeta -> [Pair]
metadataToV3Pairs JSONMeta
meta =
  (Key
"metadata" Key -> JSONMeta -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Text, Value)] -> JSONMeta
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text, Value)]
regMeta) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: ((Text, Value) -> Pair) -> [(Text, Value)] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Value) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => (Text, v) -> kv
toPair [(Text, Value)]
extraMeta
  where ([(Text, Value)]
extraMeta, [(Text, Value)]
regMeta) = ((Text, Value) -> Bool)
-> [(Text, Value)] -> ([(Text, Value)], [(Text, Value)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Text, Value) -> Bool
forall b. (Text, b) -> Bool
isExtraMeta ([(Text, Value)] -> ([(Text, Value)], [(Text, Value)]))
-> [(Text, Value)] -> ([(Text, Value)], [(Text, Value)])
forall a b. (a -> b) -> a -> b
$ JSONMeta -> [(Text, Value)]
forall k a. Map k a -> [(k, a)]
M.toList JSONMeta
meta
        toPair :: (Text, v) -> kv
toPair (Text
k,v
v) = (String -> Key
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack Text
k)) Key -> v -> kv
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
v
        isExtraMeta :: (Text, b) -> Bool
isExtraMeta (Text
k,b
_) = Text
k Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
v3MetaInMainCell

v3MetaInMainCell :: Set.Set Text
v3MetaInMainCell :: Set Text
v3MetaInMainCell = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList [Text
"collapsed", Text
"language"]

parseV3Metadata :: Aeson.Object -> Aeson.Parser JSONMeta
parseV3Metadata :: Object -> Parser JSONMeta
parseV3Metadata Object
v = do
  JSONMeta
meta <- Object
v Object -> Key -> Parser (Maybe JSONMeta)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"metadata" Parser (Maybe JSONMeta) -> JSONMeta -> Parser JSONMeta
forall a. Parser (Maybe a) -> a -> Parser a
.!= JSONMeta
forall a. Monoid a => a
mempty
  JSONMeta
vm <- Value -> Parser JSONMeta
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
  let extraMeta :: JSONMeta
extraMeta = JSONMeta -> Set Text -> JSONMeta
forall k a. Ord k => Map k a -> Set k -> Map k a
M.restrictKeys JSONMeta
vm Set Text
v3MetaInMainCell
  JSONMeta -> Parser JSONMeta
forall (m :: * -> *) a. Monad m => a -> m a
return (JSONMeta
meta JSONMeta -> JSONMeta -> JSONMeta
forall a. Semigroup a => a -> a -> a
<> JSONMeta
extraMeta)

-- | Information about the type of a notebook cell, plus
-- data specific to that type.  note that 'Heading' is
-- for v3 only; a 'Heading' will be rendered as 'Markdown'
-- in v4.
data CellType a =
    Markdown
  | Heading -- V3 only
    { CellType a -> Int
headingLevel  :: Int
    }
  | Raw
  | Code
    { CellType a -> Maybe Int
codeExecutionCount :: Maybe Int
    , CellType a -> [Output a]
codeOutputs        :: [Output a]
    }
  deriving (Int -> CellType a -> ShowS
[CellType a] -> ShowS
CellType a -> String
(Int -> CellType a -> ShowS)
-> (CellType a -> String)
-> ([CellType a] -> ShowS)
-> Show (CellType a)
forall a. Int -> CellType a -> ShowS
forall a. [CellType a] -> ShowS
forall a. CellType a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CellType a] -> ShowS
$cshowList :: forall a. [CellType a] -> ShowS
show :: CellType a -> String
$cshow :: forall a. CellType a -> String
showsPrec :: Int -> CellType a -> ShowS
$cshowsPrec :: forall a. Int -> CellType a -> ShowS
Show, CellType a -> CellType a -> Bool
(CellType a -> CellType a -> Bool)
-> (CellType a -> CellType a -> Bool) -> Eq (CellType a)
forall a. CellType a -> CellType a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CellType a -> CellType a -> Bool
$c/= :: forall a. CellType a -> CellType a -> Bool
== :: CellType a -> CellType a -> Bool
$c== :: forall a. CellType a -> CellType a -> Bool
Eq, (forall x. CellType a -> Rep (CellType a) x)
-> (forall x. Rep (CellType a) x -> CellType a)
-> Generic (CellType a)
forall x. Rep (CellType a) x -> CellType a
forall x. CellType a -> Rep (CellType a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (CellType a) x -> CellType a
forall a x. CellType a -> Rep (CellType a) x
$cto :: forall a x. Rep (CellType a) x -> CellType a
$cfrom :: forall a x. CellType a -> Rep (CellType a) x
Generic)

-- | Output from a Code cell.
data Output a =
    Stream
    { Output a -> Text
streamName :: Text
    , Output a -> Source
streamText :: Source }
  | DisplayData
    { Output a -> MimeBundle
displayData     :: MimeBundle
    , Output a -> JSONMeta
displayMetadata :: JSONMeta
    }
  | ExecuteResult
    { Output a -> Int
executeCount    :: Int
    , Output a -> MimeBundle
executeData     :: MimeBundle
    , Output a -> JSONMeta
executeMetadata :: JSONMeta
    }
  | Err
    { Output a -> Text
errName      :: Text
    , Output a -> Text
errValue     :: Text
    , Output a -> [Text]
errTraceback :: [Text]
    }
  deriving (Int -> Output a -> ShowS
[Output a] -> ShowS
Output a -> String
(Int -> Output a -> ShowS)
-> (Output a -> String) -> ([Output a] -> ShowS) -> Show (Output a)
forall a. Int -> Output a -> ShowS
forall a. [Output a] -> ShowS
forall a. Output a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Output a] -> ShowS
$cshowList :: forall a. [Output a] -> ShowS
show :: Output a -> String
$cshow :: forall a. Output a -> String
showsPrec :: Int -> Output a -> ShowS
$cshowsPrec :: forall a. Int -> Output a -> ShowS
Show, Output a -> Output a -> Bool
(Output a -> Output a -> Bool)
-> (Output a -> Output a -> Bool) -> Eq (Output a)
forall a. Output a -> Output a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Output a -> Output a -> Bool
$c/= :: forall a. Output a -> Output a -> Bool
== :: Output a -> Output a -> Bool
$c== :: forall a. Output a -> Output a -> Bool
Eq, (forall x. Output a -> Rep (Output a) x)
-> (forall x. Rep (Output a) x -> Output a) -> Generic (Output a)
forall x. Rep (Output a) x -> Output a
forall x. Output a -> Rep (Output a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Output a) x -> Output a
forall a x. Output a -> Rep (Output a) x
$cto :: forall a x. Rep (Output a) x -> Output a
$cfrom :: forall a x. Output a -> Rep (Output a) x
Generic)

instance FromJSON (Output NbV4) where
  parseJSON :: Value -> Parser (Output NbV4)
parseJSON = String
-> (Object -> Parser (Output NbV4))
-> Value
-> Parser (Output NbV4)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Object" ((Object -> Parser (Output NbV4)) -> Value -> Parser (Output NbV4))
-> (Object -> Parser (Output NbV4))
-> Value
-> Parser (Output NbV4)
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    String
ty <- Object
v Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"output_type"
    case String
ty of
      String
"stream" ->
        Text -> Source -> Output NbV4
forall a. Text -> Source -> Output a
Stream
          (Text -> Source -> Output NbV4)
-> Parser Text -> Parser (Source -> Output NbV4)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
          Parser (Source -> Output NbV4)
-> Parser Source -> Parser (Output NbV4)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Source
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"text"
      String
"display_data" ->
        MimeBundle -> JSONMeta -> Output NbV4
forall a. MimeBundle -> JSONMeta -> Output a
DisplayData
          (MimeBundle -> JSONMeta -> Output NbV4)
-> Parser MimeBundle -> Parser (JSONMeta -> Output NbV4)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser MimeBundle
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
          Parser (JSONMeta -> Output NbV4)
-> Parser JSONMeta -> Parser (Output NbV4)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe JSONMeta)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"metadata" Parser (Maybe JSONMeta) -> JSONMeta -> Parser JSONMeta
forall a. Parser (Maybe a) -> a -> Parser a
.!= JSONMeta
forall a. Monoid a => a
mempty
      String
"execute_result" ->
        Int -> MimeBundle -> JSONMeta -> Output NbV4
forall a. Int -> MimeBundle -> JSONMeta -> Output a
ExecuteResult
          (Int -> MimeBundle -> JSONMeta -> Output NbV4)
-> Parser Int -> Parser (MimeBundle -> JSONMeta -> Output NbV4)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"execution_count"
          Parser (MimeBundle -> JSONMeta -> Output NbV4)
-> Parser MimeBundle -> Parser (JSONMeta -> Output NbV4)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser MimeBundle
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
          Parser (JSONMeta -> Output NbV4)
-> Parser JSONMeta -> Parser (Output NbV4)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe JSONMeta)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"metadata" Parser (Maybe JSONMeta) -> JSONMeta -> Parser JSONMeta
forall a. Parser (Maybe a) -> a -> Parser a
.!= JSONMeta
forall a. Monoid a => a
mempty
      String
"error" ->
        Text -> Text -> [Text] -> Output NbV4
forall a. Text -> Text -> [Text] -> Output a
Err
          (Text -> Text -> [Text] -> Output NbV4)
-> Parser Text -> Parser (Text -> [Text] -> Output NbV4)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ename"
          Parser (Text -> [Text] -> Output NbV4)
-> Parser Text -> Parser ([Text] -> Output NbV4)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"evalue"
          Parser ([Text] -> Output NbV4)
-> Parser [Text] -> Parser (Output NbV4)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"traceback"
      String
_ -> String -> Parser (Output NbV4)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Output NbV4)) -> String -> Parser (Output NbV4)
forall a b. (a -> b) -> a -> b
$ String
"Unknown object_type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ty

instance FromJSON (Output NbV3) where
  parseJSON :: Value -> Parser (Output NbV3)
parseJSON = String
-> (Object -> Parser (Output NbV3))
-> Value
-> Parser (Output NbV3)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Object" ((Object -> Parser (Output NbV3)) -> Value -> Parser (Output NbV3))
-> (Object -> Parser (Output NbV3))
-> Value
-> Parser (Output NbV3)
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    String
ty <- Object
v Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"output_type"
    case String
ty of
      String
"stream" ->
        Text -> Source -> Output NbV3
forall a. Text -> Source -> Output a
Stream
          (Text -> Source -> Output NbV3)
-> Parser Text -> Parser (Source -> Output NbV3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stream"
          Parser (Source -> Output NbV3)
-> Parser Source -> Parser (Output NbV3)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Source
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"text"
      String
"display_data" ->
        MimeBundle -> JSONMeta -> Output NbV3
forall a. MimeBundle -> JSONMeta -> Output a
DisplayData
          (MimeBundle -> JSONMeta -> Output NbV3)
-> Parser MimeBundle -> Parser (JSONMeta -> Output NbV3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser MimeBundle
extractNbV3Data Object
v
          Parser (JSONMeta -> Output NbV3)
-> Parser JSONMeta -> Parser (Output NbV3)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe JSONMeta)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"metadata" Parser (Maybe JSONMeta) -> JSONMeta -> Parser JSONMeta
forall a. Parser (Maybe a) -> a -> Parser a
.!= JSONMeta
forall a. Monoid a => a
mempty
      String
"pyout" ->
        Int -> MimeBundle -> JSONMeta -> Output NbV3
forall a. Int -> MimeBundle -> JSONMeta -> Output a
ExecuteResult
          (Int -> MimeBundle -> JSONMeta -> Output NbV3)
-> Parser Int -> Parser (MimeBundle -> JSONMeta -> Output NbV3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"prompt_number"
          Parser (MimeBundle -> JSONMeta -> Output NbV3)
-> Parser MimeBundle -> Parser (JSONMeta -> Output NbV3)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser MimeBundle
extractNbV3Data Object
v
          Parser (JSONMeta -> Output NbV3)
-> Parser JSONMeta -> Parser (Output NbV3)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe JSONMeta)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"metadata" Parser (Maybe JSONMeta) -> JSONMeta -> Parser JSONMeta
forall a. Parser (Maybe a) -> a -> Parser a
.!= JSONMeta
forall a. Monoid a => a
mempty
      String
"pyerr" ->
        Text -> Text -> [Text] -> Output NbV3
forall a. Text -> Text -> [Text] -> Output a
Err
          (Text -> Text -> [Text] -> Output NbV3)
-> Parser Text -> Parser (Text -> [Text] -> Output NbV3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ename"
          Parser (Text -> [Text] -> Output NbV3)
-> Parser Text -> Parser ([Text] -> Output NbV3)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"evalue"
          Parser ([Text] -> Output NbV3)
-> Parser [Text] -> Parser (Output NbV3)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"traceback"
      String
_ -> String -> Parser (Output NbV3)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Output NbV3)) -> String -> Parser (Output NbV3)
forall a b. (a -> b) -> a -> b
$ String
"Unknown object_type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ty

-- Remove keys output_type, prompt_number, metadata;
-- change short keys like text and png to mime types.
extractNbV3Data :: Aeson.Object -> Aeson.Parser MimeBundle
extractNbV3Data :: Object -> Parser MimeBundle
extractNbV3Data Object
v = do
  let go :: (a, b) -> Maybe (a, b)
go (a
"output_type", b
_)   = Maybe (a, b)
forall a. Maybe a
Nothing
      go (a
"metadata", b
_)      = Maybe (a, b)
forall a. Maybe a
Nothing
      go (a
"prompt_number", b
_) = Maybe (a, b)
forall a. Maybe a
Nothing
      go (a
"text", b
x)          = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
"text/plain", b
x)
      go (a
"latex", b
x)         = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
"text/latex", b
x)
      go (a
"html", b
x)          = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
"text/html", b
x)
      go (a
"png", b
x)           = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
"image/png", b
x)
      go (a
"jpeg", b
x)          = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
"image/jpeg", b
x)
      go (a
"javascript", b
x)    = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
"application/javascript", b
x)
      go (a
_, b
_)               = Maybe (a, b)
forall a. Maybe a
Nothing -- TODO complete list? where documented?
  Value -> Parser MimeBundle
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object (Object -> Value) -> (Object -> Object) -> Object -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList ([Pair] -> Object) -> (Object -> [Pair]) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pair -> Maybe Pair) -> [Pair] -> [Pair]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Pair -> Maybe Pair
forall a a b.
(Eq a, IsString a, IsString a) =>
(a, b) -> Maybe (a, b)
go ([Pair] -> [Pair]) -> (Object -> [Pair]) -> Object -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
KM.toList (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Object
v)

instance ToJSON (Output NbV4) where
  toJSON :: Output NbV4 -> Value
toJSON s :: Output NbV4
s@Stream{} = [Pair] -> Value
object
    [ Key
"output_type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"stream" :: Text)
    , Key
"name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV4 -> Text
forall a. Output a -> Text
streamName Output NbV4
s
    , Key
"text" Key -> Source -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV4 -> Source
forall a. Output a -> Source
streamText Output NbV4
s
    ]
  toJSON d :: Output NbV4
d@DisplayData{} = [Pair] -> Value
object
    [ Key
"output_type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"display_data" :: Text)
    , Key
"data" Key -> MimeBundle -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV4 -> MimeBundle
forall a. Output a -> MimeBundle
displayData Output NbV4
d
    , Key
"metadata" Key -> JSONMeta -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV4 -> JSONMeta
forall a. Output a -> JSONMeta
displayMetadata Output NbV4
d
    ]
  toJSON e :: Output NbV4
e@ExecuteResult{} = [Pair] -> Value
object
    [ Key
"output_type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"execute_result" :: Text)
    , Key
"execution_count" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV4 -> Int
forall a. Output a -> Int
executeCount Output NbV4
e
    , Key
"data" Key -> MimeBundle -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV4 -> MimeBundle
forall a. Output a -> MimeBundle
executeData Output NbV4
e
    , Key
"metadata" Key -> JSONMeta -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV4 -> JSONMeta
forall a. Output a -> JSONMeta
executeMetadata Output NbV4
e
    ]
  toJSON e :: Output NbV4
e@Err{} = [Pair] -> Value
object
    [ Key
"output_type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"error" :: Text)
    , Key
"ename" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV4 -> Text
forall a. Output a -> Text
errName Output NbV4
e
    , Key
"evalue" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV4 -> Text
forall a. Output a -> Text
errValue Output NbV4
e
    , Key
"traceback" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV4 -> [Text]
forall a. Output a -> [Text]
errTraceback Output NbV4
e
    ]

instance ToJSON (Output NbV3) where
  toJSON :: Output NbV3 -> Value
toJSON s :: Output NbV3
s@Stream{} = [Pair] -> Value
object
    [ Key
"output_type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"stream" :: Text)
    , Key
"stream" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV3 -> Text
forall a. Output a -> Text
streamName Output NbV3
s
    , Key
"text" Key -> Source -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV3 -> Source
forall a. Output a -> Source
streamText Output NbV3
s
    ]
  toJSON d :: Output NbV3
d@DisplayData{} =
    Value -> Value
adjustV3DataFields (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
    [ Key
"output_type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"display_data" :: Text)
    , Key
"data" Key -> MimeBundle -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV3 -> MimeBundle
forall a. Output a -> MimeBundle
displayData Output NbV3
d
    , Key
"metadata" Key -> JSONMeta -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV3 -> JSONMeta
forall a. Output a -> JSONMeta
displayMetadata Output NbV3
d ]
  toJSON e :: Output NbV3
e@ExecuteResult{} =
    Value -> Value
adjustV3DataFields (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
    [ Key
"output_type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"pyout" :: Text)
    , Key
"prompt_number" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV3 -> Int
forall a. Output a -> Int
executeCount Output NbV3
e
    , Key
"data" Key -> MimeBundle -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV3 -> MimeBundle
forall a. Output a -> MimeBundle
executeData Output NbV3
e
    , Key
"metadata" Key -> JSONMeta -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV3 -> JSONMeta
forall a. Output a -> JSONMeta
executeMetadata Output NbV3
e ]
  toJSON e :: Output NbV3
e@Err{} = [Pair] -> Value
object
    [ Key
"output_type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"pyerr" :: Text)
    , Key
"ename" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV3 -> Text
forall a. Output a -> Text
errName Output NbV3
e
    , Key
"evalue" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV3 -> Text
forall a. Output a -> Text
errValue Output NbV3
e
    , Key
"traceback" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Output NbV3 -> [Text]
forall a. Output a -> [Text]
errTraceback Output NbV3
e
    ]

adjustV3DataFields :: Value -> Value
adjustV3DataFields :: Value -> Value
adjustV3DataFields (Object Object
hm) =
  case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"data" Object
hm of
    Just (Object Object
dm) -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$
      Key -> Object -> Object
forall v. Key -> KeyMap v -> KeyMap v
KM.delete Key
"data" (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ (Pair -> Object -> Object) -> Object -> [Pair] -> Object
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\(Key
k, Value
v) -> Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KM.insert (Key -> Key
forall p. (Eq p, IsString p) => p -> p
modKey Key
k) Value
v) Object
hm
      (Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
dm)
    Maybe Value
_ -> Object -> Value
Object Object
hm
  where  modKey :: p -> p
modKey p
"text/plain"             = p
"text"
         modKey p
"text/latex"             = p
"latex"
         modKey p
"text/html"              = p
"html"
         modKey p
"image/jpeg"             = p
"jpeg"
         modKey p
"image/png"              = p
"png"
         modKey p
"application/javascript" = p
"javascript"
         modKey p
x                        = p
x
adjustV3DataFields Value
x = Value
x

-- | Data in an execution result or display data cell.
data MimeData =
    BinaryData ByteString
  | TextualData Text
  | JsonData Value
  deriving (Int -> MimeData -> ShowS
[MimeData] -> ShowS
MimeData -> String
(Int -> MimeData -> ShowS)
-> (MimeData -> String) -> ([MimeData] -> ShowS) -> Show MimeData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MimeData] -> ShowS
$cshowList :: [MimeData] -> ShowS
show :: MimeData -> String
$cshow :: MimeData -> String
showsPrec :: Int -> MimeData -> ShowS
$cshowsPrec :: Int -> MimeData -> ShowS
Show, MimeData -> MimeData -> Bool
(MimeData -> MimeData -> Bool)
-> (MimeData -> MimeData -> Bool) -> Eq MimeData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MimeData -> MimeData -> Bool
$c/= :: MimeData -> MimeData -> Bool
== :: MimeData -> MimeData -> Bool
$c== :: MimeData -> MimeData -> Bool
Eq, (forall x. MimeData -> Rep MimeData x)
-> (forall x. Rep MimeData x -> MimeData) -> Generic MimeData
forall x. Rep MimeData x -> MimeData
forall x. MimeData -> Rep MimeData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MimeData x -> MimeData
$cfrom :: forall x. MimeData -> Rep MimeData x
Generic)

type MimeType = Text

-- | A 'MimeBundle' wraps a map from mime types to mime data.
newtype MimeBundle = MimeBundle{ MimeBundle -> Map Text MimeData
unMimeBundle :: M.Map MimeType MimeData }
  deriving (Int -> MimeBundle -> ShowS
[MimeBundle] -> ShowS
MimeBundle -> String
(Int -> MimeBundle -> ShowS)
-> (MimeBundle -> String)
-> ([MimeBundle] -> ShowS)
-> Show MimeBundle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MimeBundle] -> ShowS
$cshowList :: [MimeBundle] -> ShowS
show :: MimeBundle -> String
$cshow :: MimeBundle -> String
showsPrec :: Int -> MimeBundle -> ShowS
$cshowsPrec :: Int -> MimeBundle -> ShowS
Show, MimeBundle -> MimeBundle -> Bool
(MimeBundle -> MimeBundle -> Bool)
-> (MimeBundle -> MimeBundle -> Bool) -> Eq MimeBundle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MimeBundle -> MimeBundle -> Bool
$c/= :: MimeBundle -> MimeBundle -> Bool
== :: MimeBundle -> MimeBundle -> Bool
$c== :: MimeBundle -> MimeBundle -> Bool
Eq, (forall x. MimeBundle -> Rep MimeBundle x)
-> (forall x. Rep MimeBundle x -> MimeBundle) -> Generic MimeBundle
forall x. Rep MimeBundle x -> MimeBundle
forall x. MimeBundle -> Rep MimeBundle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MimeBundle x -> MimeBundle
$cfrom :: forall x. MimeBundle -> Rep MimeBundle x
Generic, b -> MimeBundle -> MimeBundle
NonEmpty MimeBundle -> MimeBundle
MimeBundle -> MimeBundle -> MimeBundle
(MimeBundle -> MimeBundle -> MimeBundle)
-> (NonEmpty MimeBundle -> MimeBundle)
-> (forall b. Integral b => b -> MimeBundle -> MimeBundle)
-> Semigroup MimeBundle
forall b. Integral b => b -> MimeBundle -> MimeBundle
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> MimeBundle -> MimeBundle
$cstimes :: forall b. Integral b => b -> MimeBundle -> MimeBundle
sconcat :: NonEmpty MimeBundle -> MimeBundle
$csconcat :: NonEmpty MimeBundle -> MimeBundle
<> :: MimeBundle -> MimeBundle -> MimeBundle
$c<> :: MimeBundle -> MimeBundle -> MimeBundle
Semigroup, Semigroup MimeBundle
MimeBundle
Semigroup MimeBundle
-> MimeBundle
-> (MimeBundle -> MimeBundle -> MimeBundle)
-> ([MimeBundle] -> MimeBundle)
-> Monoid MimeBundle
[MimeBundle] -> MimeBundle
MimeBundle -> MimeBundle -> MimeBundle
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [MimeBundle] -> MimeBundle
$cmconcat :: [MimeBundle] -> MimeBundle
mappend :: MimeBundle -> MimeBundle -> MimeBundle
$cmappend :: MimeBundle -> MimeBundle -> MimeBundle
mempty :: MimeBundle
$cmempty :: MimeBundle
$cp1Monoid :: Semigroup MimeBundle
Monoid)

instance FromJSON MimeBundle where
  parseJSON :: Value -> Parser MimeBundle
parseJSON Value
v = do
    [(Text, MimeData)]
m <- Value -> Parser JSONMeta
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser JSONMeta
-> (JSONMeta -> Parser [(Text, MimeData)])
-> Parser [(Text, MimeData)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Text, Value) -> Parser (Text, MimeData))
-> [(Text, Value)] -> Parser [(Text, MimeData)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Value) -> Parser (Text, MimeData)
pairToMimeData ([(Text, Value)] -> Parser [(Text, MimeData)])
-> (JSONMeta -> [(Text, Value)])
-> JSONMeta
-> Parser [(Text, MimeData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONMeta -> [(Text, Value)]
forall k a. Map k a -> [(k, a)]
M.toList
    MimeBundle -> Parser MimeBundle
forall (m :: * -> *) a. Monad m => a -> m a
return (MimeBundle -> Parser MimeBundle)
-> MimeBundle -> Parser MimeBundle
forall a b. (a -> b) -> a -> b
$ Map Text MimeData -> MimeBundle
MimeBundle (Map Text MimeData -> MimeBundle)
-> Map Text MimeData -> MimeBundle
forall a b. (a -> b) -> a -> b
$ [(Text, MimeData)] -> Map Text MimeData
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text, MimeData)]
m

pairToMimeData :: (MimeType, Value) -> Aeson.Parser (MimeType, MimeData)
pairToMimeData :: (Text, Value) -> Parser (Text, MimeData)
pairToMimeData (Text
mt, Value
v)
  | Text
mt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"application/json" Bool -> Bool -> Bool
||
    Text
"+json" Text -> Text -> Bool
`T.isSuffixOf` Text
mt = (Text, MimeData) -> Parser (Text, MimeData)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
mt, Value -> MimeData
JsonData Value
v)
pairToMimeData (Text
mt, Value
v) = do
  Text
t <- Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> Parser [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [Text]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
  let mimeprefix :: Text
mimeprefix = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'/') Text
mt
  if Text
mimeprefix Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"text"
     then (Text, MimeData) -> Parser (Text, MimeData)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
mt, Text -> MimeData
TextualData Text
t)
     else
       case ByteString -> Either String ByteString
Base64.decode (Text -> ByteString
TE.encodeUtf8 ((Char -> Bool) -> Text -> Text
T.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) Text
t)) of
            Left String
_  -> (Text, MimeData) -> Parser (Text, MimeData)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
mt, Text -> MimeData
TextualData Text
t)
            Right ByteString
b -> (Text, MimeData) -> Parser (Text, MimeData)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
mt, ByteString -> MimeData
BinaryData ByteString
b)

instance ToJSON MimeBundle where
  toJSON :: MimeBundle -> Value
toJSON (MimeBundle Map Text MimeData
m) =
    let mimeBundleToValue :: MimeData -> Value
mimeBundleToValue (BinaryData ByteString
bs) =
          Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (ByteString -> Text) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n") (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"\n" ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> ByteString -> [ByteString]
chunksOf Int
76 (ByteString -> [ByteString])
-> (ByteString -> ByteString) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            ByteString -> ByteString
Base64.encode
            (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ ByteString
bs
        mimeBundleToValue (JsonData Value
v) = Value
v
        mimeBundleToValue (TextualData Text
t) = [Text] -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> [Text]
breakLines Text
t)
    in  JSONMeta -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONMeta -> Value) -> JSONMeta -> Value
forall a b. (a -> b) -> a -> b
$ (MimeData -> Value) -> Map Text MimeData -> JSONMeta
forall a b k. (a -> b) -> Map k a -> Map k b
M.map MimeData -> Value
mimeBundleToValue Map Text MimeData
m

chunksOf :: Int -> ByteString -> [ByteString]
chunksOf :: Int -> ByteString -> [ByteString]
chunksOf Int
k ByteString
s
   | ByteString -> Bool
B.null ByteString
s = []
   | Bool
otherwise =
     let (ByteString
h,ByteString
t) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
k ByteString
s
     in ByteString
h ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Int -> ByteString -> [ByteString]
chunksOf Int
k ByteString
t

-- | Break up a string into a list of strings, each representing
-- one line of the string (including trailing newline if any).
breakLines :: Text -> [Text]
breakLines :: Text -> [Text]
breakLines Text
t =
  let (Text
x, Text
y) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n') Text
t
  in  case Text -> Maybe (Char, Text)
T.uncons Text
y of
         Maybe (Char, Text)
Nothing        -> if Text -> Bool
T.null Text
x then [] else [Text
x]
         Just (Char
c, Text
rest) -> (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
breakLines Text
rest