-- | @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 <- 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`.
  currentCausal <- Cli.getCurrentBranch
  let currentNamespace = Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
currentCausal
  let currentNamespaceWithoutLibdeps = Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.deleteLibdeps Branch0 IO
currentNamespace

  (defnsInLib, dependentsOfTodo, directDependencies, hashLen, incoherentDeclReasons) <-
    Cli.runTransaction do
      -- We call a shared `hasDefnsLib` helper even though we could easily duplicate the logic with the branch in hand
      defnsInLib <- do
        branch <-
          currentCausal
            & Branch._history
            & Causal.valueHash
            & coerce @_ @BranchHash
            & Operations.expectBranchByBranchHash
        hasDefnsInLib branch

      let todoReference :: TermReference
          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 (String -> TypeReference
forall a. HasCallStack => String -> a
error (String -> String -> String
reportBug String
"E260496" String
"No reference for builtin named 'todo'"))

      -- All type-and-term dependents of the `todo` builtin, but we know they're all terms.
      dependentsOfTodo <-
        Operations.directDependentsWithinScope
          (Defns.fromTerms (Branch.deepTermReferenceIds currentNamespaceWithoutLibdeps))
          (Defns.fromTerms (Set.singleton todoReference))

      directDependencies <-
        Operations.directDependenciesOfScope
          Builtin.isBuiltinType
          Defns
            { terms = Branch.deepTermReferenceIds currentNamespaceWithoutLibdeps,
              types = Branch.deepTypeReferenceIds currentNamespaceWithoutLibdeps
            }

      hashLen <- Codebase.hashLength

      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 Branch.asUnconflicted 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
            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)
            pure case checkAllDeclCoherency (Names.lenientToNametree currentNamesWithoutLibdeps) 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

      pure (defnsInLib, dependentsOfTodo.terms, directDependencies, hashLen, incoherentDeclReasons)

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

  Cli.respondNumbered $
    Output'Todo
      TodoOutput
        { defnsInLib,
          dependentsOfTodo,
          directDependenciesWithoutNames =
            Defns
              { terms = Set.difference directDependencies.terms (Branch.deepTermReferences currentNamespace),
                types = Set.difference directDependencies.types (Branch.deepTypeReferences currentNamespace)
              },
          hashLen,
          incoherentDeclReasons,
          nameConflicts = Names.conflicts (Branch.toNames currentNamespaceWithoutLibdeps),
          ppe
        }