module Unison.Codebase.Editor.HandleInput.ShowDefinition
( handleShowDefinition,
showDefinitions,
)
where
import Control.Lens
import Control.Monad.Reader (ask)
import Control.Monad.State qualified as State
import Data.List qualified as List
import Data.List.NonEmpty qualified as List (NonEmpty)
import Data.List.NonEmpty qualified as List.NonEmpty
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import Unison.Builtin.Decls qualified as DD
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Cli.NamesUtils qualified as Cli
import Unison.Cli.Pretty qualified as Pretty
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.Editor.DisplayObject (DisplayObject)
import Unison.Codebase.Editor.Input (OutputLocation (..), RelativeToFold (..), ShowDefinitionScope (..))
import Unison.Codebase.Editor.Output
import Unison.DataDeclaration (Decl)
import Unison.DataDeclaration qualified as DD
import Unison.HashQualified qualified as HQ
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.Names qualified as Names
import Unison.NamesWithHistory qualified as Names
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.PrettyPrintEnvDecl.Names qualified as PPED
import Unison.Reference (Reference, TermReferenceId)
import Unison.Reference qualified as Reference
import Unison.Referent qualified as Referent
import Unison.Server.Backend qualified as Backend
import Unison.Server.NameSearch.FromNames qualified as NameSearch
import Unison.Symbol (Symbol)
import Unison.Syntax.Name qualified as Name (toVar)
import Unison.Syntax.NamePrinter (SyntaxText)
import Unison.Term (Term)
import Unison.Type (Type)
import Unison.UnisonFile (TypecheckedUnisonFile (..), UnisonFile (..))
import Unison.UnisonFile qualified as UnisonFile
import Unison.Util.Defns (Defns (..))
import Unison.Util.Pretty (Pretty)
import Unison.Util.Pretty qualified as Pretty
import Unison.Util.Set qualified as Set
import Unison.WatchKind qualified as WatchKind
handleShowDefinition :: OutputLocation -> ShowDefinitionScope -> List.NonEmpty (HQ.HashQualified Name) -> Cli ()
handleShowDefinition :: OutputLocation
-> ShowDefinitionScope -> NonEmpty (HashQualified Name) -> Cli ()
handleShowDefinition OutputLocation
outputLoc ShowDefinitionScope
showDefinitionScope NonEmpty (HashQualified Name)
query = do
Env
env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
let hasAbsoluteQuery :: Bool
hasAbsoluteQuery = (HashQualified Name -> Bool)
-> NonEmpty (HashQualified Name) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Name -> Bool) -> HashQualified Name -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Name -> Bool
Name.isAbsolute) NonEmpty (HashQualified Name)
query
(Names
names, PrettyPrintEnvDecl
unbiasedPPED) <- case (Bool
hasAbsoluteQuery, ShowDefinitionScope
showDefinitionScope) of
(Bool
True, ShowDefinitionScope
_) -> do
Branch IO
root <- Cli (Branch IO)
Cli.getCurrentProjectRoot
let root0 :: Branch0 IO
root0 = Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
root
let names :: Names
names = Names -> Names
Names.makeAbsolute (Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
root0)
let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
suffixify Names
names)
(Names, PrettyPrintEnvDecl) -> Cli (Names, PrettyPrintEnvDecl)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Names
names, PrettyPrintEnvDecl
pped)
(Bool
_, ShowDefinitionScope
ShowDefinitionGlobal) -> do
Branch IO
root <- Cli (Branch IO)
Cli.getCurrentProjectRoot
let root0 :: Branch0 IO
root0 = Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
root
let names :: Names
names = Names -> Names
Names.makeAbsolute (Names -> Names) -> Names -> Names
forall a b. (a -> b) -> a -> b
$ Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
root0
let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
suffixify Names
names)
(Names, PrettyPrintEnvDecl) -> Cli (Names, PrettyPrintEnvDecl)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Names
names, PrettyPrintEnvDecl
pped)
(Bool
_, ShowDefinitionScope
ShowDefinitionLocal) -> do
Names
currentNames <- Cli Names
Cli.currentNames
let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
currentNames) (Names -> Suffixifier
suffixify Names
currentNames)
(Names, PrettyPrintEnvDecl) -> Cli (Names, PrettyPrintEnvDecl)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Names
currentNames, PrettyPrintEnvDecl
pped)
let pped :: PrettyPrintEnvDecl
pped = [Name] -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl
PPED.biasTo ((HashQualified Name -> Maybe Name)
-> [HashQualified Name] -> [Name]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName (NonEmpty (HashQualified Name) -> [HashQualified Name]
forall a. NonEmpty a -> [a]
List.NonEmpty.toList NonEmpty (HashQualified Name)
query)) PrettyPrintEnvDecl
unbiasedPPED
Backend.DefinitionResults Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Map TermReference (DisplayObject () (Decl Symbol Ann))
types [HashQualified Name]
misses <- do
let nameSearch :: NameSearch Transaction
nameSearch = Int -> Names -> NameSearch Transaction
forall (m :: * -> *). Applicative m => Int -> Names -> NameSearch m
NameSearch.makeNameSearch Int
10 Names
names
Transaction DefinitionResults -> Cli DefinitionResults
forall a. Transaction a -> Cli a
Cli.runTransaction (Codebase IO Symbol Ann
-> NameSearch Transaction
-> IncludeCycles
-> SearchType
-> [HashQualified Name]
-> Transaction DefinitionResults
forall (m :: * -> *).
Codebase m Symbol Ann
-> NameSearch Transaction
-> IncludeCycles
-> SearchType
-> [HashQualified Name]
-> Transaction DefinitionResults
Backend.definitionsByName Env
env.codebase NameSearch Transaction
nameSearch IncludeCycles
includeCycles SearchType
Names.IncludeSuffixes (NonEmpty (HashQualified Name) -> [HashQualified Name]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (HashQualified Name)
query))
OutputLocation
-> PrettyPrintEnvDecl
-> Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map TermReference (DisplayObject () (Decl Symbol Ann))
-> [HashQualified Name]
-> Cli ()
showDefinitions OutputLocation
outputLoc PrettyPrintEnvDecl
pped Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Map TermReference (DisplayObject () (Decl Symbol Ann))
types [HashQualified Name]
misses
where
suffixify :: Names -> Suffixifier
suffixify =
case OutputLocation
outputLoc of
OutputLocation
ConsoleLocation -> Names -> Suffixifier
PPE.suffixifyByHash
FileLocation FilePath
_ RelativeToFold
_ -> Names -> Suffixifier
PPE.suffixifyByHashName
LatestFileLocation RelativeToFold
_ -> Names -> Suffixifier
PPE.suffixifyByHashName
includeCycles :: IncludeCycles
includeCycles =
case OutputLocation
outputLoc of
OutputLocation
ConsoleLocation -> IncludeCycles
Backend.DontIncludeCycles
FileLocation FilePath
_ RelativeToFold
_ -> IncludeCycles
Backend.IncludeCycles
LatestFileLocation RelativeToFold
_ -> IncludeCycles
Backend.IncludeCycles
showDefinitions ::
OutputLocation ->
PPED.PrettyPrintEnvDecl ->
(Map Reference.Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))) ->
( Map
Reference.Reference
(DisplayObject () (Decl Symbol Ann))
) ->
[HQ.HashQualified Name] ->
Cli ()
showDefinitions :: OutputLocation
-> PrettyPrintEnvDecl
-> Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map TermReference (DisplayObject () (Decl Symbol Ann))
-> [HashQualified Name]
-> Cli ()
showDefinitions OutputLocation
outputLoc PrettyPrintEnvDecl
pped Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Map TermReference (DisplayObject () (Decl Symbol Ann))
types [HashQualified Name]
misses = do
Env
env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
Maybe (FilePath, RelativeToFold)
outputPath <- Cli (Maybe (FilePath, RelativeToFold))
getOutputPath
case Maybe (FilePath, RelativeToFold)
outputPath of
Maybe (FilePath, RelativeToFold)
_ | Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Bool
forall a. Map TermReference a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Bool -> Bool -> Bool
&& Map TermReference (DisplayObject () (Decl Symbol Ann)) -> Bool
forall a. Map TermReference a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map TermReference (DisplayObject () (Decl Symbol Ann))
types -> () -> Cli ()
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Maybe (FilePath, RelativeToFold)
Nothing -> do
let isTest :: p -> Bool
isTest p
_ = Bool
False
let isSourceFile :: Bool
isSourceFile = Bool
False
let (Pretty ColorText
renderedCodePretty, Int
_numRendered) =
PrettyPrintEnvDecl
-> Bool
-> (TypeReferenceId -> Bool)
-> Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map TermReference (DisplayObject () (Decl Symbol Ann))
-> Defns (Set Symbol) (Set Symbol)
-> (Pretty ColorText, Int)
forall {r}.
(HasField "types" r (Set Symbol),
HasField "terms" r (Set Symbol)) =>
PrettyPrintEnvDecl
-> Bool
-> (TypeReferenceId -> Bool)
-> Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map TermReference (DisplayObject () (Decl Symbol Ann))
-> r
-> (Pretty ColorText, Int)
renderCodePretty
PrettyPrintEnvDecl
pped
Bool
isSourceFile
TypeReferenceId -> Bool
forall {p}. p -> Bool
isTest
Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms
Map TermReference (DisplayObject () (Decl Symbol Ann))
types
(Set Symbol -> Set Symbol -> Defns (Set Symbol) (Set Symbol)
forall terms types. terms -> types -> Defns terms types
Defns Set Symbol
forall a. Set a
Set.empty Set Symbol
forall a. Set a
Set.empty)
Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ Pretty ColorText -> Output
DisplayDefinitions Pretty ColorText
renderedCodePretty
Just (FilePath
fp, RelativeToFold
relToFold) -> do
Defns (Set Symbol) (Set Symbol)
excludeNames <-
case RelativeToFold
relToFold of
RelativeToFold
AboveFold -> Defns (Set Symbol) (Set Symbol)
-> Cli (Defns (Set Symbol) (Set Symbol))
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set Symbol -> Set Symbol -> Defns (Set Symbol) (Set Symbol)
forall terms types. terms -> types -> Defns terms types
Defns Set Symbol
forall a. Set a
Set.empty Set Symbol
forall a. Set a
Set.empty)
RelativeToFold
WithinFold ->
Getting
(Maybe
(Either
(UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
LoopState
(Maybe
(Either
(UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
-> Cli
(Maybe
(Either
(UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
(Maybe
(Either
(UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
LoopState
(Maybe
(Either
(UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
#latestTypecheckedFile Cli
(Maybe
(Either
(UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
-> (Maybe
(Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann))
-> Defns (Set Symbol) (Set Symbol))
-> Cli (Defns (Set Symbol) (Set Symbol))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Maybe
(Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann))
Nothing -> Set Symbol -> Set Symbol -> Defns (Set Symbol) (Set Symbol)
forall terms types. terms -> types -> Defns terms types
Defns Set Symbol
forall a. Set a
Set.empty Set Symbol
forall a. Set a
Set.empty
Just (Left UnisonFile Symbol Ann
unisonFile) ->
let boundTermNames :: Set Symbol
boundTermNames = Map Symbol (Ann, Term Symbol Ann) -> Set Symbol
forall k a. Map k a -> Set k
Map.keysSet UnisonFile Symbol Ann
unisonFile.terms
boundTestWatchNames :: Set Symbol
boundTestWatchNames =
Map FilePath [(Symbol, Ann, Term Symbol Ann)]
-> [(FilePath, [(Symbol, Ann, Term Symbol Ann)])]
forall k a. Map k a -> [(k, a)]
Map.toList UnisonFile Symbol Ann
unisonFile.watches
[(FilePath, [(Symbol, Ann, Term Symbol Ann)])]
-> ([(FilePath, [(Symbol, Ann, Term Symbol Ann)])] -> Set Symbol)
-> Set Symbol
forall a b. a -> (a -> b) -> b
& ((FilePath, [(Symbol, Ann, Term Symbol Ann)]) -> Set Symbol)
-> [(FilePath, [(Symbol, Ann, Term Symbol Ann)])] -> Set Symbol
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \case
(FilePath
WatchKind.TestWatch, [(Symbol, Ann, Term Symbol Ann)]
watches) -> [Symbol] -> Set Symbol
forall a. Ord a => [a] -> Set a
Set.fromList (((Symbol, Ann, Term Symbol Ann) -> Symbol)
-> [(Symbol, Ann, Term Symbol Ann)] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map (Getting Symbol (Symbol, Ann, Term Symbol Ann) Symbol
-> (Symbol, Ann, Term Symbol Ann) -> Symbol
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Symbol (Symbol, Ann, Term Symbol Ann) Symbol
forall s t a b. Field1 s t a b => Lens s t a b
Lens
(Symbol, Ann, Term Symbol Ann)
(Symbol, Ann, Term Symbol Ann)
Symbol
Symbol
_1) [(Symbol, Ann, Term Symbol Ann)]
watches)
(FilePath, [(Symbol, Ann, Term Symbol Ann)])
_ -> Set Symbol
forall a. Set a
Set.empty
boundDataDeclNames :: Set Symbol
boundDataDeclNames = Map Symbol (TypeReferenceId, DataDeclaration Symbol Ann)
-> Set Symbol
forall k a. Map k a -> Set k
Map.keysSet UnisonFile Symbol Ann
unisonFile.dataDeclarationsId
boundEffectDeclNames :: Set Symbol
boundEffectDeclNames = Map Symbol (TypeReferenceId, EffectDeclaration Symbol Ann)
-> Set Symbol
forall k a. Map k a -> Set k
Map.keysSet UnisonFile Symbol Ann
unisonFile.effectDeclarationsId
in Defns
{ $sel:terms:Defns :: Set Symbol
terms = Set Symbol
boundTermNames Set Symbol -> Set Symbol -> Set Symbol
forall a. Semigroup a => a -> a -> a
<> Set Symbol
boundTestWatchNames,
$sel:types:Defns :: Set Symbol
types = Set Symbol
boundDataDeclNames Set Symbol -> Set Symbol -> Set Symbol
forall a. Semigroup a => a -> a -> a
<> Set Symbol
boundEffectDeclNames
}
Just (Right TypecheckedUnisonFile Symbol Ann
typecheckedUnisonFile) ->
let boundTermNames :: Set Symbol
boundTermNames = ([(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)] -> Set Symbol)
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
-> Set Symbol
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([Symbol] -> Set Symbol
forall a. Ord a => [a] -> Set a
Set.fromList ([Symbol] -> Set Symbol)
-> ([(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)] -> [Symbol])
-> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
-> Set Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Symbol, Ann, Term Symbol Ann, Type Symbol Ann) -> Symbol)
-> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map (Getting
Symbol (Symbol, Ann, Term Symbol Ann, Type Symbol Ann) Symbol
-> (Symbol, Ann, Term Symbol Ann, Type Symbol Ann) -> Symbol
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
Symbol (Symbol, Ann, Term Symbol Ann, Type Symbol Ann) Symbol
forall s t a b. Field1 s t a b => Lens s t a b
Lens
(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
Symbol
Symbol
_1)) TypecheckedUnisonFile Symbol Ann
typecheckedUnisonFile.topLevelComponents'
boundTestWatchNames :: Set Symbol
boundTestWatchNames =
TypecheckedUnisonFile Symbol Ann
typecheckedUnisonFile.watchComponents [(FilePath, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> ([(FilePath, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> Set Symbol)
-> Set Symbol
forall a b. a -> (a -> b) -> b
& ((FilePath, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
-> Set Symbol)
-> [(FilePath, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> Set Symbol
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \case
(FilePath
WatchKind.TestWatch, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
watches) -> [Symbol] -> Set Symbol
forall a. Ord a => [a] -> Set a
Set.fromList (((Symbol, Ann, Term Symbol Ann, Type Symbol Ann) -> Symbol)
-> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map (Getting
Symbol (Symbol, Ann, Term Symbol Ann, Type Symbol Ann) Symbol
-> (Symbol, Ann, Term Symbol Ann, Type Symbol Ann) -> Symbol
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
Symbol (Symbol, Ann, Term Symbol Ann, Type Symbol Ann) Symbol
forall s t a b. Field1 s t a b => Lens s t a b
Lens
(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
Symbol
Symbol
_1) [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
watches)
(FilePath, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
_ -> Set Symbol
forall a. Set a
Set.empty
in Defns
{ $sel:terms:Defns :: Set Symbol
terms = Set Symbol
boundTermNames Set Symbol -> Set Symbol -> Set Symbol
forall a. Semigroup a => a -> a -> a
<> Set Symbol
boundTestWatchNames,
$sel:types:Defns :: Set Symbol
types = TypecheckedUnisonFile Symbol Ann -> Set Symbol
forall v a. Ord v => TypecheckedUnisonFile v a -> Set v
UnisonFile.typeNamespaceBindings TypecheckedUnisonFile Symbol Ann
typecheckedUnisonFile
}
Set TypeReferenceId
testRefs <-
Transaction (Set TypeReferenceId) -> Cli (Set TypeReferenceId)
forall a. Transaction a -> Cli a
Cli.runTransaction do
Codebase IO Symbol Ann
-> Type Symbol Ann
-> Set TypeReferenceId
-> Transaction (Set TypeReferenceId)
forall v (m :: * -> *) a.
Var v =>
Codebase m v a
-> Type v a
-> Set TypeReferenceId
-> Transaction (Set TypeReferenceId)
Codebase.filterTermsByReferenceIdHavingType
Env
env.codebase
(Ann -> Type Symbol Ann
forall v a. Ord v => a -> Type v a
DD.testResultListType Ann
forall a. Monoid a => a
mempty)
(Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Set TermReference
forall k a. Map k a -> Set k
Map.keysSet Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Set TermReference
-> (Set TermReference -> Set TypeReferenceId)
-> Set TypeReferenceId
forall a b. a -> (a -> b) -> b
& (TermReference -> Maybe TypeReferenceId)
-> Set TermReference -> Set TypeReferenceId
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe TermReference -> Maybe TypeReferenceId
Reference.toId)
let isTest :: TypeReferenceId -> Bool
isTest TypeReferenceId
r = TypeReferenceId -> Set TypeReferenceId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TypeReferenceId
r Set TypeReferenceId
testRefs
let isSourceFile :: Bool
isSourceFile = Bool
True
let (Pretty ColorText
renderedCodePretty, Int
numRendered) = PrettyPrintEnvDecl
-> Bool
-> (TypeReferenceId -> Bool)
-> Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map TermReference (DisplayObject () (Decl Symbol Ann))
-> Defns (Set Symbol) (Set Symbol)
-> (Pretty ColorText, Int)
forall {r}.
(HasField "types" r (Set Symbol),
HasField "terms" r (Set Symbol)) =>
PrettyPrintEnvDecl
-> Bool
-> (TypeReferenceId -> Bool)
-> Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map TermReference (DisplayObject () (Decl Symbol Ann))
-> r
-> (Pretty ColorText, Int)
renderCodePretty PrettyPrintEnvDecl
pped Bool
isSourceFile TypeReferenceId -> Bool
isTest Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Map TermReference (DisplayObject () (Decl Symbol Ann))
types Defns (Set Symbol) (Set Symbol)
excludeNames
Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
numRendered Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) do
let renderedCodeText :: Text
renderedCodeText = FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Width -> Pretty ColorText -> FilePath
Pretty.toPlain Width
80 Pretty ColorText
renderedCodePretty
#latestFile ?= (fp, True)
IO () -> Cli ()
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Cli ()) -> IO () -> Cli ()
forall a b. (a -> b) -> a -> b
$
Env
env.writeSource (FilePath -> Text
Text.pack FilePath
fp) Text
renderedCodeText case RelativeToFold
relToFold of
RelativeToFold
AboveFold -> Bool
True
RelativeToFold
WithinFold -> Bool
False
Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Int -> Output
LoadedDefinitionsToSourceFile FilePath
fp Int
numRendered
Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([HashQualified Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HashQualified Name]
misses)) (Output -> Cli ()
Cli.respond ([HashQualified Name] -> Output
SearchTermsNotFound [HashQualified Name]
misses))
where
getOutputPath :: Cli (Maybe (FilePath, RelativeToFold))
getOutputPath :: Cli (Maybe (FilePath, RelativeToFold))
getOutputPath =
case OutputLocation
outputLoc of
OutputLocation
ConsoleLocation -> Maybe (FilePath, RelativeToFold)
-> Cli (Maybe (FilePath, RelativeToFold))
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (FilePath, RelativeToFold)
forall a. Maybe a
Nothing
FileLocation FilePath
path RelativeToFold
relToFold -> Maybe (FilePath, RelativeToFold)
-> Cli (Maybe (FilePath, RelativeToFold))
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FilePath, RelativeToFold) -> Maybe (FilePath, RelativeToFold)
forall a. a -> Maybe a
Just (FilePath
path, RelativeToFold
relToFold))
LatestFileLocation RelativeToFold
relToFold -> do
LoopState
loopState <- Cli LoopState
forall s (m :: * -> *). MonadState s m => m s
State.get
pure case LoopState
loopState LoopState
-> Getting
(Maybe (FilePath, Bool)) LoopState (Maybe (FilePath, Bool))
-> Maybe (FilePath, Bool)
forall s a. s -> Getting a s a -> a
^. Getting (Maybe (FilePath, Bool)) LoopState (Maybe (FilePath, Bool))
#latestFile of
Maybe (FilePath, Bool)
Nothing -> (FilePath, RelativeToFold) -> Maybe (FilePath, RelativeToFold)
forall a. a -> Maybe a
Just (FilePath
"scratch.u", RelativeToFold
relToFold)
Just (FilePath
path, Bool
_) -> (FilePath, RelativeToFold) -> Maybe (FilePath, RelativeToFold)
forall a. a -> Maybe a
Just (FilePath
path, RelativeToFold
relToFold)
renderCodePretty :: PrettyPrintEnvDecl
-> Bool
-> (TypeReferenceId -> Bool)
-> Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map TermReference (DisplayObject () (Decl Symbol Ann))
-> r
-> (Pretty ColorText, Int)
renderCodePretty PrettyPrintEnvDecl
pped Bool
isSourceFile TypeReferenceId -> Bool
isTest Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Map TermReference (DisplayObject () (Decl Symbol Ann))
types r
excludeNames =
let prettyTypes :: [Pretty (SyntaxText' TermReference)]
prettyTypes = PrettyPrintEnvDecl
-> Map TermReference (DisplayObject () (Decl Symbol Ann))
-> Set Symbol
-> [Pretty (SyntaxText' TermReference)]
prettyTypeDisplayObjects PrettyPrintEnvDecl
pped Map TermReference (DisplayObject () (Decl Symbol Ann))
types r
excludeNames.types
prettyTerms :: [Pretty (SyntaxText' TermReference)]
prettyTerms = PrettyPrintEnvDecl
-> Bool
-> (TypeReferenceId -> Bool)
-> Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Set Symbol
-> [Pretty (SyntaxText' TermReference)]
prettyTermDisplayObjects PrettyPrintEnvDecl
pped Bool
isSourceFile TypeReferenceId -> Bool
isTest Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms r
excludeNames.terms
in ( Pretty (SyntaxText' TermReference) -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
Pretty.syntaxToColor (Pretty (SyntaxText' TermReference)
-> [Pretty (SyntaxText' TermReference)]
-> Pretty (SyntaxText' TermReference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
Pretty.sep Pretty (SyntaxText' TermReference)
"\n\n" ([Pretty (SyntaxText' TermReference)]
prettyTypes [Pretty (SyntaxText' TermReference)]
-> [Pretty (SyntaxText' TermReference)]
-> [Pretty (SyntaxText' TermReference)]
forall a. [a] -> [a] -> [a]
++ [Pretty (SyntaxText' TermReference)]
prettyTerms)),
[Pretty (SyntaxText' TermReference)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pretty (SyntaxText' TermReference)]
prettyTerms Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Pretty (SyntaxText' TermReference)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pretty (SyntaxText' TermReference)]
prettyTypes
)
prettyTypeDisplayObjects ::
PPED.PrettyPrintEnvDecl ->
(Map Reference (DisplayObject () (DD.Decl Symbol Ann))) ->
Set Symbol ->
[Pretty SyntaxText]
prettyTypeDisplayObjects :: PrettyPrintEnvDecl
-> Map TermReference (DisplayObject () (Decl Symbol Ann))
-> Set Symbol
-> [Pretty (SyntaxText' TermReference)]
prettyTypeDisplayObjects PrettyPrintEnvDecl
pped Map TermReference (DisplayObject () (Decl Symbol Ann))
types Set Symbol
excludeNames =
Map TermReference (DisplayObject () (Decl Symbol Ann))
types
Map TermReference (DisplayObject () (Decl Symbol Ann))
-> (Map TermReference (DisplayObject () (Decl Symbol Ann))
-> [(TermReference, DisplayObject () (Decl Symbol Ann))])
-> [(TermReference, DisplayObject () (Decl Symbol Ann))]
forall a b. a -> (a -> b) -> b
& Map TermReference (DisplayObject () (Decl Symbol Ann))
-> [(TermReference, DisplayObject () (Decl Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList
[(TermReference, DisplayObject () (Decl Symbol Ann))]
-> ([(TermReference, DisplayObject () (Decl Symbol Ann))]
-> [(HashQualified Name, TermReference,
DisplayObject () (Decl Symbol Ann))])
-> [(HashQualified Name, TermReference,
DisplayObject () (Decl Symbol Ann))]
forall a b. a -> (a -> b) -> b
& ((TermReference, DisplayObject () (Decl Symbol Ann))
-> Maybe
(HashQualified Name, TermReference,
DisplayObject () (Decl Symbol Ann)))
-> [(TermReference, DisplayObject () (Decl Symbol Ann))]
-> [(HashQualified Name, TermReference,
DisplayObject () (Decl Symbol Ann))]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe
( \(TermReference
ref, DisplayObject () (Decl Symbol Ann)
dt) -> do
let hqName :: HashQualified Name
hqName = PrettyPrintEnv -> TermReference -> HashQualified Name
PPE.typeName PrettyPrintEnv
unsuffixifiedPPE TermReference
ref
Maybe Name -> (Name -> Maybe ()) -> Maybe ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName HashQualified Name
hqName) \Name
name ->
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Symbol -> Set Symbol -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember (Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Name
name) Set Symbol
excludeNames)
(HashQualified Name, TermReference,
DisplayObject () (Decl Symbol Ann))
-> Maybe
(HashQualified Name, TermReference,
DisplayObject () (Decl Symbol Ann))
forall a. a -> Maybe a
Just (HashQualified Name
hqName, TermReference
ref, DisplayObject () (Decl Symbol Ann)
dt)
)
[(HashQualified Name, TermReference,
DisplayObject () (Decl Symbol Ann))]
-> ([(HashQualified Name, TermReference,
DisplayObject () (Decl Symbol Ann))]
-> [(HashQualified Name, TermReference,
DisplayObject () (Decl Symbol Ann))])
-> [(HashQualified Name, TermReference,
DisplayObject () (Decl Symbol Ann))]
forall a b. a -> (a -> b) -> b
& ((HashQualified Name, TermReference,
DisplayObject () (Decl Symbol Ann))
-> (HashQualified Name, TermReference,
DisplayObject () (Decl Symbol Ann))
-> Ordering)
-> [(HashQualified Name, TermReference,
DisplayObject () (Decl Symbol Ann))]
-> [(HashQualified Name, TermReference,
DisplayObject () (Decl Symbol Ann))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (\(HashQualified Name
n0, TermReference
_, DisplayObject () (Decl Symbol Ann)
_) (HashQualified Name
n1, TermReference
_, DisplayObject () (Decl Symbol Ann)
_) -> HashQualified Name -> HashQualified Name -> Ordering
forall n. Alphabetical n => n -> n -> Ordering
Name.compareAlphabetical HashQualified Name
n0 HashQualified Name
n1)
[(HashQualified Name, TermReference,
DisplayObject () (Decl Symbol Ann))]
-> ([(HashQualified Name, TermReference,
DisplayObject () (Decl Symbol Ann))]
-> [Pretty (SyntaxText' TermReference)])
-> [Pretty (SyntaxText' TermReference)]
forall a b. a -> (a -> b) -> b
& ((HashQualified Name, TermReference,
DisplayObject () (Decl Symbol Ann))
-> Pretty (SyntaxText' TermReference))
-> [(HashQualified Name, TermReference,
DisplayObject () (Decl Symbol Ann))]
-> [Pretty (SyntaxText' TermReference)]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyPrintEnvDecl
-> (HashQualified Name, TermReference,
DisplayObject () (Decl Symbol Ann))
-> Pretty (SyntaxText' TermReference)
Pretty.prettyType PrettyPrintEnvDecl
pped)
where
unsuffixifiedPPE :: PrettyPrintEnv
unsuffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
pped
prettyTermDisplayObjects ::
PPED.PrettyPrintEnvDecl ->
Bool ->
(TermReferenceId -> Bool) ->
(Map Reference.TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))) ->
Set Symbol ->
[Pretty SyntaxText]
prettyTermDisplayObjects :: PrettyPrintEnvDecl
-> Bool
-> (TypeReferenceId -> Bool)
-> Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Set Symbol
-> [Pretty (SyntaxText' TermReference)]
prettyTermDisplayObjects PrettyPrintEnvDecl
pped Bool
isSourceFile TypeReferenceId -> Bool
isTest Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Set Symbol
excludeNames =
Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms
Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> (Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> [(TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))])
-> [(TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
forall a b. a -> (a -> b) -> b
& Map
TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> [(TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList
[(TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
-> ([(TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
-> [(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))])
-> [(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
forall a b. a -> (a -> b) -> b
& ((TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Maybe
(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
-> [(TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
-> [(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe
( \(TermReference
ref, DisplayObject (Type Symbol Ann) (Term Symbol Ann)
dt) -> do
let hqName :: HashQualified Name
hqName = PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName PrettyPrintEnv
unsuffixifiedPPE (TermReference -> Referent
Referent.Ref TermReference
ref)
Maybe Name -> (Name -> Maybe ()) -> Maybe ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName HashQualified Name
hqName) \Name
name ->
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Symbol -> Set Symbol -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember (Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Name
name) Set Symbol
excludeNames)
(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Maybe
(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall a. a -> Maybe a
Just (HashQualified Name
hqName, TermReference
ref, DisplayObject (Type Symbol Ann) (Term Symbol Ann)
dt)
)
[(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
-> ([(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
-> [(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))])
-> [(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
forall a b. a -> (a -> b) -> b
& ((HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> (HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Ordering)
-> [(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
-> [(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (\(HashQualified Name
n0, TermReference
_, DisplayObject (Type Symbol Ann) (Term Symbol Ann)
_) (HashQualified Name
n1, TermReference
_, DisplayObject (Type Symbol Ann) (Term Symbol Ann)
_) -> HashQualified Name -> HashQualified Name -> Ordering
forall n. Alphabetical n => n -> n -> Ordering
Name.compareAlphabetical HashQualified Name
n0 HashQualified Name
n1)
[(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
-> ([(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
-> [Pretty (SyntaxText' TermReference)])
-> [Pretty (SyntaxText' TermReference)]
forall a b. a -> (a -> b) -> b
& ((HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Pretty (SyntaxText' TermReference))
-> [(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
-> [Pretty (SyntaxText' TermReference)]
forall a b. (a -> b) -> [a] -> [b]
map (\(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))
t -> PrettyPrintEnvDecl
-> Bool
-> Bool
-> (HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Pretty (SyntaxText' TermReference)
Pretty.prettyTerm PrettyPrintEnvDecl
pped Bool
isSourceFile (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> (TermReference -> Maybe Bool) -> TermReference -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeReferenceId -> Bool) -> Maybe TypeReferenceId -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeReferenceId -> Bool
isTest (Maybe TypeReferenceId -> Maybe Bool)
-> (TermReference -> Maybe TypeReferenceId)
-> TermReference
-> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TermReference -> Maybe TypeReferenceId
Reference.toId (TermReference -> Bool) -> TermReference -> Bool
forall a b. (a -> b) -> a -> b
$ ((HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))
t (HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Getting
TermReference
(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))
TermReference
-> TermReference
forall s a. s -> Getting a s a -> a
^. Getting
TermReference
(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))
TermReference
forall s t a b. Field2 s t a b => Lens s t a b
Lens
(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))
(HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))
TermReference
TermReference
_2)) (HashQualified Name, TermReference,
DisplayObject (Type Symbol Ann) (Term Symbol Ann))
t)
where
unsuffixifiedPPE :: PrettyPrintEnv
unsuffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
pped