{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE OverloadedStrings #-}

module Unison.Codebase.Init
  ( Init (..),
    DebugName,
    InitError (..),
    CodebaseInitOptions (..),
    CodebaseLockOption (..),
    InitResult (..),
    SpecifiedCodebase (..),
    MigrationStrategy (..),
    BackupStrategy (..),
    VacuumStrategy (..),
    Pretty,
    createCodebase,
    initCodebaseAndExit,
    withOpenOrCreateCodebase,
    withNewUcmCodebaseOrExit,
    withTemporaryUcmCodebase,
  )
where

import System.Exit (exitFailure)
import Unison.Codebase (Codebase, CodebasePath)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.FileCodebase qualified as FCC
import Unison.Codebase.Init.CreateCodebaseError
import Unison.Codebase.Init.OpenCodebaseError
import Unison.Codebase.Verbosity (Verbosity, isSilent)
import Unison.Parser.Ann (Ann (..))
import Unison.Prelude
import Unison.PrettyTerminal qualified as PT
import Unison.Symbol (Symbol)
import Unison.Util.Pretty qualified as P
import UnliftIO qualified
import UnliftIO.Directory (canonicalizePath)

-- CodebaseInitOptions is used to help pass around a Home directory that isn't the
-- actual home directory of the user. Useful in tests.
data CodebaseInitOptions
  = Home CodebasePath
  | Specified SpecifiedCodebase

data SpecifiedCodebase
  = CreateWhenMissing CodebasePath
  | DontCreateWhenMissing CodebasePath

data CodebaseLockOption
  = DoLock
  | DontLock

data BackupStrategy
  = -- Create a backup of the codebase in the same directory as the codebase,
    -- see 'backupCodebasePath'.
    Backup
  | -- Don't create a backup when migrating, this might be used if the caller has
    -- already created a copy of the codebase for instance.
    NoBackup
  deriving stock (Int -> BackupStrategy -> ShowS
[BackupStrategy] -> ShowS
BackupStrategy -> String
(Int -> BackupStrategy -> ShowS)
-> (BackupStrategy -> String)
-> ([BackupStrategy] -> ShowS)
-> Show BackupStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BackupStrategy -> ShowS
showsPrec :: Int -> BackupStrategy -> ShowS
$cshow :: BackupStrategy -> String
show :: BackupStrategy -> String
$cshowList :: [BackupStrategy] -> ShowS
showList :: [BackupStrategy] -> ShowS
Show, BackupStrategy -> BackupStrategy -> Bool
(BackupStrategy -> BackupStrategy -> Bool)
-> (BackupStrategy -> BackupStrategy -> Bool) -> Eq BackupStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BackupStrategy -> BackupStrategy -> Bool
== :: BackupStrategy -> BackupStrategy -> Bool
$c/= :: BackupStrategy -> BackupStrategy -> Bool
/= :: BackupStrategy -> BackupStrategy -> Bool
Eq, Eq BackupStrategy
Eq BackupStrategy =>
(BackupStrategy -> BackupStrategy -> Ordering)
-> (BackupStrategy -> BackupStrategy -> Bool)
-> (BackupStrategy -> BackupStrategy -> Bool)
-> (BackupStrategy -> BackupStrategy -> Bool)
-> (BackupStrategy -> BackupStrategy -> Bool)
-> (BackupStrategy -> BackupStrategy -> BackupStrategy)
-> (BackupStrategy -> BackupStrategy -> BackupStrategy)
-> Ord BackupStrategy
BackupStrategy -> BackupStrategy -> Bool
BackupStrategy -> BackupStrategy -> Ordering
BackupStrategy -> BackupStrategy -> BackupStrategy
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BackupStrategy -> BackupStrategy -> Ordering
compare :: BackupStrategy -> BackupStrategy -> Ordering
$c< :: BackupStrategy -> BackupStrategy -> Bool
< :: BackupStrategy -> BackupStrategy -> Bool
$c<= :: BackupStrategy -> BackupStrategy -> Bool
<= :: BackupStrategy -> BackupStrategy -> Bool
$c> :: BackupStrategy -> BackupStrategy -> Bool
> :: BackupStrategy -> BackupStrategy -> Bool
$c>= :: BackupStrategy -> BackupStrategy -> Bool
>= :: BackupStrategy -> BackupStrategy -> Bool
$cmax :: BackupStrategy -> BackupStrategy -> BackupStrategy
max :: BackupStrategy -> BackupStrategy -> BackupStrategy
$cmin :: BackupStrategy -> BackupStrategy -> BackupStrategy
min :: BackupStrategy -> BackupStrategy -> BackupStrategy
Ord)

data VacuumStrategy
  = -- Vacuum after migrating. Takes a bit longer but keeps the codebase clean and maybe reduces size.
    Vacuum
  | -- Don't vacuum after migrating. Vacuuming is time consuming on large codebases,
    -- so we don't want to do it during server migrations.
    NoVacuum
  deriving stock (Int -> VacuumStrategy -> ShowS
[VacuumStrategy] -> ShowS
VacuumStrategy -> String
(Int -> VacuumStrategy -> ShowS)
-> (VacuumStrategy -> String)
-> ([VacuumStrategy] -> ShowS)
-> Show VacuumStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VacuumStrategy -> ShowS
showsPrec :: Int -> VacuumStrategy -> ShowS
$cshow :: VacuumStrategy -> String
show :: VacuumStrategy -> String
$cshowList :: [VacuumStrategy] -> ShowS
showList :: [VacuumStrategy] -> ShowS
Show, VacuumStrategy -> VacuumStrategy -> Bool
(VacuumStrategy -> VacuumStrategy -> Bool)
-> (VacuumStrategy -> VacuumStrategy -> Bool) -> Eq VacuumStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VacuumStrategy -> VacuumStrategy -> Bool
== :: VacuumStrategy -> VacuumStrategy -> Bool
$c/= :: VacuumStrategy -> VacuumStrategy -> Bool
/= :: VacuumStrategy -> VacuumStrategy -> Bool
Eq, Eq VacuumStrategy
Eq VacuumStrategy =>
(VacuumStrategy -> VacuumStrategy -> Ordering)
-> (VacuumStrategy -> VacuumStrategy -> Bool)
-> (VacuumStrategy -> VacuumStrategy -> Bool)
-> (VacuumStrategy -> VacuumStrategy -> Bool)
-> (VacuumStrategy -> VacuumStrategy -> Bool)
-> (VacuumStrategy -> VacuumStrategy -> VacuumStrategy)
-> (VacuumStrategy -> VacuumStrategy -> VacuumStrategy)
-> Ord VacuumStrategy
VacuumStrategy -> VacuumStrategy -> Bool
VacuumStrategy -> VacuumStrategy -> Ordering
VacuumStrategy -> VacuumStrategy -> VacuumStrategy
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: VacuumStrategy -> VacuumStrategy -> Ordering
compare :: VacuumStrategy -> VacuumStrategy -> Ordering
$c< :: VacuumStrategy -> VacuumStrategy -> Bool
< :: VacuumStrategy -> VacuumStrategy -> Bool
$c<= :: VacuumStrategy -> VacuumStrategy -> Bool
<= :: VacuumStrategy -> VacuumStrategy -> Bool
$c> :: VacuumStrategy -> VacuumStrategy -> Bool
> :: VacuumStrategy -> VacuumStrategy -> Bool
$c>= :: VacuumStrategy -> VacuumStrategy -> Bool
>= :: VacuumStrategy -> VacuumStrategy -> Bool
$cmax :: VacuumStrategy -> VacuumStrategy -> VacuumStrategy
max :: VacuumStrategy -> VacuumStrategy -> VacuumStrategy
$cmin :: VacuumStrategy -> VacuumStrategy -> VacuumStrategy
min :: VacuumStrategy -> VacuumStrategy -> VacuumStrategy
Ord)

data MigrationStrategy
  = -- | Perform a migration immediately if one is required.
    MigrateAutomatically BackupStrategy VacuumStrategy
  | -- | Prompt the user that a migration is about to occur, continue after acknownledgment
    MigrateAfterPrompt BackupStrategy VacuumStrategy
  | -- | Triggers an 'OpenCodebaseRequiresMigration' error instead of migrating
    DontMigrate
  deriving stock (Int -> MigrationStrategy -> ShowS
[MigrationStrategy] -> ShowS
MigrationStrategy -> String
(Int -> MigrationStrategy -> ShowS)
-> (MigrationStrategy -> String)
-> ([MigrationStrategy] -> ShowS)
-> Show MigrationStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MigrationStrategy -> ShowS
showsPrec :: Int -> MigrationStrategy -> ShowS
$cshow :: MigrationStrategy -> String
show :: MigrationStrategy -> String
$cshowList :: [MigrationStrategy] -> ShowS
showList :: [MigrationStrategy] -> ShowS
Show, MigrationStrategy -> MigrationStrategy -> Bool
(MigrationStrategy -> MigrationStrategy -> Bool)
-> (MigrationStrategy -> MigrationStrategy -> Bool)
-> Eq MigrationStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MigrationStrategy -> MigrationStrategy -> Bool
== :: MigrationStrategy -> MigrationStrategy -> Bool
$c/= :: MigrationStrategy -> MigrationStrategy -> Bool
/= :: MigrationStrategy -> MigrationStrategy -> Bool
Eq, Eq MigrationStrategy
Eq MigrationStrategy =>
(MigrationStrategy -> MigrationStrategy -> Ordering)
-> (MigrationStrategy -> MigrationStrategy -> Bool)
-> (MigrationStrategy -> MigrationStrategy -> Bool)
-> (MigrationStrategy -> MigrationStrategy -> Bool)
-> (MigrationStrategy -> MigrationStrategy -> Bool)
-> (MigrationStrategy -> MigrationStrategy -> MigrationStrategy)
-> (MigrationStrategy -> MigrationStrategy -> MigrationStrategy)
-> Ord MigrationStrategy
MigrationStrategy -> MigrationStrategy -> Bool
MigrationStrategy -> MigrationStrategy -> Ordering
MigrationStrategy -> MigrationStrategy -> MigrationStrategy
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MigrationStrategy -> MigrationStrategy -> Ordering
compare :: MigrationStrategy -> MigrationStrategy -> Ordering
$c< :: MigrationStrategy -> MigrationStrategy -> Bool
< :: MigrationStrategy -> MigrationStrategy -> Bool
$c<= :: MigrationStrategy -> MigrationStrategy -> Bool
<= :: MigrationStrategy -> MigrationStrategy -> Bool
$c> :: MigrationStrategy -> MigrationStrategy -> Bool
> :: MigrationStrategy -> MigrationStrategy -> Bool
$c>= :: MigrationStrategy -> MigrationStrategy -> Bool
>= :: MigrationStrategy -> MigrationStrategy -> Bool
$cmax :: MigrationStrategy -> MigrationStrategy -> MigrationStrategy
max :: MigrationStrategy -> MigrationStrategy -> MigrationStrategy
$cmin :: MigrationStrategy -> MigrationStrategy -> MigrationStrategy
min :: MigrationStrategy -> MigrationStrategy -> MigrationStrategy
Ord)

initOptionsToDir :: CodebaseInitOptions -> CodebasePath
initOptionsToDir :: CodebaseInitOptions -> String
initOptionsToDir (Home String
dir) = String
dir
initOptionsToDir (Specified (CreateWhenMissing String
dir)) = String
dir
initOptionsToDir (Specified (DontCreateWhenMissing String
dir)) = String
dir

type DebugName = String

data Init m v a = Init
  { -- | open an existing codebase
    forall (m :: * -> *) v a.
Init m v a
-> forall r.
   String
   -> String
   -> CodebaseLockOption
   -> MigrationStrategy
   -> (Codebase m v a -> m r)
   -> m (Either OpenCodebaseError r)
withOpenCodebase :: forall r. DebugName -> CodebasePath -> CodebaseLockOption -> MigrationStrategy -> (Codebase m v a -> m r) -> m (Either OpenCodebaseError r),
    -- | create a new codebase
    forall (m :: * -> *) v a.
Init m v a
-> forall r.
   String
   -> String
   -> CodebaseLockOption
   -> (Codebase m v a -> m r)
   -> m (Either CreateCodebaseError r)
withCreatedCodebase :: forall r. DebugName -> CodebasePath -> CodebaseLockOption -> (Codebase m v a -> m r) -> m (Either CreateCodebaseError r),
    -- | given a codebase root, and given that the codebase root may have other junk in it,
    -- give the path to the "actual" files; e.g. what a forked transcript should clone.
    forall (m :: * -> *) v a. Init m v a -> ShowS
codebasePath :: CodebasePath -> CodebasePath
  }

-- | An error that occurred while initializing a codebase.
data InitError
  = FoundV1Codebase
  | InitErrorOpen OpenCodebaseError
  | CouldntCreateCodebase Pretty
  deriving (Int -> InitError -> ShowS
[InitError] -> ShowS
InitError -> String
(Int -> InitError -> ShowS)
-> (InitError -> String)
-> ([InitError] -> ShowS)
-> Show InitError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitError -> ShowS
showsPrec :: Int -> InitError -> ShowS
$cshow :: InitError -> String
show :: InitError -> String
$cshowList :: [InitError] -> ShowS
showList :: [InitError] -> ShowS
Show, InitError -> InitError -> Bool
(InitError -> InitError -> Bool)
-> (InitError -> InitError -> Bool) -> Eq InitError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InitError -> InitError -> Bool
== :: InitError -> InitError -> Bool
$c/= :: InitError -> InitError -> Bool
/= :: InitError -> InitError -> Bool
Eq)

data InitResult
  = OpenedCodebase
  | CreatedCodebase
  deriving (Int -> InitResult -> ShowS
[InitResult] -> ShowS
InitResult -> String
(Int -> InitResult -> ShowS)
-> (InitResult -> String)
-> ([InitResult] -> ShowS)
-> Show InitResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitResult -> ShowS
showsPrec :: Int -> InitResult -> ShowS
$cshow :: InitResult -> String
show :: InitResult -> String
$cshowList :: [InitResult] -> ShowS
showList :: [InitResult] -> ShowS
Show, InitResult -> InitResult -> Bool
(InitResult -> InitResult -> Bool)
-> (InitResult -> InitResult -> Bool) -> Eq InitResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InitResult -> InitResult -> Bool
== :: InitResult -> InitResult -> Bool
$c/= :: InitResult -> InitResult -> Bool
/= :: InitResult -> InitResult -> Bool
Eq)

createCodebaseWithResult ::
  (MonadIO m) =>
  Init m v a ->
  DebugName ->
  CodebasePath ->
  CodebaseLockOption ->
  (Codebase m v a -> m r) ->
  m (Either (CodebasePath, InitError) r)
createCodebaseWithResult :: forall (m :: * -> *) v a r.
MonadIO m =>
Init m v a
-> String
-> String
-> CodebaseLockOption
-> (Codebase m v a -> m r)
-> m (Either (String, InitError) r)
createCodebaseWithResult Init m v a
cbInit String
debugName String
dir CodebaseLockOption
lockOption Codebase m v a -> m r
action =
  Init m v a
-> String
-> String
-> CodebaseLockOption
-> (Codebase m v a -> m r)
-> m (Either Pretty r)
forall (m :: * -> *) v a r.
MonadIO m =>
Init m v a
-> String
-> String
-> CodebaseLockOption
-> (Codebase m v a -> m r)
-> m (Either Pretty r)
createCodebase Init m v a
cbInit String
debugName String
dir CodebaseLockOption
lockOption Codebase m v a -> m r
action m (Either Pretty r)
-> (Either Pretty r -> Either (String, InitError) r)
-> m (Either (String, InitError) r)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Pretty -> (String, InitError))
-> Either Pretty r -> Either (String, InitError) r
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft \case
    Pretty
errorMessage -> (String
dir, (Pretty -> InitError
CouldntCreateCodebase Pretty
errorMessage))

withOpenOrCreateCodebase ::
  (MonadIO m) =>
  Init m v a ->
  DebugName ->
  CodebaseInitOptions ->
  CodebaseLockOption ->
  MigrationStrategy ->
  ((InitResult, CodebasePath, Codebase m v a) -> m r) ->
  m (Either (CodebasePath, InitError) r)
withOpenOrCreateCodebase :: forall (m :: * -> *) v a r.
MonadIO m =>
Init m v a
-> String
-> CodebaseInitOptions
-> CodebaseLockOption
-> MigrationStrategy
-> ((InitResult, String, Codebase m v a) -> m r)
-> m (Either (String, InitError) r)
withOpenOrCreateCodebase Init m v a
cbInit String
debugName CodebaseInitOptions
initOptions CodebaseLockOption
lockOption MigrationStrategy
migrationStrategy (InitResult, String, Codebase m v a) -> m r
action = do
  let resolvedPath :: String
resolvedPath = CodebaseInitOptions -> String
initOptionsToDir CodebaseInitOptions
initOptions
  Either OpenCodebaseError r
result <- Init m v a
-> forall r.
   String
   -> String
   -> CodebaseLockOption
   -> MigrationStrategy
   -> (Codebase m v a -> m r)
   -> m (Either OpenCodebaseError r)
forall (m :: * -> *) v a.
Init m v a
-> forall r.
   String
   -> String
   -> CodebaseLockOption
   -> MigrationStrategy
   -> (Codebase m v a -> m r)
   -> m (Either OpenCodebaseError r)
withOpenCodebase Init m v a
cbInit String
debugName String
resolvedPath CodebaseLockOption
lockOption MigrationStrategy
migrationStrategy \Codebase m v a
codebase -> do
    (InitResult, String, Codebase m v a) -> m r
action (InitResult
OpenedCodebase, String
resolvedPath, Codebase m v a
codebase)
  case Either OpenCodebaseError r
result of
    Right r
r -> Either (String, InitError) r -> m (Either (String, InitError) r)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (String, InitError) r -> m (Either (String, InitError) r))
-> Either (String, InitError) r -> m (Either (String, InitError) r)
forall a b. (a -> b) -> a -> b
$ r -> Either (String, InitError) r
forall a b. b -> Either a b
Right r
r
    Left OpenCodebaseError
err -> case OpenCodebaseError
err of
      OpenCodebaseError
OpenCodebaseDoesntExist ->
        case CodebaseInitOptions
initOptions of
          Home String
homeDir -> do
            m Bool
-> m (Either (String, InitError) r)
-> m (Either (String, InitError) r)
-> m (Either (String, InitError) r)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM
              (String -> m Bool
forall (m :: * -> *). MonadIO m => String -> m Bool
FCC.codebaseExists String
homeDir)
              (do Either (String, InitError) r -> m (Either (String, InitError) r)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String, InitError) -> Either (String, InitError) r
forall a b. a -> Either a b
Left (String
homeDir, InitError
FoundV1Codebase)))
              ( do
                  -- Create V2 codebase if neither a V1 or V2 exists
                  Init m v a
-> String
-> String
-> CodebaseLockOption
-> (Codebase m v a -> m r)
-> m (Either (String, InitError) r)
forall (m :: * -> *) v a r.
MonadIO m =>
Init m v a
-> String
-> String
-> CodebaseLockOption
-> (Codebase m v a -> m r)
-> m (Either (String, InitError) r)
createCodebaseWithResult Init m v a
cbInit String
debugName String
homeDir CodebaseLockOption
lockOption (\Codebase m v a
codebase -> (InitResult, String, Codebase m v a) -> m r
action (InitResult
CreatedCodebase, String
homeDir, Codebase m v a
codebase))
              )
          Specified SpecifiedCodebase
specified ->
            m Bool
-> m (Either (String, InitError) r)
-> m (Either (String, InitError) r)
-> m (Either (String, InitError) r)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM
              (String -> m Bool
forall (m :: * -> *). MonadIO m => String -> m Bool
FCC.codebaseExists String
resolvedPath)
              (Either (String, InitError) r -> m (Either (String, InitError) r)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (String, InitError) r -> m (Either (String, InitError) r))
-> Either (String, InitError) r -> m (Either (String, InitError) r)
forall a b. (a -> b) -> a -> b
$ (String, InitError) -> Either (String, InitError) r
forall a b. a -> Either a b
Left (String
resolvedPath, InitError
FoundV1Codebase))
              case SpecifiedCodebase
specified of
                DontCreateWhenMissing String
dir ->
                  Either (String, InitError) r -> m (Either (String, InitError) r)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String, InitError) -> Either (String, InitError) r
forall a b. a -> Either a b
Left (String
dir, (OpenCodebaseError -> InitError
InitErrorOpen OpenCodebaseError
OpenCodebaseDoesntExist)))
                CreateWhenMissing String
dir ->
                  Init m v a
-> String
-> String
-> CodebaseLockOption
-> (Codebase m v a -> m r)
-> m (Either (String, InitError) r)
forall (m :: * -> *) v a r.
MonadIO m =>
Init m v a
-> String
-> String
-> CodebaseLockOption
-> (Codebase m v a -> m r)
-> m (Either (String, InitError) r)
createCodebaseWithResult Init m v a
cbInit String
debugName String
dir CodebaseLockOption
lockOption (\Codebase m v a
codebase -> (InitResult, String, Codebase m v a) -> m r
action (InitResult
CreatedCodebase, String
dir, Codebase m v a
codebase))
      OpenCodebaseUnknownSchemaVersion {} -> Either (String, InitError) r -> m (Either (String, InitError) r)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String, InitError) -> Either (String, InitError) r
forall a b. a -> Either a b
Left (String
resolvedPath, OpenCodebaseError -> InitError
InitErrorOpen OpenCodebaseError
err))
      OpenCodebaseRequiresMigration {} -> Either (String, InitError) r -> m (Either (String, InitError) r)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String, InitError) -> Either (String, InitError) r
forall a b. a -> Either a b
Left (String
resolvedPath, OpenCodebaseError -> InitError
InitErrorOpen OpenCodebaseError
err))
      OpenCodebaseFileLockFailed {} -> Either (String, InitError) r -> m (Either (String, InitError) r)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String, InitError) -> Either (String, InitError) r
forall a b. a -> Either a b
Left (String
resolvedPath, OpenCodebaseError -> InitError
InitErrorOpen OpenCodebaseError
err))

createCodebase :: (MonadIO m) => Init m v a -> DebugName -> CodebasePath -> CodebaseLockOption -> (Codebase m v a -> m r) -> m (Either Pretty r)
createCodebase :: forall (m :: * -> *) v a r.
MonadIO m =>
Init m v a
-> String
-> String
-> CodebaseLockOption
-> (Codebase m v a -> m r)
-> m (Either Pretty r)
createCodebase Init m v a
cbInit String
debugName String
path CodebaseLockOption
lockOption Codebase m v a -> m r
action = do
  Pretty
prettyDir <- String -> Pretty
forall s. IsString s => String -> Pretty s
P.string (String -> Pretty) -> m String -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m String
forall (m :: * -> *). MonadIO m => String -> m String
canonicalizePath String
path
  Init m v a
-> forall r.
   String
   -> String
   -> CodebaseLockOption
   -> (Codebase m v a -> m r)
   -> m (Either CreateCodebaseError r)
forall (m :: * -> *) v a.
Init m v a
-> forall r.
   String
   -> String
   -> CodebaseLockOption
   -> (Codebase m v a -> m r)
   -> m (Either CreateCodebaseError r)
withCreatedCodebase Init m v a
cbInit String
debugName String
path CodebaseLockOption
lockOption Codebase m v a -> m r
action m (Either CreateCodebaseError r)
-> (Either CreateCodebaseError r -> Either Pretty r)
-> m (Either Pretty r)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (CreateCodebaseError -> Pretty)
-> Either CreateCodebaseError r -> Either Pretty r
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft \case
    CreateCodebaseError
CreateCodebaseAlreadyExists ->
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
"It looks like there's already a codebase in: "
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
prettyDir

-- * compatibility stuff

-- previously: initCodebaseOrExit :: CodebasePath -> m (m (), Codebase m v a)
-- previously: FileCodebase.initCodebase :: CodebasePath -> m (m (), Codebase m v a)
withNewUcmCodebaseOrExit :: (MonadIO m) => Init m Symbol Ann -> Verbosity -> DebugName -> CodebasePath -> CodebaseLockOption -> (Codebase m Symbol Ann -> m r) -> m r
withNewUcmCodebaseOrExit :: forall (m :: * -> *) r.
MonadIO m =>
Init m Symbol Ann
-> Verbosity
-> String
-> String
-> CodebaseLockOption
-> (Codebase m Symbol Ann -> m r)
-> m r
withNewUcmCodebaseOrExit Init m Symbol Ann
cbInit Verbosity
verbosity String
debugName String
path CodebaseLockOption
lockOption Codebase m Symbol Ann -> m r
action = do
  Pretty
prettyDir <- String -> Pretty
forall s. IsString s => String -> Pretty s
P.string (String -> Pretty) -> m String -> m Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m String
forall (m :: * -> *). MonadIO m => String -> m String
canonicalizePath String
path
  let codebaseSetup :: Codebase m Symbol Ann -> m ()
codebaseSetup Codebase m Symbol Ann
codebase = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Verbosity -> Bool
isSilent Verbosity
verbosity) (m () -> m ()) -> (IO () -> m ()) -> IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
$ Pretty -> IO ()
PT.putPrettyLn' (Pretty -> IO ()) -> (Pretty -> Pretty) -> Pretty -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO ()) -> Pretty -> IO ()
forall a b. (a -> b) -> a -> b
$ Pretty
"Initializing a new codebase in: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
prettyDir
        Codebase m Symbol Ann -> Transaction () -> m ()
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m Symbol Ann
codebase (Codebase m Symbol Ann -> Transaction ()
forall (m :: * -> *). Codebase m Symbol Ann -> Transaction ()
Codebase.installUcmDependencies Codebase m Symbol Ann
codebase)
  Init m Symbol Ann
-> String
-> String
-> CodebaseLockOption
-> (Codebase m Symbol Ann -> m r)
-> m (Either Pretty r)
forall (m :: * -> *) v a r.
MonadIO m =>
Init m v a
-> String
-> String
-> CodebaseLockOption
-> (Codebase m v a -> m r)
-> m (Either Pretty r)
createCodebase Init m Symbol Ann
cbInit String
debugName String
path CodebaseLockOption
lockOption (\Codebase m Symbol Ann
cb -> Codebase m Symbol Ann -> m ()
codebaseSetup Codebase m Symbol Ann
cb m () -> m r -> m r
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Codebase m Symbol Ann -> m r
action Codebase m Symbol Ann
cb)
    m (Either Pretty r) -> (Either Pretty r -> m r) -> m r
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Pretty
error -> IO r -> m r
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO r -> m r) -> IO r -> m r
forall a b. (a -> b) -> a -> b
$ Pretty -> IO ()
PT.putPrettyLn' Pretty
error IO () -> IO r -> IO r
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO r
forall a. IO a
exitFailure
      Right r
result -> r -> m r
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
result

-- | try to init a codebase where none exists and then exit regardless (i.e. `ucm --codebase dir init`)
initCodebaseAndExit :: (MonadIO m) => Init m Symbol Ann -> Verbosity -> DebugName -> Maybe CodebasePath -> CodebaseLockOption -> m ()
initCodebaseAndExit :: forall (m :: * -> *).
MonadIO m =>
Init m Symbol Ann
-> Verbosity
-> String
-> Maybe String
-> CodebaseLockOption
-> m ()
initCodebaseAndExit Init m Symbol Ann
i Verbosity
verbosity String
debugName Maybe String
mdir CodebaseLockOption
lockOption = do
  String
codebaseDir <- Maybe String -> m String
forall (m :: * -> *). MonadIO m => Maybe String -> m String
Codebase.getCodebaseDir Maybe String
mdir
  Init m Symbol Ann
-> Verbosity
-> String
-> String
-> CodebaseLockOption
-> (Codebase m Symbol Ann -> m ())
-> m ()
forall (m :: * -> *) r.
MonadIO m =>
Init m Symbol Ann
-> Verbosity
-> String
-> String
-> CodebaseLockOption
-> (Codebase m Symbol Ann -> m r)
-> m r
withNewUcmCodebaseOrExit Init m Symbol Ann
i Verbosity
verbosity String
debugName String
codebaseDir CodebaseLockOption
lockOption (m () -> Codebase m Symbol Ann -> m ()
forall a b. a -> b -> a
const (m () -> Codebase m Symbol Ann -> m ())
-> m () -> Codebase m Symbol Ann -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

withTemporaryUcmCodebase ::
  (MonadUnliftIO m) =>
  Init m Symbol Ann ->
  Verbosity ->
  DebugName ->
  CodebaseLockOption ->
  ((CodebasePath, Codebase m Symbol Ann) -> m r) ->
  m r
withTemporaryUcmCodebase :: forall (m :: * -> *) r.
MonadUnliftIO m =>
Init m Symbol Ann
-> Verbosity
-> String
-> CodebaseLockOption
-> ((String, Codebase m Symbol Ann) -> m r)
-> m r
withTemporaryUcmCodebase Init m Symbol Ann
cbInit Verbosity
verbosity String
debugName CodebaseLockOption
lockOption (String, Codebase m Symbol Ann) -> m r
action = do
  String -> (String -> m r) -> m r
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (String -> m a) -> m a
UnliftIO.withSystemTempDirectory String
debugName ((String -> m r) -> m r) -> (String -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \String
tempDir -> do
    Init m Symbol Ann
-> Verbosity
-> String
-> String
-> CodebaseLockOption
-> (Codebase m Symbol Ann -> m r)
-> m r
forall (m :: * -> *) r.
MonadIO m =>
Init m Symbol Ann
-> Verbosity
-> String
-> String
-> CodebaseLockOption
-> (Codebase m Symbol Ann -> m r)
-> m r
withNewUcmCodebaseOrExit Init m Symbol Ann
cbInit Verbosity
verbosity String
debugName String
tempDir CodebaseLockOption
lockOption ((Codebase m Symbol Ann -> m r) -> m r)
-> (Codebase m Symbol Ann -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \Codebase m Symbol Ann
codebase -> do
      (String, Codebase m Symbol Ann) -> m r
action (String
tempDir, Codebase m Symbol Ann
codebase)