-- | @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 qualified as PPED
import Unison.Reference (TermReference)
import Unison.Syntax.Name qualified as Name
import Unison.Util.Defns (Defns (..))
import Unison.Util.Defns qualified as 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 TypeReferenceId
dependentsOfTodo, DefnsF Set TypeReference TypeReference
directDependencies, Int
hashLen, Maybe IncoherentDeclReasons
incoherentDeclReasons) <-
    Transaction
  (Bool, Set TypeReferenceId, DefnsF Set TypeReference TypeReference,
   Int, Maybe IncoherentDeclReasons)
-> Cli
     (Bool, Set TypeReferenceId, DefnsF Set TypeReference TypeReference,
      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 :: TypeReference
todoReference =
            Set TypeReference -> Maybe TypeReference
forall a. Set a -> Maybe a
Set.asSingleton (Names -> Name -> Set TypeReference
Names.refTermsNamed Names
Builtin.names (HasCallStack => Text -> Name
Text -> Name
Name.unsafeParseText Text
"todo"))
              Maybe TypeReference
-> (Maybe TypeReference -> TypeReference) -> TypeReference
forall a b. a -> (a -> b) -> b
& TypeReference -> Maybe TypeReference -> TypeReference
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> TypeReference
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 TypeReferenceId TypeReferenceId
dependentsOfTodo <-
        DefnsF Set TypeReferenceId TypeReferenceId
-> DefnsF Set TypeReference TypeReference
-> Transaction (DefnsF Set TypeReferenceId TypeReferenceId)
Operations.directDependentsWithinScope
          (Set TypeReferenceId -> DefnsF Set TypeReferenceId TypeReferenceId
forall types terms. Monoid types => terms -> Defns terms types
Defns.fromTerms (Branch0 IO -> Set TypeReferenceId
forall (m :: * -> *). Branch0 m -> Set TypeReferenceId
Branch.deepTermReferenceIds Branch0 IO
currentNamespaceWithoutLibdeps))
          (Set TypeReference -> DefnsF Set TypeReference TypeReference
forall types terms. Monoid types => terms -> Defns terms types
Defns.fromTerms (TypeReference -> Set TypeReference
forall a. a -> Set a
Set.singleton TypeReference
todoReference))

      DefnsF Set TypeReference TypeReference
directDependencies <-
        (TypeReference -> Bool)
-> DefnsF Set TypeReferenceId TypeReferenceId
-> Transaction (DefnsF Set TypeReference TypeReference)
Operations.directDependenciesOfScope
          TypeReference -> Bool
Builtin.isBuiltinType
          Defns
            { $sel:terms:Defns :: Set TypeReferenceId
terms = Branch0 IO -> Set TypeReferenceId
forall (m :: * -> *). Branch0 m -> Set TypeReferenceId
Branch.deepTermReferenceIds Branch0 IO
currentNamespaceWithoutLibdeps,
              $sel:types:Defns :: Set TypeReferenceId
types = Branch0 IO -> Set TypeReferenceId
forall (m :: * -> *). Branch0 m -> Set TypeReferenceId
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 TypeReference))
     UnconflictedLocalDefnsView
forall (m :: * -> *).
Branch0 m
-> Either
     (Defn (Conflicted Name Referent) (Conflicted Name TypeReference))
     UnconflictedLocalDefnsView
Branch.asUnconflicted Branch0 IO
currentNamespace of
          Right UnconflictedLocalDefnsView
unconflictedView ->
            Codebase IO Symbol Ann
-> BranchHash
-> UnconflictedLocalDefnsView
-> Transaction (Either IncoherentDeclReasons DeclNameLookup)
forall (m :: * -> *) v a.
Codebase m v a
-> BranchHash
-> UnconflictedLocalDefnsView
-> Transaction (Either IncoherentDeclReasons DeclNameLookup)
Codebase.getBranchDeclNameLookup Env
env.codebase (Branch IO -> BranchHash
forall (m :: * -> *). Branch m -> BranchHash
Branch.namespaceHash Branch IO
currentCausal) UnconflictedLocalDefnsView
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 TypeReference))
  UnconflictedLocalDefnsView
_ -> do
            let currentNamesWithoutLibdeps :: Names
currentNamesWithoutLibdeps = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
currentNamespaceWithoutLibdeps
            Map TypeReferenceId Int
numConstructors <-
              Codebase IO Symbol Ann
-> BranchHash
-> Set TypeReference
-> Transaction (Map TypeReferenceId Int)
forall (m :: * -> *) v a.
Codebase m v a
-> BranchHash
-> Set TypeReference
-> Transaction (Map TypeReferenceId Int)
Codebase.getBranchDeclNumConstructors
                Env
env.codebase
                (Branch IO -> BranchHash
forall (m :: * -> *). Branch m -> BranchHash
Branch.namespaceHash Branch IO
currentCausal)
                (Names -> Set TypeReference
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 TypeReference)
-> Map TypeReferenceId Int
-> Either IncoherentDeclReasons DeclNameLookup
checkAllDeclCoherency (Names -> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
Names.lenientToNametree Names
currentNamesWithoutLibdeps) Map TypeReferenceId 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 TypeReferenceId, DefnsF Set TypeReference TypeReference,
 Int, Maybe IncoherentDeclReasons)
-> Transaction
     (Bool, Set TypeReferenceId, DefnsF Set TypeReference TypeReference,
      Int, Maybe IncoherentDeclReasons)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
defnsInLib, DefnsF Set TypeReferenceId TypeReferenceId
dependentsOfTodo.terms, DefnsF Set TypeReference TypeReference
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 TypeReferenceId
dependentsOfTodo :: Set TypeReferenceId
$sel:dependentsOfTodo:TodoOutput :: Set TypeReferenceId
dependentsOfTodo,
          $sel:directDependenciesWithoutNames:TodoOutput :: DefnsF Set TypeReference TypeReference
directDependenciesWithoutNames =
            Defns
              { $sel:terms:Defns :: Set TypeReference
terms = Set TypeReference -> Set TypeReference -> Set TypeReference
forall a. Ord a => Set a -> Set a -> Set a
Set.difference DefnsF Set TypeReference TypeReference
directDependencies.terms (Branch0 IO -> Set TypeReference
forall (m :: * -> *). Branch0 m -> Set TypeReference
Branch.deepTermReferences Branch0 IO
currentNamespace),
                $sel:types:Defns :: Set TypeReference
types = Set TypeReference -> Set TypeReference -> Set TypeReference
forall a. Ord a => Set a -> Set a -> Set a
Set.difference DefnsF Set TypeReference TypeReference
directDependencies.types (Branch0 IO -> Set TypeReference
forall (m :: * -> *). Branch0 m -> Set TypeReference
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
        }