module Nbparts.Unpack where

import Control.Arrow (left)
import Control.Monad qualified as Monad
import Control.Monad.Error.Class (MonadError (throwError), liftEither)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Trans.Maybe (runMaybeT)
import Data.Aeson qualified as Aeson
import Data.Aeson.Encode.Pretty (confIndent)
import Data.Aeson.Encode.Pretty qualified as AesonPretty
import Data.Aeson.KeyMap qualified as Aeson.KeyMap
import Data.ByteString qualified as ByteString
import Data.ByteString.Lazy qualified as LazyByteString
import Data.Ipynb qualified as Ipynb
import Data.Map qualified as Map
import Data.Maybe qualified as Maybe
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.IO qualified as Text
import Data.Yaml qualified as Yaml
import Nbparts.Types
  ( Format (FormatJson, FormatMarkdown, FormatYaml),
    NotebookMetadata (NotebookMetadata),
    SomeNotebook,
    UnpackError (UnpackParseNotebookError, UnpackUnsupportedNotebookFormat),
    defManifest,
    formatExtension,
    withSomeNotebook,
  )
import Nbparts.Types.Manifest qualified as Manifest
import Nbparts.Unpack.Metadata (collectMetadata, extractNotebookVersion)
import Nbparts.Unpack.Outputs (collectOutputs)
import Nbparts.Unpack.Sources (collectSources)
import Nbparts.Unpack.Sources.Markdown (sourcesToMarkdown)
import Nbparts.Util.Prompt (confirm)
import System.Directory qualified as Directory
import System.FilePath ((<.>), (</>))
import System.IO (stderr)
import Text.Libyaml qualified as Libyaml

minNotebookFormat :: (Int, Int)
minNotebookFormat :: (Int, Int)
minNotebookFormat = (Int
4, Int
0)

data UnpackOptions = UnpackOptions
  { UnpackOptions -> FilePath
notebookPath :: FilePath,
    UnpackOptions -> Format
sourcesFormat :: Format,
    UnpackOptions -> Format
metadataFormat :: Format,
    UnpackOptions -> Format
outputsFormat :: Format,
    UnpackOptions -> Maybe FilePath
outputPath :: Maybe FilePath,
    UnpackOptions -> Bool
force :: Bool
  }

unpack :: (MonadError UnpackError m, MonadIO m) => UnpackOptions -> m ()
unpack :: forall (m :: * -> *).
(MonadError UnpackError m, MonadIO m) =>
UnpackOptions -> m ()
unpack UnpackOptions
opts = (Maybe () -> ()) -> m (Maybe ()) -> m ()
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> Maybe () -> ()
forall a. a -> Maybe a -> a
Maybe.fromMaybe ()) (m (Maybe ()) -> m ())
-> (MaybeT m () -> m (Maybe ())) -> MaybeT m () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT m () -> m (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m () -> m ()) -> MaybeT m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  let exportDirectory :: FilePath
exportDirectory = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
Maybe.fromMaybe (FilePath -> FilePath
mkDefOutputPath UnpackOptions
opts.notebookPath) UnpackOptions
opts.outputPath

  -- Check if we should overwrite the export directory (if it already exists and is non-empty).
  Bool
cont <-
    IO Bool -> MaybeT m Bool
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> MaybeT m Bool) -> IO Bool -> MaybeT m Bool
forall a b. (a -> b) -> a -> b
$
      if UnpackOptions
opts.force
        then Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        else
          FilePath -> IO Bool
shouldConfirmOverwrite FilePath
exportDirectory IO Bool -> (Bool -> IO Bool) -> IO Bool
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Bool
True -> Text -> IO Bool
confirm (Text -> IO Bool) -> Text -> IO Bool
forall a b. (a -> b) -> a -> b
$ Text
"Directory \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack FilePath
exportDirectory Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" exists and is not empty. Overwrite?"
            Bool
False -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

  Bool -> MaybeT m () -> MaybeT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.unless Bool
cont (MaybeT m () -> MaybeT m ()) -> MaybeT m () -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ IO () -> MaybeT m ()
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Text -> IO ()
Text.hPutStrLn Handle
stderr Text
"Operation cancelled: directory not overwritten")
  Bool -> MaybeT m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Monad.guard Bool
cont

  -- Parse the notebook.
  ByteString
notebookBytes <- IO ByteString -> MaybeT m ByteString
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> MaybeT m ByteString)
-> IO ByteString -> MaybeT m ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
LazyByteString.readFile UnpackOptions
opts.notebookPath
  (SomeNotebook
nb :: SomeNotebook) <-
    Either UnpackError SomeNotebook -> MaybeT m SomeNotebook
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either UnpackError SomeNotebook -> MaybeT m SomeNotebook)
-> Either UnpackError SomeNotebook -> MaybeT m SomeNotebook
forall a b. (a -> b) -> a -> b
$
      (FilePath -> UnpackError)
-> Either FilePath SomeNotebook -> Either UnpackError SomeNotebook
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (Text -> UnpackError
UnpackParseNotebookError (Text -> UnpackError)
-> (FilePath -> Text) -> FilePath -> UnpackError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack) (Either FilePath SomeNotebook -> Either UnpackError SomeNotebook)
-> Either FilePath SomeNotebook -> Either UnpackError SomeNotebook
forall a b. (a -> b) -> a -> b
$
        ByteString -> Either FilePath SomeNotebook
forall a. FromJSON a => ByteString -> Either FilePath a
Aeson.eitherDecode ByteString
notebookBytes
  let withNb :: (forall a.
 (ToJSON (Notebook a), FromJSON (Notebook a)) =>
 Notebook a -> r)
-> r
withNb = SomeNotebook
-> (forall a.
    (ToJSON (Notebook a), FromJSON (Notebook a)) =>
    Notebook a -> r)
-> r
forall r.
SomeNotebook
-> (forall a.
    (ToJSON (Notebook a), FromJSON (Notebook a)) =>
    Notebook a -> r)
-> r
withSomeNotebook SomeNotebook
nb

  -- Check notebook version.
  let format :: (Int, Int)
format = (forall a.
 (ToJSON (Notebook a), FromJSON (Notebook a)) =>
 Notebook a -> (Int, Int))
-> (Int, Int)
forall {r}.
(forall a.
 (ToJSON (Notebook a), FromJSON (Notebook a)) =>
 Notebook a -> r)
-> r
withNb Notebook a -> (Int, Int)
forall a.
(ToJSON (Notebook a), FromJSON (Notebook a)) =>
Notebook a -> (Int, Int)
forall a. Notebook a -> (Int, Int)
extractNotebookVersion
  Bool -> MaybeT m () -> MaybeT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when ((Int, Int)
format (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
< (Int, Int)
minNotebookFormat) (MaybeT m () -> MaybeT m ()) -> MaybeT m () -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ UnpackError -> MaybeT m ()
forall a. UnpackError -> MaybeT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ((Int, Int) -> UnpackError
UnpackUnsupportedNotebookFormat (Int, Int)
format)

  -- Collect manifest, sources, metadata and outputs.
  let manifest :: Manifest
manifest =
        Manifest
defManifest
          { Manifest.sourcesFormat = opts.sourcesFormat,
            Manifest.metadataFormat = opts.metadataFormat,
            Manifest.outputsFormat = opts.outputsFormat
          }
  NotebookMetadata
metadata <- Either UnpackError NotebookMetadata -> MaybeT m NotebookMetadata
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either UnpackError NotebookMetadata -> MaybeT m NotebookMetadata)
-> Either UnpackError NotebookMetadata -> MaybeT m NotebookMetadata
forall a b. (a -> b) -> a -> b
$ (forall a.
 (ToJSON (Notebook a), FromJSON (Notebook a)) =>
 Notebook a -> Either UnpackError NotebookMetadata)
-> Either UnpackError NotebookMetadata
forall {r}.
(forall a.
 (ToJSON (Notebook a), FromJSON (Notebook a)) =>
 Notebook a -> r)
-> r
withNb Notebook a -> Either UnpackError NotebookMetadata
forall a.
(ToJSON (Notebook a), FromJSON (Notebook a)) =>
Notebook a -> Either UnpackError NotebookMetadata
forall a. Notebook a -> Either UnpackError NotebookMetadata
collectMetadata

  let sourceMediaSubdir :: FilePath
sourceMediaSubdir = FilePath
"media"
  ([CellSource]
sources, [(FilePath, ByteString)]
sourceMedia) <- Either UnpackError ([CellSource], [(FilePath, ByteString)])
-> MaybeT m ([CellSource], [(FilePath, ByteString)])
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either UnpackError ([CellSource], [(FilePath, ByteString)])
 -> MaybeT m ([CellSource], [(FilePath, ByteString)]))
-> Either UnpackError ([CellSource], [(FilePath, ByteString)])
-> MaybeT m ([CellSource], [(FilePath, ByteString)])
forall a b. (a -> b) -> a -> b
$ (forall a.
 (ToJSON (Notebook a), FromJSON (Notebook a)) =>
 Notebook a
 -> Either UnpackError ([CellSource], [(FilePath, ByteString)]))
-> Either UnpackError ([CellSource], [(FilePath, ByteString)])
forall {r}.
(forall a.
 (ToJSON (Notebook a), FromJSON (Notebook a)) =>
 Notebook a -> r)
-> r
withNb (FilePath
-> Notebook a
-> Either UnpackError ([CellSource], [(FilePath, ByteString)])
forall a.
FilePath
-> Notebook a
-> Either UnpackError ([CellSource], [(FilePath, ByteString)])
collectSources FilePath
sourceMediaSubdir)

  let outputMediaSubdir :: FilePath
outputMediaSubdir = FilePath
"outputs-media"
  (UnembeddedNotebookOutputs
outputs, [(FilePath, ByteString)]
outputMedia) <- Either
  UnpackError (UnembeddedNotebookOutputs, [(FilePath, ByteString)])
-> MaybeT m (UnembeddedNotebookOutputs, [(FilePath, ByteString)])
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either
   UnpackError (UnembeddedNotebookOutputs, [(FilePath, ByteString)])
 -> MaybeT m (UnembeddedNotebookOutputs, [(FilePath, ByteString)]))
-> Either
     UnpackError (UnembeddedNotebookOutputs, [(FilePath, ByteString)])
-> MaybeT m (UnembeddedNotebookOutputs, [(FilePath, ByteString)])
forall a b. (a -> b) -> a -> b
$ (forall a.
 (ToJSON (Notebook a), FromJSON (Notebook a)) =>
 Notebook a
 -> Either
      UnpackError (UnembeddedNotebookOutputs, [(FilePath, ByteString)]))
-> Either
     UnpackError (UnembeddedNotebookOutputs, [(FilePath, ByteString)])
forall {r}.
(forall a.
 (ToJSON (Notebook a), FromJSON (Notebook a)) =>
 Notebook a -> r)
-> r
withNb (FilePath
-> Notebook a
-> Either
     UnpackError (UnembeddedNotebookOutputs, [(FilePath, ByteString)])
forall a.
FilePath
-> Notebook a
-> Either
     UnpackError (UnembeddedNotebookOutputs, [(FilePath, ByteString)])
collectOutputs FilePath
outputMediaSubdir)

  IO () -> MaybeT m ()
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT m ()) -> IO () -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
Directory.createDirectoryIfMissing Bool
True FilePath
exportDirectory
  let yamlOptions :: EncodeOptions
yamlOptions = (Text -> (Tag, Style)) -> EncodeOptions -> EncodeOptions
Yaml.setStringStyle Text -> (Tag, Style)
nbpartsYamlStringStyle EncodeOptions
Yaml.defaultEncodeOptions
  let mkExportPath :: FilePath -> Format -> FilePath
      mkExportPath :: FilePath -> Format -> FilePath
mkExportPath FilePath
fname Format
fmt = FilePath
exportDirectory FilePath -> FilePath -> FilePath
</> FilePath
fname FilePath -> FilePath -> FilePath
<.> Format -> FilePath
formatExtension Format
fmt

  -- Export manifest.
  let manifestPath :: FilePath
manifestPath = FilePath -> Format -> FilePath
mkExportPath FilePath
"nbparts" Format
FormatYaml
  IO () -> MaybeT m ()
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT m ()) -> IO () -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Manifest -> IO ()
forall a. ToJSON a => FilePath -> a -> IO ()
Yaml.encodeFile FilePath
manifestPath Manifest
manifest

  -- Export sources.
  let sourcesPath :: FilePath
sourcesPath = FilePath -> Format -> FilePath
mkExportPath FilePath
"sources" UnpackOptions
opts.sourcesFormat
  case UnpackOptions
opts.sourcesFormat of
    Format
FormatYaml -> IO () -> MaybeT m ()
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT m ()) -> IO () -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ EncodeOptions -> FilePath -> [CellSource] -> IO ()
forall a. ToJSON a => EncodeOptions -> FilePath -> a -> IO ()
Yaml.encodeFileWith EncodeOptions
yamlOptions FilePath
sourcesPath [CellSource]
sources
    Format
FormatJson -> IO () -> MaybeT m ()
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT m ()) -> IO () -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [CellSource] -> IO ()
forall a. ToJSON a => FilePath -> a -> IO ()
exportJson FilePath
sourcesPath [CellSource]
sources
    Format
FormatMarkdown -> do
      let lang :: Text
lang = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
Maybe.fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ NotebookMetadata -> Maybe Text
extractLanguage NotebookMetadata
metadata
      Text
markdownText <- Either UnpackError Text -> MaybeT m Text
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either UnpackError Text -> MaybeT m Text)
-> Either UnpackError Text -> MaybeT m Text
forall a b. (a -> b) -> a -> b
$ Text -> [CellSource] -> Either UnpackError Text
sourcesToMarkdown Text
lang [CellSource]
sources
      IO () -> MaybeT m ()
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT m ()) -> IO () -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
Text.writeFile FilePath
sourcesPath Text
markdownText

  -- Export source media.
  IO () -> MaybeT m ()
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT m ()) -> IO () -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.unless ([(FilePath, ByteString)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FilePath, ByteString)]
sourceMedia) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> FilePath -> IO ()
Directory.createDirectoryIfMissing Bool
True (FilePath
exportDirectory FilePath -> FilePath -> FilePath
</> FilePath
sourceMediaSubdir)
    ((FilePath, ByteString) -> IO ())
-> [(FilePath, ByteString)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(FilePath
path, ByteString
bytes) -> FilePath -> ByteString -> IO ()
ByteString.writeFile (FilePath
exportDirectory FilePath -> FilePath -> FilePath
</> FilePath
path) ByteString
bytes) [(FilePath, ByteString)]
sourceMedia

  -- Export metadata.
  let metadataPath :: FilePath
metadataPath = FilePath -> Format -> FilePath
mkExportPath FilePath
"metadata" UnpackOptions
opts.metadataFormat
  IO () -> MaybeT m ()
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT m ()) -> IO () -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ case UnpackOptions
opts.metadataFormat of
    Format
FormatYaml -> EncodeOptions -> FilePath -> NotebookMetadata -> IO ()
forall a. ToJSON a => EncodeOptions -> FilePath -> a -> IO ()
Yaml.encodeFileWith EncodeOptions
yamlOptions FilePath
metadataPath NotebookMetadata
metadata
    Format
FormatJson -> FilePath -> NotebookMetadata -> IO ()
forall a. ToJSON a => FilePath -> a -> IO ()
exportJson FilePath
metadataPath NotebookMetadata
metadata
    Format
_ -> FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Illegal metadata format: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Format -> FilePath
forall a. Show a => a -> FilePath
show UnpackOptions
opts.metadataFormat

  -- Export outputs.
  let outputsPath :: FilePath
outputsPath = FilePath -> Format -> FilePath
mkExportPath FilePath
"outputs" UnpackOptions
opts.outputsFormat
  IO () -> MaybeT m ()
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT m ()) -> IO () -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ case UnpackOptions
opts.outputsFormat of
    Format
FormatYaml -> EncodeOptions -> FilePath -> UnembeddedNotebookOutputs -> IO ()
forall a. ToJSON a => EncodeOptions -> FilePath -> a -> IO ()
Yaml.encodeFileWith EncodeOptions
yamlOptions FilePath
outputsPath UnembeddedNotebookOutputs
outputs
    Format
FormatJson -> FilePath -> UnembeddedNotebookOutputs -> IO ()
forall a. ToJSON a => FilePath -> a -> IO ()
exportJson FilePath
outputsPath UnembeddedNotebookOutputs
outputs
    Format
_ -> FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Illegal outputs format: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Format -> FilePath
forall a. Show a => a -> FilePath
show UnpackOptions
opts.outputsFormat

  -- Export output media.
  IO () -> MaybeT m ()
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT m ()) -> IO () -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.unless ([(FilePath, ByteString)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FilePath, ByteString)]
outputMedia) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> FilePath -> IO ()
Directory.createDirectoryIfMissing Bool
True (FilePath
exportDirectory FilePath -> FilePath -> FilePath
</> FilePath
outputMediaSubdir)
    ((FilePath, ByteString) -> IO ())
-> [(FilePath, ByteString)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(FilePath
path, ByteString
bytes) -> FilePath -> ByteString -> IO ()
ByteString.writeFile (FilePath
exportDirectory FilePath -> FilePath -> FilePath
</> FilePath
path) ByteString
bytes) [(FilePath, ByteString)]
outputMedia

  IO () -> MaybeT m ()
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT m ()) -> IO () -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStrLn (Text
"Unpacked \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack UnpackOptions
opts.notebookPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" to \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack FilePath
exportDirectory Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"")

shouldConfirmOverwrite :: FilePath -> IO Bool
shouldConfirmOverwrite :: FilePath -> IO Bool
shouldConfirmOverwrite FilePath
exportDirectory = do
  Bool
exists <- FilePath -> IO Bool
Directory.doesDirectoryExist FilePath
exportDirectory
  if Bool
exists
    then
      -- Check that the directory is not empty.
      Bool -> Bool
not (Bool -> Bool) -> ([FilePath] -> Bool) -> [FilePath] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([FilePath] -> Bool) -> IO [FilePath] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
Directory.listDirectory FilePath
exportDirectory
    else
      Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

mkDefOutputPath :: FilePath -> FilePath
mkDefOutputPath :: FilePath -> FilePath
mkDefOutputPath FilePath
nbPath = FilePath
nbPath FilePath -> FilePath -> FilePath
<.> FilePath
"nbparts"

hasOnlyOneNewline :: Text -> Bool
hasOnlyOneNewline :: Text -> Bool
hasOnlyOneNewline Text
text = Text -> Int
Text.length ((Char -> Bool) -> Text -> Text
Text.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
text) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1

hasNewlineSuffix :: Text -> Bool
hasNewlineSuffix :: Text -> Bool
hasNewlineSuffix = Text -> Text -> Bool
Text.isSuffixOf Text
"\n"

-- Based on Yaml's default string style.
nbpartsYamlStringStyle :: Text -> (Libyaml.Tag, Libyaml.Style)
nbpartsYamlStringStyle :: Text -> (Tag, Style)
nbpartsYamlStringStyle Text
s
  | Text -> Bool
hasOnlyOneNewline Text
s Bool -> Bool -> Bool
&& Text -> Bool
hasNewlineSuffix Text
s = (Tag
Libyaml.NoTag, Style
Libyaml.DoubleQuoted)
  | Text
"\n" Text -> Text -> Bool
`Text.isInfixOf` Text
s = (Tag
Libyaml.NoTag, Style
Libyaml.Literal)
  | Text -> Bool
Yaml.isSpecialString Text
s = (Tag
Libyaml.NoTag, Style
Libyaml.SingleQuoted)
  | Bool
otherwise = (Tag
Libyaml.NoTag, Style
Libyaml.PlainNoTag)

extractLanguage :: NotebookMetadata -> Maybe Text
extractLanguage :: NotebookMetadata -> Maybe Text
extractLanguage (NotebookMetadata Int
_ Int
_ (Ipynb.JSONMeta Map Text Value
nbMeta) Map Text CellMetadata
_) = do
  Value
kernelspec <- Text -> Map Text Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"kernelspec" Map Text Value
nbMeta
  Value -> Maybe Text
langFromKernelSpec Value
kernelspec

langFromKernelSpec :: Aeson.Value -> Maybe Text
langFromKernelSpec :: Value -> Maybe Text
langFromKernelSpec (Aeson.Object Object
obj) = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
Aeson.KeyMap.lookup Key
"language" Object
obj of
  Just (Aeson.String Text
lang) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
lang
  Maybe Value
_ -> Maybe Text
forall a. Maybe a
Nothing
langFromKernelSpec Value
_ = Maybe Text
forall a. Maybe a
Nothing

exportJson :: (Aeson.ToJSON (a)) => FilePath -> a -> IO ()
exportJson :: forall a. ToJSON a => FilePath -> a -> IO ()
exportJson FilePath
fp = FilePath -> ByteString -> IO ()
LazyByteString.writeFile FilePath
fp (ByteString -> IO ()) -> (a -> ByteString) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> a -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
AesonPretty.encodePretty' Config
aesonPrettyConfig

aesonPrettyConfig :: AesonPretty.Config
aesonPrettyConfig :: Config
aesonPrettyConfig = Config
AesonPretty.defConfig {confIndent = AesonPretty.Spaces 2}