module Unison.Codebase.Editor.HandleInput.Dependencies
( handleDependencies,
)
where
import Control.Arrow ((***))
import Data.Bifoldable (bifoldMap, binull)
import Data.Set qualified as Set
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.Cli.NameResolutionUtils (resolveHQName)
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.Editor.Output
import Unison.Codebase.Editor.StructuredArgument qualified as SA
import Unison.ConstructorReference qualified as ConstructorReference
import Unison.HashQualified qualified as HQ
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.LabeledDependency qualified as LD
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.Reference (Reference)
import Unison.Reference qualified as Reference
import Unison.Referent qualified as Referent
import Unison.Syntax.HashQualifiedPrime qualified as HQ'
import Unison.Util.Defns (Defns (..), DefnsF)
import Unison.Util.Defns qualified as Defns
handleDependencies :: HQ.HashQualified Name -> Cli ()
handleDependencies :: HashQualified Name -> Cli ()
handleDependencies HashQualified Name
hq = do
DefnsF Set Referent Reference
refs <- HashQualified Name -> Cli (DefnsF Set Referent Reference)
resolveHQName HashQualified Name
hq
Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DefnsF Set Referent Reference -> Bool
forall (t :: * -> * -> *) a b. Bifoldable t => t a b -> Bool
binull DefnsF Set Referent Reference
refs) do
Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly (HashQualified Name -> Output
LabeledReferenceNotFound HashQualified Name
hq)
Branch0 IO
namespace <- Cli (Branch0 IO)
Cli.getCurrentProjectRoot0
let ppe :: PrettyPrintEnv
ppe =
let names :: Names
names = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
namespace
in Namer -> Suffixifier -> PrettyPrintEnv
PPE.makePPE (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
DefnsF Set Reference Reference
dependencies <- do
Transaction (DefnsF Set Reference Reference)
-> Cli (DefnsF Set Reference Reference)
forall a. Transaction a -> Cli a
Cli.runTransaction do
(Reference -> Bool)
-> DefnsF Set TermReferenceId TermReferenceId
-> Transaction (DefnsF Set Reference Reference)
Operations.directDependenciesOfScope
Reference -> Bool
Builtin.isBuiltinType
( let refToIds :: Reference -> Set Reference.Id
refToIds :: Reference -> Set TermReferenceId
refToIds =
Set TermReferenceId
-> (TermReferenceId -> Set TermReferenceId)
-> Maybe TermReferenceId
-> Set TermReferenceId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set TermReferenceId
forall a. Set a
Set.empty TermReferenceId -> Set TermReferenceId
forall a. a -> Set a
Set.singleton (Maybe TermReferenceId -> Set TermReferenceId)
-> (Reference -> Maybe TermReferenceId)
-> Reference
-> Set TermReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Maybe TermReferenceId
Reference.toId
in (Set Referent -> DefnsF Set TermReferenceId TermReferenceId)
-> (Set Reference -> DefnsF Set TermReferenceId TermReferenceId)
-> DefnsF Set Referent Reference
-> DefnsF Set TermReferenceId TermReferenceId
forall m a b. Monoid m => (a -> m) -> (b -> m) -> Defns a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap
( (Referent -> DefnsF Set TermReferenceId TermReferenceId)
-> Set Referent -> DefnsF Set TermReferenceId TermReferenceId
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \case
Referent.Con ConstructorReference
ref ConstructorType
_ -> Set TermReferenceId -> DefnsF Set TermReferenceId TermReferenceId
forall terms types. Monoid terms => types -> Defns terms types
Defns.fromTypes (Reference -> Set TermReferenceId
refToIds (ConstructorReference
ref ConstructorReference
-> Getting Reference ConstructorReference Reference -> Reference
forall s a. s -> Getting a s a -> a
^. Getting Reference ConstructorReference Reference
forall r s (f :: * -> *).
Functor f =>
(r -> f s)
-> GConstructorReference r -> f (GConstructorReference s)
ConstructorReference.reference_))
Referent.Ref Reference
ref -> Set TermReferenceId -> DefnsF Set TermReferenceId TermReferenceId
forall types terms. Monoid types => terms -> Defns terms types
Defns.fromTerms (Reference -> Set TermReferenceId
refToIds Reference
ref)
)
((Reference -> DefnsF Set TermReferenceId TermReferenceId)
-> Set Reference -> DefnsF Set TermReferenceId TermReferenceId
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Reference -> Set TermReferenceId
refToIds (Reference -> Set TermReferenceId)
-> (Set TermReferenceId
-> DefnsF Set TermReferenceId TermReferenceId)
-> Reference
-> DefnsF Set TermReferenceId TermReferenceId
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Set TermReferenceId -> DefnsF Set TermReferenceId TermReferenceId
forall terms types. Monoid terms => types -> Defns terms types
Defns.fromTypes))
DefnsF Set Referent Reference
refs
)
let dependencyNames ::
DefnsF
[]
(HQ.HashQualified Name, HQ.HashQualified Name)
(HQ.HashQualified Name, HQ.HashQualified Name)
dependencyNames :: DefnsF
[]
(HashQualified Name, HashQualified Name)
(HashQualified Name, HashQualified Name)
dependencyNames =
(Set Reference -> [(HashQualified Name, HashQualified Name)])
-> (Set Reference -> [(HashQualified Name, HashQualified Name)])
-> DefnsF Set Reference Reference
-> DefnsF
[]
(HashQualified Name, HashQualified Name)
(HashQualified Name, HashQualified Name)
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
((Reference -> [(HashQualified Name, HashQualified Name)])
-> Set Reference -> [(HashQualified Name, HashQualified Name)]
f (Reference -> Referent
Referent.fromTermReference (Reference -> Referent)
-> (Referent -> [(HashQualified Name, HashQualified Name)])
-> Reference
-> [(HashQualified Name, HashQualified Name)]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> PrettyPrintEnv
-> Referent -> [(HashQualified Name, HashQualified Name)]
PPE.termNames PrettyPrintEnv
ppe))
((Reference -> [(HashQualified Name, HashQualified Name)])
-> Set Reference -> [(HashQualified Name, HashQualified Name)]
f (PrettyPrintEnv
-> Reference -> [(HashQualified Name, HashQualified Name)]
PPE.typeNames PrettyPrintEnv
ppe))
DefnsF Set Reference Reference
dependencies
where
f ::
(Reference -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)]) ->
Set Reference ->
[(HQ.HashQualified Name, HQ.HashQualified Name)]
f :: (Reference -> [(HashQualified Name, HashQualified Name)])
-> Set Reference -> [(HashQualified Name, HashQualified Name)]
f Reference -> [(HashQualified Name, HashQualified Name)]
g =
Set Reference -> [Reference]
forall a. Set a -> [a]
Set.toList
(Set Reference -> [Reference])
-> ([Reference] -> [(HashQualified Name, HashQualified Name)])
-> Set Reference
-> [(HashQualified Name, HashQualified Name)]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Reference
-> Either Reference (HashQualified Name, HashQualified Name))
-> [Reference]
-> [Either Reference (HashQualified Name, HashQualified Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\Reference
x -> Either Reference (HashQualified Name, HashQualified Name)
-> ((HashQualified Name, HashQualified Name)
-> Either Reference (HashQualified Name, HashQualified Name))
-> Maybe (HashQualified Name, HashQualified Name)
-> Either Reference (HashQualified Name, HashQualified Name)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Reference
-> Either Reference (HashQualified Name, HashQualified Name)
forall a b. a -> Either a b
Left Reference
x) (HashQualified Name, HashQualified Name)
-> Either Reference (HashQualified Name, HashQualified Name)
forall a b. b -> Either a b
Right ([(HashQualified Name, HashQualified Name)]
-> Maybe (HashQualified Name, HashQualified Name)
forall a. [a] -> Maybe a
listToMaybe (Reference -> [(HashQualified Name, HashQualified Name)]
g Reference
x)))
([Reference]
-> [Either Reference (HashQualified Name, HashQualified Name)])
-> ([Either Reference (HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)])
-> [Reference]
-> [(HashQualified Name, HashQualified Name)]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [Either Reference (HashQualified Name, HashQualified Name)]
-> ([Reference], [(HashQualified Name, HashQualified Name)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
([Either Reference (HashQualified Name, HashQualified Name)]
-> ([Reference], [(HashQualified Name, HashQualified Name)]))
-> (([Reference], [(HashQualified Name, HashQualified Name)])
-> [(HashQualified Name, HashQualified Name)])
-> [Either Reference (HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([Reference], [(HashQualified Name, HashQualified Name)])
-> [(HashQualified Name, HashQualified Name)]
h
h ::
([Reference], [(HQ'.HashQualified Name, HQ'.HashQualified Name)]) ->
[(HQ.HashQualified Name, HQ.HashQualified Name)]
h :: ([Reference], [(HashQualified Name, HashQualified Name)])
-> [(HashQualified Name, HashQualified Name)]
h ([Reference]
nameless, [(HashQualified Name, HashQualified Name)]
named) =
[[(HashQualified Name, HashQualified Name)]]
-> [(HashQualified Name, HashQualified Name)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [(HashQualified Name, HashQualified Name)]
named
[(HashQualified Name, HashQualified Name)]
-> ([(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)])
-> [(HashQualified Name, HashQualified Name)]
forall a b. a -> (a -> b) -> b
& ((HashQualified Name, HashQualified Name) -> Text)
-> [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
forall a. (a -> Text) -> [a] -> [a]
Name.sortByText ((HashQualified Name, HashQualified Name) -> HashQualified Name
forall a b. (a, b) -> a
fst ((HashQualified Name, HashQualified Name) -> HashQualified Name)
-> (HashQualified Name -> Text)
-> (HashQualified Name, HashQualified Name)
-> Text
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> HashQualified Name -> Text
HQ'.toText)
[(HashQualified Name, HashQualified Name)]
-> ([(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)])
-> [(HashQualified Name, HashQualified Name)]
forall a b. a -> (a -> b) -> b
& ((HashQualified Name, HashQualified Name)
-> (HashQualified Name, HashQualified Name))
-> [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
forall a b. (a -> b) -> [a] -> [b]
map (HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ (HashQualified Name -> HashQualified Name)
-> (HashQualified Name -> HashQualified Name)
-> (HashQualified Name, HashQualified Name)
-> (HashQualified Name, HashQualified Name)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ),
[Reference]
nameless
[Reference]
-> ([Reference] -> [(HashQualified Name, HashQualified Name)])
-> [(HashQualified Name, HashQualified Name)]
forall a b. a -> (a -> b) -> b
& (Reference -> (HashQualified Name, HashQualified Name))
-> [Reference] -> [(HashQualified Name, HashQualified Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\Reference
x -> let y :: HashQualified Name
y = Reference -> HashQualified Name
HQ.fromReference Reference
x in (HashQualified Name
y, HashQualified Name
y))
]
(DefnsF
[]
(HashQualified Name, HashQualified Name)
(HashQualified Name, HashQualified Name)
dependencyNames.types [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
forall a. [a] -> [a] -> [a]
++ DefnsF
[]
(HashQualified Name, HashQualified Name)
(HashQualified Name, HashQualified Name)
dependencyNames.terms)
[(HashQualified Name, HashQualified Name)]
-> ([(HashQualified Name, HashQualified Name)]
-> [StructuredArgument])
-> [StructuredArgument]
forall a b. a -> (a -> b) -> b
& ((HashQualified Name, HashQualified Name) -> StructuredArgument)
-> [(HashQualified Name, HashQualified Name)]
-> [StructuredArgument]
forall a b. (a -> b) -> [a] -> [b]
map (HashQualified Name -> StructuredArgument
SA.HashQualified (HashQualified Name -> StructuredArgument)
-> ((HashQualified Name, HashQualified Name) -> HashQualified Name)
-> (HashQualified Name, HashQualified Name)
-> StructuredArgument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashQualified Name, HashQualified Name) -> HashQualified Name
forall a b. (a, b) -> a
fst)
[StructuredArgument] -> ([StructuredArgument] -> Cli ()) -> Cli ()
forall a b. a -> (a -> b) -> b
& [StructuredArgument] -> Cli ()
Cli.setNumberedArgs
let lds :: Set LabeledDependency
lds = (Set Referent -> Set LabeledDependency)
-> (Set Reference -> Set LabeledDependency)
-> DefnsF Set Referent Reference
-> Set LabeledDependency
forall m a b. Monoid m => (a -> m) -> (b -> m) -> Defns a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap ((Referent -> LabeledDependency)
-> Set Referent -> Set LabeledDependency
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Referent -> LabeledDependency
LD.referent) ((Reference -> LabeledDependency)
-> Set Reference -> Set LabeledDependency
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Reference -> LabeledDependency
LD.typeRef) DefnsF Set Referent Reference
refs
Output -> Cli ()
Cli.respond (PrettyPrintEnv
-> Set LabeledDependency
-> DefnsF
[]
(HashQualified Name, HashQualified Name)
(HashQualified Name, HashQualified Name)
-> Output
ListDependencies PrettyPrintEnv
ppe Set LabeledDependency
lds DefnsF
[]
(HashQualified Name, HashQualified Name)
(HashQualified Name, HashQualified Name)
dependencyNames)