module Unison.Codebase.Editor.HandleInput.DebugDependentsGraph
  ( handleDebugDependentsGraph,
  )
where

import Algebra.Graph.AdjacencyMap qualified as Graph
import Data.List qualified as List
import Data.Text.IO qualified as Text
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.Branch qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.HashQualified (HashQualified)
import Unison.Name (Name)
import Unison.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..))
import Unison.Reference (TermReference, TermReferenceId, TypeReference, TypeReferenceId)
import Unison.Reference qualified as Reference
import Unison.Referent qualified as Referent
import Unison.Syntax.NamePrinter (prettyHashQualified)
import Unison.Util.Defn (Defn (..))
import Unison.Util.Defns (DefnsF)
import Unison.Util.Pretty qualified as Pretty
import Unison.Util.Relation qualified as Relation
import Unison.Util.Set qualified as Set

handleDebugDependentsGraph :: Cli ()
handleDebugDependentsGraph :: Cli ()
handleDebugDependentsGraph = do
  Branch0 IO
currentNamespace <- Cli (Branch0 IO)
Cli.getCurrentBranch0

  let currentNamespaceSansLib :: Branch0 IO
currentNamespaceSansLib =
        Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.deleteLibdeps Branch0 IO
currentNamespace

  let query :: DefnsF Set TermReference TypeReference
      query :: DefnsF Set TermReference TermReference
query =
        (Relation (Referent' TermReference) Name -> Set TermReference)
-> (Relation TermReference Name -> Set TermReference)
-> Defns
     (Relation (Referent' TermReference) Name)
     (Relation TermReference Name)
-> DefnsF Set TermReference TermReference
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((Referent' TermReference -> Maybe TermReference)
-> Set (Referent' TermReference) -> Set TermReference
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe Referent' TermReference -> Maybe TermReference
forall r. Referent' r -> Maybe r
Referent.toTermReference (Set (Referent' TermReference) -> Set TermReference)
-> (Relation (Referent' TermReference) Name
    -> Set (Referent' TermReference))
-> Relation (Referent' TermReference) Name
-> Set TermReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation (Referent' TermReference) Name
-> Set (Referent' TermReference)
forall a b. Relation a b -> Set a
Relation.dom) Relation TermReference Name -> Set TermReference
forall a b. Relation a b -> Set a
Relation.dom (Branch0 IO
-> Defns
     (Relation (Referent' TermReference) Name)
     (Relation TermReference Name)
forall (m :: * -> *).
Branch0 m
-> Defns
     (Relation (Referent' TermReference) Name)
     (Relation TermReference Name)
Branch.deepDefns Branch0 IO
currentNamespaceSansLib)

  let scope :: DefnsF Set TermReferenceId TypeReferenceId
      scope :: DefnsF Set TermReferenceId TermReferenceId
scope =
        (Set TermReference -> Set TermReferenceId)
-> (Set TermReference -> Set TermReferenceId)
-> DefnsF Set TermReference TermReference
-> DefnsF Set TermReferenceId TermReferenceId
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((TermReference -> Maybe TermReferenceId)
-> Set TermReference -> Set TermReferenceId
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe TermReference -> Maybe TermReferenceId
Reference.toId) ((TermReference -> Maybe TermReferenceId)
-> Set TermReference -> Set TermReferenceId
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe TermReference -> Maybe TermReferenceId
Reference.toId) DefnsF Set TermReference TermReference
query

  [DependencyEdge]
edges <-
    Transaction [DependencyEdge] -> Cli [DependencyEdge]
forall a. Transaction a -> Cli a
Cli.runTransaction ((TermReference -> Bool)
-> DefnsF Set TermReferenceId TermReferenceId
-> DefnsF Set TermReference TermReference
-> Transaction [DependencyEdge]
Operations.transitiveDependentsGraphWithinScope TermReference -> Bool
Builtin.isBuiltinType DefnsF Set TermReferenceId TermReferenceId
scope DefnsF Set TermReference TermReference
query)

  let graph :: Graph.AdjacencyMap (Defn TermReference TypeReference)
      graph :: AdjacencyMap (Defn TermReference TermReference)
graph =
        (AdjacencyMap (Defn TermReference TermReference)
 -> DependencyEdge
 -> AdjacencyMap (Defn TermReference TermReference))
-> AdjacencyMap (Defn TermReference TermReference)
-> [DependencyEdge]
-> AdjacencyMap (Defn TermReference TermReference)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl
          ( \AdjacencyMap (Defn TermReference TermReference)
acc DependencyEdge
edge ->
              AdjacencyMap (Defn TermReference TermReference)
-> AdjacencyMap (Defn TermReference TermReference)
-> AdjacencyMap (Defn TermReference TermReference)
forall a.
Ord a =>
AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a
Graph.overlay AdjacencyMap (Defn TermReference TermReference)
acc case DependencyEdge
edge of
                Operations.TermDependsOnTerm TermReferenceId
dependent TermReference
dependency ->
                  Defn TermReference TermReference
-> Defn TermReference TermReference
-> AdjacencyMap (Defn TermReference TermReference)
forall a. Ord a => a -> a -> AdjacencyMap a
Graph.edge (TermReference -> Defn TermReference TermReference
forall term typ. term -> Defn term typ
TermDefn (TermReferenceId -> TermReference
Reference.fromId TermReferenceId
dependent)) (TermReference -> Defn TermReference TermReference
forall term typ. term -> Defn term typ
TermDefn TermReference
dependency)
                Operations.TermDependsOnType TermReferenceId
dependent TermReference
dependency ->
                  Defn TermReference TermReference
-> Defn TermReference TermReference
-> AdjacencyMap (Defn TermReference TermReference)
forall a. Ord a => a -> a -> AdjacencyMap a
Graph.edge (TermReference -> Defn TermReference TermReference
forall term typ. term -> Defn term typ
TermDefn (TermReferenceId -> TermReference
Reference.fromId TermReferenceId
dependent)) (TermReference -> Defn TermReference TermReference
forall term typ. typ -> Defn term typ
TypeDefn TermReference
dependency)
                Operations.TypeDependsOnType TermReferenceId
dependent TermReference
dependency ->
                  Defn TermReference TermReference
-> Defn TermReference TermReference
-> AdjacencyMap (Defn TermReference TermReference)
forall a. Ord a => a -> a -> AdjacencyMap a
Graph.edge (TermReference -> Defn TermReference TermReference
forall term typ. typ -> Defn term typ
TypeDefn (TermReferenceId -> TermReference
Reference.fromId TermReferenceId
dependent)) (TermReference -> Defn TermReference TermReference
forall term typ. typ -> Defn term typ
TypeDefn TermReference
dependency)
          )
          AdjacencyMap (Defn TermReference TermReference)
forall a. AdjacencyMap a
Graph.empty
          [DependencyEdge]
edges

  let adjacency :: [(Defn TermReference TermReference,
  [Defn TermReference TermReference])]
adjacency =
        AdjacencyMap (Defn TermReference TermReference)
-> [(Defn TermReference TermReference,
     [Defn TermReference TermReference])]
forall a. AdjacencyMap a -> [(a, [a])]
Graph.adjacencyList AdjacencyMap (Defn TermReference TermReference)
graph

  let ppe :: PrettyPrintEnv
ppe =
        (Int -> Branch0 IO -> PrettyPrintEnvDecl
forall (m :: * -> *). Int -> Branch0 m -> PrettyPrintEnvDecl
Branch.toPrettyPrintEnvDecl Int
10 Branch0 IO
currentNamespace).suffixifiedPPE

  let prettyDefn :: Defn TermReference TypeReference -> HashQualified Name
      prettyDefn :: Defn TermReference TermReference -> HashQualified Name
prettyDefn = \case
        TermDefn TermReference
ref -> PrettyPrintEnv -> Referent' TermReference -> HashQualified Name
PPE.termName PrettyPrintEnv
ppe (TermReference -> Referent' TermReference
Referent.fromTermReference TermReference
ref)
        TypeDefn TermReference
ref -> PrettyPrintEnv -> TermReference -> HashQualified Name
PPE.typeName PrettyPrintEnv
ppe TermReference
ref

  let output :: Pretty SyntaxText
output =
        [Pretty SyntaxText] -> Pretty SyntaxText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pretty.lines
          ( ((Defn TermReference TermReference,
  [Defn TermReference TermReference])
 -> Pretty SyntaxText)
-> [(Defn TermReference TermReference,
     [Defn TermReference TermReference])]
-> [Pretty SyntaxText]
forall a b. (a -> b) -> [a] -> [b]
map
              ( \(Defn TermReference TermReference
dependent, [Defn TermReference TermReference]
dependencies) ->
                  HashQualified Name -> Pretty SyntaxText
prettyHashQualified (Defn TermReference TermReference -> HashQualified Name
prettyDefn Defn TermReference TermReference
dependent)
                    Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> Pretty SyntaxText
" depends on: "
                    Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> [Pretty SyntaxText] -> Pretty SyntaxText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pretty.commas ((Defn TermReference TermReference -> Pretty SyntaxText)
-> [Defn TermReference TermReference] -> [Pretty SyntaxText]
forall a b. (a -> b) -> [a] -> [b]
map (HashQualified Name -> Pretty SyntaxText
prettyHashQualified (HashQualified Name -> Pretty SyntaxText)
-> (Defn TermReference TermReference -> HashQualified Name)
-> Defn TermReference TermReference
-> Pretty SyntaxText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defn TermReference TermReference -> HashQualified Name
prettyDefn) [Defn TermReference TermReference]
dependencies)
              )
              [(Defn TermReference TermReference,
  [Defn TermReference TermReference])]
adjacency
          )

  IO () -> Cli ()
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Text -> IO ()
Text.putStrLn (Width -> Pretty ColorText -> Text
Pretty.toANSI Width
80 (Pretty SyntaxText -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
Pretty.syntaxToColor Pretty SyntaxText
output)))