-- | @todo@ input handler
module Unison.Codebase.Editor.HandleInput.Todo
  ( handleTodo,
  )
where

import Control.Monad.Reader (ask)
import Data.Set qualified as Set
import U.Codebase.HashTags (BranchHash (..))
import U.Codebase.Sqlite.Operations qualified as Operations
import Unison.Builtin qualified as Builtin
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.Causal qualified as Causal
import Unison.Codebase.Editor.HandleInput.Merge2 (hasDefnsInLib)
import Unison.Codebase.Editor.Output
import Unison.DeclCoherencyCheck (checkAllDeclCoherency)
import Unison.Hash (HashFor (..))
import Unison.Names qualified as Names
import Unison.Prelude
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl.Names qualified as PPED
import Unison.Reference (TermReference)
import Unison.Syntax.Name qualified as Name
import Unison.Util.Defns (Defns (..))
import Unison.Util.Set qualified as Set

handleTodo :: Cli ()
handleTodo :: Cli ()
handleTodo = do
  Env
env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask

  -- For now, we don't go through any great trouble to seek out the root of the project branch. Just assume the current
  -- namespace is the root, which will be the case unless the user uses `deprecated.cd`.
  Branch IO
currentCausal <- Cli (Branch IO)
Cli.getCurrentBranch
  let currentNamespace :: Branch0 IO
currentNamespace = Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
currentCausal
  let currentNamespaceWithoutLibdeps :: Branch0 IO
currentNamespaceWithoutLibdeps = Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.deleteLibdeps Branch0 IO
currentNamespace

  (Bool
defnsInLib, Set TermReferenceId
dependentsOfTodo, DefnsF Set TermReference TermReference
directDependencies, Int
hashLen, Maybe IncoherentDeclReasons
incoherentDeclReasons) <-
    Transaction
  (Bool, Set TermReferenceId, DefnsF Set TermReference TermReference,
   Int, Maybe IncoherentDeclReasons)
-> Cli
     (Bool, Set TermReferenceId, DefnsF Set TermReference TermReference,
      Int, Maybe IncoherentDeclReasons)
forall a. Transaction a -> Cli a
Cli.runTransaction do
      -- We call a shared `hasDefnsLib` helper even though we could easily duplicate the logic with the branch in hand
      Bool
defnsInLib <- do
        Branch Transaction
branch <-
          Branch IO
currentCausal
            Branch IO
-> (Branch IO -> UnwrappedBranch IO) -> UnwrappedBranch IO
forall a b. a -> (a -> b) -> b
& Branch IO -> UnwrappedBranch IO
forall (m :: * -> *). Branch m -> UnwrappedBranch m
Branch._history
            UnwrappedBranch IO
-> (UnwrappedBranch IO -> HashFor (Branch0 IO))
-> HashFor (Branch0 IO)
forall a b. a -> (a -> b) -> b
& UnwrappedBranch IO -> HashFor (Branch0 IO)
forall (m :: * -> *) e. Causal m e -> HashFor e
Causal.valueHash
            HashFor (Branch0 IO)
-> (HashFor (Branch0 IO) -> BranchHash) -> BranchHash
forall a b. a -> (a -> b) -> b
& forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @_ @BranchHash
            BranchHash
-> (BranchHash -> Transaction (Branch Transaction))
-> Transaction (Branch Transaction)
forall a b. a -> (a -> b) -> b
& BranchHash -> Transaction (Branch Transaction)
Operations.expectBranchByBranchHash
        Branch Transaction -> Transaction Bool
forall (m :: * -> *). Applicative m => Branch m -> m Bool
hasDefnsInLib Branch Transaction
branch

      let todoReference :: TermReference
          todoReference :: TermReference
todoReference =
            Set TermReference -> Maybe TermReference
forall a. Set a -> Maybe a
Set.asSingleton (Names -> Name -> Set TermReference
Names.refTermsNamed Names
Builtin.names (HasCallStack => Text -> Name
Text -> Name
Name.unsafeParseText Text
"todo"))
              Maybe TermReference
-> (Maybe TermReference -> TermReference) -> TermReference
forall a b. a -> (a -> b) -> b
& TermReference -> Maybe TermReference -> TermReference
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> TermReference
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char] -> [Char]
reportBug [Char]
"E260496" [Char]
"No reference for builtin named 'todo'"))

      -- All type-and-term dependents of the `todo` builtin, but we know they're all terms.
      DefnsF Set TermReferenceId TermReferenceId
dependentsOfTodo <-
        Set TermReferenceId
-> Set TermReference
-> Transaction (DefnsF Set TermReferenceId TermReferenceId)
Operations.directDependentsWithinScope
          (Branch0 IO -> Set TermReferenceId
forall (m :: * -> *). Branch0 m -> Set TermReferenceId
Branch.deepTermReferenceIds Branch0 IO
currentNamespaceWithoutLibdeps)
          (TermReference -> Set TermReference
forall a. a -> Set a
Set.singleton TermReference
todoReference)

      DefnsF Set TermReference TermReference
directDependencies <-
        (TermReference -> Bool)
-> DefnsF Set TermReferenceId TermReferenceId
-> Transaction (DefnsF Set TermReference TermReference)
Operations.directDependenciesOfScope
          TermReference -> Bool
Builtin.isBuiltinType
          Defns
            { $sel:terms:Defns :: Set TermReferenceId
terms = Branch0 IO -> Set TermReferenceId
forall (m :: * -> *). Branch0 m -> Set TermReferenceId
Branch.deepTermReferenceIds Branch0 IO
currentNamespaceWithoutLibdeps,
              $sel:types:Defns :: Set TermReferenceId
types = Branch0 IO -> Set TermReferenceId
forall (m :: * -> *). Branch0 m -> Set TermReferenceId
Branch.deepTypeReferenceIds Branch0 IO
currentNamespaceWithoutLibdeps
            }

      Int
hashLen <- Transaction Int
Codebase.hashLength

      Maybe IncoherentDeclReasons
incoherentDeclReasons <-
        -- First try the happy path of an unconflicted namespace, which is cached in the Branch object. `todo` doesn't
        -- require that the namespace is unconflicted, so we fall back on a more expensive computation in that case
        case Branch0 IO
-> Either
     (Defn (Conflicted Name Referent) (Conflicted Name TermReference))
     UnconflictedBranchView
forall (m :: * -> *).
Branch0 m
-> Either
     (Defn (Conflicted Name Referent) (Conflicted Name TermReference))
     UnconflictedBranchView
Branch.asUnconflicted Branch0 IO
currentNamespace of
          Right UnconflictedBranchView
unconflictedView ->
            Codebase IO Symbol Ann
-> BranchHash
-> UnconflictedBranchView
-> Transaction (Either IncoherentDeclReasons DeclNameLookup)
forall (m :: * -> *) v a.
Codebase m v a
-> BranchHash
-> UnconflictedBranchView
-> Transaction (Either IncoherentDeclReasons DeclNameLookup)
Codebase.getBranchDeclNameLookup Env
env.codebase (Branch IO -> BranchHash
forall (m :: * -> *). Branch m -> BranchHash
Branch.namespaceHash Branch IO
currentCausal) UnconflictedBranchView
unconflictedView Transaction (Either IncoherentDeclReasons DeclNameLookup)
-> (Either IncoherentDeclReasons DeclNameLookup
    -> Maybe IncoherentDeclReasons)
-> Transaction (Maybe IncoherentDeclReasons)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
              Right DeclNameLookup
_ -> Maybe IncoherentDeclReasons
forall a. Maybe a
Nothing
              Left IncoherentDeclReasons
reasons -> IncoherentDeclReasons -> Maybe IncoherentDeclReasons
forall a. a -> Maybe a
Just IncoherentDeclReasons
reasons
          Either
  (Defn (Conflicted Name Referent) (Conflicted Name TermReference))
  UnconflictedBranchView
_ -> do
            let currentNamesWithoutLibdeps :: Names
currentNamesWithoutLibdeps = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
currentNamespaceWithoutLibdeps
            Map TermReferenceId Int
numConstructors <-
              Codebase IO Symbol Ann
-> BranchHash
-> Set TermReference
-> Transaction (Map TermReferenceId Int)
forall (m :: * -> *) v a.
Codebase m v a
-> BranchHash
-> Set TermReference
-> Transaction (Map TermReferenceId Int)
Codebase.getBranchDeclNumConstructors
                Env
env.codebase
                (Branch IO -> BranchHash
forall (m :: * -> *). Branch m -> BranchHash
Branch.namespaceHash Branch IO
currentCausal)
                (Names -> Set TermReference
Names.typeReferences Names
currentNamesWithoutLibdeps)
            Maybe IncoherentDeclReasons
-> Transaction (Maybe IncoherentDeclReasons)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure case Nametree (DefnsF (Map NameSegment) Referent TermReference)
-> Map TermReferenceId Int
-> Either IncoherentDeclReasons DeclNameLookup
checkAllDeclCoherency (Names -> Nametree (DefnsF (Map NameSegment) Referent TermReference)
Names.lenientToNametree Names
currentNamesWithoutLibdeps) Map TermReferenceId Int
numConstructors of
              Right DeclNameLookup
_ -> Maybe IncoherentDeclReasons
forall a. Maybe a
Nothing
              Left IncoherentDeclReasons
reasons -> IncoherentDeclReasons -> Maybe IncoherentDeclReasons
forall a. a -> Maybe a
Just IncoherentDeclReasons
reasons

      (Bool, Set TermReferenceId, DefnsF Set TermReference TermReference,
 Int, Maybe IncoherentDeclReasons)
-> Transaction
     (Bool, Set TermReferenceId, DefnsF Set TermReference TermReference,
      Int, Maybe IncoherentDeclReasons)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
defnsInLib, DefnsF Set TermReferenceId TermReferenceId
dependentsOfTodo.terms, DefnsF Set TermReference TermReference
directDependencies, Int
hashLen, Maybe IncoherentDeclReasons
incoherentDeclReasons)

  let currentNames :: Names
currentNames = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
currentNamespace
  let ppe :: PrettyPrintEnvDecl
ppe = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
currentNames) (Names -> Suffixifier
PPE.suffixifyByHash Names
currentNames)

  NumberedOutput -> Cli ()
Cli.respondNumbered (NumberedOutput -> Cli ()) -> NumberedOutput -> Cli ()
forall a b. (a -> b) -> a -> b
$
    TodoOutput -> NumberedOutput
Output'Todo
      TodoOutput
        { Bool
defnsInLib :: Bool
$sel:defnsInLib:TodoOutput :: Bool
defnsInLib,
          Set TermReferenceId
dependentsOfTodo :: Set TermReferenceId
$sel:dependentsOfTodo:TodoOutput :: Set TermReferenceId
dependentsOfTodo,
          $sel:directDependenciesWithoutNames:TodoOutput :: DefnsF Set TermReference TermReference
directDependenciesWithoutNames =
            Defns
              { $sel:terms:Defns :: Set TermReference
terms = Set TermReference -> Set TermReference -> Set TermReference
forall a. Ord a => Set a -> Set a -> Set a
Set.difference DefnsF Set TermReference TermReference
directDependencies.terms (Branch0 IO -> Set TermReference
forall (m :: * -> *). Branch0 m -> Set TermReference
Branch.deepTermReferences Branch0 IO
currentNamespace),
                $sel:types:Defns :: Set TermReference
types = Set TermReference -> Set TermReference -> Set TermReference
forall a. Ord a => Set a -> Set a -> Set a
Set.difference DefnsF Set TermReference TermReference
directDependencies.types (Branch0 IO -> Set TermReference
forall (m :: * -> *). Branch0 m -> Set TermReference
Branch.deepTypeReferences Branch0 IO
currentNamespace)
              },
          Int
hashLen :: Int
$sel:hashLen:TodoOutput :: Int
hashLen,
          Maybe IncoherentDeclReasons
incoherentDeclReasons :: Maybe IncoherentDeclReasons
$sel:incoherentDeclReasons:TodoOutput :: Maybe IncoherentDeclReasons
incoherentDeclReasons,
          $sel:nameConflicts:TodoOutput :: Names
nameConflicts = Names -> Names
Names.conflicts (Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
currentNamespaceWithoutLibdeps),
          PrettyPrintEnvDecl
ppe :: PrettyPrintEnvDecl
$sel:ppe:TodoOutput :: PrettyPrintEnvDecl
ppe
        }