-- | 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'ToAbsolute,
    resolveSplit',

    -- * Project and branch resolution
    getCurrentProjectAndBranch,
    getCurrentProjectBranch,
    getCurrentProject,

    -- * Branches

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

    -- ** 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_,
    setProjectBranchRootToCausalHash,
    updateAtM,
    updateAt,
    updateAndStepAt,

    -- * Terms
    getTermsAt,

    -- * Types
    getTypesAt,

    -- * 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.Bitraversable (bitraverse)
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.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.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
  ppIds <- Cli ProjectPathIds
Cli.getProjectPathIds
  Cli.runTransaction $ Codebase.resolveProjectPathIds 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

getCurrentProject :: Cli Project
getCurrentProject :: Cli Project
getCurrentProject = do
  Getting Project ProjectPath Project -> ProjectPath -> Project
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Project ProjectPath Project
#project (ProjectPath -> Project) -> Cli ProjectPath -> Cli Project
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'@ to a @Path.Absolute@, per the current path.
resolvePath' :: Path' -> Cli PP.ProjectPath
resolvePath' :: Path' -> Cli ProjectPath
resolvePath' Path'
path' = do
  pp <- Cli ProjectPath
getCurrentProjectPath
  pure $ pp & PP.absPath_ %~ \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.Split Path' -> Cli (Path.Split ProjectPath)
resolveSplit' :: Split Path' -> Cli (Split ProjectPath)
resolveSplit' = (Path' -> Cli ProjectPath)
-> (NameSegment -> Cli NameSegment)
-> Split Path'
-> Cli (Split ProjectPath)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> (a, b) -> f (c, d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Path' -> Cli ProjectPath
resolvePath' NameSegment -> Cli NameSegment
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

------------------------------------------------------------------------------------------------------------------------
-- 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 -> Cli (Branch IO)
getBranchFromProjectPath (ProjectPath -> Cli (Branch IO))
-> (Path' -> Cli ProjectPath) -> Path' -> Cli (Branch IO)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Path' -> Cli ProjectPath
resolvePath' (Path' -> Cli (Branch IO)) -> Path' -> Cli (Branch IO)
forall a b. (a -> b) -> a -> b
$ Absolute -> Path'
AbsolutePath' Absolute
absPath
  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
    hash <- (forall void. Output -> Transaction void)
-> ShortCausalHash -> Transaction CausalHash
resolveShortCausalHashToCausalHash Output -> Transaction void
forall void. Output -> Transaction void
rollback ShortCausalHash
shortHash
    causal <- (Codebase.expectCausalBranchByCausalHash hash)
    V2Causal.value 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 <- BranchId -> Cli AbsBranchId
resolveBranchIdToAbsBranchId BranchId
branchId
  resolveAbsBranchId 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
  Text -> Cli (Branch IO) -> Cli (Branch IO)
forall a. Text -> Cli a -> Cli a
Cli.time Text
"resolveShortCausalHash" do
    Cli.Env {codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
    hash <- 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
    branch <- liftIO (Codebase.getBranchForHash codebase hash)
    pure (fromMaybe Branch.empty 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
  hashes <- ShortCausalHash -> Transaction (Set CausalHash)
Codebase.causalHashesByPrefix ShortCausalHash
shortHash
  Set.asSingleton hashes & onNothing do
    if Set.null hashes
      then rollback (Output.NoBranchWithHash shortHash)
      else do
        len <- Codebase.branchHashLength
        rollback (Output.BranchHashAmbiguous shortHash (Set.map (SCH.fromHash len) hashes))

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

-- | Get the root branch.
getCurrentProjectRoot :: Cli (Branch IO)
getCurrentProjectRoot :: Cli (Branch IO)
getCurrentProjectRoot = do
  Cli.Env {codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  ProjectAndBranch proj branch <- getCurrentProjectAndBranch
  liftIO $ Codebase.expectProjectBranchRoot codebase proj.projectId 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} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  pp <- getCurrentProjectPath
  fromMaybe Branch.empty <$> liftIO (Codebase.getBranchAtProjectPath codebase 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} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  liftIO $ Codebase.expectProjectBranchRoot codebase projectBranch.projectId 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} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  liftIO $ Codebase.getBranchAtProjectPath codebase 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
. Path -> Path'
RelativePath'

-- | 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
  path <- Path' -> Cli ProjectPath
resolvePath' Path'
path0
  getMaybeBranchFromProjectPath path & onNothingM (Cli.returnEarly (Output.BranchNotFound 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
. Path -> Path'
RelativePath'

-- | 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
  pp <- Path' -> Cli ProjectPath
resolvePath' Path'
path'
  Cli.runTransaction do
    branch <- Codebase.getShallowBranchAtProjectPath pp
    isEmpty <- V2Branch.isEmpty branch
    pure (not 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
  origRoot <- ProjectBranch -> Cli (Branch IO)
getProjectBranchRoot ProjectBranch
pb
  newRoot <- Branch.stepManyAtM (makeActionsUnabsolute actions) origRoot
  didChange <- updateProjectBranchRoot pb 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 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
    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 (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
  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)
  newRootBranch <- Branch.modifyAtM (pp ^. PP.path_) f oldRootBranch
  updateProjectBranchRoot_ (pp ^. #branch) reason (const newRootBranch)
  pure $ oldRootBranch /= 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
  env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  Cli.time "updateProjectBranchRoot" do
    beforeUpdates <- getProjectBranchRoot projectBranch
    (new, result) <- f beforeUpdates
    when (beforeUpdates /= new) do
      liftIO $ Codebase.putBranch env.codebase new
      Cli.runTransactionWithRollback \forall void. Output -> Transaction void
rollback -> do
        causalHashId <- HasCallStack =>
ProjectId -> ProjectBranchId -> Transaction CausalHashId
ProjectId -> ProjectBranchId -> Transaction CausalHashId
Q.expectProjectBranchHead ProjectBranch
projectBranch.projectId ProjectBranch
projectBranch.branchId
        currentHeadHash <- Q.expectCausalHash causalHashId
        -- Inside the transaction we ensure that the branch from before the updates matches the current head of the
        -- project branch, like a check-and-set operation.
        -- If it doesn't, then some other process has updated the branch between when we read it and computed the
        -- updates. We should abort and ask the user to try again.
        if
          | (currentHeadHash == Branch.headHash new) -> do
              -- Someone else updated the branch, but they set it to what we wanted to anyways.
              pure ()
          | (currentHeadHash /= Branch.headHash beforeUpdates) -> do
              rollback Output.BranchUpdate'BranchChanged
          | otherwise -> do
              causalHashId <- Q.expectCausalHashIdByCausalHash (Branch.headHash new)
              Q.setProjectBranchHead reason projectBranch.projectId projectBranch.branchId causalHashId
      -- The input to this function isn't necessarily the *current* project branch, which is what LSP cares about. But
      -- it might be! There's no harm in unconditionally notifying the LSP that the current project branch may have
      -- changed, but it is slightly more efficient for us to just do the == comparison here (since otherwise the LSP
      -- would have to dig around in the database before confirming whether there's a change).
      projectPathIds <- Cli.getProjectPathIds
      when ((projectBranch.projectId, projectBranch.branchId) == (projectPathIds.project, projectPathIds.branch)) do
        liftIO (env.lspCheckForChanges projectPathIds)
    pure result

setProjectBranchRootToCausalHash :: (HasCallStack) => ProjectBranch -> Text -> CausalHash -> Cli ()
setProjectBranchRootToCausalHash :: HasCallStack => ProjectBranch -> Text -> CausalHash -> Cli ()
setProjectBranchRootToCausalHash ProjectBranch
projectBranch Text
reason CausalHash
targetCH = do
  Text -> Cli () -> Cli ()
forall a. Text -> Cli a -> Cli a
Cli.time Text
"setProjectBranchRootToCausalHash" do
    Transaction () -> Cli ()
forall a. Transaction a -> Cli a
Cli.runTransaction (Transaction () -> Cli ()) -> Transaction () -> Cli ()
forall a b. (a -> b) -> a -> b
$ do
      targetCHID <- CausalHash -> Transaction CausalHashId
Q.expectCausalHashIdByCausalHash CausalHash
targetCH
      Q.setProjectBranchHead reason (projectBranch ^. #projectId) (projectBranch ^. #branchId) targetCHID

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 :: HQ'.HashQualified (Path.Split ProjectPath) -> Cli (Set Referent)
getTermsAt :: HashQualified (Split ProjectPath) -> Cli (Set Referent)
getTermsAt HashQualified (Split ProjectPath)
hq =
  let (ProjectPath
pp, NameSegment
seg) = HashQualified (Split ProjectPath) -> Split ProjectPath
forall n. HashQualified n -> n
HQ'.toName HashQualified (Split ProjectPath)
hq
   in HashQualified (Split Path) -> Branch0 IO -> Set Referent
forall (m :: * -> *).
HashQualified (Split Path) -> Branch0 m -> Set Referent
BranchUtil.getTerm ((Path
forall a. Monoid a => a
mempty, NameSegment
seg) Split Path
-> HashQualified (Split ProjectPath) -> HashQualified (Split Path)
forall a b. a -> HashQualified b -> HashQualified a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ HashQualified (Split ProjectPath)
hq) (Branch0 IO -> Set Referent)
-> Cli (Branch0 IO) -> Cli (Set Referent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProjectPath -> Cli (Branch0 IO)
getBranch0FromProjectPath ProjectPath
pp

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

getTypesAt :: HQ'.HashQualified (Path.Split ProjectPath) -> Cli (Set TypeReference)
getTypesAt :: HashQualified (Split ProjectPath) -> Cli (Set TypeReference)
getTypesAt HashQualified (Split ProjectPath)
hq =
  let (ProjectPath
pp, NameSegment
seg) = HashQualified (Split ProjectPath) -> Split ProjectPath
forall n. HashQualified n -> n
HQ'.toName HashQualified (Split ProjectPath)
hq
   in HashQualified (Split Path) -> Branch0 IO -> Set TypeReference
forall (m :: * -> *).
HashQualified (Split Path) -> Branch0 m -> Set TypeReference
BranchUtil.getType ((Path
forall a. Monoid a => a
mempty, NameSegment
seg) Split Path
-> HashQualified (Split ProjectPath) -> HashQualified (Split Path)
forall a b. a -> HashQualified b -> HashQualified a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ HashQualified (Split ProjectPath)
hq) (Branch0 IO -> Set TypeReference)
-> Cli (Branch0 IO) -> Cli (Set TypeReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProjectPath -> Cli (Branch0 IO)
getBranch0FromProjectPath ProjectPath
pp

------------------------------------------------------------------------------------------------------------------------
-- 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
  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 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
  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 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
  uf <- Cli (Maybe (UnisonFile Symbol Ann))
getLatestParsedFile
  pure $ case 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 {generateUniqueName} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  uniqueName <- liftIO generateUniqueName
  pure do
    ParsingEnv
      { uniqueNames = uniqueName,
        uniqueTypeGuid = loadUniqueTypeGuid path,
        names,
        maybeNamespace = Nothing,
        localNamespacePrefixedTypesAndConstructors = mempty
      }