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

import Data.Either qualified as Either
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.Hash (HashFor (..))
import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReasons (..), checkAllDeclCoherency)
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
  -- 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, IncoherentDeclReasons
incoherentDeclReasons) <-
    Transaction
  (Bool, Set TermReferenceId, DefnsF Set TermReference TermReference,
   Int, IncoherentDeclReasons)
-> Cli
     (Bool, Set TermReferenceId, DefnsF Set TermReference TermReference,
      Int, 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 <-
        DefnsF Set TermReferenceId TermReferenceId
-> Transaction (DefnsF Set TermReference TermReference)
Operations.directDependenciesOfScope
          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

      IncoherentDeclReasons
incoherentDeclReasons <-
        (Either IncoherentDeclReasons DeclNameLookup
 -> IncoherentDeclReasons)
-> Transaction (Either IncoherentDeclReasons DeclNameLookup)
-> Transaction IncoherentDeclReasons
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IncoherentDeclReasons
-> Either IncoherentDeclReasons DeclNameLookup
-> IncoherentDeclReasons
forall a b. a -> Either a b -> a
Either.fromLeft ([(Name, Name, Name)]
-> [Name]
-> [(Name, Name)]
-> [(TermReferenceId, Name)]
-> IncoherentDeclReasons
IncoherentDeclReasons [] [] [] [])) (Transaction (Either IncoherentDeclReasons DeclNameLookup)
 -> Transaction IncoherentDeclReasons)
-> Transaction (Either IncoherentDeclReasons DeclNameLookup)
-> Transaction IncoherentDeclReasons
forall a b. (a -> b) -> a -> b
$
          (TermReferenceId -> Transaction Int)
-> Nametree (DefnsF (Map NameSegment) Referent TermReference)
-> Transaction (Either IncoherentDeclReasons DeclNameLookup)
forall (m :: * -> *).
Monad m =>
(TermReferenceId -> m Int)
-> Nametree (DefnsF (Map NameSegment) Referent TermReference)
-> m (Either IncoherentDeclReasons DeclNameLookup)
checkAllDeclCoherency
            TermReferenceId -> Transaction Int
Operations.expectDeclNumConstructors
            (Names -> Nametree (DefnsF (Map NameSegment) Referent TermReference)
Names.lenientToNametree (Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
currentNamespaceWithoutLibdeps))

      pure (Bool
defnsInLib, DefnsF Set TermReferenceId TermReferenceId
dependentsOfTodo.terms, DefnsF Set TermReference TermReference
directDependencies, Int
hashLen, 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,
          IncoherentDeclReasons
incoherentDeclReasons :: IncoherentDeclReasons
$sel:incoherentDeclReasons:TodoOutput :: 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
        }