module Unison.Codebase.Editor.HandleInput.ShowDefinition
  ( handleShowDefinition,
    showDefinitions,
    renderToFile,
  )
where

import Control.Lens
import Control.Monad.Reader (ask)
import Control.Monad.State qualified as State
import Data.Foldable qualified as Foldable
import Data.List qualified as List
import Data.List.NonEmpty qualified as List (NonEmpty)
import Data.List.NonEmpty qualified as List.NonEmpty
import Data.List.NonEmpty qualified as NEL
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 (Codebase)
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.DisplayObject qualified as DisplayObject
import Unison.Codebase.Editor.Input (OutputLocation (..), RelativeToFold (..), ShowDefinitionScope (..))
import Unison.Codebase.Editor.Output
import Unison.DataDeclaration (Decl)
import Unison.HashQualified qualified as HQ
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment qualified as NameSegment
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.Reference (TermReference, TermReferenceId, TypeReference)
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.Syntax.TermPrinter qualified as TermPrinter
import Unison.Term (Term)
import Unison.Type (Type)
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

-- | Handle a @ShowDefinitionI@ input command, i.e. `view` or `edit`.
handleShowDefinition :: OutputLocation -> ShowDefinitionScope -> List.NonEmpty (HQ.HashQualified Name) -> Cli ()
handleShowDefinition :: OutputLocation
-> ShowDefinitionScope -> NonEmpty (HashQualified Name) -> Cli ()
handleShowDefinition OutputLocation
outputLoc ShowDefinitionScope
showDefinitionScope NonEmpty (HashQualified Name)
originalQuery = do
  env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask

  let originalQuerySet :: Set (HQ.HashQualified Name)
      originalQuerySet =
        [HashQualified Name] -> Set (HashQualified Name)
forall a. Ord a => [a] -> Set a
Set.fromList (NonEmpty (HashQualified Name) -> [HashQualified Name]
forall a. NonEmpty a -> [a]
List.NonEmpty.toList NonEmpty (HashQualified Name)
originalQuery)

  -- Take the user's original query, de-dupe (unlikely that they repeated something), and maybe add docs per above.
  let query :: Set (HQ.HashQualified Name)
      query =
        (Set (HashQualified Name)
 -> HashQualified Name -> Set (HashQualified Name))
-> Set (HashQualified Name)
-> NonEmpty (HashQualified Name)
-> Set (HashQualified Name)
forall b a. (b -> a -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl'
          ( \Set (HashQualified Name)
acc HashQualified Name
hqName ->
              Set (HashQualified Name)
acc
                Set (HashQualified Name)
-> (Set (HashQualified Name) -> Set (HashQualified Name))
-> Set (HashQualified Name)
forall a b. a -> (a -> b) -> b
& HashQualified Name
-> Set (HashQualified Name) -> Set (HashQualified Name)
forall a. Ord a => a -> Set a -> Set a
Set.insert HashQualified Name
hqName
                Set (HashQualified Name)
-> (Set (HashQualified Name) -> Set (HashQualified Name))
-> Set (HashQualified Name)
forall a b. a -> (a -> b) -> b
& case HashQualified Name
hqName of
                  HQ.NameOnly Name
name
                    | Name -> NameSegment
Name.lastSegment Name
name NameSegment -> NameSegment -> Bool
forall a. Eq a => a -> a -> Bool
/= NameSegment
NameSegment.docSegment ->
                        HashQualified Name
-> Set (HashQualified Name) -> Set (HashQualified Name)
forall a. Ord a => a -> Set a -> Set a
Set.insert (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly (Name -> NameSegment -> Name
Name.snoc Name
name NameSegment
NameSegment.docSegment))
                  HashQualified Name
_ -> Set (HashQualified Name) -> Set (HashQualified Name)
forall a. a -> a
id
          )
          Set (HashQualified Name)
forall a. Set a
Set.empty
          NonEmpty (HashQualified Name)
originalQuery

  let hasAbsoluteQuery = (HashQualified Name -> Bool) -> Set (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) Set (HashQualified Name)
query
  (names, unbiasedPPED) <- case (hasAbsoluteQuery, showDefinitionScope) of
    -- TODO: We should instead print each definition using the names from its project-branch root.
    (Bool
True, ShowDefinitionScope
_) -> do
      root <- Cli (Branch IO)
Cli.getCurrentProjectRoot
      let root0 = Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
root
      let names = Names -> Names
Names.makeAbsolute (Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
root0)
      let pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
suffixify Names
names)
      pure (names, pped)
    (Bool
_, ShowDefinitionScope
ShowDefinitionGlobal) -> do
      -- TODO: Maybe rewrite to be properly global
      root <- Cli (Branch IO)
Cli.getCurrentProjectRoot
      let root0 = Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
root
      let 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 = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
suffixify Names
names)
      pure (names, pped)
    (Bool
_, ShowDefinitionScope
ShowDefinitionLocal) -> do
      currentNames <- Cli Names
Cli.currentNames
      let pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
currentNames) (Names -> Suffixifier
suffixify Names
currentNames)
      pure (currentNames, pped)
  let 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 (Set (HashQualified Name) -> [HashQualified Name]
forall a. Set a -> [a]
Set.toList Set (HashQualified Name)
query)) PrettyPrintEnvDecl
unbiasedPPED
  Backend.DefinitionResults terms types misses0 <- do
    let nameSearch = Int -> Names -> NameSearch Transaction
forall (m :: * -> *). Applicative m => Int -> Names -> NameSearch m
NameSearch.makeNameSearch Int
10 Names
names
    Cli.runTransaction $
      Backend.definitionsByName
        env.codebase
        nameSearch
        includeCycles
        Names.IncludeSuffixes
        query
  -- Removed missed docs that the user didn't ask for from `misses`
  let misses =
        -- Unlikely that both original query list and misses list are both very long, but make a set out of original
        -- query anyway, to replace pathological O(n^2) with O(n log n)
        (HashQualified Name -> Bool)
-> [HashQualified Name] -> [HashQualified Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (HashQualified Name -> Set (HashQualified Name) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set (HashQualified Name)
originalQuerySet) [HashQualified Name]
misses0
  showDefinitions outputLoc (`Set.member` originalQuerySet) pped terms types 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

    -- `view`: don't include cycles; `edit`: include cycles
    includeCycles :: IncludeCycles
includeCycles =
      case OutputLocation
outputLoc of
        OutputLocation
ConsoleLocation -> IncludeCycles
Backend.DontIncludeCycles
        FileLocation FilePath
_ RelativeToFold
_ -> IncludeCycles
Backend.IncludeCycles
        LatestFileLocation RelativeToFold
_ -> IncludeCycles
Backend.IncludeCycles

-- | Show the provided definitions to console or scratch file.
-- The caller is responsible for ensuring that the definitions include cycles if that's
-- the desired behavior.
showDefinitions ::
  OutputLocation ->
  (HQ.HashQualified Name -> Bool) ->
  PPED.PrettyPrintEnvDecl ->
  Map TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)) ->
  Map TypeReference (DisplayObject () (Decl Symbol Ann)) ->
  [HQ.HashQualified Name] ->
  Cli ()
showDefinitions :: OutputLocation
-> (HashQualified Name -> Bool)
-> PrettyPrintEnvDecl
-> Map
     TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map TermReference (DisplayObject () (Decl Symbol Ann))
-> [HashQualified Name]
-> Cli ()
showDefinitions OutputLocation
outputLoc HashQualified Name -> Bool
nameInOriginalQuery PrettyPrintEnvDecl
pped Map
  TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Map TermReference (DisplayObject () (Decl Symbol Ann))
types [HashQualified Name]
misses = do
  Cli.Env {codebase, writeSource} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  outputPath <- getOutputPath
  case 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 -> (HashQualified Name -> Bool)
-> PrettyPrintEnvDecl
-> Map
     TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map TermReference (DisplayObject () (Decl Symbol Ann))
-> Cli ()
renderToConsole HashQualified Name -> Bool
nameInOriginalQuery PrettyPrintEnvDecl
pped Map
  TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Map TermReference (DisplayObject () (Decl Symbol Ann))
types
    Just (FilePath
fp, RelativeToFold
relToFold) -> do
      mayTF <- 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
      numRendered <- renderToFile codebase nameInOriginalQuery writeSource mayTF fp relToFold pped terms types

      when (numRendered > 0) do
        -- We set latestFile to be programmatically generated, if we
        -- are viewing these definitions to a file - this will skip the
        -- next update for that file (which will happen immediately)
        #latestFile ?= (fp, True)
      Cli.respond $ LoadedDefinitionsToSourceFile fp numRendered

  when (not (null misses)) (Cli.respond (SearchTermsNotFound misses))
  where
    -- Get the file path to send the definition(s) to. `Nothing` means the terminal.
    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 <- Cli LoopState
forall s (m :: * -> *). MonadState s m => m s
State.get
          pure case loopState ^. #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 ::
  (HQ.HashQualified Name -> Bool) ->
  PPED.PrettyPrintEnvDecl ->
  Bool ->
  (TermReferenceId -> Bool) ->
  Map TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)) ->
  Map TypeReference (DisplayObject () (Decl Symbol Ann)) ->
  Defns (Set Symbol) (Set Symbol) ->
  -- Result is Nothing if nothing was rendered
  Maybe (Pretty Pretty.ColorText, Int)
renderCodePretty :: (HashQualified Name -> Bool)
-> PrettyPrintEnvDecl
-> Bool
-> (TermReferenceId -> Bool)
-> Map
     TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map TermReference (DisplayObject () (Decl Symbol Ann))
-> Defns (Set Symbol) (Set Symbol)
-> Maybe (Pretty ColorText, Int)
renderCodePretty HashQualified Name -> Bool
nameInOriginalQuery PrettyPrintEnvDecl
pped Bool
isSourceFile TermReferenceId -> 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 =
  let -- Associate each term and type with their best unsuffixified name
      namedTerms :: Map (HQ.HashQualified Name) (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
      namedTerms :: Map
  (HashQualified Name)
  (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
namedTerms =
        PrettyPrintEnv
-> Set Symbol
-> Map
     TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map
     (HashQualified Name)
     (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall term.
PrettyPrintEnv
-> Set Symbol
-> Map TermReference term
-> Map (HashQualified Name) (TermReference, term)
nameTerms PrettyPrintEnvDecl
pped.unsuffixifiedPPE Defns (Set Symbol) (Set Symbol)
excludeNames.terms Map
  TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms

      namedTypes :: Map (HQ.HashQualified Name) (TypeReference, DisplayObject () (Decl Symbol Ann))
      namedTypes :: Map
  (HashQualified Name)
  (TermReference, DisplayObject () (Decl Symbol Ann))
namedTypes =
        PrettyPrintEnv
-> Set Symbol
-> Map TermReference (DisplayObject () (Decl Symbol Ann))
-> Map
     (HashQualified Name)
     (TermReference, DisplayObject () (Decl Symbol Ann))
forall term.
PrettyPrintEnv
-> Set Symbol
-> Map TermReference term
-> Map (HashQualified Name) (TermReference, term)
nameTypes PrettyPrintEnvDecl
pped.unsuffixifiedPPE Defns (Set Symbol) (Set Symbol)
excludeNames.types Map TermReference (DisplayObject () (Decl Symbol Ann))
types

      -- Partition those into two groups: those that end in a .doc segment, and those that don't
      -- Note that the doc-named terms aren't necessarily docs (though they they likely all are)
      docNamedTerms :: Map (HQ.HashQualified Name) (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
      notDocNamedTerms :: Map (HQ.HashQualified Name) (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
      (Map
  (HashQualified Name)
  (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
docNamedTerms, Map
  (HashQualified Name)
  (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
notDocNamedTerms) =
        (HashQualified Name
 -> (TermReference,
     DisplayObject (Type Symbol Ann) (Term Symbol Ann))
 -> Bool)
-> Map
     (HashQualified Name)
     (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> (Map
      (HashQualified Name)
      (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
    Map
      (HashQualified Name)
      (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partitionWithKey
          ( \HashQualified Name
hqName (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
_ ->
              case HashQualified Name
hqName of
                HQ.NameOnly Name
name -> Name -> NameSegment
Name.lastSegment Name
name NameSegment -> NameSegment -> Bool
forall a. Eq a => a -> a -> Bool
== NameSegment
NameSegment.docSegment
                HashQualified Name
_ -> Bool
False
          )
          Map
  (HashQualified Name)
  (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
namedTerms

      -- Define a helper that resolves a name like `foo.bar` to its rendered doc at `foo.bar.doc` (if there is one)
      lookupDocForName :: HQ.HashQualified Name -> Maybe (Pretty SyntaxText)
      lookupDocForName :: HashQualified Name -> Maybe (Pretty SyntaxText)
lookupDocForName HashQualified Name
hqName = do
        name <- HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.asNameOnly HashQualified Name
hqName
        (_, DisplayObject.UserObject docTerm) <-
          Map.lookup (HQ.NameOnly (Name.snoc name NameSegment.docSegment)) docNamedTerms
        TermPrinter.prettyDoc2 pped.suffixifiedPPE docTerm

      -- For each of the not-doc terms, e.g. foo.bar, pair with its doc, i.e. foo.bar.doc (if it's there)
      termsWithMaybeDocs ::
        Map
          (HQ.HashQualified Name)
          ( (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
            Maybe (Pretty SyntaxText)
          )
      termsWithMaybeDocs :: Map
  (HashQualified Name)
  ((TermReference,
    DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
   Maybe (Pretty SyntaxText))
termsWithMaybeDocs =
        Map
  (HashQualified Name)
  (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
notDocNamedTerms Map
  (HashQualified Name)
  (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> (Map
      (HashQualified Name)
      (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
    -> Map
         (HashQualified Name)
         ((TermReference,
           DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
          Maybe (Pretty SyntaxText)))
-> Map
     (HashQualified Name)
     ((TermReference,
       DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
      Maybe (Pretty SyntaxText))
forall a b. a -> (a -> b) -> b
& (HashQualified Name
 -> (TermReference,
     DisplayObject (Type Symbol Ann) (Term Symbol Ann))
 -> ((TermReference,
      DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
     Maybe (Pretty SyntaxText)))
-> Map
     (HashQualified Name)
     (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map
     (HashQualified Name)
     ((TermReference,
       DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
      Maybe (Pretty SyntaxText))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey \HashQualified Name
name (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
term ->
          ((TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
term, HashQualified Name -> Maybe (Pretty SyntaxText)
lookupDocForName HashQualified Name
name)

      -- Same for types - pair with their docs as well
      typesWithMaybeDocs ::
        Map
          (HQ.HashQualified Name)
          ( (TypeReference, DisplayObject () (Decl Symbol Ann)),
            Maybe (Pretty SyntaxText)
          )
      typesWithMaybeDocs :: Map
  (HashQualified Name)
  ((TermReference, DisplayObject () (Decl Symbol Ann)),
   Maybe (Pretty SyntaxText))
typesWithMaybeDocs =
        Map
  (HashQualified Name)
  (TermReference, DisplayObject () (Decl Symbol Ann))
namedTypes Map
  (HashQualified Name)
  (TermReference, DisplayObject () (Decl Symbol Ann))
-> (Map
      (HashQualified Name)
      (TermReference, DisplayObject () (Decl Symbol Ann))
    -> Map
         (HashQualified Name)
         ((TermReference, DisplayObject () (Decl Symbol Ann)),
          Maybe (Pretty SyntaxText)))
-> Map
     (HashQualified Name)
     ((TermReference, DisplayObject () (Decl Symbol Ann)),
      Maybe (Pretty SyntaxText))
forall a b. a -> (a -> b) -> b
& (HashQualified Name
 -> (TermReference, DisplayObject () (Decl Symbol Ann))
 -> ((TermReference, DisplayObject () (Decl Symbol Ann)),
     Maybe (Pretty SyntaxText)))
-> Map
     (HashQualified Name)
     (TermReference, DisplayObject () (Decl Symbol Ann))
-> Map
     (HashQualified Name)
     ((TermReference, DisplayObject () (Decl Symbol Ann)),
      Maybe (Pretty SyntaxText))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey \HashQualified Name
name (TermReference, DisplayObject () (Decl Symbol Ann))
typ ->
          ((TermReference, DisplayObject () (Decl Symbol Ann))
typ, HashQualified Name -> Maybe (Pretty SyntaxText)
lookupDocForName HashQualified Name
name)

      -- Now we can identify all of the doc-named things that didn't get paired up with a type or term. Very commonly,
      -- these will be due to the user simply having asked for the doc of something but not its term, e.g.
      -- `edit foo.doc`. We might also have doc-named things that just aren't docs.
      docNamedTermsWithNoAssociatedDefinition ::
        Map (HQ.HashQualified Name) (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
      docNamedTermsWithNoAssociatedDefinition :: Map
  (HashQualified Name)
  (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
docNamedTermsWithNoAssociatedDefinition =
        let namesOfDocsAssociatedWithDefns :: Map (HQ.HashQualified Name) (defn, Maybe doc) -> Set (HQ.HashQualified Name)
            namesOfDocsAssociatedWithDefns :: forall defn doc.
Map (HashQualified Name) (defn, Maybe doc)
-> Set (HashQualified Name)
namesOfDocsAssociatedWithDefns =
              (Set (HashQualified Name)
 -> HashQualified Name
 -> (defn, Maybe doc)
 -> Set (HashQualified Name))
-> Set (HashQualified Name)
-> Map (HashQualified Name) (defn, Maybe doc)
-> Set (HashQualified Name)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey'
                ( \Set (HashQualified Name)
acc HashQualified Name
name -> \case
                    (defn
_, Just doc
_) -> HashQualified Name
-> Set (HashQualified Name) -> Set (HashQualified Name)
forall a. Ord a => a -> Set a -> Set a
Set.insert ((Name -> NameSegment -> Name
`Name.snoc` NameSegment
NameSegment.docSegment) (Name -> Name) -> HashQualified Name -> HashQualified Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashQualified Name
name) Set (HashQualified Name)
acc
                    (defn, Maybe doc)
_ -> Set (HashQualified Name)
acc
                )
                Set (HashQualified Name)
forall a. Set a
Set.empty
         in Map
  (HashQualified Name)
  (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Set (HashQualified Name)
-> Map
     (HashQualified Name)
     (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.withoutKeys
              Map
  (HashQualified Name)
  (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
docNamedTerms
              ( Set (HashQualified Name)
-> Set (HashQualified Name) -> Set (HashQualified Name)
forall a. Ord a => Set a -> Set a -> Set a
Set.union
                  (Map
  (HashQualified Name)
  ((TermReference,
    DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
   Maybe (Pretty SyntaxText))
-> Set (HashQualified Name)
forall defn doc.
Map (HashQualified Name) (defn, Maybe doc)
-> Set (HashQualified Name)
namesOfDocsAssociatedWithDefns Map
  (HashQualified Name)
  ((TermReference,
    DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
   Maybe (Pretty SyntaxText))
termsWithMaybeDocs)
                  (Map
  (HashQualified Name)
  ((TermReference, DisplayObject () (Decl Symbol Ann)),
   Maybe (Pretty SyntaxText))
-> Set (HashQualified Name)
forall defn doc.
Map (HashQualified Name) (defn, Maybe doc)
-> Set (HashQualified Name)
namesOfDocsAssociatedWithDefns Map
  (HashQualified Name)
  ((TermReference, DisplayObject () (Decl Symbol Ann)),
   Maybe (Pretty SyntaxText))
typesWithMaybeDocs)
              )

      -- And now we can add those docs back into `termsWithTheirDocs`, themselves without docs of course
      --
      -- Here's also where we end up using our magic "should include this" predicate from the sky. Here's the
      -- motivation, by example:
      --
      -- 1. The user has `lib.base.List.sort` and `List.sort.doc` (you might think that's nuts but we have a transcript
      --    that does this!)
      -- 2. The user types `view List.sort`
      -- 3. This gets auto-expanded to `view List.sort List.sort.doc`
      -- 3. We therefore find `base.List.sort` and `List.sort.doc`
      --
      -- In this case, we have a doc with no associated definition (`List.sort.doc`), but the user didn't ask for it.
      -- So, we probably shouldn't show it. This is also highlighting a potential issue with this "add .doc to
      -- everything the user asked for" idea for this implementation. Perhaps instead we should do the normal query
      -- the user asked for, and then chase down those things' docs in a follow-up.
      termsWithMaybeDocs1 ::
        Map
          (HQ.HashQualified Name)
          ( (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
            Maybe (Pretty SyntaxText)
          )
      termsWithMaybeDocs1 :: Map
  (HashQualified Name)
  ((TermReference,
    DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
   Maybe (Pretty SyntaxText))
termsWithMaybeDocs1 =
        Map
  (HashQualified Name)
  (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
docNamedTermsWithNoAssociatedDefinition
          Map
  (HashQualified Name)
  (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> (Map
      (HashQualified Name)
      (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
    -> Map
         (HashQualified Name)
         (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
-> Map
     (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))
 -> Bool)
-> Map
     (HashQualified Name)
     (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map
     (HashQualified Name)
     (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\HashQualified Name
name (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
_ -> HashQualified Name -> Bool
nameInOriginalQuery HashQualified Name
name)
          Map
  (HashQualified Name)
  (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> (Map
      (HashQualified Name)
      (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
    -> Map
         (HashQualified Name)
         ((TermReference,
           DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
          Maybe (Pretty SyntaxText)))
-> Map
     (HashQualified Name)
     ((TermReference,
       DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
      Maybe (Pretty SyntaxText))
forall a b. a -> (a -> b) -> b
& ((TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
 -> ((TermReference,
      DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
     Maybe (Pretty SyntaxText)))
-> Map
     (HashQualified Name)
     (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map
     (HashQualified Name)
     ((TermReference,
       DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
      Maybe (Pretty SyntaxText))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (,Maybe (Pretty SyntaxText)
forall a. Maybe a
Nothing)
          Map
  (HashQualified Name)
  ((TermReference,
    DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
   Maybe (Pretty SyntaxText))
-> (Map
      (HashQualified Name)
      ((TermReference,
        DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
       Maybe (Pretty SyntaxText))
    -> Map
         (HashQualified Name)
         ((TermReference,
           DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
          Maybe (Pretty SyntaxText)))
-> Map
     (HashQualified Name)
     ((TermReference,
       DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
      Maybe (Pretty SyntaxText))
forall a b. a -> (a -> b) -> b
& Map
  (HashQualified Name)
  ((TermReference,
    DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
   Maybe (Pretty SyntaxText))
-> Map
     (HashQualified Name)
     ((TermReference,
       DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
      Maybe (Pretty SyntaxText))
-> Map
     (HashQualified Name)
     ((TermReference,
       DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
      Maybe (Pretty SyntaxText))
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map
  (HashQualified Name)
  ((TermReference,
    DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
   Maybe (Pretty SyntaxText))
termsWithMaybeDocs

      prettyTypes :: [Pretty SyntaxText]
      prettyTypes :: [Pretty SyntaxText]
prettyTypes =
        Map
  (HashQualified Name)
  ((TermReference, DisplayObject () (Decl Symbol Ann)),
   Maybe (Pretty SyntaxText))
typesWithMaybeDocs
          Map
  (HashQualified Name)
  ((TermReference, DisplayObject () (Decl Symbol Ann)),
   Maybe (Pretty SyntaxText))
-> (Map
      (HashQualified Name)
      ((TermReference, DisplayObject () (Decl Symbol Ann)),
       Maybe (Pretty SyntaxText))
    -> [(HashQualified Name,
         ((TermReference, DisplayObject () (Decl Symbol Ann)),
          Maybe (Pretty SyntaxText)))])
-> [(HashQualified Name,
     ((TermReference, DisplayObject () (Decl Symbol Ann)),
      Maybe (Pretty SyntaxText)))]
forall a b. a -> (a -> b) -> b
& Map
  (HashQualified Name)
  ((TermReference, DisplayObject () (Decl Symbol Ann)),
   Maybe (Pretty SyntaxText))
-> [(HashQualified Name,
     ((TermReference, DisplayObject () (Decl Symbol Ann)),
      Maybe (Pretty SyntaxText)))]
forall k a. Map k a -> [(k, a)]
Map.toList
          [(HashQualified Name,
  ((TermReference, DisplayObject () (Decl Symbol Ann)),
   Maybe (Pretty SyntaxText)))]
-> ([(HashQualified Name,
      ((TermReference, DisplayObject () (Decl Symbol Ann)),
       Maybe (Pretty SyntaxText)))]
    -> [(HashQualified Name,
         ((TermReference, DisplayObject () (Decl Symbol Ann)),
          Maybe (Pretty SyntaxText)))])
-> [(HashQualified Name,
     ((TermReference, DisplayObject () (Decl Symbol Ann)),
      Maybe (Pretty SyntaxText)))]
forall a b. a -> (a -> b) -> b
& ((HashQualified Name,
  ((TermReference, DisplayObject () (Decl Symbol Ann)),
   Maybe (Pretty SyntaxText)))
 -> (HashQualified Name,
     ((TermReference, DisplayObject () (Decl Symbol Ann)),
      Maybe (Pretty SyntaxText)))
 -> Ordering)
-> [(HashQualified Name,
     ((TermReference, DisplayObject () (Decl Symbol Ann)),
      Maybe (Pretty SyntaxText)))]
-> [(HashQualified Name,
     ((TermReference, DisplayObject () (Decl Symbol Ann)),
      Maybe (Pretty SyntaxText)))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (\(HashQualified Name
n0, ((TermReference, DisplayObject () (Decl Symbol Ann)),
 Maybe (Pretty SyntaxText))
_) (HashQualified Name
n1, ((TermReference, DisplayObject () (Decl Symbol Ann)),
 Maybe (Pretty SyntaxText))
_) -> 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)),
   Maybe (Pretty SyntaxText)))]
-> ([(HashQualified Name,
      ((TermReference, DisplayObject () (Decl Symbol Ann)),
       Maybe (Pretty SyntaxText)))]
    -> [Pretty SyntaxText])
-> [Pretty SyntaxText]
forall a b. a -> (a -> b) -> b
& ((HashQualified Name,
  ((TermReference, DisplayObject () (Decl Symbol Ann)),
   Maybe (Pretty SyntaxText)))
 -> Pretty SyntaxText)
-> [(HashQualified Name,
     ((TermReference, DisplayObject () (Decl Symbol Ann)),
      Maybe (Pretty SyntaxText)))]
-> [Pretty SyntaxText]
forall a b. (a -> b) -> [a] -> [b]
map \(HashQualified Name
name, ((TermReference
ref, DisplayObject () (Decl Symbol Ann)
typ), Maybe (Pretty SyntaxText)
maybeDoc)) ->
            Pretty SyntaxText
-> (Pretty SyntaxText -> Pretty SyntaxText)
-> Maybe (Pretty SyntaxText)
-> Pretty SyntaxText
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Pretty SyntaxText
forall a. Monoid a => a
mempty (Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> Pretty SyntaxText
forall s. IsString s => Pretty s
Pretty.newline) Maybe (Pretty SyntaxText)
maybeDoc
              Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> PrettyPrintEnvDecl
-> (HashQualified Name, TermReference,
    DisplayObject () (Decl Symbol Ann))
-> Pretty SyntaxText
Pretty.prettyType PrettyPrintEnvDecl
pped (HashQualified Name
name, TermReference
ref, DisplayObject () (Decl Symbol Ann)
typ)

      prettyTerms :: [Pretty SyntaxText]
      prettyTerms :: [Pretty SyntaxText]
prettyTerms =
        Map
  (HashQualified Name)
  ((TermReference,
    DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
   Maybe (Pretty SyntaxText))
termsWithMaybeDocs1
          Map
  (HashQualified Name)
  ((TermReference,
    DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
   Maybe (Pretty SyntaxText))
-> (Map
      (HashQualified Name)
      ((TermReference,
        DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
       Maybe (Pretty SyntaxText))
    -> [(HashQualified Name,
         ((TermReference,
           DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
          Maybe (Pretty SyntaxText)))])
-> [(HashQualified Name,
     ((TermReference,
       DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
      Maybe (Pretty SyntaxText)))]
forall a b. a -> (a -> b) -> b
& Map
  (HashQualified Name)
  ((TermReference,
    DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
   Maybe (Pretty SyntaxText))
-> [(HashQualified Name,
     ((TermReference,
       DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
      Maybe (Pretty SyntaxText)))]
forall k a. Map k a -> [(k, a)]
Map.toList
          [(HashQualified Name,
  ((TermReference,
    DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
   Maybe (Pretty SyntaxText)))]
-> ([(HashQualified Name,
      ((TermReference,
        DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
       Maybe (Pretty SyntaxText)))]
    -> [(HashQualified Name,
         ((TermReference,
           DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
          Maybe (Pretty SyntaxText)))])
-> [(HashQualified Name,
     ((TermReference,
       DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
      Maybe (Pretty SyntaxText)))]
forall a b. a -> (a -> b) -> b
& ((HashQualified Name,
  ((TermReference,
    DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
   Maybe (Pretty SyntaxText)))
 -> (HashQualified Name,
     ((TermReference,
       DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
      Maybe (Pretty SyntaxText)))
 -> Ordering)
-> [(HashQualified Name,
     ((TermReference,
       DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
      Maybe (Pretty SyntaxText)))]
-> [(HashQualified Name,
     ((TermReference,
       DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
      Maybe (Pretty SyntaxText)))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (\(HashQualified Name
n0, ((TermReference,
  DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
 Maybe (Pretty SyntaxText))
_) (HashQualified Name
n1, ((TermReference,
  DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
 Maybe (Pretty SyntaxText))
_) -> 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)),
   Maybe (Pretty SyntaxText)))]
-> ([(HashQualified Name,
      ((TermReference,
        DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
       Maybe (Pretty SyntaxText)))]
    -> [Pretty SyntaxText])
-> [Pretty SyntaxText]
forall a b. a -> (a -> b) -> b
& ((HashQualified Name,
  ((TermReference,
    DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
   Maybe (Pretty SyntaxText)))
 -> Pretty SyntaxText)
-> [(HashQualified Name,
     ((TermReference,
       DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
      Maybe (Pretty SyntaxText)))]
-> [Pretty SyntaxText]
forall a b. (a -> b) -> [a] -> [b]
map \(HashQualified Name
name, ((TermReference
ref, DisplayObject (Type Symbol Ann) (Term Symbol Ann)
term), Maybe (Pretty SyntaxText)
maybeDoc)) ->
            Pretty SyntaxText
-> (Pretty SyntaxText -> Pretty SyntaxText)
-> Maybe (Pretty SyntaxText)
-> Pretty SyntaxText
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Pretty SyntaxText
forall a. Monoid a => a
mempty (Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> Pretty SyntaxText
forall s. IsString s => Pretty s
Pretty.newline) Maybe (Pretty SyntaxText)
maybeDoc
              Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> PrettyPrintEnvDecl
-> Bool
-> Bool
-> (HashQualified Name, TermReference,
    DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Pretty SyntaxText
Pretty.prettyTerm PrettyPrintEnvDecl
pped Bool
isSourceFile (Bool -> (TermReferenceId -> Bool) -> Maybe TermReferenceId -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False TermReferenceId -> Bool
isTest (TermReference -> Maybe TermReferenceId
Reference.toId TermReference
ref)) (HashQualified Name
name, TermReference
ref, DisplayObject (Type Symbol Ann) (Term Symbol Ann)
term)
   in [Pretty SyntaxText] -> Maybe (NonEmpty (Pretty SyntaxText))
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty ([Pretty SyntaxText]
prettyTypes [Pretty SyntaxText] -> [Pretty SyntaxText] -> [Pretty SyntaxText]
forall a. [a] -> [a] -> [a]
++ [Pretty SyntaxText]
prettyTerms)
        Maybe (NonEmpty (Pretty SyntaxText))
-> (Pretty ColorText, Int) -> Maybe (Pretty ColorText, Int)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Pretty SyntaxText -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
Pretty.syntaxToColor (Pretty SyntaxText -> [Pretty SyntaxText] -> Pretty SyntaxText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
Pretty.sep Pretty SyntaxText
"\n\n" ([Pretty SyntaxText]
prettyTypes [Pretty SyntaxText] -> [Pretty SyntaxText] -> [Pretty SyntaxText]
forall a. [a] -> [a] -> [a]
++ [Pretty SyntaxText]
prettyTerms)), [Pretty SyntaxText] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pretty SyntaxText]
prettyTerms Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Pretty SyntaxText] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pretty SyntaxText]
prettyTypes)

renderToConsole ::
  (HQ.HashQualified Name -> Bool) ->
  PPED.PrettyPrintEnvDecl ->
  Map TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)) ->
  Map TypeReference (DisplayObject () (Decl Symbol Ann)) ->
  Cli ()
renderToConsole :: (HashQualified Name -> Bool)
-> PrettyPrintEnvDecl
-> Map
     TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map TermReference (DisplayObject () (Decl Symbol Ann))
-> Cli ()
renderToConsole HashQualified Name -> Bool
nameInOriginalQuery PrettyPrintEnvDecl
pped Map
  TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Map TermReference (DisplayObject () (Decl Symbol Ann))
types = do
  -- If we're writing to console we don't add test-watch syntax
  let isTest :: p -> Bool
isTest p
_ = Bool
False
  let isSourceFile :: Bool
isSourceFile = Bool
False
  -- No filepath, render code to console.
  let renderedCodePretty :: Maybe (Pretty ColorText)
renderedCodePretty =
        (Pretty ColorText, Int) -> Pretty ColorText
forall a b. (a, b) -> a
fst
          ((Pretty ColorText, Int) -> Pretty ColorText)
-> Maybe (Pretty ColorText, Int) -> Maybe (Pretty ColorText)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HashQualified Name -> Bool)
-> PrettyPrintEnvDecl
-> Bool
-> (TermReferenceId -> Bool)
-> Map
     TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map TermReference (DisplayObject () (Decl Symbol Ann))
-> Defns (Set Symbol) (Set Symbol)
-> Maybe (Pretty ColorText, Int)
renderCodePretty
            HashQualified Name -> Bool
nameInOriginalQuery
            PrettyPrintEnvDecl
pped
            Bool
isSourceFile
            TermReferenceId -> 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 -> Maybe (Pretty ColorText) -> Pretty ColorText
forall a. a -> Maybe a -> a
fromMaybe Pretty ColorText
forall a. Monoid a => a
mempty Maybe (Pretty ColorText)
renderedCodePretty)

-- | Render definitions to a file.
-- Returns whether anything was rendered.
-- Definitions can be obtained via definitionsByName
renderToFile ::
  (MonadIO m, Monoid a) =>
  Codebase IO Symbol a ->
  (HQ.HashQualified Name -> Bool) ->
  (Text -> Text -> Bool -> IO ()) ->
  Maybe (Either (UnisonFile.UnisonFile Symbol Ann) (UnisonFile.TypecheckedUnisonFile Symbol a)) ->
  FilePath ->
  RelativeToFold ->
  PPED.PrettyPrintEnvDecl ->
  Map TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)) ->
  Map TypeReference (DisplayObject () (Decl Symbol Ann)) ->
  (m Int)
renderToFile :: forall (m :: * -> *) a.
(MonadIO m, Monoid a) =>
Codebase IO Symbol a
-> (HashQualified Name -> Bool)
-> (SourceName -> SourceName -> Bool -> IO ())
-> Maybe
     (Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol a))
-> FilePath
-> RelativeToFold
-> PrettyPrintEnvDecl
-> Map
     TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map TermReference (DisplayObject () (Decl Symbol Ann))
-> m Int
renderToFile Codebase IO Symbol a
codebase HashQualified Name -> Bool
nameInOriginalQuery SourceName -> SourceName -> Bool -> IO ()
writeSource Maybe
  (Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol a))
mayTF FilePath
fp RelativeToFold
relToFold PrettyPrintEnvDecl
pped Map
  TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Map TermReference (DisplayObject () (Decl Symbol Ann))
types = do
  -- Of all the names we were asked to show, if this is a `WithinFold` showing, then exclude the ones that are
  -- already bound in the file
  let excludeNames :: Defns (Set Symbol) (Set Symbol)
excludeNames =
        case RelativeToFold
relToFold of
          RelativeToFold
AboveFold -> 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 ->
            case Maybe
  (Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol a))
mayTF of
              Maybe
  (Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol a))
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 (TermReferenceId, 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 (TermReferenceId, EffectDeclaration Symbol Ann)
-> Set Symbol
forall k a. Map k a -> Set k
Map.keysSet UnisonFile Symbol Ann
unisonFile.effectDeclarationsId
                 in Defns
                      { terms :: Set Symbol
terms = Set Symbol
boundTermNames Set Symbol -> Set Symbol -> Set Symbol
forall a. Semigroup a => a -> a -> a
<> Set Symbol
boundTestWatchNames,
                        types :: 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 a
typecheckedUnisonFile) -> TypecheckedUnisonFile Symbol a -> Defns (Set Symbol) (Set Symbol)
forall v a. Ord v => TypecheckedUnisonFile v a -> DefnsF Set v v
UnisonFile.namespaceBindings TypecheckedUnisonFile Symbol a
typecheckedUnisonFile

  -- We build an 'isTest' check to prepend "test>" to tests in a scratch file.
  testRefs <-
    IO (Set TermReferenceId) -> m (Set TermReferenceId)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Set TermReferenceId) -> m (Set TermReferenceId))
-> IO (Set TermReferenceId) -> m (Set TermReferenceId)
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol a
-> Transaction (Set TermReferenceId) -> IO (Set TermReferenceId)
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol a
codebase do
      Codebase IO Symbol a
-> Type Symbol a
-> Set TermReferenceId
-> Transaction (Set TermReferenceId)
forall v (m :: * -> *) a.
Var v =>
Codebase m v a
-> Type v a
-> Set TermReferenceId
-> Transaction (Set TermReferenceId)
Codebase.filterTermsByReferenceIdHavingType
        Codebase IO Symbol a
codebase
        (a -> Type Symbol a
forall v a. Ord v => a -> Type v a
DD.testResultListType a
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 TermReferenceId)
-> Set TermReferenceId
forall a b. a -> (a -> b) -> b
& (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)
  let isTest TermReferenceId
r = TermReferenceId -> Set TermReferenceId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TermReferenceId
r Set TermReferenceId
testRefs
  let isSourceFile = Bool
True
  let mayRenderedCodePretty = (HashQualified Name -> Bool)
-> PrettyPrintEnvDecl
-> Bool
-> (TermReferenceId -> Bool)
-> Map
     TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map TermReference (DisplayObject () (Decl Symbol Ann))
-> Defns (Set Symbol) (Set Symbol)
-> Maybe (Pretty ColorText, Int)
renderCodePretty HashQualified Name -> Bool
nameInOriginalQuery PrettyPrintEnvDecl
pped Bool
isSourceFile TermReferenceId -> 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
  case mayRenderedCodePretty of
    Just (Pretty ColorText
renderedCodePretty, Int
numRendered) -> do
      let (SourceName
renderedCodeText) = Width -> Pretty ColorText -> SourceName
Pretty.toPlain Width
80 Pretty ColorText
renderedCodePretty
      IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
        SourceName -> SourceName -> Bool -> IO ()
writeSource (FilePath -> SourceName
Text.pack FilePath
fp) SourceName
renderedCodeText case RelativeToFold
relToFold of
          RelativeToFold
AboveFold -> Bool
True
          RelativeToFold
WithinFold -> Bool
False
      Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
numRendered
    Maybe (Pretty ColorText, Int)
Nothing -> Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0

-- | `nameTerms ppe excludeNames terms` keys each term in `terms` by its best name in `ppe`, but terms whose best name
-- is in the set `exclude` are thrown away.
nameTerms ::
  PPE.PrettyPrintEnv ->
  Set Symbol ->
  Map TermReference term ->
  Map (HQ.HashQualified Name) (TermReference, term)
nameTerms :: forall term.
PrettyPrintEnv
-> Set Symbol
-> Map TermReference term
-> Map (HashQualified Name) (TermReference, term)
nameTerms PrettyPrintEnv
ppe =
  (TermReference -> HashQualified Name)
-> Set Symbol
-> Map TermReference term
-> Map (HashQualified Name) (TermReference, term)
forall defn ref.
(ref -> HashQualified Name)
-> Set Symbol
-> Map ref defn
-> Map (HashQualified Name) (ref, defn)
nameDefns (PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName PrettyPrintEnv
ppe (Referent -> HashQualified Name)
-> (TermReference -> Referent)
-> TermReference
-> HashQualified Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TermReference -> Referent
Referent.Ref)

-- | `nameTypes ppe excludeNames types` keys each type in `types` by its best name in `ppe`, but types whose best name
-- is in the set `exclude` are thrown away.
nameTypes ::
  PPE.PrettyPrintEnv ->
  Set Symbol ->
  Map TypeReference typ ->
  Map (HQ.HashQualified Name) (TypeReference, typ)
nameTypes :: forall term.
PrettyPrintEnv
-> Set Symbol
-> Map TermReference term
-> Map (HashQualified Name) (TermReference, term)
nameTypes PrettyPrintEnv
ppe =
  (TermReference -> HashQualified Name)
-> Set Symbol
-> Map TermReference typ
-> Map (HashQualified Name) (TermReference, typ)
forall defn ref.
(ref -> HashQualified Name)
-> Set Symbol
-> Map ref defn
-> Map (HashQualified Name) (ref, defn)
nameDefns (PrettyPrintEnv -> TermReference -> HashQualified Name
PPE.typeName PrettyPrintEnv
ppe)

nameDefns ::
  forall defn ref.
  (ref -> HQ.HashQualified Name) ->
  Set Symbol ->
  Map ref defn ->
  Map (HQ.HashQualified Name) (ref, defn)
nameDefns :: forall defn ref.
(ref -> HashQualified Name)
-> Set Symbol
-> Map ref defn
-> Map (HashQualified Name) (ref, defn)
nameDefns ref -> HashQualified Name
toName Set Symbol
exclude =
  (Map (HashQualified Name) (ref, defn)
 -> ref -> defn -> Map (HashQualified Name) (ref, defn))
-> Map (HashQualified Name) (ref, defn)
-> Map ref defn
-> Map (HashQualified Name) (ref, defn)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map (HashQualified Name) (ref, defn)
-> ref -> defn -> Map (HashQualified Name) (ref, defn)
f Map (HashQualified Name) (ref, defn)
forall k a. Map k a
Map.empty
  where
    f ::
      Map (HQ.HashQualified Name) (ref, defn) ->
      ref ->
      defn ->
      Map (HQ.HashQualified Name) (ref, defn)
    f :: Map (HashQualified Name) (ref, defn)
-> ref -> defn -> Map (HashQualified Name) (ref, defn)
f Map (HashQualified Name) (ref, defn)
acc ref
ref defn
term =
      case HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName HashQualified Name
hqName of
        Just Name
name | Symbol -> Set Symbol -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Name
name) Set Symbol
exclude -> Map (HashQualified Name) (ref, defn)
acc
        Maybe Name
_ -> HashQualified Name
-> (ref, defn)
-> Map (HashQualified Name) (ref, defn)
-> Map (HashQualified Name) (ref, defn)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert HashQualified Name
hqName (ref
ref, defn
term) Map (HashQualified Name) (ref, defn)
acc
      where
        hqName :: HashQualified Name
hqName =
          ref -> HashQualified Name
toName ref
ref