module Nbparts.Pack where

import Control.Arrow (left)
import Control.Monad ((>=>))
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 (Config (confIndent))
import Data.Aeson.Encode.Pretty qualified as AesonPretty
import Data.ByteString.Lazy qualified as LazyByteString
import Data.Ipynb qualified as Ipynb
import Data.List ((!?))
import Data.List.NonEmpty qualified as NonEmptyList
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.Version (Version (Version))
import Data.Version qualified as Version
import Data.Yaml qualified as Yaml
import Nbparts.Pack.Metadata (fillMetadata)
import Nbparts.Pack.Outputs (fillOutputs)
import Nbparts.Pack.Sources (fillSources)
import Nbparts.Pack.Sources.Markdown (markdownToSources)
import Nbparts.Types
  ( CellSource,
    Format (FormatJson, FormatMarkdown, FormatYaml),
    IllegalFormatContext (IllegalFormatMetadata, IllegalFormatOutputs),
    Manifest (Manifest, metadataFormat, nbpartsVersion, outputsFormat, sourcesFormat),
    NotebookMetadata (NotebookMetadata),
    PackError
      ( PackIllegalFormatError,
        PackManifestUnknownVersionError,
        PackParseJsonMetadataError,
        PackParseJsonOutputsError,
        PackParseJsonSourcesError,
        PackParseManifestError,
        PackParseYamlMetadataError,
        PackParseYamlOutputsError,
        PackParseYamlSourcesError,
        PackUnsupportedNotebookFormat
      ),
    ParseYamlError (ParseYamlError),
    SomeNotebook (SomeNotebook),
    UnembeddedNotebookOutputs,
    currentNbpartsVersion,
    formatExtension,
    withSomeNotebook,
  )
import Nbparts.Util.Prompt (confirm)
import System.Directory qualified as Directory
import System.FilePath ((<.>), (</>))
import System.FilePath qualified as FilePath
import System.IO (stderr)

data PackOptions = PackOptions
  { PackOptions -> FilePath
partsDirectory :: FilePath,
    PackOptions -> Maybe FilePath
outputPath :: Maybe FilePath,
    PackOptions -> Bool
force :: Bool
  }

pack :: (MonadError PackError m, MonadIO m) => PackOptions -> m ()
pack :: forall (m :: * -> *).
(MonadError PackError m, MonadIO m) =>
PackOptions -> m ()
pack PackOptions
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 outputPath :: FilePath
outputPath = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
Maybe.fromMaybe (FilePath -> FilePath
mkDefOutputPath PackOptions
opts.partsDirectory) PackOptions
opts.outputPath

  let mkImportPath :: FilePath -> Format -> FilePath
      mkImportPath :: FilePath -> Format -> FilePath
mkImportPath FilePath
fname Format
fmt = PackOptions
opts.partsDirectory FilePath -> FilePath -> FilePath
</> FilePath
fname FilePath -> FilePath -> FilePath
<.> Format -> FilePath
formatExtension Format
fmt

  -- Read manifest.
  let manifestPath :: FilePath
manifestPath = FilePath -> Format -> FilePath
mkImportPath FilePath
"nbparts" Format
FormatYaml
  ( Manifest
      { Version
nbpartsVersion :: Manifest -> Version
nbpartsVersion :: Version
nbpartsVersion,
        Format
sourcesFormat :: Manifest -> Format
sourcesFormat :: Format
sourcesFormat,
        Format
metadataFormat :: Manifest -> Format
metadataFormat :: Format
metadataFormat,
        Format
outputsFormat :: Manifest -> Format
outputsFormat :: Format
outputsFormat
      }
    ) <-
    Either PackError Manifest -> MaybeT m Manifest
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
      (Either PackError Manifest -> MaybeT m Manifest)
-> MaybeT m (Either PackError Manifest) -> MaybeT m Manifest
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either PackError Manifest)
-> MaybeT m (Either PackError Manifest)
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        ( (ParseException -> PackError)
-> Either ParseException Manifest -> Either PackError Manifest
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
            (ParseYamlError -> PackError
PackParseManifestError (ParseYamlError -> PackError)
-> (ParseException -> ParseYamlError)
-> ParseException
-> PackError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> ParseYamlError
ParseYamlError)
            (Either ParseException Manifest -> Either PackError Manifest)
-> IO (Either ParseException Manifest)
-> IO (Either PackError Manifest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Either ParseException Manifest)
forall a. FromJSON a => FilePath -> IO (Either ParseException a)
Yaml.decodeFileEither FilePath
manifestPath
        )

  Version -> MaybeT m ()
forall (m :: * -> *).
(MonadError PackError m, MonadIO m) =>
Version -> m ()
checkVersion Version
nbpartsVersion

  -- Check if we should overwrite the output path if it already exists.
  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 PackOptions
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
Directory.doesFileExist FilePath
outputPath 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
"File \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack FilePath
outputPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" exists. 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: file not overwritten")
  Bool -> MaybeT m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Monad.guard Bool
cont

  -- Read sources.
  let sourcesPath :: FilePath
sourcesPath = FilePath -> Format -> FilePath
mkImportPath FilePath
"sources" Format
sourcesFormat
  ([CellSource]
sources :: [CellSource]) <- case Format
sourcesFormat of
    Format
FormatYaml -> do
      Either ParseException [CellSource]
res <- IO (Either ParseException [CellSource])
-> MaybeT m (Either ParseException [CellSource])
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ParseException [CellSource])
 -> MaybeT m (Either ParseException [CellSource]))
-> IO (Either ParseException [CellSource])
-> MaybeT m (Either ParseException [CellSource])
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either ParseException [CellSource])
forall a. FromJSON a => FilePath -> IO (Either ParseException a)
Yaml.decodeFileEither FilePath
sourcesPath
      Either PackError [CellSource] -> MaybeT m [CellSource]
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either PackError [CellSource] -> MaybeT m [CellSource])
-> Either PackError [CellSource] -> MaybeT m [CellSource]
forall a b. (a -> b) -> a -> b
$ (ParseException -> PackError)
-> Either ParseException [CellSource]
-> Either PackError [CellSource]
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 (ParseYamlError -> PackError
PackParseYamlSourcesError (ParseYamlError -> PackError)
-> (ParseException -> ParseYamlError)
-> ParseException
-> PackError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> ParseYamlError
ParseYamlError) Either ParseException [CellSource]
res
    Format
FormatJson -> do
      Either FilePath [CellSource]
res <- IO (Either FilePath [CellSource])
-> MaybeT m (Either FilePath [CellSource])
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either FilePath [CellSource])
 -> MaybeT m (Either FilePath [CellSource]))
-> IO (Either FilePath [CellSource])
-> MaybeT m (Either FilePath [CellSource])
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either FilePath [CellSource])
forall a. FromJSON a => FilePath -> IO (Either FilePath a)
Aeson.eitherDecodeFileStrict FilePath
sourcesPath
      Either PackError [CellSource] -> MaybeT m [CellSource]
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either PackError [CellSource] -> MaybeT m [CellSource])
-> Either PackError [CellSource] -> MaybeT m [CellSource]
forall a b. (a -> b) -> a -> b
$ (FilePath -> PackError)
-> Either FilePath [CellSource] -> Either PackError [CellSource]
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 -> PackError
PackParseJsonSourcesError (Text -> PackError) -> (FilePath -> Text) -> FilePath -> PackError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack) Either FilePath [CellSource]
res
    Format
FormatMarkdown -> do
      Text
mdText <- IO Text -> MaybeT m Text
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> MaybeT m Text) -> IO Text -> MaybeT m Text
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Text
Text.readFile FilePath
sourcesPath
      Either PackError [CellSource] -> MaybeT m [CellSource]
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either PackError [CellSource] -> MaybeT m [CellSource])
-> Either PackError [CellSource] -> MaybeT m [CellSource]
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> Either PackError [CellSource]
markdownToSources FilePath
sourcesPath Text
mdText

  -- Read metadata.
  let metadataPath :: FilePath
metadataPath = FilePath -> Format -> FilePath
mkImportPath FilePath
"metadata" Format
metadataFormat
  (NotebookMetadata
metadata :: NotebookMetadata) <- case Format
metadataFormat of
    Format
FormatYaml -> do
      Either ParseException NotebookMetadata
res <- IO (Either ParseException NotebookMetadata)
-> MaybeT m (Either ParseException NotebookMetadata)
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ParseException NotebookMetadata)
 -> MaybeT m (Either ParseException NotebookMetadata))
-> IO (Either ParseException NotebookMetadata)
-> MaybeT m (Either ParseException NotebookMetadata)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either ParseException NotebookMetadata)
forall a. FromJSON a => FilePath -> IO (Either ParseException a)
Yaml.decodeFileEither FilePath
metadataPath
      Either PackError NotebookMetadata -> MaybeT m NotebookMetadata
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either PackError NotebookMetadata -> MaybeT m NotebookMetadata)
-> Either PackError NotebookMetadata -> MaybeT m NotebookMetadata
forall a b. (a -> b) -> a -> b
$ (ParseException -> PackError)
-> Either ParseException NotebookMetadata
-> Either PackError NotebookMetadata
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 (ParseYamlError -> PackError
PackParseYamlMetadataError (ParseYamlError -> PackError)
-> (ParseException -> ParseYamlError)
-> ParseException
-> PackError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> ParseYamlError
ParseYamlError) Either ParseException NotebookMetadata
res
    Format
FormatJson -> do
      Either FilePath NotebookMetadata
res <- IO (Either FilePath NotebookMetadata)
-> MaybeT m (Either FilePath NotebookMetadata)
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either FilePath NotebookMetadata)
 -> MaybeT m (Either FilePath NotebookMetadata))
-> IO (Either FilePath NotebookMetadata)
-> MaybeT m (Either FilePath NotebookMetadata)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either FilePath NotebookMetadata)
forall a. FromJSON a => FilePath -> IO (Either FilePath a)
Aeson.eitherDecodeFileStrict FilePath
metadataPath
      Either PackError NotebookMetadata -> MaybeT m NotebookMetadata
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either PackError NotebookMetadata -> MaybeT m NotebookMetadata)
-> Either PackError NotebookMetadata -> MaybeT m NotebookMetadata
forall a b. (a -> b) -> a -> b
$ (FilePath -> PackError)
-> Either FilePath NotebookMetadata
-> Either PackError NotebookMetadata
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 -> PackError
PackParseJsonMetadataError (Text -> PackError) -> (FilePath -> Text) -> FilePath -> PackError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack) Either FilePath NotebookMetadata
res
    Format
_ -> PackError -> MaybeT m NotebookMetadata
forall a. PackError -> MaybeT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PackError -> MaybeT m NotebookMetadata)
-> PackError -> MaybeT m NotebookMetadata
forall a b. (a -> b) -> a -> b
$ IllegalFormatContext -> Format -> PackError
PackIllegalFormatError IllegalFormatContext
IllegalFormatMetadata Format
metadataFormat

  -- Read outputs.
  let outputsPath :: FilePath
outputsPath = FilePath -> Format -> FilePath
mkImportPath FilePath
"outputs" Format
outputsFormat
  Bool
outputsPathExists <- 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
$ FilePath -> IO Bool
Directory.doesFileExist FilePath
outputsPath
  (UnembeddedNotebookOutputs
unembeddedOutputs :: UnembeddedNotebookOutputs) <-
    if Bool
outputsPathExists
      then case Format
outputsFormat of
        Format
FormatYaml -> do
          Either ParseException UnembeddedNotebookOutputs
res <- IO (Either ParseException UnembeddedNotebookOutputs)
-> MaybeT m (Either ParseException UnembeddedNotebookOutputs)
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ParseException UnembeddedNotebookOutputs)
 -> MaybeT m (Either ParseException UnembeddedNotebookOutputs))
-> IO (Either ParseException UnembeddedNotebookOutputs)
-> MaybeT m (Either ParseException UnembeddedNotebookOutputs)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either ParseException UnembeddedNotebookOutputs)
forall a. FromJSON a => FilePath -> IO (Either ParseException a)
Yaml.decodeFileEither FilePath
outputsPath
          Either PackError UnembeddedNotebookOutputs
-> MaybeT m UnembeddedNotebookOutputs
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either PackError UnembeddedNotebookOutputs
 -> MaybeT m UnembeddedNotebookOutputs)
-> Either PackError UnembeddedNotebookOutputs
-> MaybeT m UnembeddedNotebookOutputs
forall a b. (a -> b) -> a -> b
$ (ParseException -> PackError)
-> Either ParseException UnembeddedNotebookOutputs
-> Either PackError UnembeddedNotebookOutputs
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 (ParseYamlError -> PackError
PackParseYamlOutputsError (ParseYamlError -> PackError)
-> (ParseException -> ParseYamlError)
-> ParseException
-> PackError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> ParseYamlError
ParseYamlError) Either ParseException UnembeddedNotebookOutputs
res
        Format
FormatJson -> do
          Either FilePath UnembeddedNotebookOutputs
res <- IO (Either FilePath UnembeddedNotebookOutputs)
-> MaybeT m (Either FilePath UnembeddedNotebookOutputs)
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either FilePath UnembeddedNotebookOutputs)
 -> MaybeT m (Either FilePath UnembeddedNotebookOutputs))
-> IO (Either FilePath UnembeddedNotebookOutputs)
-> MaybeT m (Either FilePath UnembeddedNotebookOutputs)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either FilePath UnembeddedNotebookOutputs)
forall a. FromJSON a => FilePath -> IO (Either FilePath a)
Aeson.eitherDecodeFileStrict FilePath
outputsPath
          Either PackError UnembeddedNotebookOutputs
-> MaybeT m UnembeddedNotebookOutputs
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either PackError UnembeddedNotebookOutputs
 -> MaybeT m UnembeddedNotebookOutputs)
-> Either PackError UnembeddedNotebookOutputs
-> MaybeT m UnembeddedNotebookOutputs
forall a b. (a -> b) -> a -> b
$ (FilePath -> PackError)
-> Either FilePath UnembeddedNotebookOutputs
-> Either PackError UnembeddedNotebookOutputs
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 -> PackError
PackParseJsonOutputsError (Text -> PackError) -> (FilePath -> Text) -> FilePath -> PackError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack) Either FilePath UnembeddedNotebookOutputs
res
        Format
_ -> PackError -> MaybeT m UnembeddedNotebookOutputs
forall a. PackError -> MaybeT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PackError -> MaybeT m UnembeddedNotebookOutputs)
-> PackError -> MaybeT m UnembeddedNotebookOutputs
forall a b. (a -> b) -> a -> b
$ IllegalFormatContext -> Format -> PackError
PackIllegalFormatError IllegalFormatContext
IllegalFormatOutputs Format
outputsFormat
      else do
        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
$ Handle -> Text -> IO ()
Text.hPutStrLn Handle
stderr Text
"Warning: Could not find outputs file — assuming no outputs"
        UnembeddedNotebookOutputs -> MaybeT m UnembeddedNotebookOutputs
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnembeddedNotebookOutputs
forall a. Monoid a => a
mempty

  let (NotebookMetadata Int
major Int
minor JSONMeta
_ Map Text CellMetadata
_) = NotebookMetadata
metadata
  SomeNotebook
nb <- case Int
major of
    Int
4 -> SomeNotebook -> MaybeT m SomeNotebook
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeNotebook -> MaybeT m SomeNotebook)
-> SomeNotebook -> MaybeT m SomeNotebook
forall a b. (a -> b) -> a -> b
$ Notebook NbV4 -> SomeNotebook
forall a.
(ToJSON (Notebook a), FromJSON (Notebook a)) =>
Notebook a -> SomeNotebook
SomeNotebook (Notebook NbV4 -> SomeNotebook) -> Notebook NbV4 -> SomeNotebook
forall a b. (a -> b) -> a -> b
$ (forall a. (Int, Int) -> Notebook a
emptyNotebook @Ipynb.NbV4) (Int
major, Int
minor)
    Int
_ -> PackError -> MaybeT m SomeNotebook
forall a. PackError -> MaybeT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PackError -> MaybeT m SomeNotebook)
-> PackError -> MaybeT m SomeNotebook
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> PackError
PackUnsupportedNotebookFormat (Int
major, Int
minor)

  -- Create and export the notebook.
  SomeNotebook
filledNb <-
    SomeNotebook
-> (forall a.
    (ToJSON (Notebook a), FromJSON (Notebook a)) =>
    Notebook a -> MaybeT m SomeNotebook)
-> MaybeT m SomeNotebook
forall r.
SomeNotebook
-> (forall a.
    (ToJSON (Notebook a), FromJSON (Notebook a)) =>
    Notebook a -> r)
-> r
withSomeNotebook
      SomeNotebook
nb
      ( IO (Notebook a) -> MaybeT m (Notebook a)
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Notebook a) -> MaybeT m (Notebook a))
-> (Notebook a -> IO (Notebook a))
-> Notebook a
-> MaybeT m (Notebook a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [CellSource] -> Notebook a -> IO (Notebook a)
forall a. FilePath -> [CellSource] -> Notebook a -> IO (Notebook a)
fillSources PackOptions
opts.partsDirectory [CellSource]
sources
          (Notebook a -> MaybeT m (Notebook a))
-> (Notebook a -> MaybeT m SomeNotebook)
-> Notebook a
-> MaybeT m SomeNotebook
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Either PackError (Notebook a) -> MaybeT m (Notebook a)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either PackError (Notebook a) -> MaybeT m (Notebook a))
-> (Notebook a -> Either PackError (Notebook a))
-> Notebook a
-> MaybeT m (Notebook a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NotebookMetadata -> Notebook a -> Either PackError (Notebook a)
forall a.
NotebookMetadata -> Notebook a -> Either PackError (Notebook a)
fillMetadata NotebookMetadata
metadata
          (Notebook a -> MaybeT m (Notebook a))
-> (Notebook a -> MaybeT m SomeNotebook)
-> Notebook a
-> MaybeT m SomeNotebook
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> FilePath
-> UnembeddedNotebookOutputs -> Notebook a -> MaybeT m (Notebook a)
forall (m :: * -> *) a.
(MonadError PackError m, MonadIO m) =>
FilePath
-> UnembeddedNotebookOutputs -> Notebook a -> m (Notebook a)
fillOutputs PackOptions
opts.partsDirectory UnembeddedNotebookOutputs
unembeddedOutputs
          (Notebook a -> MaybeT m (Notebook a))
-> (Notebook a -> MaybeT m SomeNotebook)
-> Notebook a
-> MaybeT m SomeNotebook
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> SomeNotebook -> MaybeT m SomeNotebook
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeNotebook -> MaybeT m SomeNotebook)
-> (Notebook a -> SomeNotebook)
-> Notebook a
-> MaybeT m SomeNotebook
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Notebook a -> SomeNotebook
forall a.
(ToJSON (Notebook a), FromJSON (Notebook a)) =>
Notebook a -> SomeNotebook
SomeNotebook
      )

  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 -> SomeNotebook -> IO ()
forall a. ToJSON a => FilePath -> a -> IO ()
exportJson FilePath
outputPath SomeNotebook
filledNb

  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
"Packed \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack PackOptions
opts.partsDirectory Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" into \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack FilePath
outputPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"")

mkDefOutputPath :: FilePath -> FilePath
mkDefOutputPath :: FilePath -> FilePath
mkDefOutputPath FilePath
partsDir = case FilePath -> FilePath -> Maybe FilePath
FilePath.stripExtension FilePath
"nbparts" FilePath
partsDir of
  Just FilePath
stripped
    | FilePath
"ipynb" FilePath -> FilePath -> Bool
`FilePath.isExtensionOf` FilePath
stripped -> FilePath
stripped
    | Bool
otherwise -> FilePath
stripped FilePath -> FilePath -> FilePath
<.> FilePath
"ipynb"
  Maybe FilePath
Nothing -> case FilePath -> FilePath -> Maybe FilePath
FilePath.stripExtension FilePath
"ipynb" FilePath
partsDir of
    Just FilePath
stripped -> FilePath
stripped FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-packed" FilePath -> FilePath -> FilePath
<.> FilePath
"ipynb"
    Maybe FilePath
Nothing -> FilePath
partsDir FilePath -> FilePath -> FilePath
<.> FilePath
"ipynb"

checkVersion :: (MonadError PackError m, MonadIO m) => Version -> m ()
checkVersion :: forall (m :: * -> *).
(MonadError PackError m, MonadIO m) =>
Version -> m ()
checkVersion Version
version = do
  let Version [Int]
branch [FilePath]
_ = Version
version
      maybeMajorA :: Maybe Int
maybeMajorA = [Int]
branch [Int] -> Int -> Maybe Int
forall a. [a] -> Int -> Maybe a
!? Int
0
      maybeMajorB :: Maybe Int
maybeMajorB = [Int]
branch [Int] -> Int -> Maybe Int
forall a. [a] -> Int -> Maybe a
!? Int
1
      maybeMinor :: Maybe Int
maybeMinor = [Int]
branch [Int] -> Int -> Maybe Int
forall a. [a] -> Int -> Maybe a
!? Int
2
      maybePatch :: Maybe Int
maybePatch = [Int]
branch [Int] -> Int -> Maybe Int
forall a. [a] -> Int -> Maybe a
!? Int
3
      maybeInvalid :: Maybe Int
maybeInvalid = [Int]
branch [Int] -> Int -> Maybe Int
forall a. [a] -> Int -> Maybe a
!? Int
4 -- We want this to be Nothing.
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (Maybe Int -> Bool
forall a. Maybe a -> Bool
Maybe.isJust Maybe Int
maybeInvalid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ PackError -> m ()
forall a. PackError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Version -> PackError
PackManifestUnknownVersionError Version
version)

  (Int
majorA, Int
majorB, Int
minor, Int
patch) <- case (,,,) (Int -> Int -> Int -> Int -> (Int, Int, Int, Int))
-> Maybe Int -> Maybe (Int -> Int -> Int -> (Int, Int, Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
maybeMajorA Maybe (Int -> Int -> Int -> (Int, Int, Int, Int))
-> Maybe Int -> Maybe (Int -> Int -> (Int, Int, Int, Int))
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int
maybeMajorB Maybe (Int -> Int -> (Int, Int, Int, Int))
-> Maybe Int -> Maybe (Int -> (Int, Int, Int, Int))
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int
maybeMinor Maybe (Int -> (Int, Int, Int, Int))
-> Maybe Int -> Maybe (Int, Int, Int, Int)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int
maybePatch of
    Just (Int, Int, Int, Int)
branches -> (Int, Int, Int, Int) -> m (Int, Int, Int, Int)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int, Int, Int, Int)
branches
    Maybe (Int, Int, Int, Int)
Nothing -> PackError -> m (Int, Int, Int, Int)
forall a. PackError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PackError -> m (Int, Int, Int, Int))
-> PackError -> m (Int, Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ Version -> PackError
PackManifestUnknownVersionError Version
version

  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> IO ()
compareVersion Int
majorA Int
majorB Int
minor Int
patch
  where
    Version [Int]
cBranch' [FilePath]
_ = Version
currentNbpartsVersion
    cBranch :: NonEmpty Int
cBranch = [Int] -> NonEmpty Int
forall a. HasCallStack => [a] -> NonEmpty a
NonEmptyList.fromList [Int]
cBranch'
    -- Safety: The known current nbparts version will always have a major, minor and patch version.
    -- The same cannot be said for the version parsed from the manifest, however.
    cMajorA :: Int
cMajorA = NonEmpty Int -> Int
forall a. NonEmpty a -> a
NonEmptyList.head NonEmpty Int
cBranch
    cMajorB :: Int
cMajorB = NonEmpty Int
cBranch NonEmpty Int -> Int -> Int
forall a. HasCallStack => NonEmpty a -> Int -> a
NonEmptyList.!! Int
1
    cMinor :: Int
cMinor = NonEmpty Int
cBranch NonEmpty Int -> Int -> Int
forall a. HasCallStack => NonEmpty a -> Int -> a
NonEmptyList.!! Int
2
    cPatch :: Int
cPatch = NonEmpty Int
cBranch NonEmpty Int -> Int -> Int
forall a. HasCallStack => NonEmpty a -> Int -> a
NonEmptyList.!! Int
3

    compareVersion :: Int -> Int -> Int -> Int -> IO ()
    compareVersion :: Int -> Int -> Int -> Int -> IO ()
compareVersion Int
majorA Int
majorB Int
minor Int
patch
      | (Int
cMajorA, Int
cMajorB) (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
> (Int
majorA, Int
majorB) = Version -> VersionComponent -> VersionRelative -> IO ()
warnManifestVersion Version
version VersionComponent
Major VersionRelative
Older
      | (Int
cMajorA, Int
cMajorB) (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
majorA, Int
majorB) = Version -> VersionComponent -> VersionRelative -> IO ()
warnManifestVersion Version
version VersionComponent
Major VersionRelative
Newer
      | Int
cMinor Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minor = Version -> VersionComponent -> VersionRelative -> IO ()
warnManifestVersion Version
version VersionComponent
Minor VersionRelative
Newer
      | Int
cPatch Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
patch = Version -> VersionComponent -> VersionRelative -> IO ()
warnManifestVersion Version
version VersionComponent
Patch VersionRelative
Newer
      -- Newer minor or patch version should be backwards compatible.
      | Bool
otherwise = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

data VersionComponent = Major | Minor | Patch

data VersionRelative = Older | Newer

warnManifestVersion :: Version -> VersionComponent -> VersionRelative -> IO ()
warnManifestVersion :: Version -> VersionComponent -> VersionRelative -> IO ()
warnManifestVersion Version
ver VersionComponent
comp VersionRelative
rel =
  Handle -> Text -> IO ()
Text.hPutStrLn Handle
stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
    Text
"Warning: Manifest's "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> VersionComponent -> Text
renderVersionComponent VersionComponent
comp
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" version ("
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (Version -> FilePath
Version.showVersion Version
ver)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") is "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> VersionRelative -> Text
renderVersionRelative VersionRelative
rel
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" than the current nbparts ("
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (Version -> FilePath
Version.showVersion Version
currentNbpartsVersion)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"). nbparts will still try to continue, "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"but may fail or produce an incorrect notebook!"
  where
    renderVersionComponent :: VersionComponent -> Text
    renderVersionComponent :: VersionComponent -> Text
renderVersionComponent VersionComponent
Major = Text
"major"
    renderVersionComponent VersionComponent
Minor = Text
"minor"
    renderVersionComponent VersionComponent
Patch = Text
"patch"

    renderVersionRelative :: VersionRelative -> Text
    renderVersionRelative :: VersionRelative -> Text
renderVersionRelative VersionRelative
Older = Text
"older"
    renderVersionRelative VersionRelative
Newer = Text
"newer"

prettyConfig :: AesonPretty.Config
prettyConfig :: Config
prettyConfig = Config
AesonPretty.defConfig {confIndent = AesonPretty.Spaces 1}

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
prettyConfig

emptyNotebook :: (Int, Int) -> Ipynb.Notebook a
emptyNotebook :: forall a. (Int, Int) -> Notebook a
emptyNotebook (Int, Int)
format = JSONMeta -> (Int, Int) -> [Cell a] -> Notebook a
forall a. JSONMeta -> (Int, Int) -> [Cell a] -> Notebook a
Ipynb.Notebook (Map Text Value -> JSONMeta
Ipynb.JSONMeta Map Text Value
forall k a. Map k a
Map.empty) (Int, Int)
format []