{-# LANGUAGE MagicHash #-}

-- | Small combinators that pretty-print small types in a canonical way for human consumption, such as hashes, file
-- paths, and project names.
module Unison.Cli.Pretty
  ( displayBranchHash,
    prettyAbsolute,
    prettyProjectPath,
    prettyBranchRelativePath,
    prettyBase32Hex#,
    prettyBase32Hex,
    prettyBranchId,
    prettyCausalHash,
    prettyDeclPair,
    prettyDeclTriple,
    prettyFilePath,
    prettyHash,
    prettyHash32,
    prettyHumanReadableTime,
    prettyLabeledDependencies,
    prettyPath,
    prettyPath',
    prettyMergeSource,
    prettyMergeSourceOrTarget,
    prettyProjectAndBranchName,
    prettyProjectBranchName,
    prettyProjectName,
    prettyProjectNameSlash,
    prettyNamespaceKey,
    prettyReadRemoteNamespace,
    prettyReadRemoteNamespaceWith,
    prettyRelative,
    prettyRemoteBranchInfo,
    prettyRepoInfo,
    prettySCH,
    prettySemver,
    prettySharePath,
    prettyShareURI,
    prettySlashProjectBranchName,
    prettyTerm,
    prettyTermName,
    prettyType,
    prettyTypeName,
    prettyTypeResultHeader',
    prettyTypeResultHeaderFull',
    prettyURI,
    prettyUnisonFile,
    prettyWhichBranchEmpty,
    prettyWriteRemoteNamespace,
    shareOrigin,
    unsafePrettyTermResultSigFull',
  )
where

import Control.Lens hiding (at)
import Control.Monad.Writer (Writer, runWriter)
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Time (UTCTime)
import Data.Time.Format.Human (HumanTimeLocale (..), defaultHumanTimeLocale, humanReadableTimeI18N')
import Network.URI (URI)
import Network.URI qualified as URI
import U.Codebase.HashTags (CausalHash (..))
import U.Codebase.Reference qualified as Reference
import U.Codebase.Sqlite.Project qualified as Sqlite
import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite
import U.Util.Base32Hex (Base32Hex)
import U.Util.Base32Hex qualified as Base32Hex
import Unison.Cli.MergeTypes (MergeSource (..), MergeSourceOrTarget (..))
import Unison.Cli.Share.Projects.Types qualified as Share
import Unison.Codebase.Editor.DisplayObject (DisplayObject (BuiltinObject, MissingObject, UserObject))
import Unison.Codebase.Editor.Input qualified as Input
import Unison.Codebase.Editor.Output
import Unison.Codebase.Editor.RemoteRepo
  ( ReadRemoteNamespace (..),
  )
import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.ProjectPath (ProjectPath)
import Unison.Codebase.ProjectPath qualified as PP
import Unison.Codebase.ShortCausalHash (ShortCausalHash)
import Unison.Codebase.ShortCausalHash qualified as SCH
import Unison.CommandLine.BranchRelativePath (BranchRelativePath)
import Unison.Core.Project (ProjectBranchName)
import Unison.DataDeclaration qualified as DD
import Unison.Debug qualified as Debug
import Unison.Hash qualified as Hash
import Unison.Hash32 (Hash32)
import Unison.Hash32 qualified as Hash32
import Unison.HashQualified qualified as HQ
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.LabeledDependency as LD
import Unison.Name (Name)
import Unison.NameSegment (NameSegment)
import Unison.NameSegment.Internal qualified as NameSegment
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnv.Util qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.Project (ProjectAndBranch (..), ProjectName, Semver (..))
import Unison.Reference (Reference)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Server.SearchResultPrime qualified as SR'
import Unison.ShortHash (ShortHash)
import Unison.Symbol (Symbol)
import Unison.Sync.Types qualified as Share
import Unison.Syntax.DeclPrinter (AccessorName)
import Unison.Syntax.DeclPrinter qualified as DeclPrinter
import Unison.Syntax.HashQualified qualified as HQ (unsafeFromVar)
import Unison.Syntax.Name qualified as Name (unsafeParseVar)
import Unison.Syntax.NamePrinter (SyntaxText, prettyHashQualified, styleHashQualified')
import Unison.Syntax.TermPrinter qualified as TermPrinter
import Unison.Syntax.TypePrinter qualified as TypePrinter
import Unison.Term (Term)
import Unison.Type (Type)
import Unison.UnisonFile qualified as UF
import Unison.UnisonFile.Names qualified as UF
import Unison.Util.Monoid qualified as Monoid
import Unison.Util.Pretty qualified as P
import Unison.Var (Var)
import Unison.Var qualified as Var
import Unison.WatchKind qualified as WK

type Pretty = P.Pretty P.ColorText

prettyURI :: URI -> Pretty
prettyURI :: URI -> Pretty ColorText
prettyURI = Pretty ColorText -> Pretty ColorText
P.bold (Pretty ColorText -> Pretty ColorText)
-> (URI -> Pretty ColorText) -> URI -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty ColorText -> Pretty ColorText
P.blue (Pretty ColorText -> Pretty ColorText)
-> (URI -> Pretty ColorText) -> URI -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Pretty ColorText
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown

prettyShareURI :: URI -> Pretty
prettyShareURI :: URI -> Pretty ColorText
prettyShareURI URI
host
  | ([Char] -> [Char]) -> URI -> [Char] -> [Char]
URI.uriToString [Char] -> [Char]
forall a. a -> a
id URI
host [Char]
"" [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"https://api.unison-lang.org" = Pretty ColorText -> Pretty ColorText
P.bold (Pretty ColorText -> Pretty ColorText
P.blue Pretty ColorText
"Unison Share")
  | Bool
otherwise = Pretty ColorText -> Pretty ColorText
P.bold (Pretty ColorText -> Pretty ColorText
P.blue (URI -> Pretty ColorText
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown URI
host))

prettyReadRemoteNamespace :: ReadRemoteNamespace Share.RemoteProjectBranch -> Pretty
prettyReadRemoteNamespace :: ReadRemoteNamespace RemoteProjectBranch -> Pretty ColorText
prettyReadRemoteNamespace =
  (RemoteProjectBranch -> Text)
-> ReadRemoteNamespace RemoteProjectBranch -> Pretty ColorText
forall a. (a -> Text) -> ReadRemoteNamespace a -> Pretty ColorText
prettyReadRemoteNamespaceWith \RemoteProjectBranch
remoteProjectBranch ->
    forall target source. From source target => source -> target
into @Text (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch (RemoteProjectBranch
remoteProjectBranch RemoteProjectBranch
-> Getting ProjectName RemoteProjectBranch ProjectName
-> ProjectName
forall s a. s -> Getting a s a -> a
^. Getting ProjectName RemoteProjectBranch ProjectName
#projectName) (RemoteProjectBranch
remoteProjectBranch RemoteProjectBranch
-> Getting ProjectBranchName RemoteProjectBranch ProjectBranchName
-> ProjectBranchName
forall s a. s -> Getting a s a -> a
^. Getting ProjectBranchName RemoteProjectBranch ProjectBranchName
#branchName))

prettyReadRemoteNamespaceWith :: (a -> Text) -> ReadRemoteNamespace a -> Pretty
prettyReadRemoteNamespaceWith :: forall a. (a -> Text) -> ReadRemoteNamespace a -> Pretty ColorText
prettyReadRemoteNamespaceWith a -> Text
printProject =
  Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
P.group (Pretty ColorText -> Pretty ColorText)
-> (ReadRemoteNamespace a -> Pretty ColorText)
-> ReadRemoteNamespace a
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty ColorText -> Pretty ColorText
P.blue (Pretty ColorText -> Pretty ColorText)
-> (ReadRemoteNamespace a -> Pretty ColorText)
-> ReadRemoteNamespace a
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty ColorText)
-> (ReadRemoteNamespace a -> Text)
-> ReadRemoteNamespace a
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> ReadRemoteNamespace a -> Text
forall a. (a -> Text) -> ReadRemoteNamespace a -> Text
RemoteRepo.printReadRemoteNamespace a -> Text
printProject

prettyWriteRemoteNamespace :: (ProjectAndBranch ProjectName ProjectBranchName) -> Pretty
prettyWriteRemoteNamespace :: ProjectAndBranch ProjectName ProjectBranchName -> Pretty ColorText
prettyWriteRemoteNamespace =
  Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
P.group (Pretty ColorText -> Pretty ColorText)
-> (ProjectAndBranch ProjectName ProjectBranchName
    -> Pretty ColorText)
-> ProjectAndBranch ProjectName ProjectBranchName
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty ColorText -> Pretty ColorText
P.blue (Pretty ColorText -> Pretty ColorText)
-> (ProjectAndBranch ProjectName ProjectBranchName
    -> Pretty ColorText)
-> ProjectAndBranch ProjectName ProjectBranchName
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty ColorText)
-> (ProjectAndBranch ProjectName ProjectBranchName -> Text)
-> ProjectAndBranch ProjectName ProjectBranchName
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectAndBranch ProjectName ProjectBranchName -> Text
RemoteRepo.printWriteRemoteNamespace

shareOrigin :: Text
shareOrigin :: Text
shareOrigin = Text
"https://share.unison-lang.org"

prettyRepoInfo :: Share.RepoInfo -> Pretty
prettyRepoInfo :: RepoInfo -> Pretty ColorText
prettyRepoInfo (Share.RepoInfo Text
repoInfo) =
  Pretty ColorText -> Pretty ColorText
P.blue (Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text Text
repoInfo)

prettySharePath :: Share.Path -> Pretty
prettySharePath :: Path -> Pretty ColorText
prettySharePath =
  Relative -> Pretty ColorText
prettyRelative
    (Relative -> Pretty ColorText)
-> (Path -> Relative) -> Path -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Relative
Path.Relative
    (Path -> Relative) -> (Path -> Path) -> Path -> Relative
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NameSegment] -> Path
Path.fromList
    ([NameSegment] -> Path) -> (Path -> [NameSegment]) -> Path -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @[Text] @[NameSegment]
    ([Text] -> [NameSegment])
-> (Path -> [Text]) -> Path -> [NameSegment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    (NonEmpty Text -> [Text])
-> (Path -> NonEmpty Text) -> Path -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> NonEmpty Text
Share.pathSegments

prettyFilePath :: FilePath -> Pretty
prettyFilePath :: [Char] -> Pretty ColorText
prettyFilePath [Char]
fp =
  Pretty ColorText -> Pretty ColorText
P.blue ([Char] -> Pretty ColorText
forall s. IsString s => [Char] -> Pretty s
P.string [Char]
fp)

prettyPath :: Path.Path -> Pretty
prettyPath :: Path -> Pretty ColorText
prettyPath Path
path =
  if Path
path Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
Path.empty
    then Pretty ColorText
"the current namespace"
    else Pretty ColorText -> Pretty ColorText
P.blue (Path -> Pretty ColorText
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown Path
path)

prettyPath' :: Path.Path' -> Pretty
prettyPath' :: Path' -> Pretty ColorText
prettyPath' Path'
p' =
  if Path' -> Bool
Path.isCurrentPath Path'
p'
    then Pretty ColorText
"the current namespace"
    else Pretty ColorText -> Pretty ColorText
P.blue (Path' -> Pretty ColorText
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown Path'
p')

prettyNamespaceKey :: Either ProjectPath (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch) -> Pretty
prettyNamespaceKey :: Either ProjectPath (ProjectAndBranch Project ProjectBranch)
-> Pretty ColorText
prettyNamespaceKey = \case
  Left ProjectPath
path -> ProjectPath -> Pretty ColorText
prettyProjectPath ProjectPath
path
  Right (ProjectAndBranch Project
project ProjectBranch
branch) ->
    ProjectAndBranch ProjectName ProjectBranchName -> Pretty ColorText
prettyProjectAndBranchName (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch (Project
project Project -> Getting ProjectName Project ProjectName -> ProjectName
forall s a. s -> Getting a s a -> a
^. Getting ProjectName Project ProjectName
#name) (ProjectBranch
branch ProjectBranch
-> Getting ProjectBranchName ProjectBranch ProjectBranchName
-> ProjectBranchName
forall s a. s -> Getting a s a -> a
^. Getting ProjectBranchName ProjectBranch ProjectBranchName
#name))

prettyBranchId :: Input.AbsBranchId -> Pretty
prettyBranchId :: AbsBranchId -> Pretty ColorText
prettyBranchId = \case
  Input.BranchAtSCH ShortCausalHash
sch -> ShortCausalHash -> Pretty ColorText
forall s. IsString s => ShortCausalHash -> Pretty s
prettySCH ShortCausalHash
sch
  Input.BranchAtPath Absolute
absPath -> Absolute -> Pretty ColorText
prettyAbsolute (Absolute -> Pretty ColorText) -> Absolute -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Absolute
absPath
  Input.BranchAtProjectPath ProjectPath
pp -> ProjectPath -> Pretty ColorText
prettyProjectPath ProjectPath
pp

prettyRelative :: Path.Relative -> Pretty
prettyRelative :: Relative -> Pretty ColorText
prettyRelative = Pretty ColorText -> Pretty ColorText
P.blue (Pretty ColorText -> Pretty ColorText)
-> (Relative -> Pretty ColorText) -> Relative -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relative -> Pretty ColorText
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown

prettyAbsolute :: Path.Absolute -> Pretty
prettyAbsolute :: Absolute -> Pretty ColorText
prettyAbsolute = Pretty ColorText -> Pretty ColorText
P.blue (Pretty ColorText -> Pretty ColorText)
-> (Absolute -> Pretty ColorText) -> Absolute -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Absolute -> Pretty ColorText
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown

prettyProjectPath :: PP.ProjectPath -> Pretty
prettyProjectPath :: ProjectPath -> Pretty ColorText
prettyProjectPath (PP.ProjectPath Project
project ProjectBranch
branch Absolute
path) =
  ProjectAndBranch ProjectName ProjectBranchName -> Pretty ColorText
prettyProjectAndBranchName (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch Project
project.name ProjectBranch
branch.name)
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<>
    -- Only show the path if it's not the root
    Bool -> Pretty ColorText -> Pretty ColorText
forall a. Monoid a => Bool -> a -> a
Monoid.whenM (Absolute
path Absolute -> Absolute -> Bool
forall a. Eq a => a -> a -> Bool
/= Absolute
Path.absoluteEmpty) (Pretty ColorText -> Pretty ColorText
P.cyan (Pretty ColorText
":" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Absolute -> Pretty ColorText
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown Absolute
path))

prettySCH :: (IsString s) => ShortCausalHash -> P.Pretty s
prettySCH :: forall s. IsString s => ShortCausalHash -> Pretty s
prettySCH ShortCausalHash
hash = Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
P.group (Pretty s -> Pretty s) -> Pretty s -> Pretty s
forall a b. (a -> b) -> a -> b
$ Pretty s
"#" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty s
forall s. IsString s => Text -> Pretty s
P.text (ShortCausalHash -> Text
SCH.toText ShortCausalHash
hash)

prettyCausalHash :: (IsString s) => CausalHash -> P.Pretty s
prettyCausalHash :: forall s. IsString s => CausalHash -> Pretty s
prettyCausalHash CausalHash
hash = Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
P.group (Pretty s -> Pretty s) -> Pretty s -> Pretty s
forall a b. (a -> b) -> a -> b
$ Pretty s
"#" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty s
forall s. IsString s => Text -> Pretty s
P.text (Hash -> Text
Hash.toBase32HexText (Hash -> Text) -> (CausalHash -> Hash) -> CausalHash -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CausalHash -> Hash
unCausalHash (CausalHash -> Text) -> CausalHash -> Text
forall a b. (a -> b) -> a -> b
$ CausalHash
hash)

prettyBase32Hex :: (IsString s) => Base32Hex -> P.Pretty s
prettyBase32Hex :: forall s. IsString s => Base32Hex -> Pretty s
prettyBase32Hex = Text -> Pretty s
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty s) -> (Base32Hex -> Text) -> Base32Hex -> Pretty s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base32Hex -> Text
Base32Hex.toText

prettyBase32Hex# :: (IsString s) => Base32Hex -> P.Pretty s
prettyBase32Hex# :: forall s. IsString s => Base32Hex -> Pretty s
prettyBase32Hex# Base32Hex
b = Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
P.group (Pretty s -> Pretty s) -> Pretty s -> Pretty s
forall a b. (a -> b) -> a -> b
$ Pretty s
"#" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Base32Hex -> Pretty s
forall s. IsString s => Base32Hex -> Pretty s
prettyBase32Hex Base32Hex
b

prettyHash :: (IsString s) => Hash.Hash -> P.Pretty s
prettyHash :: forall s. IsString s => Hash -> Pretty s
prettyHash = Base32Hex -> Pretty s
forall s. IsString s => Base32Hex -> Pretty s
prettyBase32Hex# (Base32Hex -> Pretty s) -> (Hash -> Base32Hex) -> Hash -> Pretty s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> Base32Hex
Hash.toBase32Hex

prettyHash32 :: (IsString s) => Hash32 -> P.Pretty s
prettyHash32 :: forall s. IsString s => Hash32 -> Pretty s
prettyHash32 = Base32Hex -> Pretty s
forall s. IsString s => Base32Hex -> Pretty s
prettyBase32Hex# (Base32Hex -> Pretty s)
-> (Hash32 -> Base32Hex) -> Hash32 -> Pretty s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash32 -> Base32Hex
Hash32.toBase32Hex

prettyMergeSource :: MergeSource -> Pretty
prettyMergeSource :: MergeSource -> Pretty ColorText
prettyMergeSource = \case
  MergeSource'LocalProjectBranch ProjectAndBranch ProjectName ProjectBranchName
branch -> ProjectAndBranch ProjectName ProjectBranchName -> Pretty ColorText
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
branch
  MergeSource'RemoteProjectBranch ProjectAndBranch ProjectName ProjectBranchName
branch -> Pretty ColorText
"remote " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> ProjectAndBranch ProjectName ProjectBranchName -> Pretty ColorText
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
branch
  MergeSource'RemoteLooseCode ReadShareLooseCode
info -> ReadRemoteNamespace RemoteProjectBranch -> Pretty ColorText
prettyReadRemoteNamespace (ReadShareLooseCode -> ReadRemoteNamespace RemoteProjectBranch
forall a. ReadShareLooseCode -> ReadRemoteNamespace a
ReadShare'LooseCode ReadShareLooseCode
info)

prettyMergeSourceOrTarget :: MergeSourceOrTarget -> Pretty
prettyMergeSourceOrTarget :: MergeSourceOrTarget -> Pretty ColorText
prettyMergeSourceOrTarget = \case
  MergeSourceOrTarget'Target ProjectAndBranch ProjectName ProjectBranchName
alice -> ProjectAndBranch ProjectName ProjectBranchName -> Pretty ColorText
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
alice
  MergeSourceOrTarget'Source MergeSource
bob -> MergeSource -> Pretty ColorText
prettyMergeSource MergeSource
bob

prettyProjectName :: ProjectName -> Pretty
prettyProjectName :: ProjectName -> Pretty ColorText
prettyProjectName =
  Pretty ColorText -> Pretty ColorText
P.green (Pretty ColorText -> Pretty ColorText)
-> (ProjectName -> Pretty ColorText)
-> ProjectName
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty ColorText)
-> (ProjectName -> Text) -> ProjectName -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source. From source target => source -> target
into @Text

-- | 'prettyProjectName' with a trailing slash.
prettyProjectNameSlash :: ProjectName -> Pretty
prettyProjectNameSlash :: ProjectName -> Pretty ColorText
prettyProjectNameSlash ProjectName
project =
  Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
P.group (ProjectName -> Pretty ColorText
prettyProjectName ProjectName
project Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
P.hiBlack Pretty ColorText
"/")

prettyProjectBranchName :: ProjectBranchName -> Pretty
prettyProjectBranchName :: ProjectBranchName -> Pretty ColorText
prettyProjectBranchName =
  Pretty ColorText -> Pretty ColorText
P.blue (Pretty ColorText -> Pretty ColorText)
-> (ProjectBranchName -> Pretty ColorText)
-> ProjectBranchName
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty ColorText)
-> (ProjectBranchName -> Text)
-> ProjectBranchName
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source. From source target => source -> target
into @Text

prettySemver :: Semver -> Pretty
prettySemver :: Semver -> Pretty ColorText
prettySemver (Semver Int
x Int
y Int
z) =
  Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
P.group (Int -> Pretty ColorText
forall n s. (Show n, Num n, IsString s) => n -> Pretty s
P.num Int
x Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"." Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Int -> Pretty ColorText
forall n s. (Show n, Num n, IsString s) => n -> Pretty s
P.num Int
y Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"." Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Int -> Pretty ColorText
forall n s. (Show n, Num n, IsString s) => n -> Pretty s
P.num Int
z)

-- | Like 'prettyProjectBranchName', but with a leading forward slash. This is used in some outputs to
-- encourage/advertise an unambiguous syntax for project branches, as there's an ambiguity with single-segment relative
-- paths.
--
-- Not all project branches are printed such: for example, when listing all branches of a project, we probably don't
-- need or want to prefix every one with a forward slash.
prettySlashProjectBranchName :: ProjectBranchName -> Pretty
prettySlashProjectBranchName :: ProjectBranchName -> Pretty ColorText
prettySlashProjectBranchName ProjectBranchName
branch =
  Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
P.group (Pretty ColorText -> Pretty ColorText
P.hiBlack Pretty ColorText
"/" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Pretty ColorText
prettyProjectBranchName ProjectBranchName
branch)

prettyProjectAndBranchName :: ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName :: ProjectAndBranch ProjectName ProjectBranchName -> Pretty ColorText
prettyProjectAndBranchName (ProjectAndBranch ProjectName
project ProjectBranchName
branch) =
  Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
P.group (ProjectName -> Pretty ColorText
prettyProjectName ProjectName
project Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
P.hiBlack Pretty ColorText
"/" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Pretty ColorText
prettyProjectBranchName ProjectBranchName
branch)

prettyBranchRelativePath :: BranchRelativePath -> Pretty
prettyBranchRelativePath :: BranchRelativePath -> Pretty ColorText
prettyBranchRelativePath = Pretty ColorText -> Pretty ColorText
P.blue (Pretty ColorText -> Pretty ColorText)
-> (BranchRelativePath -> Pretty ColorText)
-> BranchRelativePath
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty ColorText)
-> (BranchRelativePath -> Text)
-> BranchRelativePath
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source. From source target => source -> target
into @Text

-- produces:
-- -- #5v5UtREE1fTiyTsTK2zJ1YNqfiF25SkfUnnji86Lms#0
-- Optional.None, Maybe.Nothing : Maybe a
unsafePrettyTermResultSigFull' ::
  (Var v) =>
  PPE.PrettyPrintEnv ->
  SR'.TermResult' v a ->
  Pretty
unsafePrettyTermResultSigFull' :: forall v a.
Var v =>
PrettyPrintEnv -> TermResult' v a -> Pretty ColorText
unsafePrettyTermResultSigFull' PrettyPrintEnv
ppe = \case
  SR'.TermResult' HashQualified Name
hq (Just Type v a
typ) Referent
r Set (HashQualified Name)
aliases ->
    [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
      [ Pretty ColorText -> Pretty ColorText
P.hiBlack Pretty ColorText
"-- " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Pretty ColorText
greyHash (Referent -> HashQualified Name
HQ.fromReferent Referent
r),
        Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
P.group (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
          [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.commas ((HashQualified Name -> Pretty ColorText)
-> [HashQualified Name] -> [Pretty ColorText]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HashQualified Name -> Pretty ColorText
greyHash ([HashQualified Name] -> [Pretty ColorText])
-> [HashQualified Name] -> [Pretty ColorText]
forall a b. (a -> b) -> a -> b
$ HashQualified Name
hq HashQualified Name -> [HashQualified Name] -> [HashQualified Name]
forall a. a -> [a] -> [a]
: (HashQualified Name -> HashQualified Name)
-> [HashQualified Name] -> [HashQualified Name]
forall a b. (a -> b) -> [a] -> [b]
map HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ (Set (HashQualified Name) -> [HashQualified Name]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set (HashQualified Name)
aliases))
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" : "
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty SyntaxText -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
P.syntaxToColor (PrettyPrintEnv -> Type v a -> Pretty SyntaxText
forall v a.
Var v =>
PrettyPrintEnv -> Type v a -> Pretty SyntaxText
TypePrinter.prettySyntax PrettyPrintEnv
ppe Type v a
typ),
        Pretty ColorText
forall a. Monoid a => a
mempty
      ]
  TermResult' v a
_ -> [Char] -> Pretty ColorText
forall a. HasCallStack => [Char] -> a
error [Char]
"Don't pass Nothing"
  where
    greyHash :: HashQualified Name -> Pretty ColorText
greyHash = (Pretty ColorText -> Pretty ColorText)
-> (Pretty ColorText -> Pretty ColorText)
-> HashQualified Name
-> Pretty ColorText
forall s.
IsString s =>
(Pretty s -> Pretty s)
-> (Pretty s -> Pretty s) -> HashQualified Name -> Pretty s
styleHashQualified' Pretty ColorText -> Pretty ColorText
forall a. a -> a
id Pretty ColorText -> Pretty ColorText
P.hiBlack

prettyTypeResultHeader' :: (Var v) => SR'.TypeResult' v a -> Pretty
prettyTypeResultHeader' :: forall v a. Var v => TypeResult' v a -> Pretty ColorText
prettyTypeResultHeader' (SR'.TypeResult' HashQualified Name
name DisplayObject () (Decl v a)
dt Reference
r Set (HashQualified Name)
_aliases) =
  (HashQualified Name, Reference, DisplayObject () (Decl v a))
-> Pretty ColorText
forall v a.
Var v =>
(HashQualified Name, Reference, DisplayObject () (Decl v a))
-> Pretty ColorText
prettyDeclTriple (HashQualified Name
name, Reference
r, DisplayObject () (Decl v a)
dt)

-- produces:
-- -- #5v5UtREE1fTiyTsTK2zJ1YNqfiF25SkfUnnji86Lms
-- type Optional
-- type Maybe
prettyTypeResultHeaderFull' :: (Var v) => SR'.TypeResult' v a -> Pretty
prettyTypeResultHeaderFull' :: forall v a. Var v => TypeResult' v a -> Pretty ColorText
prettyTypeResultHeaderFull' (SR'.TypeResult' HashQualified Name
name DisplayObject () (Decl v a)
dt Reference
r Set (HashQualified Name)
aliases) =
  [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines [Pretty ColorText]
stuff Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
P.newline
  where
    stuff :: [Pretty ColorText]
stuff =
      (Pretty ColorText -> Pretty ColorText
P.hiBlack Pretty ColorText
"-- " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Pretty ColorText
greyHash (Reference -> HashQualified Name
HQ.fromReference Reference
r))
        Pretty ColorText -> [Pretty ColorText] -> [Pretty ColorText]
forall a. a -> [a] -> [a]
: (HashQualified Name -> Pretty ColorText)
-> [HashQualified Name] -> [Pretty ColorText]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (\HashQualified Name
name -> (HashQualified Name, Reference, DisplayObject () (Decl v a))
-> Pretty ColorText
forall v a.
Var v =>
(HashQualified Name, Reference, DisplayObject () (Decl v a))
-> Pretty ColorText
prettyDeclTriple (HashQualified Name
name, Reference
r, DisplayObject () (Decl v a)
dt))
          (HashQualified Name
name HashQualified Name -> [HashQualified Name] -> [HashQualified Name]
forall a. a -> [a] -> [a]
: (HashQualified Name -> HashQualified Name)
-> [HashQualified Name] -> [HashQualified Name]
forall a b. (a -> b) -> [a] -> [b]
map HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ (Set (HashQualified Name) -> [HashQualified Name]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set (HashQualified Name)
aliases))
      where
        greyHash :: HashQualified Name -> Pretty ColorText
greyHash = (Pretty ColorText -> Pretty ColorText)
-> (Pretty ColorText -> Pretty ColorText)
-> HashQualified Name
-> Pretty ColorText
forall s.
IsString s =>
(Pretty s -> Pretty s)
-> (Pretty s -> Pretty s) -> HashQualified Name -> Pretty s
styleHashQualified' Pretty ColorText -> Pretty ColorText
forall a. a -> a
id Pretty ColorText -> Pretty ColorText
P.hiBlack

prettyDeclTriple ::
  (Var v) =>
  (HQ.HashQualified Name, Reference.Reference, DisplayObject () (DD.Decl v a)) ->
  Pretty
prettyDeclTriple :: forall v a.
Var v =>
(HashQualified Name, Reference, DisplayObject () (Decl v a))
-> Pretty ColorText
prettyDeclTriple (HashQualified Name
name, Reference
_, DisplayObject () (Decl v a)
displayDecl) = case DisplayObject () (Decl v a)
displayDecl of
  BuiltinObject ()
_ -> Pretty ColorText -> Pretty ColorText
P.hiBlack Pretty ColorText
"builtin " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
P.hiBlue Pretty ColorText
"type " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
P.blue (Pretty SyntaxText -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
P.syntaxToColor (Pretty SyntaxText -> Pretty ColorText)
-> Pretty SyntaxText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Pretty SyntaxText
prettyHashQualified HashQualified Name
name)
  MissingObject ShortHash
_ -> Pretty ColorText
forall a. Monoid a => a
mempty -- these need to be handled elsewhere
  UserObject Decl v a
decl -> Pretty SyntaxText -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
P.syntaxToColor (Pretty SyntaxText -> Pretty ColorText)
-> Pretty SyntaxText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Decl v a -> Pretty SyntaxText
forall v a.
Var v =>
HashQualified Name
-> Either (EffectDeclaration v a) (DataDeclaration v a)
-> Pretty SyntaxText
DeclPrinter.prettyDeclHeader HashQualified Name
name Decl v a
decl

prettyDeclPair ::
  (Var v) =>
  PPE.PrettyPrintEnv ->
  (Reference, DisplayObject () (DD.Decl v a)) ->
  Pretty
prettyDeclPair :: forall v a.
Var v =>
PrettyPrintEnv
-> (Reference, DisplayObject () (Decl v a)) -> Pretty ColorText
prettyDeclPair PrettyPrintEnv
ppe (Reference
r, DisplayObject () (Decl v a)
dt) = (HashQualified Name, Reference, DisplayObject () (Decl v a))
-> Pretty ColorText
forall v a.
Var v =>
(HashQualified Name, Reference, DisplayObject () (Decl v a))
-> Pretty ColorText
prettyDeclTriple (PrettyPrintEnv -> Reference -> HashQualified Name
PPE.typeName PrettyPrintEnv
ppe Reference
r, Reference
r, DisplayObject () (Decl v a)
dt)

prettyTermName :: PPE.PrettyPrintEnv -> Referent -> Pretty
prettyTermName :: PrettyPrintEnv -> Referent -> Pretty ColorText
prettyTermName PrettyPrintEnv
ppe Referent
r =
  Pretty SyntaxText -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
P.syntaxToColor (Pretty SyntaxText -> Pretty ColorText)
-> Pretty SyntaxText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
    HashQualified Name -> Pretty SyntaxText
prettyHashQualified (PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName PrettyPrintEnv
ppe Referent
r)

prettyTypeName :: PPE.PrettyPrintEnv -> Reference -> Pretty
prettyTypeName :: PrettyPrintEnv -> Reference -> Pretty ColorText
prettyTypeName PrettyPrintEnv
ppe Reference
r =
  Pretty SyntaxText -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
P.syntaxToColor (Pretty SyntaxText -> Pretty ColorText)
-> Pretty SyntaxText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
    HashQualified Name -> Pretty SyntaxText
prettyHashQualified (PrettyPrintEnv -> Reference -> HashQualified Name
PPE.typeName PrettyPrintEnv
ppe Reference
r)

-- | Pretty-print a 'WhichBranchEmpty'.
prettyWhichBranchEmpty :: WhichBranchEmpty -> Pretty
prettyWhichBranchEmpty :: WhichBranchEmpty -> Pretty ColorText
prettyWhichBranchEmpty = \case
  WhichBranchEmptyHash ShortCausalHash
hash -> ShortCausalHash -> Pretty ColorText
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown ShortCausalHash
hash
  WhichBranchEmptyPath ProjectPath
pp -> ProjectPath -> Pretty ColorText
prettyProjectPath ProjectPath
pp

-- | Displays a full, non-truncated Branch.CausalHash to a string, e.g. #abcdef
displayBranchHash :: CausalHash -> Text
displayBranchHash :: CausalHash -> Text
displayBranchHash = (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (CausalHash -> Text) -> CausalHash -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> Text
Hash.toBase32HexText (Hash -> Text) -> (CausalHash -> Hash) -> CausalHash -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CausalHash -> Hash
unCausalHash

prettyHumanReadableTime :: UTCTime -> UTCTime -> Pretty
prettyHumanReadableTime :: UTCTime -> UTCTime -> Pretty ColorText
prettyHumanReadableTime UTCTime
now UTCTime
time =
  Pretty ColorText -> Pretty ColorText
P.green (Pretty ColorText -> Pretty ColorText)
-> ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Pretty ColorText
forall s. IsString s => [Char] -> Pretty s
P.string ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ HumanTimeLocale -> UTCTime -> UTCTime -> [Char]
humanReadableTimeI18N' HumanTimeLocale
terseTimeLocale UTCTime
now UTCTime
time
  where
    terseTimeLocale :: HumanTimeLocale
terseTimeLocale =
      HumanTimeLocale
defaultHumanTimeLocale
        { justNow = "now",
          secondsAgo = \Bool
f -> ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" secs" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Bool -> [Char]
forall {a}. IsString a => Bool -> a
dir Bool
f),
          oneMinuteAgo = \Bool
f -> [Char]
"a min" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Bool -> [Char]
forall {a}. IsString a => Bool -> a
dir Bool
f,
          minutesAgo = \Bool
f -> ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" mins" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Bool -> [Char]
forall {a}. IsString a => Bool -> a
dir Bool
f),
          oneHourAgo = \Bool
f -> [Char]
"an hour" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Bool -> [Char]
forall {a}. IsString a => Bool -> a
dir Bool
f,
          aboutHoursAgo = \Bool
f [Char]
x -> [Char]
"about " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" hours" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Bool -> [Char]
forall {a}. IsString a => Bool -> a
dir Bool
f,
          at = \Int
_ [Char]
t -> [Char]
t,
          daysAgo = \Bool
f -> ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" days" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Bool -> [Char]
forall {a}. IsString a => Bool -> a
dir Bool
f),
          weekAgo = \Bool
f -> ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" week" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Bool -> [Char]
forall {a}. IsString a => Bool -> a
dir Bool
f),
          weeksAgo = \Bool
f -> ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" weeks" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Bool -> [Char]
forall {a}. IsString a => Bool -> a
dir Bool
f),
          onYear = \[Char]
dt -> [Char]
dt,
          dayOfWeekFmt = "%A, %-l:%M%p",
          thisYearFmt = "%b %e",
          prevYearFmt = "%b %e, %Y"
        }

    dir :: Bool -> a
dir Bool
True = a
" from now"
    dir Bool
False = a
" ago"

prettyRemoteBranchInfo :: (URI, ProjectName, ProjectBranchName) -> Pretty
prettyRemoteBranchInfo :: (URI, ProjectName, ProjectBranchName) -> Pretty ColorText
prettyRemoteBranchInfo (URI
host, ProjectName
remoteProject, ProjectBranchName
remoteBranch) =
  -- Special-case Unison Share since we know its project branch URLs
  if ([Char] -> [Char]) -> URI -> [Char] -> [Char]
URI.uriToString [Char] -> [Char]
forall a. a -> a
id URI
host [Char]
"" [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"https://api.unison-lang.org"
    then
      Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
P.group (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
        Pretty ColorText
"https://share.unison-lang.org/"
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> ProjectName -> Pretty ColorText
prettyProjectName ProjectName
remoteProject
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"/code/"
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Pretty ColorText
prettyProjectBranchName ProjectBranchName
remoteBranch
    else
      ProjectAndBranch ProjectName ProjectBranchName -> Pretty ColorText
prettyProjectAndBranchName (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
remoteProject ProjectBranchName
remoteBranch)
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" on "
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> URI -> Pretty ColorText
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown URI
host

prettyLabeledDependencies :: PPE.PrettyPrintEnv -> Set LabeledDependency -> Pretty
prettyLabeledDependencies :: PrettyPrintEnv -> Set LabeledDependency -> Pretty ColorText
prettyLabeledDependencies PrettyPrintEnv
ppe Set LabeledDependency
lds =
  Pretty SyntaxText -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
P.syntaxToColor (Pretty SyntaxText -> [Pretty SyntaxText] -> Pretty SyntaxText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty SyntaxText
", " (LabeledDependency -> Pretty SyntaxText
ld (LabeledDependency -> Pretty SyntaxText)
-> [LabeledDependency] -> [Pretty SyntaxText]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set LabeledDependency -> [LabeledDependency]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set LabeledDependency
lds))
  where
    ld :: LabeledDependency -> Pretty SyntaxText
ld = \case
      LD.TermReferent Referent
r -> HashQualified Name -> Pretty SyntaxText
prettyHashQualified (PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termNameOrHashOnly PrettyPrintEnv
ppe Referent
r)
      LD.TypeReference Reference
r -> Pretty SyntaxText
"type " Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Pretty SyntaxText
prettyHashQualified (PrettyPrintEnv -> Reference -> HashQualified Name
PPE.typeNameOrHashOnly PrettyPrintEnv
ppe Reference
r)

prettyUnisonFile :: forall v a. (Var v, Ord a) => PPED.PrettyPrintEnvDecl -> UF.UnisonFile v a -> P.Pretty P.ColorText
prettyUnisonFile :: forall v a.
(Var v, Ord a) =>
PrettyPrintEnvDecl -> UnisonFile v a -> Pretty ColorText
prettyUnisonFile PrettyPrintEnvDecl
ppe uf :: UnisonFile v a
uf@(UF.UnisonFileId Map v (TypeReferenceId, DataDeclaration v a)
datas Map v (TypeReferenceId, EffectDeclaration v a)
effects Map v (a, Term v a)
terms Map [Char] [(v, a, Term v a)]
watches) =
  Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty ColorText
"\n\n" (((a, Pretty ColorText) -> Pretty ColorText)
-> [(a, Pretty ColorText)] -> [Pretty ColorText]
forall a b. (a -> b) -> [a] -> [b]
map (a, Pretty ColorText) -> Pretty ColorText
forall a b. (a, b) -> b
snd ([(a, Pretty ColorText)] -> [Pretty ColorText])
-> ([(a, Pretty ColorText)] -> [(a, Pretty ColorText)])
-> [(a, Pretty ColorText)]
-> [Pretty ColorText]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Pretty ColorText) -> a)
-> [(a, Pretty ColorText)] -> [(a, Pretty ColorText)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (a, Pretty ColorText) -> a
forall a b. (a, b) -> a
fst ([(a, Pretty ColorText)] -> [Pretty ColorText])
-> [(a, Pretty ColorText)] -> [Pretty ColorText]
forall a b. (a -> b) -> a -> b
$ [(a, Pretty ColorText)]
prettyEffects [(a, Pretty ColorText)]
-> [(a, Pretty ColorText)] -> [(a, Pretty ColorText)]
forall a. Semigroup a => a -> a -> a
<> [(a, Pretty ColorText)]
prettyDatas [(a, Pretty ColorText)]
-> [(a, Pretty ColorText)] -> [(a, Pretty ColorText)]
forall a. Semigroup a => a -> a -> a
<> [Maybe (a, Pretty ColorText)] -> [(a, Pretty ColorText)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (a, Pretty ColorText)]
prettyTerms [(a, Pretty ColorText)]
-> [(a, Pretty ColorText)] -> [(a, Pretty ColorText)]
forall a. Semigroup a => a -> a -> a
<> [(a, Pretty ColorText)]
prettyWatches)
  where
    prettyEffects :: [(a, Pretty ColorText)]
prettyEffects = ((v, (TypeReferenceId, EffectDeclaration v a))
 -> (a, Pretty ColorText))
-> [(v, (TypeReferenceId, EffectDeclaration v a))]
-> [(a, Pretty ColorText)]
forall a b. (a -> b) -> [a] -> [b]
map (v, (TypeReferenceId, EffectDeclaration v a))
-> (a, Pretty ColorText)
prettyEffectDecl (Map v (TypeReferenceId, EffectDeclaration v a)
-> [(v, (TypeReferenceId, EffectDeclaration v a))]
forall k a. Map k a -> [(k, a)]
Map.toList Map v (TypeReferenceId, EffectDeclaration v a)
effects)
    ([(a, Pretty ColorText)]
prettyDatas, Set Name
accessorNames) = Writer (Set Name) [(a, Pretty ColorText)]
-> ([(a, Pretty ColorText)], Set Name)
forall w a. Writer w a -> (a, w)
runWriter (Writer (Set Name) [(a, Pretty ColorText)]
 -> ([(a, Pretty ColorText)], Set Name))
-> Writer (Set Name) [(a, Pretty ColorText)]
-> ([(a, Pretty ColorText)], Set Name)
forall a b. (a -> b) -> a -> b
$ ((v, (TypeReferenceId, DataDeclaration v a))
 -> WriterT (Set Name) Identity (a, Pretty ColorText))
-> [(v, (TypeReferenceId, DataDeclaration v a))]
-> Writer (Set Name) [(a, Pretty ColorText)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (v, (TypeReferenceId, DataDeclaration v a))
-> WriterT (Set Name) Identity (a, Pretty ColorText)
prettyDataDecl (Map v (TypeReferenceId, DataDeclaration v a)
-> [(v, (TypeReferenceId, DataDeclaration v a))]
forall k a. Map k a -> [(k, a)]
Map.toList Map v (TypeReferenceId, DataDeclaration v a)
datas)
    prettyTerms :: [Maybe (a, Pretty ColorText)]
prettyTerms = (v
 -> (a, Term v a)
 -> [Maybe (a, Pretty ColorText)]
 -> [Maybe (a, Pretty ColorText)])
-> [Maybe (a, Pretty ColorText)]
-> Map v (a, Term v a)
-> [Maybe (a, Pretty ColorText)]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\v
k (a, Term v a)
v -> (Set Name -> v -> (a, Term v a) -> Maybe (a, Pretty ColorText)
prettyTerm Set Name
accessorNames v
k (a, Term v a)
v Maybe (a, Pretty ColorText)
-> [Maybe (a, Pretty ColorText)] -> [Maybe (a, Pretty ColorText)]
forall a. a -> [a] -> [a]
:)) [] Map v (a, Term v a)
terms
    prettyWatches :: [(a, Pretty ColorText)]
prettyWatches = Map [Char] [(v, a, Term v a)] -> [([Char], [(v, a, Term v a)])]
forall k a. Map k a -> [(k, a)]
Map.toList Map [Char] [(v, a, Term v a)]
watches [([Char], [(v, a, Term v a)])]
-> (([Char], [(v, a, Term v a)]) -> [(a, Pretty ColorText)])
-> [(a, Pretty ColorText)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \([Char]
wk, [(v, a, Term v a)]
tms) -> ((v, a, Term v a) -> (a, Pretty ColorText))
-> [(v, a, Term v a)] -> [(a, Pretty ColorText)]
forall a b. (a -> b) -> [a] -> [b]
map (([Char], (v, a, Term v a)) -> (a, Pretty ColorText)
prettyWatch (([Char], (v, a, Term v a)) -> (a, Pretty ColorText))
-> ((v, a, Term v a) -> ([Char], (v, a, Term v a)))
-> (v, a, Term v a)
-> (a, Pretty ColorText)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
wk,)) [(v, a, Term v a)]
tms

    prettyEffectDecl :: (v, (Reference.Id, DD.EffectDeclaration v a)) -> (a, P.Pretty P.ColorText)
    prettyEffectDecl :: (v, (TypeReferenceId, EffectDeclaration v a))
-> (a, Pretty ColorText)
prettyEffectDecl (v
n, (TypeReferenceId
r, EffectDeclaration v a
et)) =
      (DataDeclaration v a -> a
forall v a. DataDeclaration v a -> a
DD.annotation (DataDeclaration v a -> a)
-> (EffectDeclaration v a -> DataDeclaration v a)
-> EffectDeclaration v a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EffectDeclaration v a -> DataDeclaration v a
forall v a. EffectDeclaration v a -> DataDeclaration v a
DD.toDataDecl (EffectDeclaration v a -> a) -> EffectDeclaration v a -> a
forall a b. (a -> b) -> a -> b
$ EffectDeclaration v a
et, Pretty SyntaxText -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
st (Pretty SyntaxText -> Pretty ColorText)
-> Pretty SyntaxText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnvDecl
-> Reference -> HashQualified Name -> Decl v a -> Pretty SyntaxText
forall v a.
Var v =>
PrettyPrintEnvDecl
-> Reference -> HashQualified Name -> Decl v a -> Pretty SyntaxText
DeclPrinter.prettyDecl PrettyPrintEnvDecl
ppe' (TypeReferenceId -> Reference
forall {h} {t}. Id' h -> Reference' t h
rd TypeReferenceId
r) (v -> HashQualified Name
forall {v}. Var v => v -> HashQualified Name
hqv v
n) (EffectDeclaration v a -> Decl v a
forall a b. a -> Either a b
Left EffectDeclaration v a
et))
    prettyDataDecl :: (v, (Reference.Id, DD.DataDeclaration v a)) -> Writer (Set AccessorName) (a, P.Pretty P.ColorText)
    prettyDataDecl :: (v, (TypeReferenceId, DataDeclaration v a))
-> WriterT (Set Name) Identity (a, Pretty ColorText)
prettyDataDecl (v
n, (TypeReferenceId
r, DataDeclaration v a
dt)) =
      (DataDeclaration v a -> a
forall v a. DataDeclaration v a -> a
DD.annotation DataDeclaration v a
dt,) (Pretty ColorText -> (a, Pretty ColorText))
-> (Pretty SyntaxText -> Pretty ColorText)
-> Pretty SyntaxText
-> (a, Pretty ColorText)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty SyntaxText -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
st (Pretty SyntaxText -> (a, Pretty ColorText))
-> WriterT (Set Name) Identity (Pretty SyntaxText)
-> WriterT (Set Name) Identity (a, Pretty ColorText)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrettyPrintEnvDecl
-> Reference
-> HashQualified Name
-> Decl v a
-> WriterT (Set Name) Identity (Pretty SyntaxText)
forall v a.
Var v =>
PrettyPrintEnvDecl
-> Reference
-> HashQualified Name
-> Decl v a
-> WriterT (Set Name) Identity (Pretty SyntaxText)
DeclPrinter.prettyDeclW PrettyPrintEnvDecl
ppe' (TypeReferenceId -> Reference
forall {h} {t}. Id' h -> Reference' t h
rd TypeReferenceId
r) (v -> HashQualified Name
forall {v}. Var v => v -> HashQualified Name
hqv v
n) (DataDeclaration v a -> Decl v a
forall a b. b -> Either a b
Right DataDeclaration v a
dt)
    prettyTerm :: Set AccessorName -> v -> (a, Term v a) -> Maybe (a, P.Pretty P.ColorText)
    prettyTerm :: Set Name -> v -> (a, Term v a) -> Maybe (a, Pretty ColorText)
prettyTerm Set Name
skip v
n (a
a, Term v a
tm) =
      if Bool -> Bool
traceMember Bool
isMember then Maybe (a, Pretty ColorText)
forall a. Maybe a
Nothing else (a, Pretty ColorText) -> Maybe (a, Pretty ColorText)
forall a. a -> Maybe a
Just (a
a, HashQualified Name -> Term v a -> Pretty ColorText
pb HashQualified Name
hq Term v a
tm)
      where
        traceMember :: Bool -> Bool
traceMember =
          if DebugFlag -> Bool
Debug.shouldDebug DebugFlag
Debug.Update
            then [Char] -> Bool -> Bool
forall a. [Char] -> a -> a
trace (HashQualified Name -> [Char]
forall a. Show a => a -> [Char]
show HashQualified Name
hq [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -> " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ if Bool
isMember then [Char]
"skip" else [Char]
"print")
            else Bool -> Bool
forall a. a -> a
id
        isMember :: Bool
isMember = Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar v
n) Set Name
skip
        hq :: HashQualified Name
hq = v -> HashQualified Name
forall {v}. Var v => v -> HashQualified Name
hqv v
n
    prettyWatch :: (String, (v, a, Term v a)) -> (a, P.Pretty P.ColorText)
    prettyWatch :: ([Char], (v, a, Term v a)) -> (a, Pretty ColorText)
prettyWatch ([Char]
wk, (v
n, a
a, Term v a
tm)) = (a
a, [Char] -> v -> Term v a -> Pretty ColorText
go [Char]
wk v
n Term v a
tm)
      where
        go :: [Char] -> v -> Term v a -> Pretty ColorText
go [Char]
wk v
v Term v a
tm = case [Char]
wk of
          [Char]
WK.RegularWatch
            | Var.UnnamedWatch [Char]
_ Text
_ <- v -> Type
forall v. Var v => v -> Type
Var.typeOf v
v ->
                Pretty ColorText
"> " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentNAfterNewline Width
2 (PrettyPrintEnv -> Term v a -> Pretty ColorText
forall v a. Var v => PrettyPrintEnv -> Term v a -> Pretty ColorText
TermPrinter.pretty PrettyPrintEnv
sppe Term v a
tm)
          [Char]
WK.RegularWatch -> Pretty ColorText
"> " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Term v a -> Pretty ColorText
pb (v -> HashQualified Name
forall {v}. Var v => v -> HashQualified Name
hqv v
v) Term v a
tm
          [Char]
WK.TestWatch -> Pretty ColorText
"test> " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty SyntaxText -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
st (PrettyPrintEnv
-> HashQualified Name -> Term v a -> Pretty SyntaxText
forall v at ap a.
Var v =>
PrettyPrintEnv
-> HashQualified Name -> Term2 v at ap v a -> Pretty SyntaxText
TermPrinter.prettyBindingWithoutTypeSignature PrettyPrintEnv
sppe (v -> HashQualified Name
forall {v}. Var v => v -> HashQualified Name
hqv v
v) Term v a
tm)
          [Char]
w -> [Char] -> Pretty ColorText
forall s. IsString s => [Char] -> Pretty s
P.string [Char]
w Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"> " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Term v a -> Pretty ColorText
pb (v -> HashQualified Name
forall {v}. Var v => v -> HashQualified Name
hqv v
v) Term v a
tm
    st :: Pretty (SyntaxText' r) -> Pretty ColorText
st = Pretty (SyntaxText' r) -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
P.syntaxToColor
    sppe :: PrettyPrintEnv
sppe = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
ppe'
    pb :: HashQualified Name -> Term v a -> Pretty ColorText
pb HashQualified Name
v Term v a
tm = Pretty SyntaxText -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
st (Pretty SyntaxText -> Pretty ColorText)
-> Pretty SyntaxText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv
-> HashQualified Name -> Term v a -> Pretty SyntaxText
forall v at ap a.
Var v =>
PrettyPrintEnv
-> HashQualified Name -> Term2 v at ap v a -> Pretty SyntaxText
TermPrinter.prettyBinding PrettyPrintEnv
sppe HashQualified Name
v Term v a
tm
    ppe' :: PrettyPrintEnvDecl
ppe' = PrettyPrintEnv -> PrettyPrintEnv -> PrettyPrintEnvDecl
PPED.PrettyPrintEnvDecl PrettyPrintEnv
dppe PrettyPrintEnv
dppe PrettyPrintEnvDecl -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl
`PPED.addFallback` PrettyPrintEnvDecl
ppe
    dppe :: PrettyPrintEnv
dppe = Namer -> Suffixifier -> PrettyPrintEnv
PPE.makePPE (Names -> Namer
PPE.namer (UnisonFile v a -> Names
forall v a. Var v => UnisonFile v a -> Names
UF.toNames UnisonFile v a
uf)) Suffixifier
PPE.dontSuffixify
    rd :: Id' h -> Reference' t h
rd = Id' h -> Reference' t h
forall {h} {t}. Id' h -> Reference' t h
Reference.DerivedId
    hqv :: v -> HashQualified Name
hqv v
v = v -> HashQualified Name
forall {v}. Var v => v -> HashQualified Name
HQ.unsafeFromVar v
v

prettyTerm ::
  PPED.PrettyPrintEnvDecl ->
  Bool {- whether we're printing to a source-file or not. -} ->
  Bool {- Whether the term is a test -} ->
  (HQ.HashQualified Name, Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)) ->
  P.Pretty SyntaxText
prettyTerm :: PrettyPrintEnvDecl
-> Bool
-> Bool
-> (HashQualified Name, Reference,
    DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Pretty SyntaxText
prettyTerm PrettyPrintEnvDecl
pped Bool
isSourceFile Bool
isTest (HashQualified Name
n, Reference
r, DisplayObject (Type Symbol Ann) (Term Symbol Ann)
dt) =
  case DisplayObject (Type Symbol Ann) (Term Symbol Ann)
dt of
    MissingObject ShortHash
r -> HashQualified Name -> ShortHash -> Pretty SyntaxText
missingDefinitionMsg HashQualified Name
n ShortHash
r
    BuiltinObject Type Symbol Ann
typ ->
      Pretty SyntaxText -> Pretty SyntaxText
commentBuiltin (Pretty SyntaxText -> Pretty SyntaxText)
-> Pretty SyntaxText -> Pretty SyntaxText
forall a b. (a -> b) -> a -> b
$
        Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.hang
          (Pretty SyntaxText
"builtin " Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Pretty SyntaxText
prettyHashQualified HashQualified Name
n Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> Pretty SyntaxText
" :")
          (PrettyPrintEnv -> Type Symbol Ann -> Pretty SyntaxText
forall v a.
Var v =>
PrettyPrintEnv -> Type v a -> Pretty SyntaxText
TypePrinter.prettySyntax (HashQualified Name -> Reference -> PrettyPrintEnv
ppeBody HashQualified Name
n Reference
r) Type Symbol Ann
typ)
    UserObject Term Symbol Ann
tm ->
      if Bool
isTest
        then Pretty SyntaxText
forall a. (Eq a, IsString a) => a
WK.TestWatch Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> Pretty SyntaxText
"> " Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> PrettyPrintEnv
-> HashQualified Name -> Term Symbol Ann -> Pretty SyntaxText
forall v at ap a.
Var v =>
PrettyPrintEnv
-> HashQualified Name -> Term2 v at ap v a -> Pretty SyntaxText
TermPrinter.prettyBindingWithoutTypeSignature (HashQualified Name -> Reference -> PrettyPrintEnv
ppeBody HashQualified Name
n Reference
r) HashQualified Name
n Term Symbol Ann
tm
        else PrettyPrintEnv
-> HashQualified Name -> Term Symbol Ann -> Pretty SyntaxText
forall v at ap a.
Var v =>
PrettyPrintEnv
-> HashQualified Name -> Term2 v at ap v a -> Pretty SyntaxText
TermPrinter.prettyBinding (HashQualified Name -> Reference -> PrettyPrintEnv
ppeBody HashQualified Name
n Reference
r) HashQualified Name
n Term Symbol Ann
tm
  where
    commentBuiltin :: Pretty SyntaxText -> Pretty SyntaxText
commentBuiltin Pretty SyntaxText
txt =
      if Bool
isSourceFile
        then Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.indent Pretty SyntaxText
"-- " Pretty SyntaxText
txt
        else Pretty SyntaxText
txt
    ppeBody :: HashQualified Name -> Reference -> PrettyPrintEnv
ppeBody HashQualified Name
n Reference
r = [Name] -> PrettyPrintEnv -> PrettyPrintEnv
PPE.biasTo (Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList (Maybe Name -> [Name]) -> Maybe Name -> [Name]
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName HashQualified Name
n) (PrettyPrintEnv -> PrettyPrintEnv)
-> PrettyPrintEnv -> PrettyPrintEnv
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnvDecl -> Reference -> PrettyPrintEnv
PPE.declarationPPE PrettyPrintEnvDecl
pped Reference
r

prettyType :: PPED.PrettyPrintEnvDecl -> (HQ.HashQualified Name, Reference, DisplayObject () (DD.Decl Symbol Ann)) -> P.Pretty SyntaxText
prettyType :: PrettyPrintEnvDecl
-> (HashQualified Name, Reference,
    DisplayObject () (Decl Symbol Ann))
-> Pretty SyntaxText
prettyType PrettyPrintEnvDecl
pped (HashQualified Name
n, Reference
r, DisplayObject () (Decl Symbol Ann)
dt) =
  case DisplayObject () (Decl Symbol Ann)
dt of
    MissingObject ShortHash
r -> HashQualified Name -> ShortHash -> Pretty SyntaxText
missingDefinitionMsg HashQualified Name
n ShortHash
r
    BuiltinObject ()
_ -> HashQualified Name -> Pretty SyntaxText
builtin HashQualified Name
n
    UserObject Decl Symbol Ann
decl -> PrettyPrintEnvDecl
-> Reference
-> HashQualified Name
-> Decl Symbol Ann
-> Pretty SyntaxText
forall v a.
Var v =>
PrettyPrintEnvDecl
-> Reference -> HashQualified Name -> Decl v a -> Pretty SyntaxText
DeclPrinter.prettyDecl ([Name] -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl
PPED.biasTo (Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList (Maybe Name -> [Name]) -> Maybe Name -> [Name]
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName HashQualified Name
n) (PrettyPrintEnvDecl -> PrettyPrintEnvDecl)
-> PrettyPrintEnvDecl -> PrettyPrintEnvDecl
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnvDecl -> Reference -> PrettyPrintEnvDecl
PPE.declarationPPEDecl PrettyPrintEnvDecl
pped Reference
r) Reference
r HashQualified Name
n Decl Symbol Ann
decl
  where
    builtin :: HashQualified Name -> Pretty SyntaxText
builtin HashQualified Name
n = Pretty SyntaxText -> Pretty SyntaxText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty SyntaxText -> Pretty SyntaxText)
-> Pretty SyntaxText -> Pretty SyntaxText
forall a b. (a -> b) -> a -> b
$ Pretty SyntaxText
"--" Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Pretty SyntaxText
prettyHashQualified HashQualified Name
n Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> Pretty SyntaxText
" is built-in."

missingDefinitionMsg :: HQ.HashQualified Name -> ShortHash -> P.Pretty SyntaxText
missingDefinitionMsg :: HashQualified Name -> ShortHash -> Pretty SyntaxText
missingDefinitionMsg HashQualified Name
n ShortHash
r =
  Pretty SyntaxText -> Pretty SyntaxText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
    ( Pretty SyntaxText
"-- The name "
        Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Pretty SyntaxText
prettyHashQualified HashQualified Name
n
        Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> Pretty SyntaxText
" is assigned to the "
        Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> Pretty SyntaxText
"reference "
        Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> [Char] -> Pretty SyntaxText
forall a. IsString a => [Char] -> a
fromString (ShortHash -> [Char]
forall a. Show a => a -> [Char]
show ShortHash
r [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
",")
        Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> Pretty SyntaxText
"which is missing from the codebase."
    )
    Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> Pretty SyntaxText
forall s. IsString s => Pretty s
P.newline
    Pretty SyntaxText -> Pretty SyntaxText -> Pretty SyntaxText
forall a. Semigroup a => a -> a -> a
<> Pretty SyntaxText -> Pretty SyntaxText
tip Pretty SyntaxText
"You might need to repair the codebase manually."
  where
    tip :: P.Pretty SyntaxText -> P.Pretty SyntaxText
    tip :: Pretty SyntaxText -> Pretty SyntaxText
tip Pretty SyntaxText
s = [(Pretty SyntaxText, Pretty SyntaxText)] -> Pretty SyntaxText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2 [(Pretty SyntaxText
"Tip:", Pretty SyntaxText -> Pretty SyntaxText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty SyntaxText
s)]