-- | This module contains miscellaneous helper utils for rote actions in the Cli monad, like resolving a relative path
-- to an absolute path, per the current path.
module Unison.Cli.MonadUtils
  ( -- * Paths
    getCurrentPath,
    getCurrentProjectName,
    getCurrentProjectBranchName,
    getCurrentProjectPath,
    resolvePath,
    resolvePath',
    resolvePath'ToAbsolute,
    resolveSplit',

    -- * Project and branch resolution
    getCurrentProjectAndBranch,
    getCurrentProjectBranch,

    -- * Branches

    -- ** Resolving branch identifiers
    resolveAbsBranchId,
    resolveAbsBranchIdV2,
    resolveBranchId,
    resolveBranchIdToAbsBranchId,
    resolveShortCausalHash,

    -- ** Getting/setting branches
    getCurrentProjectRoot,
    getCurrentProjectRoot0,
    getCurrentBranch,
    getCurrentBranch0,
    getProjectBranchRoot,
    getBranchFromProjectPath,
    getBranch0FromProjectPath,
    getMaybeBranchFromProjectPath,
    getMaybeBranch0FromProjectPath,
    expectBranchAtPath,
    expectBranchAtPath',
    expectBranch0AtPath,
    expectBranch0AtPath',
    assertNoBranchAtPath',
    branchExistsAtPath',

    -- ** Updating branches
    stepAt',
    stepAt,
    stepAtM,
    stepManyAt,
    stepManyAtM,
    updateProjectBranchRoot,
    updateProjectBranchRoot_,
    updateAtM,
    updateAt,
    updateAndStepAt,

    -- * Terms
    getTermsAt,

    -- * Types
    getTypesAt,

    -- * Patches

    -- ** Default patch
    defaultPatchPath,

    -- ** Getting patches
    getPatchAt,

    -- * Latest touched Unison file
    getLatestFile,
    getLatestParsedFile,
    getNamesFromLatestFile,
    getTermFromLatestParsedFile,
    expectLatestFile,
    expectLatestParsedFile,
    getLatestTypecheckedFile,
    expectLatestTypecheckedFile,

    -- * Parsing env
    makeParsingEnv,
  )
where

import Control.Lens
import Control.Monad.Reader (ask)
import Control.Monad.State
import Data.Foldable
import Data.Set qualified as Set
import U.Codebase.Branch qualified as V2 (Branch)
import U.Codebase.Branch qualified as V2Branch
import U.Codebase.Causal qualified as V2Causal
import U.Codebase.HashTags (CausalHash (..))
import U.Codebase.Sqlite.Project (Project)
import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..))
import U.Codebase.Sqlite.Queries qualified as Q
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.UniqueTypeGuidLookup (loadUniqueTypeGuid)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch (Branch (..), Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.BranchUtil qualified as BranchUtil
import Unison.Codebase.Editor.Input qualified as Input
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.Patch (Patch (..))
import Unison.Codebase.Patch qualified as Patch
import Unison.Codebase.Path (Path, Path' (..))
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.ProjectPath (ProjectPath)
import Unison.Codebase.ProjectPath qualified as PP
import Unison.Codebase.ShortCausalHash (ShortCausalHash)
import Unison.Codebase.ShortCausalHash qualified as SCH
import Unison.HashQualified qualified as HQ
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.Name qualified as Name
import Unison.NameSegment qualified as NameSegment
import Unison.Names (Names)
import Unison.Parser.Ann (Ann (..))
import Unison.Prelude
import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName)
import Unison.Reference (TypeReference)
import Unison.Referent (Referent)
import Unison.Sqlite (Transaction)
import Unison.Sqlite qualified as Sqlite
import Unison.Symbol (Symbol)
import Unison.Syntax.Name qualified as Name (toText)
import Unison.Syntax.Parser (ParsingEnv (..))
import Unison.Term qualified as Term
import Unison.UnisonFile (TypecheckedUnisonFile, UnisonFile)
import Unison.UnisonFile qualified as UF
import Unison.UnisonFile.Names qualified as UFN
import Unison.Util.Set qualified as Set
import Unison.Var qualified as Var

------------------------------------------------------------------------------------------------------------------------
-- Getting paths, path resolution, etc.

getCurrentProjectPath :: Cli PP.ProjectPath
getCurrentProjectPath :: Cli ProjectPath
getCurrentProjectPath = do
  ProjectPathIds
ppIds <- Cli ProjectPathIds
Cli.getProjectPathIds
  Transaction ProjectPath -> Cli ProjectPath
forall a. Transaction a -> Cli a
Cli.runTransaction (Transaction ProjectPath -> Cli ProjectPath)
-> Transaction ProjectPath -> Cli ProjectPath
forall a b. (a -> b) -> a -> b
$ ProjectPathIds -> Transaction ProjectPath
Codebase.resolveProjectPathIds ProjectPathIds
ppIds

getCurrentProjectAndBranch :: Cli (ProjectAndBranch Project ProjectBranch)
getCurrentProjectAndBranch :: Cli (ProjectAndBranch Project ProjectBranch)
getCurrentProjectAndBranch = do
  ProjectPath -> ProjectAndBranch Project ProjectBranch
forall p b. ProjectPathG p b -> ProjectAndBranch p b
PP.toProjectAndBranch (ProjectPath -> ProjectAndBranch Project ProjectBranch)
-> Cli ProjectPath -> Cli (ProjectAndBranch Project ProjectBranch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cli ProjectPath
getCurrentProjectPath

getCurrentProjectBranch :: Cli ProjectBranch
getCurrentProjectBranch :: Cli ProjectBranch
getCurrentProjectBranch = do
  Getting ProjectBranch ProjectPath ProjectBranch
-> ProjectPath -> ProjectBranch
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProjectBranch ProjectPath ProjectBranch
#branch (ProjectPath -> ProjectBranch)
-> Cli ProjectPath -> Cli ProjectBranch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cli ProjectPath
getCurrentProjectPath

-- | Get the current path relative to the current project.
getCurrentPath :: Cli Path.Absolute
getCurrentPath :: Cli Absolute
getCurrentPath = do
  Getting Absolute ProjectPath Absolute -> ProjectPath -> Absolute
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Absolute ProjectPath Absolute
forall p b (f :: * -> *).
Functor f =>
(Absolute -> f Absolute)
-> ProjectPathG p b -> f (ProjectPathG p b)
PP.absPath_ (ProjectPath -> Absolute) -> Cli ProjectPath -> Cli Absolute
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cli ProjectPath
getCurrentProjectPath

getCurrentProjectName :: Cli ProjectName
getCurrentProjectName :: Cli ProjectName
getCurrentProjectName = do
  Getting ProjectName ProjectPath ProjectName
-> ProjectPath -> ProjectName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Project -> Const ProjectName Project)
-> ProjectPath -> Const ProjectName ProjectPath
#project ((Project -> Const ProjectName Project)
 -> ProjectPath -> Const ProjectName ProjectPath)
-> ((ProjectName -> Const ProjectName ProjectName)
    -> Project -> Const ProjectName Project)
-> Getting ProjectName ProjectPath ProjectName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectName -> Const ProjectName ProjectName)
-> Project -> Const ProjectName Project
#name) (ProjectPath -> ProjectName) -> Cli ProjectPath -> Cli ProjectName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cli ProjectPath
getCurrentProjectPath

getCurrentProjectBranchName :: Cli ProjectBranchName
getCurrentProjectBranchName :: Cli ProjectBranchName
getCurrentProjectBranchName = do
  Getting ProjectBranchName ProjectPath ProjectBranchName
-> ProjectPath -> ProjectBranchName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ProjectBranch -> Const ProjectBranchName ProjectBranch)
-> ProjectPath -> Const ProjectBranchName ProjectPath
#branch ((ProjectBranch -> Const ProjectBranchName ProjectBranch)
 -> ProjectPath -> Const ProjectBranchName ProjectPath)
-> ((ProjectBranchName
     -> Const ProjectBranchName ProjectBranchName)
    -> ProjectBranch -> Const ProjectBranchName ProjectBranch)
-> Getting ProjectBranchName ProjectPath ProjectBranchName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectBranchName -> Const ProjectBranchName ProjectBranchName)
-> ProjectBranch -> Const ProjectBranchName ProjectBranch
#name) (ProjectPath -> ProjectBranchName)
-> Cli ProjectPath -> Cli ProjectBranchName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cli ProjectPath
getCurrentProjectPath

-- | Resolve a @Path@ (interpreted as relative) to a @Path.Absolute@, per the current path.
resolvePath :: Path -> Cli PP.ProjectPath
resolvePath :: Path -> Cli ProjectPath
resolvePath Path
path = do
  ProjectPath
pp <- Cli ProjectPath
getCurrentProjectPath
  pure $ ProjectPath
pp ProjectPath -> (ProjectPath -> ProjectPath) -> ProjectPath
forall a b. a -> (a -> b) -> b
& (Absolute -> Identity Absolute)
-> ProjectPath -> Identity ProjectPath
forall p b (f :: * -> *).
Functor f =>
(Absolute -> f Absolute)
-> ProjectPathG p b -> f (ProjectPathG p b)
PP.absPath_ ((Absolute -> Identity Absolute)
 -> ProjectPath -> Identity ProjectPath)
-> (Absolute -> Absolute) -> ProjectPath -> ProjectPath
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \Absolute
p -> Absolute -> Path -> Absolute
forall l r o. Resolve l r o => l -> r -> o
Path.resolve Absolute
p Path
path

-- | Resolve a @Path'@ to a @Path.Absolute@, per the current path.
resolvePath' :: Path' -> Cli PP.ProjectPath
resolvePath' :: Path' -> Cli ProjectPath
resolvePath' Path'
path' = do
  ProjectPath
pp <- Cli ProjectPath
getCurrentProjectPath
  pure $ ProjectPath
pp ProjectPath -> (ProjectPath -> ProjectPath) -> ProjectPath
forall a b. a -> (a -> b) -> b
& (Absolute -> Identity Absolute)
-> ProjectPath -> Identity ProjectPath
forall p b (f :: * -> *).
Functor f =>
(Absolute -> f Absolute)
-> ProjectPathG p b -> f (ProjectPathG p b)
PP.absPath_ ((Absolute -> Identity Absolute)
 -> ProjectPath -> Identity ProjectPath)
-> (Absolute -> Absolute) -> ProjectPath -> ProjectPath
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \Absolute
p -> Absolute -> Path' -> Absolute
forall l r o. Resolve l r o => l -> r -> o
Path.resolve Absolute
p Path'
path'

resolvePath'ToAbsolute :: Path' -> Cli Path.Absolute
resolvePath'ToAbsolute :: Path' -> Cli Absolute
resolvePath'ToAbsolute Path'
path' = do
  Getting Absolute ProjectPath Absolute -> ProjectPath -> Absolute
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Absolute ProjectPath Absolute
forall p b (f :: * -> *).
Functor f =>
(Absolute -> f Absolute)
-> ProjectPathG p b -> f (ProjectPathG p b)
PP.absPath_ (ProjectPath -> Absolute) -> Cli ProjectPath -> Cli Absolute
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path' -> Cli ProjectPath
resolvePath' Path'
path'

-- | Resolve a path split, per the current path.
resolveSplit' :: (Path', a) -> Cli (PP.ProjectPath, a)
resolveSplit' :: forall a. (Path', a) -> Cli (ProjectPath, a)
resolveSplit' =
  LensLike Cli (Path', a) (ProjectPath, a) Path' ProjectPath
-> LensLike Cli (Path', a) (ProjectPath, a) Path' ProjectPath
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike Cli (Path', a) (ProjectPath, a) Path' ProjectPath
forall s t a b. Field1 s t a b => Lens s t a b
Lens (Path', a) (ProjectPath, a) Path' ProjectPath
_1 Path' -> Cli ProjectPath
resolvePath'

------------------------------------------------------------------------------------------------------------------------
-- Branch resolution

-- | Resolve an @AbsBranchId@ to the corresponding @Branch IO@, or fail if no such branch hash is found. (Non-existent
-- branches by path are OK - the empty branch will be returned).
resolveAbsBranchId :: Input.AbsBranchId -> Cli (Branch IO)
resolveAbsBranchId :: AbsBranchId -> Cli (Branch IO)
resolveAbsBranchId = \case
  Input.BranchAtSCH ShortCausalHash
hash -> ShortCausalHash -> Cli (Branch IO)
resolveShortCausalHash ShortCausalHash
hash
  Input.BranchAtPath Absolute
absPath -> do
    ProjectPath
pp <- Path' -> Cli ProjectPath
resolvePath' (Either Absolute Relative -> Path'
Path' (Absolute -> Either Absolute Relative
forall a b. a -> Either a b
Left Absolute
absPath))
    ProjectPath -> Cli (Branch IO)
getBranchFromProjectPath ProjectPath
pp
  Input.BranchAtProjectPath ProjectPath
pp -> ProjectPath -> Cli (Branch IO)
getBranchFromProjectPath ProjectPath
pp

-- | V2 version of 'resolveAbsBranchId2'.
resolveAbsBranchIdV2 ::
  (forall void. Output.Output -> Sqlite.Transaction void) ->
  ProjectAndBranch Project ProjectBranch ->
  Input.AbsBranchId ->
  Sqlite.Transaction (V2.Branch Sqlite.Transaction)
resolveAbsBranchIdV2 :: (forall void. Output -> Transaction void)
-> ProjectAndBranch Project ProjectBranch
-> AbsBranchId
-> Transaction (Branch Transaction)
resolveAbsBranchIdV2 forall void. Output -> Transaction void
rollback (ProjectAndBranch Project
proj ProjectBranch
branch) = \case
  Input.BranchAtSCH ShortCausalHash
shortHash -> do
    CausalHash
hash <- (forall void. Output -> Transaction void)
-> ShortCausalHash -> Transaction CausalHash
resolveShortCausalHashToCausalHash Output -> Transaction void
forall void. Output -> Transaction void
rollback ShortCausalHash
shortHash
    CausalBranch Transaction
causal <- (CausalHash -> Transaction (CausalBranch Transaction)
Codebase.expectCausalBranchByCausalHash CausalHash
hash)
    CausalBranch Transaction -> Transaction (Branch Transaction)
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
V2Causal.value CausalBranch Transaction
causal
  Input.BranchAtPath Absolute
absPath -> do
    let pp :: ProjectPath
pp = Project -> ProjectBranch -> Absolute -> ProjectPath
forall proj branch.
proj -> branch -> Absolute -> ProjectPathG proj branch
PP.ProjectPath Project
proj ProjectBranch
branch Absolute
absPath
    ProjectPath -> Transaction (Branch Transaction)
Codebase.getShallowBranchAtProjectPath ProjectPath
pp
  Input.BranchAtProjectPath ProjectPath
pp -> ProjectPath -> Transaction (Branch Transaction)
Codebase.getShallowBranchAtProjectPath ProjectPath
pp

-- | Resolve a @BranchId@ to the corresponding @Branch IO@, or fail if no such branch hash is found. (Non-existent
-- branches by path are OK - the empty branch will be returned).
resolveBranchId :: Input.BranchId -> Cli (Branch IO)
resolveBranchId :: BranchId -> Cli (Branch IO)
resolveBranchId BranchId
branchId = do
  AbsBranchId
absBranchId <- BranchId -> Cli AbsBranchId
resolveBranchIdToAbsBranchId BranchId
branchId
  AbsBranchId -> Cli (Branch IO)
resolveAbsBranchId AbsBranchId
absBranchId

-- | Resolve a @BranchId@ to an @AbsBranchId@.
resolveBranchIdToAbsBranchId :: Input.BranchId -> Cli Input.AbsBranchId
resolveBranchIdToAbsBranchId :: BranchId -> Cli AbsBranchId
resolveBranchIdToAbsBranchId =
  (Path' -> Cli Absolute) -> BranchId -> Cli AbsBranchId
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BranchIdG a -> f (BranchIdG b)
traverse ((ProjectPath -> Absolute) -> Cli ProjectPath -> Cli Absolute
forall a b. (a -> b) -> Cli a -> Cli b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting Absolute ProjectPath Absolute -> ProjectPath -> Absolute
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Absolute ProjectPath Absolute
forall p b (f :: * -> *).
Functor f =>
(Absolute -> f Absolute)
-> ProjectPathG p b -> f (ProjectPathG p b)
PP.absPath_) (Cli ProjectPath -> Cli Absolute)
-> (Path' -> Cli ProjectPath) -> Path' -> Cli Absolute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> Cli ProjectPath
resolvePath')

-- | Resolve a @ShortCausalHash@ to the corresponding @Branch IO@, or fail if no such branch hash is found.
resolveShortCausalHash :: ShortCausalHash -> Cli (Branch IO)
resolveShortCausalHash :: ShortCausalHash -> Cli (Branch IO)
resolveShortCausalHash ShortCausalHash
shortHash = do
  FilePath -> Cli (Branch IO) -> Cli (Branch IO)
forall a. FilePath -> Cli a -> Cli a
Cli.time FilePath
"resolveShortCausalHash" do
    Cli.Env {Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
    CausalHash
hash <- ((forall void. Output -> Transaction void)
 -> Transaction CausalHash)
-> Cli CausalHash
forall a.
((forall void. Output -> Transaction void) -> Transaction a)
-> Cli a
Cli.runTransactionWithRollback \forall void. Output -> Transaction void
rollback -> (forall void. Output -> Transaction void)
-> ShortCausalHash -> Transaction CausalHash
resolveShortCausalHashToCausalHash Output -> Transaction void
forall void. Output -> Transaction void
rollback ShortCausalHash
shortHash
    Maybe (Branch IO)
branch <- IO (Maybe (Branch IO)) -> Cli (Maybe (Branch IO))
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Codebase IO Symbol Ann -> CausalHash -> IO (Maybe (Branch IO))
forall (m :: * -> *) v a.
Codebase m v a -> CausalHash -> m (Maybe (Branch m))
Codebase.getBranchForHash Codebase IO Symbol Ann
codebase CausalHash
hash)
    pure (Branch IO -> Maybe (Branch IO) -> Branch IO
forall a. a -> Maybe a -> a
fromMaybe Branch IO
forall (m :: * -> *). Branch m
Branch.empty Maybe (Branch IO)
branch)

resolveShortCausalHashToCausalHash ::
  (forall void. Output.Output -> Sqlite.Transaction void) ->
  ShortCausalHash ->
  Sqlite.Transaction CausalHash
resolveShortCausalHashToCausalHash :: (forall void. Output -> Transaction void)
-> ShortCausalHash -> Transaction CausalHash
resolveShortCausalHashToCausalHash forall void. Output -> Transaction void
rollback ShortCausalHash
shortHash = do
  Set CausalHash
hashes <- ShortCausalHash -> Transaction (Set CausalHash)
Codebase.causalHashesByPrefix ShortCausalHash
shortHash
  Set CausalHash -> Maybe CausalHash
forall a. Set a -> Maybe a
Set.asSingleton Set CausalHash
hashes Maybe CausalHash
-> (Maybe CausalHash -> Transaction CausalHash)
-> Transaction CausalHash
forall a b. a -> (a -> b) -> b
& Transaction CausalHash
-> Maybe CausalHash -> Transaction CausalHash
forall (m :: * -> *) a. Applicative m => m a -> Maybe a -> m a
onNothing do
    if Set CausalHash -> Bool
forall a. Set a -> Bool
Set.null Set CausalHash
hashes
      then Output -> Transaction CausalHash
forall void. Output -> Transaction void
rollback (ShortCausalHash -> Output
Output.NoBranchWithHash ShortCausalHash
shortHash)
      else do
        Int
len <- Transaction Int
Codebase.branchHashLength
        Output -> Transaction CausalHash
forall void. Output -> Transaction void
rollback (ShortCausalHash -> Set ShortCausalHash -> Output
Output.BranchHashAmbiguous ShortCausalHash
shortHash ((CausalHash -> ShortCausalHash)
-> Set CausalHash -> Set ShortCausalHash
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Int -> CausalHash -> ShortCausalHash
SCH.fromHash Int
len) Set CausalHash
hashes))

------------------------------------------------------------------------------------------------------------------------
-- Getting/Setting branches

-- | Get the root branch.
getCurrentProjectRoot :: Cli (Branch IO)
getCurrentProjectRoot :: Cli (Branch IO)
getCurrentProjectRoot = do
  Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  ProjectAndBranch Project
proj ProjectBranch
branch <- Cli (ProjectAndBranch Project ProjectBranch)
getCurrentProjectAndBranch
  IO (Branch IO) -> Cli (Branch IO)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Branch IO) -> Cli (Branch IO))
-> IO (Branch IO) -> Cli (Branch IO)
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> ProjectId -> ProjectBranchId -> IO (Branch IO)
forall (m :: * -> *) v a.
MonadIO m =>
Codebase m v a -> ProjectId -> ProjectBranchId -> m (Branch m)
Codebase.expectProjectBranchRoot Codebase IO Symbol Ann
codebase Project
proj.projectId ProjectBranch
branch.branchId

-- | Get the root branch0.
getCurrentProjectRoot0 :: Cli (Branch0 IO)
getCurrentProjectRoot0 :: Cli (Branch0 IO)
getCurrentProjectRoot0 =
  Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head (Branch IO -> Branch0 IO) -> Cli (Branch IO) -> Cli (Branch0 IO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cli (Branch IO)
getCurrentProjectRoot

-- | Get the current branch.
getCurrentBranch :: Cli (Branch IO)
getCurrentBranch :: Cli (Branch IO)
getCurrentBranch = do
  Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  ProjectPath
pp <- Cli ProjectPath
getCurrentProjectPath
  Branch IO -> Maybe (Branch IO) -> Branch IO
forall a. a -> Maybe a -> a
fromMaybe Branch IO
forall (m :: * -> *). Branch m
Branch.empty (Maybe (Branch IO) -> Branch IO)
-> Cli (Maybe (Branch IO)) -> Cli (Branch IO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (Branch IO)) -> Cli (Maybe (Branch IO))
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Codebase IO Symbol Ann -> ProjectPath -> IO (Maybe (Branch IO))
forall (m :: * -> *) v a.
MonadIO m =>
Codebase m v a -> ProjectPath -> m (Maybe (Branch m))
Codebase.getBranchAtProjectPath Codebase IO Symbol Ann
codebase ProjectPath
pp)

-- | Get the current branch0.
getCurrentBranch0 :: Cli (Branch0 IO)
getCurrentBranch0 :: Cli (Branch0 IO)
getCurrentBranch0 = do
  Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head (Branch IO -> Branch0 IO) -> Cli (Branch IO) -> Cli (Branch0 IO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cli (Branch IO)
getCurrentBranch

-- | Get the branch at an absolute path from the project root.
getBranchFromProjectPath :: PP.ProjectPath -> Cli (Branch IO)
getBranchFromProjectPath :: ProjectPath -> Cli (Branch IO)
getBranchFromProjectPath ProjectPath
pp =
  ProjectPath -> Cli (Maybe (Branch IO))
getMaybeBranchFromProjectPath ProjectPath
pp Cli (Maybe (Branch IO))
-> (Maybe (Branch IO) -> Branch IO) -> Cli (Branch IO)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Branch IO -> Maybe (Branch IO) -> Branch IO
forall a. a -> Maybe a -> a
fromMaybe Branch IO
forall (m :: * -> *). Branch m
Branch.empty

-- | Get the branch0 at an absolute path.
getBranch0FromProjectPath :: PP.ProjectPath -> Cli (Branch0 IO)
getBranch0FromProjectPath :: ProjectPath -> Cli (Branch0 IO)
getBranch0FromProjectPath ProjectPath
pp =
  Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head (Branch IO -> Branch0 IO) -> Cli (Branch IO) -> Cli (Branch0 IO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProjectPath -> Cli (Branch IO)
getBranchFromProjectPath ProjectPath
pp

getProjectBranchRoot :: ProjectBranch -> Cli (Branch IO)
getProjectBranchRoot :: ProjectBranch -> Cli (Branch IO)
getProjectBranchRoot ProjectBranch
projectBranch = do
  Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO (Branch IO) -> Cli (Branch IO)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Branch IO) -> Cli (Branch IO))
-> IO (Branch IO) -> Cli (Branch IO)
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> ProjectId -> ProjectBranchId -> IO (Branch IO)
forall (m :: * -> *) v a.
MonadIO m =>
Codebase m v a -> ProjectId -> ProjectBranchId -> m (Branch m)
Codebase.expectProjectBranchRoot Codebase IO Symbol Ann
codebase ProjectBranch
projectBranch.projectId ProjectBranch
projectBranch.branchId

-- | Get the maybe-branch at an absolute path.
getMaybeBranchFromProjectPath :: PP.ProjectPath -> Cli (Maybe (Branch IO))
getMaybeBranchFromProjectPath :: ProjectPath -> Cli (Maybe (Branch IO))
getMaybeBranchFromProjectPath ProjectPath
pp = do
  Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO (Maybe (Branch IO)) -> Cli (Maybe (Branch IO))
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Branch IO)) -> Cli (Maybe (Branch IO)))
-> IO (Maybe (Branch IO)) -> Cli (Maybe (Branch IO))
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann -> ProjectPath -> IO (Maybe (Branch IO))
forall (m :: * -> *) v a.
MonadIO m =>
Codebase m v a -> ProjectPath -> m (Maybe (Branch m))
Codebase.getBranchAtProjectPath Codebase IO Symbol Ann
codebase ProjectPath
pp

-- | Get the maybe-branch0 at an absolute path.
getMaybeBranch0FromProjectPath :: PP.ProjectPath -> Cli (Maybe (Branch0 IO))
getMaybeBranch0FromProjectPath :: ProjectPath -> Cli (Maybe (Branch0 IO))
getMaybeBranch0FromProjectPath ProjectPath
pp =
  (Branch IO -> Branch0 IO)
-> Maybe (Branch IO) -> Maybe (Branch0 IO)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head (Maybe (Branch IO) -> Maybe (Branch0 IO))
-> Cli (Maybe (Branch IO)) -> Cli (Maybe (Branch0 IO))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProjectPath -> Cli (Maybe (Branch IO))
getMaybeBranchFromProjectPath ProjectPath
pp

-- | Get the branch at a relative path, or return early if there's no such branch.
expectBranchAtPath :: Path -> Cli (Branch IO)
expectBranchAtPath :: Path -> Cli (Branch IO)
expectBranchAtPath =
  Path' -> Cli (Branch IO)
expectBranchAtPath' (Path' -> Cli (Branch IO))
-> (Path -> Path') -> Path -> Cli (Branch IO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Absolute Relative -> Path'
Path' (Either Absolute Relative -> Path')
-> (Path -> Either Absolute Relative) -> Path -> Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relative -> Either Absolute Relative
forall a b. b -> Either a b
Right (Relative -> Either Absolute Relative)
-> (Path -> Relative) -> Path -> Either Absolute Relative
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Relative
Path.Relative

-- | Get the branch at an absolute or relative path, or return early if there's no such branch.
expectBranchAtPath' :: Path' -> Cli (Branch IO)
expectBranchAtPath' :: Path' -> Cli (Branch IO)
expectBranchAtPath' Path'
path0 = do
  ProjectPath
path <- Path' -> Cli ProjectPath
resolvePath' Path'
path0
  ProjectPath -> Cli (Maybe (Branch IO))
getMaybeBranchFromProjectPath ProjectPath
path Cli (Maybe (Branch IO))
-> (Cli (Maybe (Branch IO)) -> Cli (Branch IO)) -> Cli (Branch IO)
forall a b. a -> (a -> b) -> b
& Cli (Branch IO) -> Cli (Maybe (Branch IO)) -> Cli (Branch IO)
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
onNothingM (Output -> Cli (Branch IO)
forall a. Output -> Cli a
Cli.returnEarly (Path' -> Output
Output.BranchNotFound Path'
path0))

-- | Get the branch0 at an absolute or relative path, or return early if there's no such branch.
expectBranch0AtPath' :: Path' -> Cli (Branch0 IO)
expectBranch0AtPath' :: Path' -> Cli (Branch0 IO)
expectBranch0AtPath' =
  (Branch IO -> Branch0 IO) -> Cli (Branch IO) -> Cli (Branch0 IO)
forall a b. (a -> b) -> Cli a -> Cli b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head (Cli (Branch IO) -> Cli (Branch0 IO))
-> (Path' -> Cli (Branch IO)) -> Path' -> Cli (Branch0 IO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> Cli (Branch IO)
expectBranchAtPath'

-- | Get the branch0 at a relative path, or return early if there's no such branch.
expectBranch0AtPath :: Path -> Cli (Branch0 IO)
expectBranch0AtPath :: Path -> Cli (Branch0 IO)
expectBranch0AtPath =
  Path' -> Cli (Branch0 IO)
expectBranch0AtPath' (Path' -> Cli (Branch0 IO))
-> (Path -> Path') -> Path -> Cli (Branch0 IO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Absolute Relative -> Path'
Path' (Either Absolute Relative -> Path')
-> (Path -> Either Absolute Relative) -> Path -> Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relative -> Either Absolute Relative
forall a b. b -> Either a b
Right (Relative -> Either Absolute Relative)
-> (Path -> Relative) -> Path -> Either Absolute Relative
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Relative
Path.Relative

-- | Assert that there's "no branch" at an absolute or relative path, or return early if there is one, where "no branch"
-- means either there's actually no branch, or there is a branch whose head is empty (i.e. it may have a history, but no
-- current terms/types etc).
assertNoBranchAtPath' :: Path' -> Cli ()
assertNoBranchAtPath' :: Path' -> Cli ()
assertNoBranchAtPath' Path'
path' = do
  Cli Bool -> Cli () -> Cli ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Path' -> Cli Bool
branchExistsAtPath' Path'
path') do
    Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly (Path' -> Output
Output.BranchAlreadyExists Path'
path')

-- | Check if there's a branch at an absolute or relative path
--
-- "no branch" means either there's actually no branch, or there is a branch whose head is empty (i.e. it may have a history, but no
-- current terms/types etc).
branchExistsAtPath' :: Path' -> Cli Bool
branchExistsAtPath' :: Path' -> Cli Bool
branchExistsAtPath' Path'
path' = do
  ProjectPath
pp <- Path' -> Cli ProjectPath
resolvePath' Path'
path'
  Transaction Bool -> Cli Bool
forall a. Transaction a -> Cli a
Cli.runTransaction do
    Branch Transaction
branch <- ProjectPath -> Transaction (Branch Transaction)
Codebase.getShallowBranchAtProjectPath ProjectPath
pp
    Bool
isEmpty <- Branch Transaction -> Transaction Bool
forall (m :: * -> *). Branch m -> Transaction Bool
V2Branch.isEmpty Branch Transaction
branch
    pure (Bool -> Bool
not Bool
isEmpty)

------------------------------------------------------------------------------------------------------------------------
-- Updating branches

makeActionsUnabsolute :: (Functor f) => f (Path.Absolute, x) -> f (Path, x)
makeActionsUnabsolute :: forall (f :: * -> *) x. Functor f => f (Absolute, x) -> f (Path, x)
makeActionsUnabsolute = ((Absolute, x) -> (Path, x)) -> f (Absolute, x) -> f (Path, x)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Absolute -> Path) -> (Absolute, x) -> (Path, x)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Absolute -> Path
Path.unabsolute)

stepAt ::
  Text ->
  (ProjectPath, Branch0 IO -> Branch0 IO) ->
  Cli ()
stepAt :: Text -> (ProjectPath, Branch0 IO -> Branch0 IO) -> Cli ()
stepAt Text
cause (ProjectPath
pp, Branch0 IO -> Branch0 IO
action) = ProjectBranch
-> Text -> [(Absolute, Branch0 IO -> Branch0 IO)] -> Cli ()
stepManyAt ProjectPath
pp.branch Text
cause [(ProjectPath
pp.absPath, Branch0 IO -> Branch0 IO
action)]

stepAt' ::
  Text ->
  (ProjectPath, Branch0 IO -> Cli (Branch0 IO)) ->
  Cli Bool
stepAt' :: Text -> (ProjectPath, Branch0 IO -> Cli (Branch0 IO)) -> Cli Bool
stepAt' Text
cause (ProjectPath
pp, Branch0 IO -> Cli (Branch0 IO)
action) = ProjectBranch
-> Text -> [(Absolute, Branch0 IO -> Cli (Branch0 IO))] -> Cli Bool
stepManyAt' ProjectPath
pp.branch Text
cause [(ProjectPath
pp.absPath, Branch0 IO -> Cli (Branch0 IO)
action)]

stepAtM ::
  Text ->
  (ProjectPath, Branch0 IO -> IO (Branch0 IO)) ->
  Cli ()
stepAtM :: Text -> (ProjectPath, Branch0 IO -> IO (Branch0 IO)) -> Cli ()
stepAtM Text
cause (ProjectPath
pp, Branch0 IO -> IO (Branch0 IO)
action) = ProjectBranch
-> Text -> [(Absolute, Branch0 IO -> IO (Branch0 IO))] -> Cli ()
stepManyAtM ProjectPath
pp.branch Text
cause [(ProjectPath
pp.absPath, Branch0 IO -> IO (Branch0 IO)
action)]

stepManyAt ::
  ProjectBranch ->
  Text ->
  [(Path.Absolute, Branch0 IO -> Branch0 IO)] ->
  Cli ()
stepManyAt :: ProjectBranch
-> Text -> [(Absolute, Branch0 IO -> Branch0 IO)] -> Cli ()
stepManyAt ProjectBranch
pb Text
reason [(Absolute, Branch0 IO -> Branch0 IO)]
actions = do
  ProjectBranch -> Text -> (Branch IO -> Branch IO) -> Cli ()
updateProjectBranchRoot_ ProjectBranch
pb Text
reason ((Branch IO -> Branch IO) -> Cli ())
-> (Branch IO -> Branch IO) -> Cli ()
forall a b. (a -> b) -> a -> b
$ [(Path, Branch0 IO -> Branch0 IO)] -> Branch IO -> Branch IO
forall (m :: * -> *) (f :: * -> *).
(Monad m, Foldable f) =>
f (Path, Branch0 m -> Branch0 m) -> Branch m -> Branch m
Branch.stepManyAt ([(Absolute, Branch0 IO -> Branch0 IO)]
-> [(Path, Branch0 IO -> Branch0 IO)]
forall (f :: * -> *) x. Functor f => f (Absolute, x) -> f (Path, x)
makeActionsUnabsolute [(Absolute, Branch0 IO -> Branch0 IO)]
actions)

stepManyAt' ::
  ProjectBranch ->
  Text ->
  [(Path.Absolute, Branch0 IO -> Cli (Branch0 IO))] ->
  Cli Bool
stepManyAt' :: ProjectBranch
-> Text -> [(Absolute, Branch0 IO -> Cli (Branch0 IO))] -> Cli Bool
stepManyAt' ProjectBranch
pb Text
reason [(Absolute, Branch0 IO -> Cli (Branch0 IO))]
actions = do
  Branch IO
origRoot <- ProjectBranch -> Cli (Branch IO)
getProjectBranchRoot ProjectBranch
pb
  Branch IO
newRoot <- [(Path, Branch0 IO -> Cli (Branch0 IO))]
-> Branch IO -> Cli (Branch IO)
forall (m :: * -> *) (n :: * -> *) (f :: * -> *).
(Monad m, Monad n, Foldable f) =>
f (Path, Branch0 m -> n (Branch0 m)) -> Branch m -> n (Branch m)
Branch.stepManyAtM ([(Absolute, Branch0 IO -> Cli (Branch0 IO))]
-> [(Path, Branch0 IO -> Cli (Branch0 IO))]
forall (f :: * -> *) x. Functor f => f (Absolute, x) -> f (Path, x)
makeActionsUnabsolute [(Absolute, Branch0 IO -> Cli (Branch0 IO))]
actions) Branch IO
origRoot
  Bool
didChange <- ProjectBranch
-> Text -> (Branch IO -> Cli (Branch IO, Bool)) -> Cli Bool
forall r.
ProjectBranch -> Text -> (Branch IO -> Cli (Branch IO, r)) -> Cli r
updateProjectBranchRoot ProjectBranch
pb Text
reason (\Branch IO
oldRoot -> (Branch IO, Bool) -> Cli (Branch IO, Bool)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Branch IO
newRoot, Branch IO
oldRoot Branch IO -> Branch IO -> Bool
forall a. Eq a => a -> a -> Bool
/= Branch IO
newRoot))
  pure Bool
didChange

-- Like stepManyAt, but doesn't update the last saved root
stepManyAtM ::
  ProjectBranch ->
  Text ->
  [(Path.Absolute, Branch0 IO -> IO (Branch0 IO))] ->
  Cli ()
stepManyAtM :: ProjectBranch
-> Text -> [(Absolute, Branch0 IO -> IO (Branch0 IO))] -> Cli ()
stepManyAtM ProjectBranch
pb Text
reason [(Absolute, Branch0 IO -> IO (Branch0 IO))]
actions = do
  ProjectBranch
-> Text -> (Branch IO -> Cli (Branch IO, ())) -> Cli ()
forall r.
ProjectBranch -> Text -> (Branch IO -> Cli (Branch IO, r)) -> Cli r
updateProjectBranchRoot ProjectBranch
pb Text
reason \Branch IO
oldRoot -> do
    Branch IO
newRoot <- IO (Branch IO) -> Cli (Branch IO)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([(Path, Branch0 IO -> IO (Branch0 IO))]
-> Branch IO -> IO (Branch IO)
forall (m :: * -> *) (n :: * -> *) (f :: * -> *).
(Monad m, Monad n, Foldable f) =>
f (Path, Branch0 m -> n (Branch0 m)) -> Branch m -> n (Branch m)
Branch.stepManyAtM ([(Absolute, Branch0 IO -> IO (Branch0 IO))]
-> [(Path, Branch0 IO -> IO (Branch0 IO))]
forall (f :: * -> *) x. Functor f => f (Absolute, x) -> f (Path, x)
makeActionsUnabsolute [(Absolute, Branch0 IO -> IO (Branch0 IO))]
actions) Branch IO
oldRoot)
    pure (Branch IO
newRoot, ())

-- | Update a branch at the given path, returning `True` if
-- an update occurred and false otherwise
updateAtM ::
  Text ->
  ProjectPath ->
  (Branch IO -> Cli (Branch IO)) ->
  Cli Bool
updateAtM :: Text -> ProjectPath -> (Branch IO -> Cli (Branch IO)) -> Cli Bool
updateAtM Text
reason ProjectPath
pp Branch IO -> Cli (Branch IO)
f = do
  Branch IO
oldRootBranch <- ProjectBranch -> Cli (Branch IO)
getProjectBranchRoot (ProjectPath
pp ProjectPath
-> Getting ProjectBranch ProjectPath ProjectBranch -> ProjectBranch
forall s a. s -> Getting a s a -> a
^. Getting ProjectBranch ProjectPath ProjectBranch
#branch)
  Branch IO
newRootBranch <- Path
-> (Branch IO -> Cli (Branch IO)) -> Branch IO -> Cli (Branch IO)
forall (n :: * -> *) (m :: * -> *).
(Functor n, Applicative m) =>
Path -> (Branch m -> n (Branch m)) -> Branch m -> n (Branch m)
Branch.modifyAtM (ProjectPath
pp ProjectPath -> Getting Path ProjectPath Path -> Path
forall s a. s -> Getting a s a -> a
^. Getting Path ProjectPath Path
forall p b (f :: * -> *).
Functor f =>
(Path -> f Path) -> ProjectPathG p b -> f (ProjectPathG p b)
PP.path_) Branch IO -> Cli (Branch IO)
f Branch IO
oldRootBranch
  ProjectBranch -> Text -> (Branch IO -> Branch IO) -> Cli ()
updateProjectBranchRoot_ (ProjectPath
pp ProjectPath
-> Getting ProjectBranch ProjectPath ProjectBranch -> ProjectBranch
forall s a. s -> Getting a s a -> a
^. Getting ProjectBranch ProjectPath ProjectBranch
#branch) Text
reason (Branch IO -> Branch IO -> Branch IO
forall a b. a -> b -> a
const Branch IO
newRootBranch)
  pure $ Branch IO
oldRootBranch Branch IO -> Branch IO -> Bool
forall a. Eq a => a -> a -> Bool
/= Branch IO
newRootBranch

-- | Update a branch at the given path, returning `True` if
-- an update occurred and false otherwise
updateAt ::
  Text ->
  ProjectPath ->
  (Branch IO -> Branch IO) ->
  Cli Bool
updateAt :: Text -> ProjectPath -> (Branch IO -> Branch IO) -> Cli Bool
updateAt Text
reason ProjectPath
pp Branch IO -> Branch IO
f = do
  Text -> ProjectPath -> (Branch IO -> Cli (Branch IO)) -> Cli Bool
updateAtM Text
reason ProjectPath
pp (Branch IO -> Cli (Branch IO)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Branch IO -> Cli (Branch IO))
-> (Branch IO -> Branch IO) -> Branch IO -> Cli (Branch IO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch IO -> Branch IO
f)

updateAndStepAt ::
  (Foldable f, Foldable g, Functor g) =>
  Text ->
  ProjectBranch ->
  f (Path.Absolute, Branch IO -> Branch IO) ->
  g (Path.Absolute, Branch0 IO -> Branch0 IO) ->
  Cli ()
updateAndStepAt :: forall (f :: * -> *) (g :: * -> *).
(Foldable f, Foldable g, Functor g) =>
Text
-> ProjectBranch
-> f (Absolute, Branch IO -> Branch IO)
-> g (Absolute, Branch0 IO -> Branch0 IO)
-> Cli ()
updateAndStepAt Text
reason ProjectBranch
projectBranch f (Absolute, Branch IO -> Branch IO)
updates g (Absolute, Branch0 IO -> Branch0 IO)
steps = do
  let f :: Branch IO -> Branch IO
f Branch IO
b =
        Branch IO
b
          Branch IO -> (Branch IO -> Branch IO) -> Branch IO
forall a b. a -> (a -> b) -> b
& (\Branch IO
root -> (Branch IO -> (Absolute, Branch IO -> Branch IO) -> Branch IO)
-> Branch IO -> f (Absolute, Branch IO -> Branch IO) -> Branch IO
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Branch IO
b (Path.Absolute Path
p, Branch IO -> Branch IO
f) -> Path -> (Branch IO -> Branch IO) -> Branch IO -> Branch IO
forall (m :: * -> *).
Applicative m =>
Path -> (Branch m -> Branch m) -> Branch m -> Branch m
Branch.modifyAt Path
p Branch IO -> Branch IO
f Branch IO
b) Branch IO
root f (Absolute, Branch IO -> Branch IO)
updates)
          Branch IO -> (Branch IO -> Branch IO) -> Branch IO
forall a b. a -> (a -> b) -> b
& (g (Path, Branch0 IO -> Branch0 IO) -> Branch IO -> Branch IO
forall (m :: * -> *) (f :: * -> *).
(Monad m, Foldable f) =>
f (Path, Branch0 m -> Branch0 m) -> Branch m -> Branch m
Branch.stepManyAt ((Absolute -> Path)
-> (Absolute, Branch0 IO -> Branch0 IO)
-> (Path, Branch0 IO -> Branch0 IO)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Absolute -> Path
Path.unabsolute ((Absolute, Branch0 IO -> Branch0 IO)
 -> (Path, Branch0 IO -> Branch0 IO))
-> g (Absolute, Branch0 IO -> Branch0 IO)
-> g (Path, Branch0 IO -> Branch0 IO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g (Absolute, Branch0 IO -> Branch0 IO)
steps))
  ProjectBranch -> Text -> (Branch IO -> Branch IO) -> Cli ()
updateProjectBranchRoot_ ProjectBranch
projectBranch Text
reason Branch IO -> Branch IO
f

updateProjectBranchRoot :: ProjectBranch -> Text -> (Branch IO -> Cli (Branch IO, r)) -> Cli r
updateProjectBranchRoot :: forall r.
ProjectBranch -> Text -> (Branch IO -> Cli (Branch IO, r)) -> Cli r
updateProjectBranchRoot ProjectBranch
projectBranch Text
reason Branch IO -> Cli (Branch IO, r)
f = do
  Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  FilePath -> Cli r -> Cli r
forall a. FilePath -> Cli a -> Cli a
Cli.time FilePath
"updateProjectBranchRoot" do
    Branch IO
old <- ProjectBranch -> Cli (Branch IO)
getProjectBranchRoot ProjectBranch
projectBranch
    (Branch IO
new, r
result) <- Branch IO -> Cli (Branch IO, r)
f Branch IO
old
    Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Branch IO
old Branch IO -> Branch IO -> Bool
forall a. Eq a => a -> a -> Bool
/= Branch IO
new) do
      IO () -> Cli ()
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Cli ()) -> IO () -> Cli ()
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann -> Branch IO -> IO ()
forall (m :: * -> *) v a. Codebase m v a -> Branch m -> m ()
Codebase.putBranch Codebase IO Symbol Ann
codebase Branch IO
new
      Transaction () -> Cli ()
forall a. Transaction a -> Cli a
Cli.runTransaction (Transaction () -> Cli ()) -> Transaction () -> Cli ()
forall a b. (a -> b) -> a -> b
$ do
        -- TODO: If we transactionally check that the project branch hasn't changed while we were computing the new
        -- branch, and if it has, abort the transaction and return an error, then we can
        -- remove the single UCM per codebase restriction.
        CausalHashId
causalHashId <- CausalHash -> Transaction CausalHashId
Q.expectCausalHashIdByCausalHash (Branch IO -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch IO
new)
        Text
-> ProjectId -> ProjectBranchId -> CausalHashId -> Transaction ()
Q.setProjectBranchHead Text
reason (ProjectBranch
projectBranch ProjectBranch
-> Getting ProjectId ProjectBranch ProjectId -> ProjectId
forall s a. s -> Getting a s a -> a
^. Getting ProjectId ProjectBranch ProjectId
#projectId) (ProjectBranch
projectBranch ProjectBranch
-> Getting ProjectBranchId ProjectBranch ProjectBranchId
-> ProjectBranchId
forall s a. s -> Getting a s a -> a
^. Getting ProjectBranchId ProjectBranch ProjectBranchId
#branchId) CausalHashId
causalHashId
    pure r
result

updateProjectBranchRoot_ :: ProjectBranch -> Text -> (Branch IO -> Branch IO) -> Cli ()
updateProjectBranchRoot_ :: ProjectBranch -> Text -> (Branch IO -> Branch IO) -> Cli ()
updateProjectBranchRoot_ ProjectBranch
projectBranch Text
reason Branch IO -> Branch IO
f = do
  ProjectBranch
-> Text -> (Branch IO -> Cli (Branch IO, ())) -> Cli ()
forall r.
ProjectBranch -> Text -> (Branch IO -> Cli (Branch IO, r)) -> Cli r
updateProjectBranchRoot ProjectBranch
projectBranch Text
reason (\Branch IO
b -> (Branch IO, ()) -> Cli (Branch IO, ())
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Branch IO -> Branch IO
f Branch IO
b, ()))

------------------------------------------------------------------------------------------------------------------------
-- Getting terms

getTermsAt :: (PP.ProjectPath, HQ'.HQSegment) -> Cli (Set Referent)
getTermsAt :: (ProjectPath, HQSegment) -> Cli (Set Referent)
getTermsAt (ProjectPath
pp, HQSegment
hqSeg) = do
  Branch0 IO
rootBranch0 <- ProjectPath -> Cli (Branch0 IO)
getBranch0FromProjectPath ProjectPath
pp
  pure (HQSplit -> Branch0 IO -> Set Referent
forall (m :: * -> *). HQSplit -> Branch0 m -> Set Referent
BranchUtil.getTerm (Path
forall a. Monoid a => a
mempty, HQSegment
hqSeg) Branch0 IO
rootBranch0)

------------------------------------------------------------------------------------------------------------------------
-- Getting types

getTypesAt :: (PP.ProjectPath, HQ'.HQSegment) -> Cli (Set TypeReference)
getTypesAt :: (ProjectPath, HQSegment) -> Cli (Set TypeReference)
getTypesAt (ProjectPath
pp, HQSegment
hqSeg) = do
  Branch0 IO
rootBranch0 <- ProjectPath -> Cli (Branch0 IO)
getBranch0FromProjectPath ProjectPath
pp
  pure (HQSplit -> Branch0 IO -> Set TypeReference
forall (m :: * -> *). HQSplit -> Branch0 m -> Set TypeReference
BranchUtil.getType (Path
forall a. Monoid a => a
mempty, HQSegment
hqSeg) Branch0 IO
rootBranch0)

------------------------------------------------------------------------------------------------------------------------
-- Getting patches

-- | The default patch path.
defaultPatchPath :: Path.Split'
defaultPatchPath :: Split'
defaultPatchPath =
  (Relative -> Path'
Path.RelativePath' (Path -> Relative
Path.Relative Path
Path.empty), NameSegment
NameSegment.defaultPatchSegment)

-- | Get the patch at a path, or the empty patch if there's no such patch.
getPatchAt :: Path.Split' -> Cli Patch
getPatchAt :: Split' -> Cli Patch
getPatchAt Split'
path =
  Split' -> Cli (Maybe Patch)
getMaybePatchAt Split'
path Cli (Maybe Patch) -> (Maybe Patch -> Patch) -> Cli Patch
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Patch -> Maybe Patch -> Patch
forall a. a -> Maybe a -> a
fromMaybe Patch
Patch.empty

-- | Get the patch at a path.
getMaybePatchAt :: Path.Split' -> Cli (Maybe Patch)
getMaybePatchAt :: Split' -> Cli (Maybe Patch)
getMaybePatchAt Split'
path0 = do
  (ProjectPath
pp, NameSegment
name) <- Split' -> Cli (ProjectPath, NameSegment)
forall a. (Path', a) -> Cli (ProjectPath, a)
resolveSplit' Split'
path0
  Branch0 IO
branch <- ProjectPath -> Cli (Branch0 IO)
getBranch0FromProjectPath ProjectPath
pp
  IO (Maybe Patch) -> Cli (Maybe Patch)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (NameSegment -> Branch0 IO -> IO (Maybe Patch)
forall (m :: * -> *).
Applicative m =>
NameSegment -> Branch0 m -> m (Maybe Patch)
Branch.getMaybePatch NameSegment
name Branch0 IO
branch)

------------------------------------------------------------------------------------------------------------------------
-- Latest (typechecked) unison file utils

getLatestFile :: Cli (Maybe (FilePath, Bool))
getLatestFile :: Cli (Maybe (FilePath, Bool))
getLatestFile = do
  Getting (Maybe (FilePath, Bool)) LoopState (Maybe (FilePath, Bool))
-> Cli (Maybe (FilePath, Bool))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe (FilePath, Bool)) LoopState (Maybe (FilePath, Bool))
#latestFile

expectLatestFile :: Cli (FilePath, Bool)
expectLatestFile :: Cli (FilePath, Bool)
expectLatestFile = do
  Cli (Maybe (FilePath, Bool))
getLatestFile Cli (Maybe (FilePath, Bool))
-> (Cli (Maybe (FilePath, Bool)) -> Cli (FilePath, Bool))
-> Cli (FilePath, Bool)
forall a b. a -> (a -> b) -> b
& Cli (FilePath, Bool)
-> Cli (Maybe (FilePath, Bool)) -> Cli (FilePath, Bool)
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
onNothingM (Output -> Cli (FilePath, Bool)
forall a. Output -> Cli a
Cli.returnEarly Output
Output.NoUnisonFile)

-- | Get the latest typechecked unison file.
getLatestTypecheckedFile :: Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
getLatestTypecheckedFile :: Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
getLatestTypecheckedFile = do
  Maybe
  (Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann))
oe <- Getting
  (Maybe
     (Either
        (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
  LoopState
  (Maybe
     (Either
        (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
-> Cli
     (Maybe
        (Either
           (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Maybe
     (Either
        (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
  LoopState
  (Maybe
     (Either
        (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
#latestTypecheckedFile
  pure $ case Maybe
  (Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann))
oe of
    Just (Right TypecheckedUnisonFile Symbol Ann
tf) -> TypecheckedUnisonFile Symbol Ann
-> Maybe (TypecheckedUnisonFile Symbol Ann)
forall a. a -> Maybe a
Just TypecheckedUnisonFile Symbol Ann
tf
    Maybe
  (Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann))
_ -> Maybe (TypecheckedUnisonFile Symbol Ann)
forall a. Maybe a
Nothing

-- | Get the latest parsed unison file.
getLatestParsedFile :: Cli (Maybe (UnisonFile Symbol Ann))
getLatestParsedFile :: Cli (Maybe (UnisonFile Symbol Ann))
getLatestParsedFile = do
  Maybe
  (Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann))
oe <- Getting
  (Maybe
     (Either
        (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
  LoopState
  (Maybe
     (Either
        (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
-> Cli
     (Maybe
        (Either
           (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Maybe
     (Either
        (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
  LoopState
  (Maybe
     (Either
        (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
#latestTypecheckedFile
  pure $ case Maybe
  (Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann))
oe of
    Just (Left UnisonFile Symbol Ann
uf) -> UnisonFile Symbol Ann -> Maybe (UnisonFile Symbol Ann)
forall a. a -> Maybe a
Just UnisonFile Symbol Ann
uf
    Just (Right TypecheckedUnisonFile Symbol Ann
tf) -> UnisonFile Symbol Ann -> Maybe (UnisonFile Symbol Ann)
forall a. a -> Maybe a
Just (UnisonFile Symbol Ann -> Maybe (UnisonFile Symbol Ann))
-> UnisonFile Symbol Ann -> Maybe (UnisonFile Symbol Ann)
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile Symbol Ann -> UnisonFile Symbol Ann
forall v a. Ord v => TypecheckedUnisonFile v a -> UnisonFile v a
UF.discardTypes TypecheckedUnisonFile Symbol Ann
tf
    Maybe
  (Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann))
_ -> Maybe (UnisonFile Symbol Ann)
forall a. Maybe a
Nothing

expectLatestParsedFile :: Cli (UnisonFile Symbol Ann)
expectLatestParsedFile :: Cli (UnisonFile Symbol Ann)
expectLatestParsedFile =
  Cli (Maybe (UnisonFile Symbol Ann))
getLatestParsedFile Cli (Maybe (UnisonFile Symbol Ann))
-> (Cli (Maybe (UnisonFile Symbol Ann))
    -> Cli (UnisonFile Symbol Ann))
-> Cli (UnisonFile Symbol Ann)
forall a b. a -> (a -> b) -> b
& Cli (UnisonFile Symbol Ann)
-> Cli (Maybe (UnisonFile Symbol Ann))
-> Cli (UnisonFile Symbol Ann)
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
onNothingM (Output -> Cli (UnisonFile Symbol Ann)
forall a. Output -> Cli a
Cli.returnEarly Output
Output.NoUnisonFile)

-- | Returns a parsed term (potentially with free variables) from the latest file.
-- This term will refer to other terms in the file by vars, not by hash.
-- Used to implement rewriting and other refactorings on the current file.
getTermFromLatestParsedFile :: HQ.HashQualified Name.Name -> Cli (Maybe (Term.Term Symbol Ann))
getTermFromLatestParsedFile :: HashQualified Name -> Cli (Maybe (Term Symbol Ann))
getTermFromLatestParsedFile (HQ.NameOnly Name
n) = do
  Maybe (UnisonFile Symbol Ann)
uf <- Cli (Maybe (UnisonFile Symbol Ann))
getLatestParsedFile
  pure $ case Maybe (UnisonFile Symbol Ann)
uf of
    Maybe (UnisonFile Symbol Ann)
Nothing -> Maybe (Term Symbol Ann)
forall a. Maybe a
Nothing
    Just UnisonFile Symbol Ann
uf ->
      case UnisonFile Symbol Ann -> Term Symbol Ann
forall v a. (Var v, Monoid a) => UnisonFile v a -> Term v a
UF.typecheckingTerm UnisonFile Symbol Ann
uf of
        Term.LetRecNamed' [(Symbol, Term Symbol Ann)]
bs Term Symbol Ann
_ -> Symbol -> [(Symbol, Term Symbol Ann)] -> Maybe (Term Symbol Ann)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> Symbol
forall v. Var v => Text -> v
Var.named (Name -> Text
Name.toText Name
n)) [(Symbol, Term Symbol Ann)]
bs
        Term Symbol Ann
_ -> Maybe (Term Symbol Ann)
forall a. Maybe a
Nothing
getTermFromLatestParsedFile HashQualified Name
_ = Maybe (Term Symbol Ann) -> Cli (Maybe (Term Symbol Ann))
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Term Symbol Ann)
forall a. Maybe a
Nothing

-- | Gets the names from the latest typechecked unison file, or latest parsed file if it
-- didn't typecheck.
getNamesFromLatestFile :: Cli Names
getNamesFromLatestFile :: Cli Names
getNamesFromLatestFile = do
  Getting
  (Maybe
     (Either
        (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
  LoopState
  (Maybe
     (Either
        (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
-> Cli
     (Maybe
        (Either
           (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Maybe
     (Either
        (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
  LoopState
  (Maybe
     (Either
        (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
#latestTypecheckedFile Cli
  (Maybe
     (Either
        (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
-> (Maybe
      (Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann))
    -> Names)
-> Cli Names
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    Just (Right TypecheckedUnisonFile Symbol Ann
tf) -> TypecheckedUnisonFile Symbol Ann -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names
UFN.typecheckedToNames TypecheckedUnisonFile Symbol Ann
tf
    Just (Left UnisonFile Symbol Ann
uf) -> UnisonFile Symbol Ann -> Names
forall v a. Var v => UnisonFile v a -> Names
UFN.toNames UnisonFile Symbol Ann
uf
    Maybe
  (Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann))
Nothing -> Names
forall a. Monoid a => a
mempty

-- | Get the latest typechecked unison file, or return early if there isn't one.
expectLatestTypecheckedFile :: Cli (TypecheckedUnisonFile Symbol Ann)
expectLatestTypecheckedFile :: Cli (TypecheckedUnisonFile Symbol Ann)
expectLatestTypecheckedFile =
  Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
getLatestTypecheckedFile Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
-> (Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
    -> Cli (TypecheckedUnisonFile Symbol Ann))
-> Cli (TypecheckedUnisonFile Symbol Ann)
forall a b. a -> (a -> b) -> b
& Cli (TypecheckedUnisonFile Symbol Ann)
-> Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
-> Cli (TypecheckedUnisonFile Symbol Ann)
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
onNothingM (Output -> Cli (TypecheckedUnisonFile Symbol Ann)
forall a. Output -> Cli a
Cli.returnEarly Output
Output.NoUnisonFile)

-- @makeParsingEnv path names@ makes a parsing environment with @names@ in scope, which are all relative to @path@.
makeParsingEnv :: ProjectPath -> Names -> Cli (ParsingEnv Transaction)
makeParsingEnv :: ProjectPath -> Names -> Cli (ParsingEnv Transaction)
makeParsingEnv ProjectPath
path Names
names = do
  Cli.Env {IO UniqueName
generateUniqueName :: IO UniqueName
$sel:generateUniqueName:Env :: Env -> IO UniqueName
generateUniqueName} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  UniqueName
uniqueName <- IO UniqueName -> Cli UniqueName
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UniqueName
generateUniqueName
  pure do
    ParsingEnv
      { $sel:uniqueNames:ParsingEnv :: UniqueName
uniqueNames = UniqueName
uniqueName,
        $sel:uniqueTypeGuid:ParsingEnv :: Name -> Transaction (Maybe Text)
uniqueTypeGuid = ProjectPath -> Name -> Transaction (Maybe Text)
loadUniqueTypeGuid ProjectPath
path,
        Names
names :: Names
$sel:names:ParsingEnv :: Names
names,
        $sel:maybeNamespace:ParsingEnv :: Maybe Name
maybeNamespace = Maybe Name
forall a. Maybe a
Nothing,
        $sel:localNamespacePrefixedTypesAndConstructors:ParsingEnv :: Names
localNamespacePrefixedTypesAndConstructors = Names
forall a. Monoid a => a
mempty
      }