{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE RecordWildCards #-}

module Unison.CommandLine.OutputMessages where

import Control.Arrow ((***))
import Control.Lens hiding (at)
import Control.Monad.State.Strict qualified as State
import Data.ByteString.Lazy qualified as LazyByteString
import Data.Foldable qualified as Foldable
import Data.List (stripPrefix)
import Data.List qualified as List
import Data.List.Extra (nubOrd, nubOrdOn)
import Data.List.NonEmpty qualified as NEList
import Data.Map qualified as Map
import Data.Ord (comparing)
import Data.Sequence qualified as Seq
import Data.Set qualified as Set
import Data.Set.NonEmpty (NESet)
import Data.Set.NonEmpty qualified as Set.NonEmpty
import Data.Set.NonEmpty qualified as Set.Nonempty
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Data.Text.Lazy qualified as TL
import Data.Time (UTCTime, getCurrentTime)
import Data.Tuple (swap)
import Data.Tuple.Extra (dupe)
import Data.Void (absurd)
import Debug.RecoverRTTI qualified as RTTI
import GitHub qualified as GH
import Network.HTTP.Types qualified as Http
import Servant.Client qualified as Servant
import System.Console.ANSI qualified as ANSI
import System.Console.Haskeline.Completion qualified as Completion
import System.Directory (canonicalizePath, getHomeDirectory)
import System.Exit (ExitCode (..))
import Text.Pretty.Simple (pShowNoColor, pStringNoColor)
import U.Codebase.Branch (NamespaceStats (..))
import U.Codebase.Branch.Diff (NameChanges (..))
import U.Codebase.Config qualified as Config
import U.Codebase.HashTags (CausalHash (..))
import U.Codebase.Reference qualified as Reference
import U.Codebase.Sqlite.HistoryComment (HistoryComment (..))
import U.Codebase.Sqlite.Project (Project (..))
import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..))
import U.Codebase.Sqlite.ProjectReflog qualified as ProjectReflog
import Unison.ABT qualified as ABT
import Unison.Auth.Types qualified as Auth
import Unison.Builtin.Decls qualified as DD
import Unison.Cli.MergeTypes (MergeSourceAndTarget (..))
import Unison.Cli.Pretty
import Unison.Cli.ServantClientUtils qualified as ServantClientUtils
import Unison.Codebase.Editor.DisplayObject (DisplayObject (..))
import Unison.Codebase.Editor.Input (BranchIdG (..))
import Unison.Codebase.Editor.Input qualified as Input
import Unison.Codebase.Editor.Output
  ( CreatedProjectBranchFrom (..),
    NumberedArgs,
    NumberedOutput (..),
    Output (..),
    ShareError (..),
    TestReportStats (CachedTests, NewlyComputed),
    TodoOutput,
    UndoFailureReason (CantUndoPastMerge, CantUndoPastStart),
    todoOutputIsEmpty,
  )
import Unison.Codebase.Editor.Output qualified as E
import Unison.Codebase.Editor.Output.BranchDiff qualified as OBD
import Unison.Codebase.Editor.Output.PushPull qualified as PushPull
import Unison.Codebase.Editor.SlurpResult qualified as SlurpResult
import Unison.Codebase.Editor.StructuredArgument (StructuredArgument)
import Unison.Codebase.Editor.StructuredArgument qualified as SA
import Unison.Codebase.Init.OpenCodebaseError qualified as CodebaseInit
import Unison.Codebase.IntegrityCheck (IntegrityResult (..), prettyPrintIntegrityErrors)
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.Runtime qualified as Runtime
import Unison.Codebase.ShortCausalHash (ShortCausalHash)
import Unison.Codebase.ShortCausalHash qualified as SCH
import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv
import Unison.CommandLine.FZFResolvers qualified as FZFResolvers
import Unison.CommandLine.Helpers (bigproblem, note, tip)
import Unison.CommandLine.InputPattern (InputPattern)
import Unison.CommandLine.InputPatterns (makeExample')
import Unison.CommandLine.InputPatterns qualified as IP
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.ConstructorType qualified as CT
import Unison.Core.Project (ProjectBranchName (UnsafeProjectBranchName))
import Unison.DataDeclaration (DeclOrBuiltin)
import Unison.DataDeclaration qualified as DD
import Unison.DeclCoherencyCheck (IncoherentDeclReason (..))
import Unison.Hash qualified as Hash
import Unison.Hash32 (Hash32)
import Unison.HashQualified qualified as HQ
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.LabeledDependency (LabeledDependency)
import Unison.LabeledDependency qualified as LD
import Unison.Merge (GUpdated (..), TwoWay (..))
import Unison.Merge qualified as Merge
import Unison.Merge.DiffOp qualified as Merge.DiffOp
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment (NameSegment)
import Unison.NameSegment qualified as NameSegment
import Unison.Names (Names (..))
import Unison.Names qualified as Names
import Unison.NamesWithHistory qualified as Names
import Unison.Parser.Ann (Ann, startingLine)
import Unison.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnv.Util qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.PrettyTerminal (clearCurrentLine, putPretty')
import Unison.PrintError
  ( prettyParseError,
    prettyResolutionFailures,
    prettyVar,
    printNoteWithSource,
    renderCompilerBug,
    renderTypeWarnings,
  )
import Unison.Project (ProjectAndBranch (..), defaultBranchName)
import Unison.Reference (Reference, TermReference, TypeReference)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.ReferentPrime qualified as Referent
import Unison.Result qualified as Result
import Unison.Runtime.Interface (prettyError)
import Unison.Server.Backend (ShallowListEntry (..), TypeEntry (..))
import Unison.Server.Backend qualified as Backend
import Unison.Server.SearchResultPrime qualified as SR'
import Unison.Share.Sync.Types qualified as Share (CodeserverTransportError (..), GetCausalHashByPathError (..), PullError (..))
import Unison.Share.Sync.Types qualified as Sync
import Unison.Symbol (Symbol)
import Unison.Sync.Types qualified as Share
import Unison.SyncV2.Types qualified as SyncV2
import Unison.Syntax.DeclPrinter qualified as DeclPrinter
import Unison.Syntax.HashQualified qualified as HQ (toText, unsafeFromVar)
import Unison.Syntax.Name qualified as Name (toText)
import Unison.Syntax.NamePrinter
  ( prettyHashQualified,
    prettyHashQualified',
    prettyHashQualifiedFull,
    prettyName,
    prettyNameParens,
    prettyNamedReference,
    prettyNamedReferent,
    prettyReference,
    prettyReferent,
    prettyShortHash,
  )
import Unison.Syntax.TermPrinter qualified as TermPrinter
import Unison.Syntax.TypePrinter qualified as TypePrinter
import Unison.Term (Term)
import Unison.Term qualified as Term
import Unison.Type (Type)
import Unison.Typed (Typed (..))
import Unison.Util.Alphabetical (sortAlphabetically, sortAlphabeticallyOn)
import Unison.Util.Conflicted (Conflicted (..))
import Unison.Util.Defn (Defn (..))
import Unison.Util.Defns (Defns (..))
import Unison.Util.List qualified as List
import Unison.Util.Monoid (intercalateMap)
import Unison.Util.Monoid qualified as Monoid
import Unison.Util.Pretty qualified as P
import Unison.Util.Relation qualified as R
import Unison.Var (Var)
import Unison.Var qualified as Var
import Unison.WatchKind qualified as WK
import Witch (unsafeFrom)

reportBugURL :: Pretty
reportBugURL :: Pretty
reportBugURL = Pretty
"https://github.com/unisonweb/unison/issues/new"

type Pretty = P.Pretty P.ColorText

shortenDirectory :: FilePath -> IO FilePath
shortenDirectory :: String -> IO String
shortenDirectory String
dir = do
  String
home <- IO String
getHomeDirectory
  String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
home String
dir of
    Just String
d -> String
"~" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
d
    Maybe String
Nothing -> String
dir

renderFileName :: FilePath -> IO Pretty
renderFileName :: String -> IO Pretty
renderFileName String
dir = Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty -> Pretty) -> (String -> Pretty) -> String -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
P.blue (Pretty -> Pretty) -> (String -> Pretty) -> String -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Pretty
forall a. IsString a => String -> a
fromString (String -> Pretty) -> IO String -> IO Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
shortenDirectory String
dir

notifyNumbered :: NumberedOutput -> (Pretty, NumberedArgs)
notifyNumbered :: NumberedOutput -> (Pretty, NumberedArgs)
notifyNumbered = \case
  ShowDiffNamespace Either ShortCausalHash ProjectPath
oldPrefix Either ShortCausalHash ProjectPath
newPrefix PrettyPrintEnv
ppe BranchDiffOutput Symbol Ann
diffOutput ->
    ShowNumbers
-> PrettyPrintEnv
-> AbsBranchId
-> AbsBranchId
-> BranchDiffOutput Symbol Ann
-> (Pretty, NumberedArgs)
forall v.
Var v =>
ShowNumbers
-> PrettyPrintEnv
-> AbsBranchId
-> AbsBranchId
-> BranchDiffOutput v Ann
-> (Pretty, NumberedArgs)
showDiffNamespace ShowNumbers
ShowNumbers PrettyPrintEnv
ppe ((ShortCausalHash -> AbsBranchId)
-> (ProjectPath -> AbsBranchId)
-> Either ShortCausalHash ProjectPath
-> AbsBranchId
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ShortCausalHash -> AbsBranchId
forall p. ShortCausalHash -> BranchIdG p
BranchAtSCH ProjectPath -> AbsBranchId
forall p. ProjectPath -> BranchIdG p
BranchAtProjectPath Either ShortCausalHash ProjectPath
oldPrefix) ((ShortCausalHash -> AbsBranchId)
-> (ProjectPath -> AbsBranchId)
-> Either ShortCausalHash ProjectPath
-> AbsBranchId
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ShortCausalHash -> AbsBranchId
forall p. ShortCausalHash -> BranchIdG p
BranchAtSCH ProjectPath -> AbsBranchId
forall p. ProjectPath -> BranchIdG p
BranchAtProjectPath Either ShortCausalHash ProjectPath
newPrefix) BranchDiffOutput Symbol Ann
diffOutput
  ShowDiffAfterDeleteBranch Absolute
bAbs PrettyPrintEnv
ppe BranchDiffOutput Symbol Ann
diff ->
    (Pretty -> Pretty)
-> (Pretty, NumberedArgs) -> (Pretty, NumberedArgs)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
      ( \Pretty
p ->
          [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
            [ Pretty
p,
              Pretty
"",
              Pretty
undoTip
            ]
      )
      (ShowNumbers
-> PrettyPrintEnv
-> AbsBranchId
-> AbsBranchId
-> BranchDiffOutput Symbol Ann
-> (Pretty, NumberedArgs)
forall v.
Var v =>
ShowNumbers
-> PrettyPrintEnv
-> AbsBranchId
-> AbsBranchId
-> BranchDiffOutput v Ann
-> (Pretty, NumberedArgs)
showDiffNamespace ShowNumbers
ShowNumbers PrettyPrintEnv
ppe (Absolute -> AbsBranchId
forall {p}. p -> BranchIdG p
absPathToBranchId Absolute
bAbs) (Absolute -> AbsBranchId
forall {p}. p -> BranchIdG p
absPathToBranchId Absolute
bAbs) BranchDiffOutput Symbol Ann
diff)
  ShowDiffAfterModifyBranch Path'
b' Absolute
_ PrettyPrintEnv
_ (BranchDiffOutput Symbol Ann -> Bool
forall v a. BranchDiffOutput v a -> Bool
OBD.isEmpty -> Bool
True) ->
    (Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Nothing changed in" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Path' -> Pretty
forall path. Pathy path => path -> Pretty
prettyPath Path'
b' Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".", NumberedArgs
forall a. Monoid a => a
mempty)
  ShowDiffAfterModifyBranch Path'
b' Absolute
bAbs PrettyPrintEnv
ppe BranchDiffOutput Symbol Ann
diff ->
    (Pretty -> Pretty)
-> (Pretty, NumberedArgs) -> (Pretty, NumberedArgs)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
      ( \Pretty
p ->
          [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
            [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Here's what changed in" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Path' -> Pretty
forall path. Pathy path => path -> Pretty
prettyPath Path'
b' Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
":",
              Pretty
"",
              Pretty
p,
              Pretty
"",
              Pretty
undoTip
            ]
      )
      (ShowNumbers
-> PrettyPrintEnv
-> AbsBranchId
-> AbsBranchId
-> BranchDiffOutput Symbol Ann
-> (Pretty, NumberedArgs)
forall v.
Var v =>
ShowNumbers
-> PrettyPrintEnv
-> AbsBranchId
-> AbsBranchId
-> BranchDiffOutput v Ann
-> (Pretty, NumberedArgs)
showDiffNamespace ShowNumbers
ShowNumbers PrettyPrintEnv
ppe (Absolute -> AbsBranchId
forall {p}. p -> BranchIdG p
absPathToBranchId Absolute
bAbs) (Absolute -> AbsBranchId
forall {p}. p -> BranchIdG p
absPathToBranchId Absolute
bAbs) BranchDiffOutput Symbol Ann
diff)
  ShowDiffAfterUndo PrettyPrintEnv
ppe BranchDiffOutput Symbol Ann
diffOutput ->
    (Pretty -> Pretty)
-> (Pretty, NumberedArgs) -> (Pretty, NumberedArgs)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
      (\Pretty
p -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines [Pretty
"Here are the changes I undid", Pretty
"", Pretty
p])
      (ShowNumbers
-> PrettyPrintEnv
-> AbsBranchId
-> AbsBranchId
-> BranchDiffOutput Symbol Ann
-> (Pretty, NumberedArgs)
forall v.
Var v =>
ShowNumbers
-> PrettyPrintEnv
-> AbsBranchId
-> AbsBranchId
-> BranchDiffOutput v Ann
-> (Pretty, NumberedArgs)
showDiffNamespace ShowNumbers
ShowNumbers PrettyPrintEnv
ppe (Absolute -> AbsBranchId
forall {p}. p -> BranchIdG p
absPathToBranchId Absolute
Path.Root) (Absolute -> AbsBranchId
forall {p}. p -> BranchIdG p
absPathToBranchId Absolute
Path.Root) BranchDiffOutput Symbol Ann
diffOutput)
  ShowDiffAfterPull Path'
dest' Absolute
destAbs PrettyPrintEnv
ppe BranchDiffOutput Symbol Ann
diff ->
    if BranchDiffOutput Symbol Ann -> Bool
forall v a. BranchDiffOutput v a -> Bool
OBD.isEmpty BranchDiffOutput Symbol Ann
diff
      then (Pretty
"✅  Looks like " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Path' -> Pretty
forall path. Pathy path => path -> Pretty
prettyPath Path'
dest' Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" is up to date.", NumberedArgs
forall a. Monoid a => a
mempty)
      else
        (Pretty -> Pretty)
-> (Pretty, NumberedArgs) -> (Pretty, NumberedArgs)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
          ( \Pretty
p ->
              [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
                [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Here's what's changed in " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Path' -> Pretty
forall path. Pathy path => path -> Pretty
prettyPath Path'
dest' Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"after the pull:",
                  Pretty
"",
                  Pretty
p,
                  Pretty
"",
                  Pretty
undoTip
                ]
          )
          (ShowNumbers
-> PrettyPrintEnv
-> AbsBranchId
-> AbsBranchId
-> BranchDiffOutput Symbol Ann
-> (Pretty, NumberedArgs)
forall v.
Var v =>
ShowNumbers
-> PrettyPrintEnv
-> AbsBranchId
-> AbsBranchId
-> BranchDiffOutput v Ann
-> (Pretty, NumberedArgs)
showDiffNamespace ShowNumbers
ShowNumbers PrettyPrintEnv
ppe (Absolute -> AbsBranchId
forall {p}. p -> BranchIdG p
absPathToBranchId Absolute
destAbs) (Absolute -> AbsBranchId
forall {p}. p -> BranchIdG p
absPathToBranchId Absolute
destAbs) BranchDiffOutput Symbol Ann
diff)
  -- todo: these numbers aren't going to work,
  --  since the content isn't necessarily here.
  -- Should we have a mode with no numbers? :P

  ShowDiffAfterCreateAuthor NameSegment
authorNS Path'
authorPath' Absolute
bAbs PrettyPrintEnv
ppe BranchDiffOutput Symbol Ann
diff ->
    (Pretty -> Pretty)
-> (Pretty, NumberedArgs) -> (Pretty, NumberedArgs)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
      ( \Pretty
p ->
          [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
            [ Pretty
p,
              Pretty
"",
              Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
                Pretty
"Add"
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName (NameSegment -> Name
Name.fromSegment NameSegment
NameSegment.licenseSegment)
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"values for"
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName (NameSegment -> Name
Name.fromSegment NameSegment
authorNS)
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"under"
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Path' -> Pretty
forall path. Pathy path => path -> Pretty
prettyPath Path'
authorPath' Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
            ]
      )
      (ShowNumbers
-> PrettyPrintEnv
-> AbsBranchId
-> AbsBranchId
-> BranchDiffOutput Symbol Ann
-> (Pretty, NumberedArgs)
forall v.
Var v =>
ShowNumbers
-> PrettyPrintEnv
-> AbsBranchId
-> AbsBranchId
-> BranchDiffOutput v Ann
-> (Pretty, NumberedArgs)
showDiffNamespace ShowNumbers
ShowNumbers PrettyPrintEnv
ppe (Absolute -> AbsBranchId
forall {p}. p -> BranchIdG p
absPathToBranchId Absolute
bAbs) (Absolute -> AbsBranchId
forall {p}. p -> BranchIdG p
absPathToBranchId Absolute
bAbs) BranchDiffOutput Symbol Ann
diff)
  TestResults TestReportStats
stats PrettyPrintEnv
ppe Bool
_showSuccess Bool
_showFailures Map TermReferenceId [Text]
oksUnsorted Map TermReferenceId [Text]
failsUnsorted ->
    let oks :: [(HashQualified Name, [Text])]
oks = ((HashQualified Name, [Text]) -> Text)
-> [(HashQualified Name, [Text])] -> [(HashQualified Name, [Text])]
forall a. (a -> Text) -> [a] -> [a]
Name.sortByText (HashQualified Name -> Text
HQ.toText (HashQualified Name -> Text)
-> ((HashQualified Name, [Text]) -> HashQualified Name)
-> (HashQualified Name, [Text])
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashQualified Name, [Text]) -> HashQualified Name
forall a b. (a, b) -> a
fst) [(TermReferenceId -> HashQualified Name
name TermReferenceId
r, [Text]
msgs) | (TermReferenceId
r, [Text]
msgs) <- Map TermReferenceId [Text] -> [(TermReferenceId, [Text])]
forall k a. Map k a -> [(k, a)]
Map.toList Map TermReferenceId [Text]
oksUnsorted]
        fails :: [(HashQualified Name, [Text])]
fails = ((HashQualified Name, [Text]) -> Text)
-> [(HashQualified Name, [Text])] -> [(HashQualified Name, [Text])]
forall a. (a -> Text) -> [a] -> [a]
Name.sortByText (HashQualified Name -> Text
HQ.toText (HashQualified Name -> Text)
-> ((HashQualified Name, [Text]) -> HashQualified Name)
-> (HashQualified Name, [Text])
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashQualified Name, [Text]) -> HashQualified Name
forall a b. (a, b) -> a
fst) [(TermReferenceId -> HashQualified Name
name TermReferenceId
r, [Text]
msgs) | (TermReferenceId
r, [Text]
msgs) <- Map TermReferenceId [Text] -> [(TermReferenceId, [Text])]
forall k a. Map k a -> [(k, a)]
Map.toList Map TermReferenceId [Text]
failsUnsorted]
        name :: TermReferenceId -> HashQualified Name
name TermReferenceId
r = PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName PrettyPrintEnv
ppe (TermReferenceId -> Referent
Referent.fromTermReferenceId TermReferenceId
r)
     in ( case TestReportStats
stats of
            CachedTests Int
0 Int
_ -> Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"😶" (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"No tests to run."
            CachedTests Int
n Int
n' | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n' -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines [Pretty
cache, Pretty
"", Bool
-> [(HashQualified Name, [Text])]
-> [(HashQualified Name, [Text])]
-> Pretty
displayTestResults Bool
True [(HashQualified Name, [Text])]
oks [(HashQualified Name, [Text])]
fails]
            CachedTests Int
_n Int
m ->
              if Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                then Pretty
"✅  "
                else
                  Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
                    [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines [Pretty
"", Pretty
cache, Pretty
"", Bool
-> [(HashQualified Name, [Text])]
-> [(HashQualified Name, [Text])]
-> Pretty
displayTestResults Bool
False [(HashQualified Name, [Text])]
oks [(HashQualified Name, [Text])]
fails, Pretty
"", Pretty
"✅  "]
            TestReportStats
NewlyComputed ->
              [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
                [ Pretty
"  " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.bold Pretty
"New test results:",
                  Pretty
"",
                  Bool
-> [(HashQualified Name, [Text])]
-> [(HashQualified Name, [Text])]
-> Pretty
displayTestResults Bool
True [(HashQualified Name, [Text])]
oks [(HashQualified Name, [Text])]
fails
                ],
          ((HashQualified Name, [Text]) -> StructuredArgument)
-> [(HashQualified Name, [Text])] -> NumberedArgs
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HashQualified Name -> StructuredArgument
SA.HashQualified (HashQualified Name -> StructuredArgument)
-> ((HashQualified Name, [Text]) -> HashQualified Name)
-> (HashQualified Name, [Text])
-> StructuredArgument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashQualified Name, [Text]) -> HashQualified Name
forall a b. (a, b) -> a
fst) ([(HashQualified Name, [Text])] -> NumberedArgs)
-> [(HashQualified Name, [Text])] -> NumberedArgs
forall a b. (a -> b) -> a -> b
$ [(HashQualified Name, [Text])]
oks [(HashQualified Name, [Text])]
-> [(HashQualified Name, [Text])] -> [(HashQualified Name, [Text])]
forall a. Semigroup a => a -> a -> a
<> [(HashQualified Name, [Text])]
fails
        )
    where
      cache :: Pretty
cache = Pretty -> Pretty
P.bold Pretty
"Cached test results " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"(`help testcache` to learn more)"
  Output'Todo TodoOutput
todoOutput -> Numbered Pretty -> (Pretty, NumberedArgs)
forall a. Numbered a -> (a, NumberedArgs)
runNumbered (TodoOutput -> Numbered Pretty
handleTodoOutput TodoOutput
todoOutput)
  CantDeleteNamespace PrettyPrintEnvDecl
ppeDecl Map LabeledDependency (NESet LabeledDependency)
endangerments ->
    ( Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
          [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"I didn't delete the namespace because the following definitions are still in use.",
            Pretty
"",
            PrettyPrintEnvDecl
-> Map LabeledDependency (NESet LabeledDependency) -> Pretty
endangeredDependentsTable PrettyPrintEnvDecl
ppeDecl Map LabeledDependency (NESet LabeledDependency)
endangerments,
            Pretty
"",
            Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty
"If you want to proceed anyways and leave those definitions without names, use " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.patternName InputPattern
IP.deleteNamespaceForce)
          ],
      PrettyPrintEnvDecl
-> Map LabeledDependency (NESet LabeledDependency) -> NumberedArgs
numberedArgsForEndangerments PrettyPrintEnvDecl
ppeDecl Map LabeledDependency (NESet LabeledDependency)
endangerments
    )
  History Maybe Int
_cap Int
schLength [(CausalHash, Maybe (HistoryComment () ()), Diff)]
history (Maybe (HistoryComment () ()), HistoryTail)
tail ->
    let (Pretty
tailMsg, [CausalHash]
tailHashes) = Int -> (Pretty, [CausalHash])
handleTail ([(CausalHash, Maybe (HistoryComment () ()), Diff)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(CausalHash, Maybe (HistoryComment () ()), Diff)]
history Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        msg :: Pretty
        msg :: Pretty
msg =
          [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
            [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
note (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"The most recent namespace hash is immediately below this message.",
              Pretty
"",
              Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty
"\n\n" [Int
-> ShortCausalHash
-> Maybe (HistoryComment () ())
-> Diff
-> Pretty
displayCausal Int
i (CausalHash -> ShortCausalHash
toSCH CausalHash
h) Maybe (HistoryComment () ())
mayComment Diff
diff | (Int
i, (CausalHash
h, Maybe (HistoryComment () ())
mayComment, Diff
diff)) <- [Int]
-> [(CausalHash, Maybe (HistoryComment () ()), Diff)]
-> [(Int, (CausalHash, Maybe (HistoryComment () ()), Diff))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] [(CausalHash, Maybe (HistoryComment () ()), Diff)]
reversedHistory],
              Pretty
"",
              Pretty
tailMsg
            ]
        branchHashes :: [CausalHash]
        branchHashes :: [CausalHash]
branchHashes = (Getting
  CausalHash
  (CausalHash, Maybe (HistoryComment () ()), Diff)
  CausalHash
-> (CausalHash, Maybe (HistoryComment () ()), Diff) -> CausalHash
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  CausalHash
  (CausalHash, Maybe (HistoryComment () ()), Diff)
  CausalHash
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (CausalHash, Maybe (HistoryComment () ()), Diff)
  (CausalHash, Maybe (HistoryComment () ()), Diff)
  CausalHash
  CausalHash
_1 ((CausalHash, Maybe (HistoryComment () ()), Diff) -> CausalHash)
-> [(CausalHash, Maybe (HistoryComment () ()), Diff)]
-> [CausalHash]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(CausalHash, Maybe (HistoryComment () ()), Diff)]
reversedHistory) [CausalHash] -> [CausalHash] -> [CausalHash]
forall a. Semigroup a => a -> a -> a
<> [CausalHash]
tailHashes
     in (Pretty
msg, CausalHash -> StructuredArgument
SA.Namespace (CausalHash -> StructuredArgument) -> [CausalHash] -> NumberedArgs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CausalHash]
branchHashes)
    where
      toSCH :: CausalHash -> ShortCausalHash
      toSCH :: CausalHash -> ShortCausalHash
toSCH CausalHash
h = Int -> CausalHash -> ShortCausalHash
SCH.fromHash Int
schLength CausalHash
h
      reversedHistory :: [(CausalHash, Maybe (HistoryComment () ()), Diff)]
reversedHistory = [(CausalHash, Maybe (HistoryComment () ()), Diff)]
-> [(CausalHash, Maybe (HistoryComment () ()), Diff)]
forall a. [a] -> [a]
reverse [(CausalHash, Maybe (HistoryComment () ()), Diff)]
history
      showNum :: Int -> Pretty
      showNum :: Int -> Pretty
showNum Int
n = Int -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown Int
n Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
". "
      displayComment :: Bool -> Maybe (HistoryComment () ()) -> [Pretty]
      displayComment :: Bool -> Maybe (HistoryComment () ()) -> [Pretty]
displayComment Bool
prefixSpacer Maybe (HistoryComment () ())
mayComment = case Maybe (HistoryComment () ())
mayComment of
        Maybe (HistoryComment () ())
Nothing -> []
        Just (HistoryComment {Text
author :: Text
$sel:author:HistoryComment :: forall causal id. HistoryComment causal id -> Text
author, Text
subject :: Text
$sel:subject:HistoryComment :: forall causal id. HistoryComment causal id -> Text
subject, Text
content :: Text
$sel:content:HistoryComment :: forall causal id. HistoryComment causal id -> Text
content}) ->
          Bool -> [Pretty] -> [Pretty]
forall a. Monoid a => Bool -> a -> a
Monoid.whenM Bool
prefixSpacer [Pretty
""]
            [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [(Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
"⊙ " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.bold (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
author))]
            [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [ Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.indent (Pretty -> Pretty
P.blue Pretty
"  ┃ ") (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
subject)
               ]
            [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> Bool -> [Pretty] -> [Pretty]
forall a. Monoid a => Bool -> a -> a
Monoid.whenM
              (Bool -> Bool
not (Text -> Bool
Text.null Text
content))
              [ (Pretty -> Pretty
P.blue Pretty
"  ┃ "),
                Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.indent (Pretty -> Pretty
P.blue Pretty
"  ┃ ") (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
content)
              ]
            [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [ Pretty
""
               ]
      handleTail :: Int -> (Pretty, [CausalHash])
      handleTail :: Int -> (Pretty, [CausalHash])
handleTail Int
n = case (Maybe (HistoryComment () ()), HistoryTail)
tail of
        (Maybe (HistoryComment () ())
mayComment, E.EndOfLog CausalHash
h) ->
          ( [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
              Bool -> Maybe (HistoryComment () ()) -> [Pretty]
displayComment Bool
True Maybe (HistoryComment () ())
mayComment
                [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [ Pretty
"□ " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Int -> Pretty
showNum Int
n Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ShortCausalHash -> Pretty
forall s. IsString s => ShortCausalHash -> Pretty s
prettySCH (CausalHash -> ShortCausalHash
toSCH CausalHash
h) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" (start of history)"
                   ],
            [CausalHash
h]
          )
        (Maybe (HistoryComment () ())
mayComment, E.MergeTail CausalHash
h [CausalHash]
hs) ->
          ( [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
              Bool -> Maybe (HistoryComment () ()) -> [Pretty]
displayComment Bool
True Maybe (HistoryComment () ())
mayComment
                [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"This segment of history starts with a merge." Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
ex,
                     Pretty
"",
                     Pretty
"⊙ " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Int -> Pretty
showNum Int
n Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ShortCausalHash -> Pretty
forall s. IsString s => ShortCausalHash -> Pretty s
prettySCH (CausalHash -> ShortCausalHash
toSCH CausalHash
h)
                   ]
                [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [ Pretty
"⑃",
                     [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([CausalHash]
hs [CausalHash] -> ([CausalHash] -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& (Int -> CausalHash -> Pretty) -> [CausalHash] -> [Pretty]
forall a b. (Int -> a -> b) -> [a] -> [b]
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap \Int
i CausalHash
h -> Int -> Pretty
showNum (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ShortCausalHash -> Pretty
forall s. IsString s => ShortCausalHash -> Pretty s
prettySCH (CausalHash -> ShortCausalHash
toSCH CausalHash
h))
                   ],
            CausalHash
h CausalHash -> [CausalHash] -> [CausalHash]
forall a. a -> [a] -> [a]
: [CausalHash]
hs
          )
        (Maybe (HistoryComment () ())
mayComment, E.PageEnd CausalHash
h Int
_n) ->
          ( [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
              Bool -> Maybe (HistoryComment () ()) -> [Pretty]
displayComment Bool
True Maybe (HistoryComment () ())
mayComment
                [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"There's more history before the versions shown here." Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
ex,
                     Pretty
"",
                     Pretty
dots,
                     Pretty
"",
                     Pretty
"⊙ " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Int -> Pretty
showNum Int
n Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ShortCausalHash -> Pretty
forall s. IsString s => ShortCausalHash -> Pretty s
prettySCH (CausalHash -> ShortCausalHash
toSCH CausalHash
h)
                   ],
            [CausalHash
h]
          )
      dots :: Pretty
dots = Pretty
"⠇"
      displayCausal :: Int
-> ShortCausalHash
-> Maybe (HistoryComment () ())
-> Diff
-> Pretty
displayCausal Int
i ShortCausalHash
sch Maybe (HistoryComment () ())
mayComment Diff
diff =
        [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
          Bool -> Maybe (HistoryComment () ()) -> [Pretty]
displayComment Bool
False Maybe (HistoryComment () ())
mayComment
            [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [ Pretty
"⊙ " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Int -> Pretty
showNum Int
i Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ShortCausalHash -> Pretty
forall s. IsString s => ShortCausalHash -> Pretty s
prettySCH ShortCausalHash
sch,
                 Pretty
""
               ]
            [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [ Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Diff -> Pretty
prettyDiff Diff
diff
               ]
      ex :: Pretty
ex =
        Pretty
"Use"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.history [Pretty
"#som3n4m3space"]
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to view history starting from a given namespace hash."
  DeletedDespiteDependents PrettyPrintEnvDecl
ppeDecl Map LabeledDependency (NESet LabeledDependency)
endangerments ->
    ( Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
          [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Of the things I deleted, the following are still used in the following definitions. They now contain un-named references.",
            Pretty
"",
            PrettyPrintEnvDecl
-> Map LabeledDependency (NESet LabeledDependency) -> Pretty
endangeredDependentsTable PrettyPrintEnvDecl
ppeDecl Map LabeledDependency (NESet LabeledDependency)
endangerments
          ],
      PrettyPrintEnvDecl
-> Map LabeledDependency (NESet LabeledDependency) -> NumberedArgs
numberedArgsForEndangerments PrettyPrintEnvDecl
ppeDecl Map LabeledDependency (NESet LabeledDependency)
endangerments
    )
  ListProjects [Project]
projects ->
    ( [Pretty] -> Pretty
forall (f :: * -> *). Foldable f => f Pretty -> Pretty
P.numberedList ((Project -> Pretty) -> [Project] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map (ProjectName -> Pretty
prettyProjectName (ProjectName -> Pretty)
-> (Project -> ProjectName) -> Project -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProjectName Project ProjectName -> Project -> ProjectName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProjectName Project ProjectName
#name) [Project]
projects),
      (Project -> StructuredArgument) -> [Project] -> NumberedArgs
forall a b. (a -> b) -> [a] -> [b]
map (ProjectName -> StructuredArgument
SA.Project (ProjectName -> StructuredArgument)
-> (Project -> ProjectName) -> Project -> StructuredArgument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProjectName Project ProjectName -> Project -> ProjectName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProjectName Project ProjectName
#name) [Project]
projects
    )
  ListBranches ProjectName
projectName [(ProjectBranchName, [(URI, ProjectName, ProjectBranchName)])]
branches ->
    ( [Pretty] -> [[Pretty]] -> Pretty
P.columnNHeader
        [Pretty
"", Pretty
"Branch", Pretty
"Remote branch"]
        ( do
            (Int
i, (ProjectBranchName
branchName, [(URI, ProjectName, ProjectBranchName)]
remoteBranches0)) <- [Int]
-> [(ProjectBranchName, [(URI, ProjectName, ProjectBranchName)])]
-> [(Int,
     (ProjectBranchName, [(URI, ProjectName, ProjectBranchName)]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1 :: Int) ..] [(ProjectBranchName, [(URI, ProjectName, ProjectBranchName)])]
branches
            case [(URI, ProjectName, ProjectBranchName)]
-> Maybe
     ((URI, ProjectName, ProjectBranchName),
      [(URI, ProjectName, ProjectBranchName)])
forall s a. Cons s s a a => s -> Maybe (a, s)
uncons [(URI, ProjectName, ProjectBranchName)]
remoteBranches0 of
              Maybe
  ((URI, ProjectName, ProjectBranchName),
   [(URI, ProjectName, ProjectBranchName)])
Nothing -> [Pretty] -> [[Pretty]]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Pretty -> Pretty
P.hiBlack (Int -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown Int
i Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."), ProjectBranchName -> Pretty
prettyProjectBranchName ProjectBranchName
branchName, Pretty
""]
              Just ((URI, ProjectName, ProjectBranchName)
firstRemoteBranch, [(URI, ProjectName, ProjectBranchName)]
remoteBranches) ->
                [ Pretty -> Pretty
P.hiBlack (Int -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown Int
i Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."),
                  ProjectBranchName -> Pretty
prettyProjectBranchName ProjectBranchName
branchName,
                  (URI, ProjectName, ProjectBranchName) -> Pretty
prettyRemoteBranchInfo (URI, ProjectName, ProjectBranchName)
firstRemoteBranch
                ]
                  [Pretty] -> [[Pretty]] -> [[Pretty]]
forall a. a -> [a] -> [a]
: ((URI, ProjectName, ProjectBranchName) -> [Pretty])
-> [(URI, ProjectName, ProjectBranchName)] -> [[Pretty]]
forall a b. (a -> b) -> [a] -> [b]
map (\(URI, ProjectName, ProjectBranchName)
branch -> [Pretty
"", Pretty
"", (URI, ProjectName, ProjectBranchName) -> Pretty
prettyRemoteBranchInfo (URI, ProjectName, ProjectBranchName)
branch]) [(URI, ProjectName, ProjectBranchName)]
remoteBranches
        ),
      ((ProjectBranchName, [(URI, ProjectName, ProjectBranchName)])
 -> StructuredArgument)
-> [(ProjectBranchName, [(URI, ProjectName, ProjectBranchName)])]
-> NumberedArgs
forall a b. (a -> b) -> [a] -> [b]
map
        (ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> StructuredArgument
SA.ProjectBranch (ProjectAndBranch (Maybe ProjectName) ProjectBranchName
 -> StructuredArgument)
-> ((ProjectBranchName, [(URI, ProjectName, ProjectBranchName)])
    -> ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> (ProjectBranchName, [(URI, ProjectName, ProjectBranchName)])
-> StructuredArgument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ProjectName
-> ProjectBranchName
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch (ProjectName -> Maybe ProjectName
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectName
projectName) (ProjectBranchName
 -> ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> ((ProjectBranchName, [(URI, ProjectName, ProjectBranchName)])
    -> ProjectBranchName)
-> (ProjectBranchName, [(URI, ProjectName, ProjectBranchName)])
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectBranchName, [(URI, ProjectName, ProjectBranchName)])
-> ProjectBranchName
forall a b. (a, b) -> a
fst)
        [(ProjectBranchName, [(URI, ProjectName, ProjectBranchName)])]
branches
    )
  AmbiguousSwitch ProjectName
project (ProjectAndBranch ProjectName
currentProject ProjectBranchName
branch) ->
    ( Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
        ( Pretty
"I'm not sure if you wanted to switch to the branch"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
currentProject ProjectBranchName
branch)
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"or the project"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectName -> Pretty
prettyProjectName ProjectName
project Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"Could you be more specific?"
        )
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> [Pretty] -> Pretty
forall (f :: * -> *). Foldable f => f Pretty -> Pretty
P.numberedList
          [ ProjectBranchName -> Pretty
prettySlashProjectBranchName ProjectBranchName
branch Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" (the branch " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Pretty
prettyProjectBranchName ProjectBranchName
branch Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" in the current project)",
            ProjectName -> Pretty
prettyProjectNameSlash ProjectName
project Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" (the project " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectName -> Pretty
prettyProjectName ProjectName
project Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
", with the branch left unspecified)"
          ]
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip
          ( Pretty
"use "
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> [Pretty] -> Pretty
switch [Pretty
"1"]
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" or "
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> [Pretty] -> Pretty
switch [Pretty
"2"]
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" to pick one of these."
          ),
      [ ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> StructuredArgument
SA.ProjectBranch (ProjectAndBranch (Maybe ProjectName) ProjectBranchName
 -> StructuredArgument)
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> StructuredArgument
forall a b. (a -> b) -> a -> b
$ Maybe ProjectName
-> ProjectBranchName
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch Maybe ProjectName
forall a. Maybe a
Nothing ProjectBranchName
branch,
        ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> StructuredArgument
SA.ProjectBranch (ProjectAndBranch (Maybe ProjectName) ProjectBranchName
 -> StructuredArgument)
-> (ProjectBranchName
    -> ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> ProjectBranchName
-> StructuredArgument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ProjectName
-> ProjectBranchName
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch (ProjectName -> Maybe ProjectName
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectName
project) (ProjectBranchName -> StructuredArgument)
-> ProjectBranchName -> StructuredArgument
forall a b. (a -> b) -> a -> b
$
          ProjectBranchName
defaultBranchName
      ]
    )
    where
      switch :: [Pretty] -> Pretty
switch = InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.projectSwitch
  AmbiguousReset AmbiguousReset'Argument
sourceOfAmbiguity (ProjectAndBranch Project
_pn0 ProjectBranch
_bn0, Path
path) (ProjectAndBranch ProjectName
currentProject ProjectBranchName
branch) ->
    ( Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
        ( Pretty
openingLine
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
currentProject ProjectBranchName
branch)
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
orTheNamespace
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
relPath0
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"in the current branch."
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"Could you be more specific?"
        )
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> [Pretty] -> Pretty
forall (f :: * -> *). Foldable f => f Pretty -> Pretty
P.numberedList
          [ ProjectBranchName -> Pretty
prettySlashProjectBranchName ProjectBranchName
branch Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" (the branch " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Pretty
prettyProjectBranchName ProjectBranchName
branch Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" in the current project)",
            Pretty
relPath0 Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" (the relative path " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
relPath0 Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" in the current branch)"
          ]
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip
          ( Pretty
"use "
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> [Pretty] -> Pretty
reset ([Pretty] -> [Pretty]
resetArgs [Pretty
"1"])
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" or "
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> [Pretty] -> Pretty
reset ([Pretty] -> [Pretty]
resetArgs [Pretty
"2"])
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" to pick one of these."
          ),
      [ ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> StructuredArgument
SA.ProjectBranch (ProjectAndBranch (Maybe ProjectName) ProjectBranchName
 -> StructuredArgument)
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> StructuredArgument
forall a b. (a -> b) -> a -> b
$ Maybe ProjectName
-> ProjectBranchName
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch Maybe ProjectName
forall a. Maybe a
Nothing ProjectBranchName
branch,
        Absolute -> StructuredArgument
SA.AbsolutePath Absolute
absPath0
      ]
    )
    where
      openingLine :: Pretty
openingLine = case AmbiguousReset'Argument
sourceOfAmbiguity of
        AmbiguousReset'Argument
E.AmbiguousReset'Hash -> Pretty
"I'm not sure if you wanted to reset to the branch"
        AmbiguousReset'Argument
E.AmbiguousReset'Target -> Pretty
"I'm not sure if you wanted to reset the branch"
      orTheNamespace :: Pretty
orTheNamespace = case AmbiguousReset'Argument
sourceOfAmbiguity of
        AmbiguousReset'Argument
E.AmbiguousReset'Hash -> Pretty
"or to the namespace"
        AmbiguousReset'Argument
E.AmbiguousReset'Target -> Pretty
"or the namespace"
      resetArgs :: [Pretty] -> [Pretty]
resetArgs = case AmbiguousReset'Argument
sourceOfAmbiguity of
        AmbiguousReset'Argument
E.AmbiguousReset'Hash -> \[Pretty]
xs -> [Pretty]
xs
        AmbiguousReset'Argument
E.AmbiguousReset'Target -> \[Pretty]
xs -> Pretty
"<some hash>" Pretty -> [Pretty] -> [Pretty]
forall a. a -> [a] -> [a]
: [Pretty]
xs
      reset :: [Pretty] -> Pretty
reset = InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.reset
      relPath0 :: Pretty
relPath0 = Path -> Pretty
forall path. Pathy path => path -> Pretty
prettyPath Path
path
      absPath0 :: Absolute
absPath0 = Path -> Absolute
Path.Absolute Path
path
  ListNamespaceDependencies PrettyPrintEnv
_ppe ProjectPath
_path Map LabeledDependency (Set Name)
Empty -> (Pretty
"This namespace has no external dependencies.", NumberedArgs
forall a. Monoid a => a
mempty)
  ListNamespaceDependencies PrettyPrintEnv
ppe ProjectPath
path' Map LabeledDependency (Set Name)
externalDependencies ->
    ( Pretty -> Pretty -> [(Pretty, Pretty)] -> Pretty
P.column2Header (Pretty -> Pretty
P.hiBlack Pretty
"External dependency") (Pretty
"Dependents in " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectPath -> Pretty
prettyProjectPath ProjectPath
path') ([(Pretty, Pretty)] -> Pretty) -> [(Pretty, Pretty)] -> Pretty
forall a b. (a -> b) -> a -> b
$
        (Pretty, Pretty) -> [(Pretty, Pretty)] -> [(Pretty, Pretty)]
forall a. a -> [a] -> [a]
List.intersperse (Pretty, Pretty)
spacer (Map LabeledDependency (Set Name) -> [(Pretty, Pretty)]
externalDepsTable Map LabeledDependency (Set Name)
externalDependencies),
      NumberedArgs
numberedArgs
    )
    where
      spacer :: (Pretty, Pretty)
spacer = (Pretty
"", Pretty
"")
      (Map Name Int
nameNumbers, NumberedArgs
numberedArgs) = Map LabeledDependency (Set Name) -> (Map Name Int, NumberedArgs)
numberedDependents Map LabeledDependency (Set Name)
externalDependencies
      getNameNumber :: Name -> Int
getNameNumber Name
name = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (String -> Int
forall a. HasCallStack => String -> a
error String
"ListNamespaceDependencies: name is missing number") (Name -> Map Name Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name Map Name Int
nameNumbers)
      numberedDependents :: Map LabeledDependency (Set Name) -> (Map Name Int, NumberedArgs)
      numberedDependents :: Map LabeledDependency (Set Name) -> (Map Name Int, NumberedArgs)
numberedDependents Map LabeledDependency (Set Name)
deps =
        Map LabeledDependency (Set Name)
deps
          Map LabeledDependency (Set Name)
-> (Map LabeledDependency (Set Name) -> [Set Name]) -> [Set Name]
forall a b. a -> (a -> b) -> b
& Map LabeledDependency (Set Name) -> [Set Name]
forall k a. Map k a -> [a]
Map.elems
          [Set Name]
-> ([Set Name] -> (Int, (Map Name Int, [Name])))
-> (Int, (Map Name Int, [Name]))
forall a b. a -> (a -> b) -> b
& ((Int, (Map Name Int, [Name]))
 -> Set Name -> (Int, (Map Name Int, [Name])))
-> (Int, (Map Name Int, [Name]))
-> [Set Name]
-> (Int, (Map Name Int, [Name]))
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
            ( \(Int
nextNum, (Map Name Int
nameToNum, [Name]
args)) Set Name
names ->
                let unnumberedNames :: [Name]
unnumberedNames = Set Name -> [Name]
forall a. Set a -> [a]
Set.toList (Set Name -> [Name]) -> Set Name -> [Name]
forall a b. (a -> b) -> a -> b
$ Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set Name
names (Map Name Int -> Set Name
forall k a. Map k a -> Set k
Map.keysSet Map Name Int
nameToNum)
                    newNextNum :: Int
newNextNum = Int
nextNum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Name] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
unnumberedNames
                 in ( Int
newNextNum,
                      ( Map Name Int
nameToNum Map Name Int -> Map Name Int -> Map Name Int
forall a. Semigroup a => a -> a -> a
<> ([(Name, Int)] -> Map Name Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Name] -> [Int] -> [(Name, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
unnumberedNames [Int
nextNum ..])),
                        [Name]
args [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> [Name]
unnumberedNames
                      )
                    )
            )
            (Int
1, (Map Name Int
forall a. Monoid a => a
mempty, [Name]
forall a. Monoid a => a
mempty))
          (Int, (Map Name Int, [Name]))
-> ((Int, (Map Name Int, [Name])) -> (Map Name Int, [Name]))
-> (Map Name Int, [Name])
forall a b. a -> (a -> b) -> b
& (Int, (Map Name Int, [Name])) -> (Map Name Int, [Name])
forall a b. (a, b) -> b
snd
          (Map Name Int, [Name])
-> ((Map Name Int, [Name]) -> (Map Name Int, NumberedArgs))
-> (Map Name Int, NumberedArgs)
forall a b. a -> (a -> b) -> b
& ASetter
  (Map Name Int, [Name])
  (Map Name Int, NumberedArgs)
  Name
  StructuredArgument
-> (Name -> StructuredArgument)
-> (Map Name Int, [Name])
-> (Map Name Int, NumberedArgs)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (([Name] -> Identity NumberedArgs)
-> (Map Name Int, [Name]) -> Identity (Map Name Int, NumberedArgs)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Map Name Int, [Name])
  (Map Name Int, NumberedArgs)
  [Name]
  NumberedArgs
_2 (([Name] -> Identity NumberedArgs)
 -> (Map Name Int, [Name]) -> Identity (Map Name Int, NumberedArgs))
-> ((Name -> Identity StructuredArgument)
    -> [Name] -> Identity NumberedArgs)
-> ASetter
     (Map Name Int, [Name])
     (Map Name Int, NumberedArgs)
     Name
     StructuredArgument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Identity StructuredArgument)
-> [Name] -> Identity NumberedArgs
Setter [Name] NumberedArgs Name StructuredArgument
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) Name -> StructuredArgument
SA.Name
      externalDepsTable :: Map LabeledDependency (Set Name) -> [(P.Pretty P.ColorText, P.Pretty P.ColorText)]
      externalDepsTable :: Map LabeledDependency (Set Name) -> [(Pretty, Pretty)]
externalDepsTable = (LabeledDependency -> Set Name -> [(Pretty, Pretty)])
-> Map LabeledDependency (Set Name) -> [(Pretty, Pretty)]
forall m a.
Monoid m =>
(LabeledDependency -> a -> m) -> Map LabeledDependency a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap ((LabeledDependency -> Set Name -> [(Pretty, Pretty)])
 -> Map LabeledDependency (Set Name) -> [(Pretty, Pretty)])
-> (LabeledDependency -> Set Name -> [(Pretty, Pretty)])
-> Map LabeledDependency (Set Name)
-> [(Pretty, Pretty)]
forall a b. (a -> b) -> a -> b
$ \LabeledDependency
ld Set Name
dependents ->
        [(LabeledDependency -> Pretty
prettyLD LabeledDependency
ld, Set Name -> Pretty
prettyDependents Set Name
dependents)]
      prettyLD :: LabeledDependency -> P.Pretty P.ColorText
      prettyLD :: LabeledDependency -> Pretty
prettyLD =
        Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor
          (Pretty (SyntaxText' TypeReference) -> Pretty)
-> (LabeledDependency -> Pretty (SyntaxText' TypeReference))
-> LabeledDependency
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified
          (HashQualified Name -> Pretty (SyntaxText' TypeReference))
-> (LabeledDependency -> HashQualified Name)
-> LabeledDependency
-> Pretty (SyntaxText' TypeReference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeReference -> HashQualified Name)
-> (Referent -> HashQualified Name)
-> LabeledDependency
-> HashQualified Name
forall a.
(TypeReference -> a) -> (Referent -> a) -> LabeledDependency -> a
LD.fold
            (PrettyPrintEnv -> TypeReference -> HashQualified Name
PPE.typeName PrettyPrintEnv
ppe)
            (PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName PrettyPrintEnv
ppe)
      prettyDependents :: Set Name -> P.Pretty P.ColorText
      prettyDependents :: Set Name -> Pretty
prettyDependents Set Name
refs =
        Set Name
refs
          Set Name -> (Set Name -> [Name]) -> [Name]
forall a b. a -> (a -> b) -> b
& Set Name -> [Name]
forall a. Set a -> [a]
Set.toList
          [Name] -> ([Name] -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& (Name -> Pretty) -> [Name] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Name
name -> Int -> Pretty
formatNum (Name -> Int
getNameNumber Name
name) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
name)
          [Pretty] -> ([Pretty] -> Pretty) -> Pretty
forall a b. a -> (a -> b) -> b
& [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
  ShowProjectBranchReflog Maybe UTCTime
now MoreEntriesThanShown
moreToShow [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
entries -> Maybe UTCTime
-> MoreEntriesThanShown
-> [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
-> (Pretty, NumberedArgs)
displayProjectBranchReflogEntries Maybe UTCTime
now MoreEntriesThanShown
moreToShow [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
entries
  DeletedDefinitions DefnsF Set Name Name
defns ->
    let typesList :: [Name]
typesList = [Name] -> [Name]
forall a. Alphabetical a => [a] -> [a]
sortAlphabetically (Set Name -> [Name]
forall a. Set a -> [a]
Set.toList DefnsF Set Name Name
defns.types)
        termsList :: [Name]
termsList = [Name] -> [Name]
forall a. Alphabetical a => [a] -> [a]
sortAlphabetically (Set Name -> [Name]
forall a. Set a -> [a]
Set.toList DefnsF Set Name Name
defns.terms)
        deletedTheseTypes :: Pretty
deletedTheseTypes =
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"I deleted these types:"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 ([Pretty] -> Pretty
forall (f :: * -> *). Foldable f => f Pretty -> Pretty
P.numberedList ((Name -> Pretty) -> [Name] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName [Name]
typesList))
        deletedTheseTerms :: Pretty
deletedTheseTerms =
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"I deleted these terms:"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Int -> [Pretty] -> Pretty
forall (f :: * -> *). Foldable f => Int -> f Pretty -> Pretty
P.numberedListFrom (Set Name -> Int
forall a. Set a -> Int
Set.size DefnsF Set Name Name
defns.types) ((Name -> Pretty) -> [Name] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName [Name]
termsList))
     in ( ( case (Set Name -> Bool
forall a. Set a -> Bool
Set.null DefnsF Set Name Name
defns.types, Set Name -> Bool
forall a. Set a -> Bool
Set.null DefnsF Set Name Name
defns.terms) of
              (Bool
True, Bool
_) -> Pretty
deletedTheseTerms
              (Bool
_, Bool
True) -> Pretty
deletedTheseTypes
              (Bool, Bool)
_ -> Pretty
deletedTheseTypes Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
deletedTheseTerms
          )
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
undoTip,
          (Name -> StructuredArgument) -> [Name] -> NumberedArgs
forall a b. (a -> b) -> [a] -> [b]
map Name -> StructuredArgument
SA.Name ([Name]
typesList [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
termsList)
        )
  where
    absPathToBranchId :: p -> BranchIdG p
absPathToBranchId = p -> BranchIdG p
forall {p}. p -> BranchIdG p
BranchAtPath

undoTip :: P.Pretty P.ColorText
undoTip :: Pretty
undoTip =
  Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
    Pretty
"You can use"
      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.undo
      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" or use a hash from "
      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.branchReflog
      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to undo this change."

issueUrl :: Word -> P.Pretty P.ColorText
issueUrl :: Word -> Pretty
issueUrl = (Pretty
"https://github.com/unisonweb/unison/issues/" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<>) (Pretty -> Pretty) -> (Word -> Pretty) -> Word -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown

showIssueUrl :: (Applicative f) => Word -> f (P.Pretty P.ColorText)
showIssueUrl :: forall (f :: * -> *). Applicative f => Word -> f Pretty
showIssueUrl = Pretty -> f Pretty
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> f Pretty) -> (Word -> Pretty) -> Word -> f Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Pretty
issueUrl

githubTitleForIssue :: Word -> IO (Either GH.Error Text)
githubTitleForIssue :: Word -> IO (Either Error Text)
githubTitleForIssue =
  (Either Error Issue -> Either Error Text)
-> IO (Either Error Issue) -> IO (Either Error Text)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Issue -> Text) -> Either Error Issue -> Either Error Text
forall a b. (a -> b) -> Either Error a -> Either Error b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Issue -> Text
GH.issueTitle) (IO (Either Error Issue) -> IO (Either Error Text))
-> (Word -> IO (Either Error Issue))
-> Word
-> IO (Either Error Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name Owner -> Name Repo -> IssueNumber -> Request 'RO Issue)
-> Name Owner
-> Name Repo
-> IssueNumber
-> IO (Either Error Issue)
forall req res. GitHubRO req res => req -> res
GH.github' Name Owner -> Name Repo -> IssueNumber -> Request 'RO Issue
forall (k :: RW).
Name Owner -> Name Repo -> IssueNumber -> Request k Issue
GH.issueR Name Owner
"unisonweb" Name Repo
"unison" (IssueNumber -> IO (Either Error Issue))
-> (Word -> IssueNumber) -> Word -> IO (Either Error Issue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IssueNumber
GH.IssueNumber (Int -> IssueNumber) -> (Word -> Int) -> Word -> IssueNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Look up the issue in the unisonweb/unison repo, and include the title in the message.
fetchIssueFromGitHub :: Word -> IO Pretty
fetchIssueFromGitHub :: Word -> IO Pretty
fetchIssueFromGitHub Word
i =
  (Error -> Pretty)
-> (Text -> Pretty) -> Either Error Text -> Pretty
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Pretty -> Error -> Pretty
forall a b. a -> b -> a
const (Pretty -> Error -> Pretty) -> Pretty -> Error -> Pretty
forall a b. (a -> b) -> a -> b
$ Word -> Pretty
issueUrl Word
i) (\Text
title -> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
title Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Word -> Pretty
issueUrl Word
i) (Either Error Text -> Pretty)
-> IO (Either Error Text) -> IO Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> IO (Either Error Text)
githubTitleForIssue Word
i

notifyUser ::
  -- | The directory being watched for .u files. If a `FilePath` isn’t provided, it uses a constant string. This is
  --   useful in contexts like transcripts, where we need the output to be consistent, and not vary because of a temp
  --   directory.
  Maybe FilePath ->
  -- | How to present any GitHub issues associated with an error. For example, `showIssueUrl` or `fetchIssueFromGitHub`.
  (Word -> IO (P.Pretty P.ColorText)) ->
  Output ->
  IO Pretty
notifyUser :: Maybe String -> (Word -> IO Pretty) -> Output -> IO Pretty
notifyUser Maybe String
dir Word -> IO Pretty
issueFn = \case
  SaveTermNameConflict Name
name ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout
      (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
      (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Cannot save the last run result into"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. IsString s => Pretty s -> Pretty s
P.backticked (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Name -> Text
Name.toText Name
name))
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"because that name conflicts with a name in the scratch file."
  Output
NoLastRunResult ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout
      (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
      (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"There is no previous evaluation to save."
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"Use"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. IsString s => Pretty s -> Pretty s
P.backticked Pretty
"run"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to evaluate something before attempting"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to save it."
  Output
Success -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty
P.bold Pretty
"Done."
  NamespaceEmpty NonEmpty (Either ShortCausalHash ProjectPath)
p ->
    case NonEmpty (Either ShortCausalHash ProjectPath)
p of
      (Either ShortCausalHash ProjectPath
p0 NEList.:| []) ->
        Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout
          (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"The namespace "
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> (ShortCausalHash -> Pretty)
-> (ProjectPath -> Pretty)
-> Either ShortCausalHash ProjectPath
-> Pretty
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ShortCausalHash -> Pretty
forall s. IsString s => ShortCausalHash -> Pretty s
prettySCH ProjectPath -> Pretty
prettyProjectPath Either ShortCausalHash ProjectPath
p0
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" is empty. Was there a typo?"
      NonEmpty (Either ShortCausalHash ProjectPath)
ps ->
        Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout
          (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"The namespaces "
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> NonEmpty Pretty -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.commas ((ShortCausalHash -> Pretty)
-> (ProjectPath -> Pretty)
-> Either ShortCausalHash ProjectPath
-> Pretty
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ShortCausalHash -> Pretty
forall s. IsString s => ShortCausalHash -> Pretty s
prettySCH ProjectPath -> Pretty
prettyProjectPath (Either ShortCausalHash ProjectPath -> Pretty)
-> NonEmpty (Either ShortCausalHash ProjectPath) -> NonEmpty Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Either ShortCausalHash ProjectPath)
ps)
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" are empty. Was there a typo?"
  LoadedDefinitionsToSourceFile String
fp Int
numDefinitions ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"☝️" (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
          [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"I added " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> forall a s. (Show a, IsString s) => a -> Pretty s
P.shown @Int Int
numDefinitions Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" definitions to the top of " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> String -> Pretty
forall a. IsString a => String -> a
fromString String
fp,
            Pretty
"",
            Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
              Pretty
"You can edit them there, then run"
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
makeExample' InputPattern
IP.update
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to replace the definitions currently in this namespace."
          ]
  DisplayDefinitions Pretty
code -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
code
  OutputRewrittenFile String
dest [Symbol]
vs -> String -> [Symbol] -> IO Pretty
forall v. Var v => String -> [v] -> IO Pretty
displayOutputRewrittenFile String
dest [Symbol]
vs
  DisplayRendered Maybe String
outputLoc Pretty
pp ->
    Maybe String -> Pretty -> IO Pretty
displayRendered Maybe String
outputLoc Pretty
pp
  TestIncrementalOutputStart PrettyPrintEnv
ppe (Int
n, Int
total) TermReferenceId
r -> do
    Pretty -> IO ()
putPretty' (Pretty -> IO ()) -> Pretty -> IO ()
forall a b. (a -> b) -> a -> b
$
      Int -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" tests left to run, current test: "
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified (PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName PrettyPrintEnv
ppe (Referent -> HashQualified Name) -> Referent -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ TermReferenceId -> Referent
Referent.fromTermReferenceId TermReferenceId
r))
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty
  TestIncrementalOutputEnd PrettyPrintEnv
_ppe (Int
_n, Int
_total) TermReferenceId
_r Bool
isOk -> do
    IO ()
clearCurrentLine
    if Bool
isOk
      then Pretty -> IO ()
putPretty' Pretty
"  ✅  "
      else Pretty -> IO ()
putPretty' Pretty
"  🚫  "
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty
  TermMissingType TypeReference
ref ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.fatalCallout (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
          Pretty
"The type signature for reference "
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.blue (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (TypeReference -> Text
Reference.toText TypeReference
ref))
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" is missing from the codebase! This means something might be wrong "
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" with the codebase, or the term was deleted just now "
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" by someone else. Trying your command again might fix it."
      ]
  EvaluationFailure Pretty -> Pretty
ctx Error
err -> Pretty -> Pretty
ctx (Pretty -> Pretty) -> IO Pretty -> IO Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word -> IO Pretty) -> Error -> IO Pretty
forall (f :: * -> *).
Applicative f =>
(Word -> f Pretty) -> Error -> f Pretty
prettyError Word -> IO Pretty
issueFn Error
err
  SearchTermsNotFound [HashQualified Name]
hqs | [HashQualified Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HashQualified Name]
hqs -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty
  SearchTermsNotFound [HashQualified Name]
hqs ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout Pretty
"The following names were not found in the codebase. Check your spelling."
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> (Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> Pretty (SyntaxText' TypeReference) -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.indent Pretty (SyntaxText' TypeReference)
"  " ([Pretty (SyntaxText' TypeReference)]
-> Pretty (SyntaxText' TypeReference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines (HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified (HashQualified Name -> Pretty (SyntaxText' TypeReference))
-> [HashQualified Name] -> [Pretty (SyntaxText' TypeReference)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HashQualified Name]
hqs)))
  SearchTermsNotFoundDetailed Bool
wasTerm [HashQualified Name]
hqMisses [HashQualified Name]
otherHits ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty
missMsg Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
hitMsg)
    where
      typeOrTermMsg :: Pretty
typeOrTermMsg =
        if Bool
wasTerm
          then Pretty
"I was expecting the following names to be terms, though I found types instead."
          else Pretty
"I was expecting the following names to be types, though I found terms instead."
      missMsg :: Pretty
missMsg = case [HashQualified Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HashQualified Name]
hqMisses of
        Bool
True -> Pretty
forall a. Monoid a => a
mempty
        Bool
False ->
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout Pretty
"The following names were not found in the codebase. Check your spelling."
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.indent Pretty (SyntaxText' TypeReference)
"  " ([Pretty (SyntaxText' TypeReference)]
-> Pretty (SyntaxText' TypeReference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines (HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified (HashQualified Name -> Pretty (SyntaxText' TypeReference))
-> [HashQualified Name] -> [Pretty (SyntaxText' TypeReference)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HashQualified Name]
hqMisses)))
      hitMsg :: Pretty
hitMsg = case [HashQualified Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HashQualified Name]
otherHits of
        Bool
True -> Pretty
forall a. Monoid a => a
mempty
        Bool
False ->
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout Pretty
typeOrTermMsg
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.indent Pretty (SyntaxText' TypeReference)
"  " ([Pretty (SyntaxText' TypeReference)]
-> Pretty (SyntaxText' TypeReference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines (HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified (HashQualified Name -> Pretty (SyntaxText' TypeReference))
-> [HashQualified Name] -> [Pretty (SyntaxText' TypeReference)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HashQualified Name]
otherHits)))
  TermAndOrTypeNameNotFound Maybe (Defn () ())
which HashQualified Name
name ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
          Pretty
"I couldn't find any"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> case Maybe (Defn () ())
which of
              Maybe (Defn () ())
Nothing -> Pretty
"terms or types"
              Just (TermDefn ()) -> Pretty
"terms"
              Just (TypeDefn ()) -> Pretty
"types"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"that match the name"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified' HashQualified Name
name) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
  TermNotFound HashQualified (Split Path')
_ ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"I don't know about that term."
  TypeNotFound HashQualified (Split Path')
_ ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"I don't know about that type."
  MoveNothingFound Path'
p ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"There is no term, type, or namespace at " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Path' -> Pretty
forall path. Pathy path => path -> Pretty
prettyPath Path'
p Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."
  TermAlreadyExists Split Path'
_ Set Referent
_ ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"A term by that name already exists."
  TypeAlreadyExists Split Path'
_ Set TypeReference
_ ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"A type by that name already exists."
  BranchEmpty WhichBranchEmpty
b ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (WhichBranchEmpty -> Pretty
prettyWhichBranchEmpty WhichBranchEmpty
b) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"is an empty namespace."
  CantUndo UndoFailureReason
reason -> case UndoFailureReason
reason of
    UndoFailureReason
CantUndoPastStart -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Nothing more to undo."
    UndoFailureReason
CantUndoPastMerge -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Sorry, I can't undo a merge (not implemented yet)."
  NoMainFunction HashQualified Name
main PrettyPrintEnv
ppe [Type Symbol Ann]
ts ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"😶" (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
            Pretty
"I looked for a function"
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. IsString s => Pretty s -> Pretty s
P.backticked (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty) -> Text -> Pretty
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Text
HQ.toText HashQualified Name
main)
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"in the most recently typechecked file and codebase but couldn't find one. It has to have the type:",
          Pretty
"",
          Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines [Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (HashQualified Name -> Text
HQ.toText HashQualified Name
main) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" : " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> PrettyPrintEnv -> Type Symbol Ann -> Pretty
forall v a. Var v => PrettyPrintEnv -> Type v a -> Pretty
TypePrinter.pretty PrettyPrintEnv
ppe Type Symbol Ann
t | Type Symbol Ann
t <- [Type Symbol Ann]
ts]
        ]
  BadMainFunction Text
what HashQualified Name
main Type Symbol Ann
ty PrettyPrintEnv
ppe [Type Symbol Ann]
ts ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"😶" (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ String -> Pretty
forall s. IsString s => String -> Pretty s
P.string String
"I found this function:",
          Pretty
"",
          Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (HashQualified Name -> Text
HQ.toText HashQualified Name
main) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" : " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> PrettyPrintEnv -> Type Symbol Ann -> Pretty
forall v a. Var v => PrettyPrintEnv -> Type v a -> Pretty
TypePrinter.pretty PrettyPrintEnv
ppe Type Symbol Ann
ty,
          Pretty
"",
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ String -> Pretty
forall s. IsString s => String -> Pretty s
P.string String
"but in order for me to" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. IsString s => Pretty s -> Pretty s
P.backticked (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
what) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"it needs to be a subtype of:",
          Pretty
"",
          Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines [Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (HashQualified Name -> Text
HQ.toText HashQualified Name
main) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" : " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> PrettyPrintEnv -> Type Symbol Ann -> Pretty
forall v a. Var v => PrettyPrintEnv -> Type v a -> Pretty
TypePrinter.pretty PrettyPrintEnv
ppe Type Symbol Ann
t | Type Symbol Ann
t <- [Type Symbol Ann]
ts]
        ]
  Output
NoUnisonFile -> do
    Pretty
fileName <- IO Pretty -> (String -> IO Pretty) -> Maybe String -> IO Pretty
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty
P.blue Pretty
"〈redacted〉") (String -> IO Pretty
renderFileName (String -> IO Pretty)
-> (String -> IO String) -> String -> IO Pretty
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> IO String
canonicalizePath) Maybe String
dir
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"😶" (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"There's nothing for me to add right now.",
          Pretty
"",
          [(Pretty, Pretty)] -> Pretty
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2 [(Pretty -> Pretty
P.bold Pretty
"Hint:", Pretty -> Pretty
msg Pretty
fileName)]
        ]
    where
      msg :: Pretty -> Pretty
msg Pretty
dir =
        Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
          Pretty
"I'm currently watching for definitions in .u files under the"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
dir
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"directory. Make sure you've updated something there before using the"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
makeExample' InputPattern
IP.update
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"command, or use"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
makeExample' InputPattern
IP.load
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to load a file explicitly."
  InvalidSourceName String
name ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"😶" (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
"The file "
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.blue (String -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown String
name)
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" does not exist or is not a valid source file."
  InvalidStructuredFindReplace HashQualified Name
_sym ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"😶" (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ InputPattern -> Pretty
IP.helpFor InputPattern
IP.sfindReplace
  InvalidStructuredFind HashQualified Name
_sym ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"😶" (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ InputPattern -> Pretty
IP.helpFor InputPattern
IP.sfind
  SourceLoadFailed String
name ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"😶" (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
"The file "
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.blue (String -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown String
name)
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" could not be loaded."
  BadNamespace String
msg String
path ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Invalid namespace " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.blue (String -> Pretty
forall s. IsString s => String -> Pretty s
P.string String
path) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
", " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> String -> Pretty
forall s. IsString s => String -> Pretty s
P.string String
msg
  BranchNotFound Path'
b ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"The namespace " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Path' -> Pretty
forall path. Pathy path => path -> Pretty
prettyPath Path'
b Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" doesn't exist."
  EmptyLooseCodePush Path'
b ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"The namespace " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Path' -> Pretty
forall path. Pathy path => path -> Pretty
prettyPath Path'
b Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" is empty. There is nothing to push."
  EmptyProjectBranchPush ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"is empty. There is nothing to push."
  CreatedNewBranch Absolute
path ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"☝️  The namespace " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Absolute -> Pretty
forall path. Pathy path => path -> Pretty
prettyPath Absolute
path Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" is empty."
  -- RenameOutput rootPath oldName newName r -> do
  --   nameChange "rename" "renamed" oldName newName r
  -- AliasOutput rootPath existingName newName r -> do
  --   nameChange "alias" "aliased" existingName newName r
  Output
DeletedEverything ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [ Pretty
"Okay, I deleted everything except the history.",
        Pretty
"Use "
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.undo
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" to undo, or "
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.mergeBuiltins
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" to restore the absolute "
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"basics to the current path."
      ]
  Output
DeleteEverythingConfirmation ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [ Pretty
"Are you sure you want to clear away everything?",
        Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
          ( Pretty
"You could use "
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.projectCreate
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" to switch to a new project instead,"
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" or delete the current branch with "
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.deleteBranch
          )
      ]
  DeleteBranchConfirmation [(Path', (Names, [SearchResult' Symbol Ann]))]
_uniqueDeletions -> String -> IO Pretty
forall a. HasCallStack => String -> a
error String
"todo"
  -- let
  --   pretty (branchName, (ppe, results)) =
  --     header $ listOfDefinitions' ppe False results
  --     where
  --     header = plural uniqueDeletions id ((P.text branchName <> ":") `P.hang`)
  --
  -- in putPrettyLn . P.warnCallout
  --   $ P.wrap ("The"
  --   <> plural uniqueDeletions "namespace contains" "namespaces contain"
  --   <> "definitions that don't exist in any other branches:")
  --   <> P.border 2 (mconcat (fmap pretty uniqueDeletions))
  --   <> P.newline
  --   <> P.wrap "Please repeat the same command to confirm the deletion."
  Output
MoveRootBranchConfirmation ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [ Pretty
"Moves which affect the root branch cannot be undone, are you sure?",
        Pretty
"Re-run the same command to proceed."
      ]
  MovedOverExistingBranch Path'
dest' ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"A branch existed at the destination:" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Path' -> Pretty
forall path. Pathy path => path -> Pretty
prettyPath Path'
dest' Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"so I over-wrote it.",
        Pretty
"",
        Pretty
undoTip
      ]
  ListOfDefinitions FindScope
fscope PrettyPrintEnv
ppe Bool
detailed [SearchResult' Symbol Ann]
results ->
    FindScope
-> PrettyPrintEnv
-> Bool
-> [SearchResult' Symbol Ann]
-> IO Pretty
forall v a.
Var v =>
FindScope
-> PrettyPrintEnv -> Bool -> [SearchResult' v a] -> IO Pretty
listOfDefinitions FindScope
fscope PrettyPrintEnv
ppe Bool
detailed [SearchResult' Symbol Ann]
results
  GlobalFindBranchResults ProjectAndBranch ProjectName ProjectBranchName
projBranchName PrettyPrintEnv
ppe Bool
detailed [SearchResult' Symbol Ann]
results -> do
    Pretty
output <- FindScope
-> PrettyPrintEnv
-> Bool
-> [SearchResult' Symbol Ann]
-> IO Pretty
forall v a.
Var v =>
FindScope
-> PrettyPrintEnv -> Bool -> [SearchResult' v a] -> IO Pretty
listOfDefinitions FindScope
Input.FindGlobal PrettyPrintEnv
ppe Bool
detailed [SearchResult' Symbol Ann]
results
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Found results in " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (forall target source. From source target => source -> target
into @Text ProjectAndBranch ProjectName ProjectBranchName
projBranchName),
          Pretty
"",
          Pretty
output
        ]
  ListNames String
namesQuery Int
len [(TypeReference, [HashQualified Name])]
types [(Referent, [HashQualified Name])]
terms ->
    String
-> Int
-> [(TypeReference, [HashQualified Name])]
-> [(Referent, [HashQualified Name])]
-> IO Pretty
listOfNames String
namesQuery Int
len [(TypeReference, [HashQualified Name])]
types [(Referent, [HashQualified Name])]
terms
  GlobalListNames String
namesQuery ProjectAndBranch ProjectName ProjectBranchName
projectBranchName Int
len [(TypeReference, [HashQualified Name])]
types [(Referent, [HashQualified Name])]
terms -> do
    Pretty
output <- String
-> Int
-> [(TypeReference, [HashQualified Name])]
-> [(Referent, [HashQualified Name])]
-> IO Pretty
listOfNames String
namesQuery Int
len [(TypeReference, [HashQualified Name])]
types [(Referent, [HashQualified Name])]
terms
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Found results in " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (forall target source. From source target => source -> target
into @Text ProjectAndBranch ProjectName ProjectBranchName
projectBranchName),
          Pretty
"",
          Pretty
output
        ]
  ListShallow IO PrettyPrintEnv
buildPPE [ShallowListEntry Symbol Ann]
entries -> do
    let needPPE :: Bool
needPPE =
          [ShallowListEntry Symbol Ann]
entries
            [ShallowListEntry Symbol Ann]
-> ([ShallowListEntry Symbol Ann] -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& (ShallowListEntry Symbol Ann -> Bool)
-> [ShallowListEntry Symbol Ann] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any \case
              ShallowTermEntry {} -> Bool
True
              ShallowListEntry Symbol Ann
_ -> Bool
False
    PrettyPrintEnv
ppe <-
      if Bool
needPPE
        then IO PrettyPrintEnv
buildPPE
        else PrettyPrintEnv -> IO PrettyPrintEnv
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrettyPrintEnv
PPE.empty
    -- todo: make a version of prettyNumberedResult to support 3-columns
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      if [ShallowListEntry Symbol Ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ShallowListEntry Symbol Ann]
entries
        then ColorText -> Pretty
forall s. (IsString s, ListLike s Char) => s -> Pretty s
P.lit ColorText
"nothing to show"
        else PrettyPrintEnv -> [ShallowListEntry Symbol Ann] -> Pretty
forall v a.
Var v =>
PrettyPrintEnv -> [ShallowListEntry v a] -> Pretty
numberedEntries PrettyPrintEnv
ppe [ShallowListEntry Symbol Ann]
entries
    where
      numberedEntries :: (Var v) => PPE.PrettyPrintEnv -> [ShallowListEntry v a] -> Pretty
      numberedEntries :: forall v a.
Var v =>
PrettyPrintEnv -> [ShallowListEntry v a] -> Pretty
numberedEntries PrettyPrintEnv
ppe [ShallowListEntry v a]
entries =
        ([(Pretty, Pretty, Pretty)] -> Pretty
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s, Pretty s)] -> Pretty s
P.column3 ([(Pretty, Pretty, Pretty)] -> Pretty)
-> ([(Integer, (Pretty, Pretty))] -> [(Pretty, Pretty, Pretty)])
-> [(Integer, (Pretty, Pretty))]
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Integer, (Pretty, Pretty)) -> (Pretty, Pretty, Pretty))
-> [(Integer, (Pretty, Pretty))] -> [(Pretty, Pretty, Pretty)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer, (Pretty, Pretty)) -> (Pretty, Pretty, Pretty)
forall {a} {b} {c}. Show a => (a, (b, c)) -> (Pretty, b, c)
f) ([(Integer
1 :: Integer) ..] [Integer] -> [(Pretty, Pretty)] -> [(Integer, (Pretty, Pretty))]
forall a b. [a] -> [b] -> [(a, b)]
`zip` (ShallowListEntry v a -> (Pretty, Pretty))
-> [ShallowListEntry v a] -> [(Pretty, Pretty)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PrettyPrintEnv -> ShallowListEntry v a -> (Pretty, Pretty)
forall v a.
Var v =>
PrettyPrintEnv -> ShallowListEntry v a -> (Pretty, Pretty)
formatEntry PrettyPrintEnv
ppe) [ShallowListEntry v a]
entries)
        where
          f :: (a, (b, c)) -> (Pretty, b, c)
f (a
i, (b
p1, c
p2)) = (Pretty -> Pretty
P.hiBlack (Pretty -> Pretty) -> (String -> Pretty) -> String -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Pretty
forall a. IsString a => String -> a
fromString (String -> Pretty) -> String -> Pretty
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".", b
p1, c
p2)
      formatEntry :: (Var v) => PPE.PrettyPrintEnv -> ShallowListEntry v a -> (Pretty, Pretty)
      formatEntry :: forall v a.
Var v =>
PrettyPrintEnv -> ShallowListEntry v a -> (Pretty, Pretty)
formatEntry PrettyPrintEnv
ppe = \case
        ShallowTermEntry TermEntry v a
termEntry ->
          ( Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> (TermEntry v a -> Pretty (SyntaxText' TypeReference))
-> TermEntry v a
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified' (HashQualified Name -> Pretty (SyntaxText' TypeReference))
-> (TermEntry v a -> HashQualified Name)
-> TermEntry v a
-> Pretty (SyntaxText' TypeReference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TermEntry v a -> HashQualified Name
forall v a. TermEntry v a -> HashQualified Name
Backend.termEntryHQName (TermEntry v a -> Pretty) -> TermEntry v a -> Pretty
forall a b. (a -> b) -> a -> b
$ TermEntry v a
termEntry,
            ColorText -> Pretty
forall s. (IsString s, ListLike s Char) => s -> Pretty s
P.lit ColorText
"(" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> (Type v a -> Pretty) -> Maybe (Type v a) -> Pretty
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Pretty
"type missing" (PrettyPrintEnv -> Type v a -> Pretty
forall v a. Var v => PrettyPrintEnv -> Type v a -> Pretty
TypePrinter.pretty PrettyPrintEnv
ppe) (TermEntry v a -> Maybe (Type v a)
forall v a. TermEntry v a -> Maybe (Type v a)
Backend.termEntryType TermEntry v a
termEntry) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ColorText -> Pretty
forall s. (IsString s, ListLike s Char) => s -> Pretty s
P.lit ColorText
")"
          )
        ShallowTypeEntry TypeEntry
typeEntry ->
          ( Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> (TypeEntry -> Pretty (SyntaxText' TypeReference))
-> TypeEntry
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified' (HashQualified Name -> Pretty (SyntaxText' TypeReference))
-> (TypeEntry -> HashQualified Name)
-> TypeEntry
-> Pretty (SyntaxText' TypeReference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeEntry -> HashQualified Name
Backend.typeEntryHQName (TypeEntry -> Pretty) -> TypeEntry -> Pretty
forall a b. (a -> b) -> a -> b
$ TypeEntry
typeEntry,
            TypeReference -> Pretty
forall {t} {h}. Reference' t h -> Pretty
isBuiltin (TypeEntry -> TypeReference
typeEntryReference TypeEntry
typeEntry)
          )
        ShallowBranchEntry NameSegment
ns CausalHash
_ (NamespaceStats {Int
numContainedTerms :: Int
$sel:numContainedTerms:NamespaceStats :: NamespaceStats -> Int
numContainedTerms, Int
numContainedTypes :: Int
$sel:numContainedTypes:NamespaceStats :: NamespaceStats -> Int
numContainedTypes}) ->
          ( (Pretty (SyntaxText' Any) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' Any) -> Pretty)
-> (NameSegment -> Pretty (SyntaxText' Any))
-> NameSegment
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Pretty (SyntaxText' Any)
forall s. IsString s => Name -> Pretty s
prettyName (Name -> Pretty (SyntaxText' Any))
-> (NameSegment -> Name) -> NameSegment -> Pretty (SyntaxText' Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Name
Name.fromSegment) NameSegment
ns Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".",
            case [Maybe Pretty] -> [Pretty]
forall a. [Maybe a] -> [a]
catMaybes [Pretty -> Int -> Maybe Pretty
formatCount Pretty
"term" Int
numContainedTerms, Pretty -> Int -> Maybe Pretty
formatCount Pretty
"type" Int
numContainedTypes] of
              [] -> Pretty
""
              [Pretty]
counts -> Pretty -> Pretty
P.hiBlack (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"(" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> (Pretty -> Pretty) -> [Pretty] -> Pretty
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap Pretty
", " Pretty -> Pretty
forall a. a -> a
id [Pretty]
counts Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
")"
          )
        ShallowPatchEntry NameSegment
ns ->
          ( (Pretty (SyntaxText' Any) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' Any) -> Pretty)
-> (NameSegment -> Pretty (SyntaxText' Any))
-> NameSegment
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Pretty (SyntaxText' Any)
forall s. IsString s => Name -> Pretty s
prettyName (Name -> Pretty (SyntaxText' Any))
-> (NameSegment -> Name) -> NameSegment -> Pretty (SyntaxText' Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Name
Name.fromSegment) NameSegment
ns,
            ColorText -> Pretty
forall s. (IsString s, ListLike s Char) => s -> Pretty s
P.lit ColorText
"(patch)"
          )
      formatCount :: Pretty -> Int -> Maybe Pretty
      formatCount :: Pretty -> Int -> Maybe Pretty
formatCount Pretty
_thing Int
0 = Maybe Pretty
forall a. Maybe a
Nothing
      formatCount Pretty
thing Int
1 = Pretty -> Maybe Pretty
forall a. a -> Maybe a
Just (Pretty -> Maybe Pretty) -> Pretty -> Maybe Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"1 " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
thing
      formatCount Pretty
thing Int
n = Pretty -> Maybe Pretty
forall a. a -> Maybe a
Just (Pretty -> Maybe Pretty) -> Pretty -> Maybe Pretty
forall a b. (a -> b) -> a -> b
$ Int -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown Int
n Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
thing Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"s"
      isBuiltin :: Reference' t h -> Pretty
isBuiltin = \case
        Reference.Builtin {} -> ColorText -> Pretty
forall s. (IsString s, ListLike s Char) => s -> Pretty s
P.lit ColorText
"(builtin type)"
        Reference.DerivedId {} -> ColorText -> Pretty
forall s. (IsString s, ListLike s Char) => s -> Pretty s
P.lit ColorText
"(type)"
  SlurpOutput Input
input PrettyPrintEnv
ppe SlurpResult
s ->
    let isPast :: Bool
isPast = case Input
input of
          Input.Update2I {} -> Bool
True
          Input.SaveExecuteResultI {} -> Bool
True
          Input
_ -> Bool
False
     in Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Bool -> PrettyPrintEnv -> SlurpResult -> Pretty
SlurpResult.pretty Bool
isPast PrettyPrintEnv
ppe SlurpResult
s
  Output
FindNoLocalMatches ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"☝️" (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"I couldn't find matches in this namespace, searching in 'lib'..."
  Output
NoExactTypeMatches ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"☝️" (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"I couldn't find exact type matches, resorting to fuzzy matching..."
  TypeParseError String
src Err Symbol
e ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.fatalCallout (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"I couldn't parse the type you supplied:",
          Pretty
"",
          String -> Err Symbol -> Pretty
forall v. Var v => String -> Err v -> Pretty
prettyParseError String
src Err Symbol
e
        ]
  ParseResolutionFailures String
src [ResolutionFailure Ann]
es ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      String -> [ResolutionFailure Ann] -> Pretty
forall a.
(Annotated a, Ord a) =>
String -> [ResolutionFailure a] -> Pretty
prettyResolutionFailures String
src [ResolutionFailure Ann]
es
  TypeHasFreeVars Type Symbol Ann
typ ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"The type uses these names, but I'm not sure what they are:",
          Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty
", " ((Symbol -> Pretty) -> [Symbol] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty) -> (Symbol -> Text) -> Symbol -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Text
forall v. Var v => v -> Text
Var.name) ([Symbol] -> [Pretty])
-> (Set Symbol -> [Symbol]) -> Set Symbol -> [Pretty]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Symbol -> [Symbol]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set Symbol -> [Pretty]) -> Set Symbol -> [Pretty]
forall a b. (a -> b) -> a -> b
$ Type Symbol Ann -> Set Symbol
forall (f :: * -> *) v a. Term f v a -> Set v
ABT.freeVars Type Symbol Ann
typ)
        ]
  ParseErrors Text
src [Err Symbol]
es ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty
"\n\n" ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$ String -> Err Symbol -> Pretty
forall v. Var v => String -> Err v -> Pretty
prettyParseError (Text -> String
Text.unpack Text
src) (Err Symbol -> Pretty) -> [Err Symbol] -> [Pretty]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Err Symbol]
es
  TypeErrors Absolute
_curPath Text
src PrettyPrintEnv
ppenv [ErrorNote Symbol Ann]
notes -> do
    let showNote :: [ErrorNote Symbol Ann] -> Pretty
showNote =
          Pretty
-> (Note Symbol Ann -> Pretty) -> [Note Symbol Ann] -> Pretty
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap Pretty
"\n\n" (PrettyPrintEnv -> String -> Note Symbol Ann -> Pretty
forall v a.
(Var v, Annotated a, Show a, Ord a) =>
PrettyPrintEnv -> String -> Note v a -> Pretty
printNoteWithSource PrettyPrintEnv
ppenv (Text -> String
Text.unpack Text
src))
            ([Note Symbol Ann] -> Pretty)
-> ([ErrorNote Symbol Ann] -> [Note Symbol Ann])
-> [ErrorNote Symbol Ann]
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ErrorNote Symbol Ann -> Note Symbol Ann)
-> [ErrorNote Symbol Ann] -> [Note Symbol Ann]
forall a b. (a -> b) -> [a] -> [b]
map ErrorNote Symbol Ann -> Note Symbol Ann
forall v loc. ErrorNote v loc -> Note v loc
Result.TypeError
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ [ErrorNote Symbol Ann] -> Pretty
showNote [ErrorNote Symbol Ann]
notes
  TypeWarns Absolute
_curPath Text
src PrettyPrintEnv
ppenv [Warn Symbol Ann]
warns ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> String -> [Warn Symbol Ann] -> Pretty
forall v loc.
(Var v, Annotated loc, Ord loc, Show loc) =>
PrettyPrintEnv -> String -> [Warn v loc] -> Pretty
renderTypeWarnings PrettyPrintEnv
ppenv (Text -> String
Text.unpack Text
src) [Warn Symbol Ann]
warns
  CompilerBugs Text
src PrettyPrintEnv
env [CompilerBug Symbol Ann]
bugs -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
-> (CompilerBug Symbol Ann -> Pretty)
-> [CompilerBug Symbol Ann]
-> Pretty
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap Pretty
"\n\n" CompilerBug Symbol Ann -> Pretty
bug [CompilerBug Symbol Ann]
bugs
    where
      bug :: CompilerBug Symbol Ann -> Pretty
bug = PrettyPrintEnv -> String -> CompilerBug Symbol Ann -> Pretty
forall v loc.
(Var v, Annotated loc, Ord loc, Show loc) =>
PrettyPrintEnv -> String -> CompilerBug v loc -> Pretty
renderCompilerBug PrettyPrintEnv
env (Text -> String
Text.unpack Text
src)
  Evaluated Text
fileContents PrettyPrintEnv
ppe [(Symbol, Term Symbol ())]
bindings Map Symbol (Ann, String, Term Symbol (), Bool)
watches ->
    if Map Symbol (Ann, String, Term Symbol (), Bool) -> Bool
forall a. Map Symbol a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Symbol (Ann, String, Term Symbol (), Bool)
watches
      then Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
"\n"
      else -- todo: hashqualify binding names if necessary to distinguish them from
      --       defs in the codebase.  In some cases it's fine for bindings to
      --       shadow codebase names, but you don't want it to capture them in
      --       the decompiled output.

        let prettyBindings :: Pretty
prettyBindings =
              Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.bracket (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
                Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"The watch expression(s) reference these definitions:"
                  Pretty -> [Pretty] -> [Pretty]
forall a. a -> [a] -> [a]
: Pretty
""
                  Pretty -> [Pretty] -> [Pretty]
forall a. a -> [a] -> [a]
: [ Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> Pretty (SyntaxText' TypeReference) -> Pretty
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv
-> HashQualified Name
-> Term Symbol ()
-> Pretty (SyntaxText' TypeReference)
forall v at ap a.
Var v =>
PrettyPrintEnv
-> HashQualified Name
-> Term2 v at ap v a
-> Pretty (SyntaxText' TypeReference)
TermPrinter.prettyBinding PrettyPrintEnv
ppe (Symbol -> HashQualified Name
forall v. Var v => v -> HashQualified Name
HQ.unsafeFromVar Symbol
v) Term Symbol ()
b
                      | (Symbol
v, Term Symbol ()
b) <- [(Symbol, Term Symbol ())]
bindings
                    ]
            prettyWatches :: Pretty
prettyWatches =
              Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep
                Pretty
"\n\n"
                [ Text
-> PrettyPrintEnv
-> Ann
-> String
-> Term Symbol ()
-> Bool
-> Pretty
forall v.
Var v =>
Text
-> PrettyPrintEnv -> Ann -> String -> Term v () -> Bool -> Pretty
watchPrinter Text
fileContents PrettyPrintEnv
ppe Ann
ann String
kind Term Symbol ()
evald Bool
isCacheHit
                  | (Ann
ann, String
kind, Term Symbol ()
evald, Bool
isCacheHit) <-
                      ((Ann, String, Term Symbol (), Bool) -> Ann)
-> [(Ann, String, Term Symbol (), Bool)]
-> [(Ann, String, Term Symbol (), Bool)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(Ann
a, String
_, Term Symbol ()
_, Bool
_) -> Ann
a) ([(Ann, String, Term Symbol (), Bool)]
 -> [(Ann, String, Term Symbol (), Bool)])
-> (Map Symbol (Ann, String, Term Symbol (), Bool)
    -> [(Ann, String, Term Symbol (), Bool)])
-> Map Symbol (Ann, String, Term Symbol (), Bool)
-> [(Ann, String, Term Symbol (), Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Symbol (Ann, String, Term Symbol (), Bool)
-> [(Ann, String, Term Symbol (), Bool)]
forall a. Map Symbol a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Map Symbol (Ann, String, Term Symbol (), Bool)
 -> [(Ann, String, Term Symbol (), Bool)])
-> Map Symbol (Ann, String, Term Symbol (), Bool)
-> [(Ann, String, Term Symbol (), Bool)]
forall a b. (a -> b) -> a -> b
$ Map Symbol (Ann, String, Term Symbol (), Bool)
watches
                ]
         in -- todo: use P.nonempty
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
              if [(Symbol, Term Symbol ())] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Symbol, Term Symbol ())]
bindings
                then Pretty
prettyWatches
                else Pretty
prettyBindings Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"\n" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
prettyWatches
  RunResult PrettyPrintEnv
ppe Term Symbol ()
term -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrettyPrintEnv -> Term Symbol () -> Pretty
forall v a.
(HasCallStack, Var v) =>
PrettyPrintEnv -> Term v a -> Pretty
TermPrinter.pretty PrettyPrintEnv
ppe Term Symbol ()
term)
  DisplayConflicts Relation Name Referent
termNamespace Relation Name TypeReference
typeNamespace ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty
        Pretty
"\n\n"
        [ Pretty -> Set Name -> Pretty
forall (f :: * -> *). Foldable f => Pretty -> f Name -> Pretty
showConflicts Pretty
"terms" Set Name
terms,
          Pretty -> Set Name -> Pretty
forall (f :: * -> *). Foldable f => Pretty -> f Name -> Pretty
showConflicts Pretty
"types" Set Name
types
        ]
    where
      terms :: Set Name
terms = Relation Name Referent -> Set Name
forall a b. Relation a b -> Set a
R.dom Relation Name Referent
termNamespace
      types :: Set Name
types = Relation Name TypeReference -> Set Name
forall a b. Relation a b -> Set a
R.dom Relation Name TypeReference
typeNamespace
      showConflicts :: (Foldable f) => Pretty -> f Name -> Pretty
      showConflicts :: forall (f :: * -> *). Foldable f => Pretty -> f Name -> Pretty
showConflicts Pretty
thingsName f Name
things =
        if (f Name -> Bool
forall a. f a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null f Name
things)
          then Pretty
forall a. Monoid a => a
mempty
          else
            [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
              [ Pretty
"These " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
thingsName Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" have conflicts: ",
                Pretty
"",
                [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines [(Pretty
"  " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
x) | Name
x <- f Name -> [Name]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f Name
things]
              ]
  LoadingFile Text
sourceName -> do
    Pretty
fileName <- String -> IO Pretty
renderFileName (String -> IO Pretty) -> String -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
sourceName
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Loading changes detected in " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty
fileName Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
  Typechecked PrettyPrintEnv
oldPpe PrettyPrintEnv
newPpe DefnsF (Map Name) TermSlurp TypeSlurp
slurpEntries Map Referent (NESet Name)
aliases -> do
    let newTypes0 :: [(Name, DeclOrBuiltin Symbol Ann)]
        updatedTypes0 :: [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
        deletedTypes0 :: [(Name, DeclOrBuiltin Symbol Ann)]
        numUnchangedTypes :: Int
        ([(Name, DeclOrBuiltin Symbol Ann)]
newTypes0, [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
updatedTypes0, [(Name, DeclOrBuiltin Symbol Ann)]
deletedTypes0, Int
numUnchangedTypes) =
          (([(Name, DeclOrBuiltin Symbol Ann)],
  [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
  [(Name, DeclOrBuiltin Symbol Ann)], Int)
 -> Name
 -> TypeSlurp
 -> ([(Name, DeclOrBuiltin Symbol Ann)],
     [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
     [(Name, DeclOrBuiltin Symbol Ann)], Int))
-> ([(Name, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann)], Int)
-> Map Name TypeSlurp
-> ([(Name, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann)], Int)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey'
            ( \([(Name, DeclOrBuiltin Symbol Ann)],
 [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
 [(Name, DeclOrBuiltin Symbol Ann)], Int)
acc Name
name -> \case
                SlurpResult.TypeSlurp'Add DeclOrBuiltin Symbol Ann
decl -> ASetter
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  [(Name, DeclOrBuiltin Symbol Ann)]
  [(Name, DeclOrBuiltin Symbol Ann)]
-> ([(Name, DeclOrBuiltin Symbol Ann)]
    -> [(Name, DeclOrBuiltin Symbol Ann)])
-> ([(Name, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann)], Int)
-> ([(Name, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann)], Int)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  [(Name, DeclOrBuiltin Symbol Ann)]
  [(Name, DeclOrBuiltin Symbol Ann)]
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  [(Name, DeclOrBuiltin Symbol Ann)]
  [(Name, DeclOrBuiltin Symbol Ann)]
_1 ((Name
name, DeclOrBuiltin Symbol Ann
decl) (Name, DeclOrBuiltin Symbol Ann)
-> [(Name, DeclOrBuiltin Symbol Ann)]
-> [(Name, DeclOrBuiltin Symbol Ann)]
forall a. a -> [a] -> [a]
:) ([(Name, DeclOrBuiltin Symbol Ann)],
 [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
 [(Name, DeclOrBuiltin Symbol Ann)], Int)
acc
                SlurpResult.TypeSlurp'Update Updated (DeclOrBuiltin Symbol Ann)
decl -> ASetter
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
  [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
-> ([(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
    -> [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)])
-> ([(Name, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann)], Int)
-> ([(Name, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann)], Int)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
  [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
  [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
_2 ((Name
name, Updated (DeclOrBuiltin Symbol Ann)
decl.old, Updated (DeclOrBuiltin Symbol Ann)
decl.new) (Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)
-> [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
-> [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
forall a. a -> [a] -> [a]
:) ([(Name, DeclOrBuiltin Symbol Ann)],
 [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
 [(Name, DeclOrBuiltin Symbol Ann)], Int)
acc
                SlurpResult.TypeSlurp'Delete DeclOrBuiltin Symbol Ann
decl -> ASetter
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  [(Name, DeclOrBuiltin Symbol Ann)]
  [(Name, DeclOrBuiltin Symbol Ann)]
-> ([(Name, DeclOrBuiltin Symbol Ann)]
    -> [(Name, DeclOrBuiltin Symbol Ann)])
-> ([(Name, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann)], Int)
-> ([(Name, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann)], Int)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  [(Name, DeclOrBuiltin Symbol Ann)]
  [(Name, DeclOrBuiltin Symbol Ann)]
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  [(Name, DeclOrBuiltin Symbol Ann)]
  [(Name, DeclOrBuiltin Symbol Ann)]
_3 ((Name
name, DeclOrBuiltin Symbol Ann
decl) (Name, DeclOrBuiltin Symbol Ann)
-> [(Name, DeclOrBuiltin Symbol Ann)]
-> [(Name, DeclOrBuiltin Symbol Ann)]
forall a. a -> [a] -> [a]
:) ([(Name, DeclOrBuiltin Symbol Ann)],
 [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
 [(Name, DeclOrBuiltin Symbol Ann)], Int)
acc
                TypeSlurp
SlurpResult.TypeSlurp'Unchanged -> ASetter
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  Int
  Int
-> (Int -> Int)
-> ([(Name, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann)], Int)
-> ([(Name, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
    [(Name, DeclOrBuiltin Symbol Ann)], Int)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  Int
  Int
forall s t a b. Field4 s t a b => Lens s t a b
Lens
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  ([(Name, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
   [(Name, DeclOrBuiltin Symbol Ann)], Int)
  Int
  Int
_4 (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([(Name, DeclOrBuiltin Symbol Ann)],
 [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)],
 [(Name, DeclOrBuiltin Symbol Ann)], Int)
acc
            )
            ([], [], [], Int
0)
            DefnsF (Map Name) TermSlurp TypeSlurp
slurpEntries.types

    let newTypes :: [(Name, DeclOrBuiltin Symbol Ann)]
        newTypes :: [(Name, DeclOrBuiltin Symbol Ann)]
newTypes = ((Name, DeclOrBuiltin Symbol Ann) -> Name)
-> [(Name, DeclOrBuiltin Symbol Ann)]
-> [(Name, DeclOrBuiltin Symbol Ann)]
forall a b. Alphabetical a => (b -> a) -> [b] -> [b]
sortAlphabeticallyOn (Getting Name (Name, DeclOrBuiltin Symbol Ann) Name
-> (Name, DeclOrBuiltin Symbol Ann) -> Name
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Name (Name, DeclOrBuiltin Symbol Ann) Name
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Name, DeclOrBuiltin Symbol Ann)
  (Name, DeclOrBuiltin Symbol Ann)
  Name
  Name
_1) [(Name, DeclOrBuiltin Symbol Ann)]
newTypes0
        updatedTypes :: [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
        updatedTypes :: [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
updatedTypes = ((Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)
 -> Name)
-> [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
-> [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
forall a b. Alphabetical a => (b -> a) -> [b] -> [b]
sortAlphabeticallyOn (Getting
  Name
  (Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)
  Name
-> (Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)
-> Name
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  Name
  (Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)
  Name
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)
  (Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)
  Name
  Name
_1) [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
updatedTypes0
        deletedTypes :: [(Name, DeclOrBuiltin Symbol Ann)]
        deletedTypes :: [(Name, DeclOrBuiltin Symbol Ann)]
deletedTypes = ((Name, DeclOrBuiltin Symbol Ann) -> Name)
-> [(Name, DeclOrBuiltin Symbol Ann)]
-> [(Name, DeclOrBuiltin Symbol Ann)]
forall a b. Alphabetical a => (b -> a) -> [b] -> [b]
sortAlphabeticallyOn (Getting Name (Name, DeclOrBuiltin Symbol Ann) Name
-> (Name, DeclOrBuiltin Symbol Ann) -> Name
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Name (Name, DeclOrBuiltin Symbol Ann) Name
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Name, DeclOrBuiltin Symbol Ann)
  (Name, DeclOrBuiltin Symbol Ann)
  Name
  Name
_1) [(Name, DeclOrBuiltin Symbol Ann)]
deletedTypes0

    let toAliases :: Referent -> [Name]
        toAliases :: Referent -> [Name]
toAliases Referent
ref =
          [Name] -> (NESet Name -> [Name]) -> Maybe (NESet Name) -> [Name]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ([Name] -> [Name]
forall a. Alphabetical a => [a] -> [a]
sortAlphabetically ([Name] -> [Name])
-> (NESet Name -> [Name]) -> NESet Name -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Name -> [Name]
forall a. NonEmpty a -> [a]
NEList.toList (NonEmpty Name -> [Name])
-> (NESet Name -> NonEmpty Name) -> NESet Name -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NESet Name -> NonEmpty Name
forall a. NESet a -> NonEmpty a
Set.Nonempty.toList) (Referent -> Map Referent (NESet Name) -> Maybe (NESet Name)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Referent
ref Map Referent (NESet Name)
aliases)

    let newTerms0 :: [(Name, Type Symbol Ann, [Name])]
        updatedTerms0 :: [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
        deletedTerms0 :: [(Name, Type Symbol Ann, [Name])]
        numUnchangedTerms :: Int
        ([(Name, Type Symbol Ann, [Name])]
newTerms0, [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
updatedTerms0, [(Name, Type Symbol Ann, [Name])]
deletedTerms0, Int
numUnchangedTerms) =
          (([(Name, Type Symbol Ann, [Name])],
  [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
  [(Name, Type Symbol Ann, [Name])], Int)
 -> Name
 -> TermSlurp
 -> ([(Name, Type Symbol Ann, [Name])],
     [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
     [(Name, Type Symbol Ann, [Name])], Int))
-> ([(Name, Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name])], Int)
-> Map Name TermSlurp
-> ([(Name, Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name])], Int)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey'
            ( \([(Name, Type Symbol Ann, [Name])],
 [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
 [(Name, Type Symbol Ann, [Name])], Int)
acc Name
name -> \case
                SlurpResult.TermSlurp'Add (Typed TypeReference
ref Type Symbol Ann
ty) -> ASetter
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  [(Name, Type Symbol Ann, [Name])]
  [(Name, Type Symbol Ann, [Name])]
-> ([(Name, Type Symbol Ann, [Name])]
    -> [(Name, Type Symbol Ann, [Name])])
-> ([(Name, Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name])], Int)
-> ([(Name, Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name])], Int)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  [(Name, Type Symbol Ann, [Name])]
  [(Name, Type Symbol Ann, [Name])]
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  [(Name, Type Symbol Ann, [Name])]
  [(Name, Type Symbol Ann, [Name])]
_1 ((Name
name, Type Symbol Ann
ty, Referent -> [Name]
toAliases (TypeReference -> Referent
Referent.Ref TypeReference
ref)) (Name, Type Symbol Ann, [Name])
-> [(Name, Type Symbol Ann, [Name])]
-> [(Name, Type Symbol Ann, [Name])]
forall a. a -> [a] -> [a]
:) ([(Name, Type Symbol Ann, [Name])],
 [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
 [(Name, Type Symbol Ann, [Name])], Int)
acc
                SlurpResult.TermSlurp'Update (Updated (Typed Referent
oldRef Type Symbol Ann
oldTy) (Typed Referent
newRef Type Symbol Ann
newTy)) ->
                  ASetter
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
  [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
-> ([(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
    -> [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])])
-> ([(Name, Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name])], Int)
-> ([(Name, Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name])], Int)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
  [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
  [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
_2 ((Name
name, Type Symbol Ann
oldTy, Referent -> [Name]
toAliases Referent
oldRef, Type Symbol Ann
newTy, Referent -> [Name]
toAliases Referent
newRef) (Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])
-> [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
-> [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
forall a. a -> [a] -> [a]
:) ([(Name, Type Symbol Ann, [Name])],
 [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
 [(Name, Type Symbol Ann, [Name])], Int)
acc
                SlurpResult.TermSlurp'Delete (Typed TypeReference
ref Type Symbol Ann
ty) -> ASetter
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  [(Name, Type Symbol Ann, [Name])]
  [(Name, Type Symbol Ann, [Name])]
-> ([(Name, Type Symbol Ann, [Name])]
    -> [(Name, Type Symbol Ann, [Name])])
-> ([(Name, Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name])], Int)
-> ([(Name, Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name])], Int)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  [(Name, Type Symbol Ann, [Name])]
  [(Name, Type Symbol Ann, [Name])]
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  [(Name, Type Symbol Ann, [Name])]
  [(Name, Type Symbol Ann, [Name])]
_3 ((Name
name, Type Symbol Ann
ty, Referent -> [Name]
toAliases (TypeReference -> Referent
Referent.Ref TypeReference
ref)) (Name, Type Symbol Ann, [Name])
-> [(Name, Type Symbol Ann, [Name])]
-> [(Name, Type Symbol Ann, [Name])]
forall a. a -> [a] -> [a]
:) ([(Name, Type Symbol Ann, [Name])],
 [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
 [(Name, Type Symbol Ann, [Name])], Int)
acc
                TermSlurp
SlurpResult.TermSlurp'Unchanged -> ASetter
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  Int
  Int
-> (Int -> Int)
-> ([(Name, Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name])], Int)
-> ([(Name, Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
    [(Name, Type Symbol Ann, [Name])], Int)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  Int
  Int
forall s t a b. Field4 s t a b => Lens s t a b
Lens
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  ([(Name, Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
   [(Name, Type Symbol Ann, [Name])], Int)
  Int
  Int
_4 (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([(Name, Type Symbol Ann, [Name])],
 [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])],
 [(Name, Type Symbol Ann, [Name])], Int)
acc
            )
            ([], [], [], Int
0)
            DefnsF (Map Name) TermSlurp TypeSlurp
slurpEntries.terms

    let newTerms :: [(Name, Type Symbol Ann, [Name])]
        newTerms :: [(Name, Type Symbol Ann, [Name])]
newTerms = ((Name, Type Symbol Ann, [Name]) -> Name)
-> [(Name, Type Symbol Ann, [Name])]
-> [(Name, Type Symbol Ann, [Name])]
forall a b. Alphabetical a => (b -> a) -> [b] -> [b]
sortAlphabeticallyOn (Getting Name (Name, Type Symbol Ann, [Name]) Name
-> (Name, Type Symbol Ann, [Name]) -> Name
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Name (Name, Type Symbol Ann, [Name]) Name
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Name, Type Symbol Ann, [Name])
  (Name, Type Symbol Ann, [Name])
  Name
  Name
_1) [(Name, Type Symbol Ann, [Name])]
newTerms0
        updatedTerms :: [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
        updatedTerms :: [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
updatedTerms = ((Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name]) -> Name)
-> [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
-> [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
forall a b. Alphabetical a => (b -> a) -> [b] -> [b]
sortAlphabeticallyOn (Getting
  Name (Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name]) Name
-> (Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name]) -> Name
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  Name (Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name]) Name
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])
  (Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])
  Name
  Name
_1) [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
updatedTerms0
        deletedTerms :: [(Name, Type Symbol Ann, [Name])]
        deletedTerms :: [(Name, Type Symbol Ann, [Name])]
deletedTerms = ((Name, Type Symbol Ann, [Name]) -> Name)
-> [(Name, Type Symbol Ann, [Name])]
-> [(Name, Type Symbol Ann, [Name])]
forall a b. Alphabetical a => (b -> a) -> [b] -> [b]
sortAlphabeticallyOn (Getting Name (Name, Type Symbol Ann, [Name]) Name
-> (Name, Type Symbol Ann, [Name]) -> Name
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Name (Name, Type Symbol Ann, [Name]) Name
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Name, Type Symbol Ann, [Name])
  (Name, Type Symbol Ann, [Name])
  Name
  Name
_1) [(Name, Type Symbol Ann, [Name])]
deletedTerms0

    let existAdds :: Bool
existAdds = Bool -> Bool
not ([(Name, DeclOrBuiltin Symbol Ann)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [(Name, DeclOrBuiltin Symbol Ann)]
newTypes Bool -> Bool -> Bool
&& [(Name, Type Symbol Ann, [Name])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [(Name, Type Symbol Ann, [Name])]
newTerms)
        existUpdates :: Bool
existUpdates = Bool -> Bool
not ([(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
updatedTypes Bool -> Bool -> Bool
&& [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
updatedTerms)
        existDeletes :: Bool
existDeletes = Bool -> Bool
not ([(Name, DeclOrBuiltin Symbol Ann)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [(Name, DeclOrBuiltin Symbol Ann)]
deletedTypes Bool -> Bool -> Bool
&& [(Name, Type Symbol Ann, [Name])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [(Name, Type Symbol Ann, [Name])]
deletedTerms)
        existChanges :: Bool
existChanges = Bool
existAdds Bool -> Bool -> Bool
|| Bool
existUpdates Bool -> Bool -> Bool
|| Bool
existDeletes

    let renderType :: Name -> DeclOrBuiltin Symbol Ann -> Pretty
        renderType :: Name -> DeclOrBuiltin Symbol Ann -> Pretty
renderType Name
name DeclOrBuiltin Symbol Ann
decl =
          Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor
            (RenderUniqueTypeGuids
-> HashQualified Name
-> DeclOrBuiltin Symbol Ann
-> Pretty (SyntaxText' TypeReference)
forall v a.
Var v =>
RenderUniqueTypeGuids
-> HashQualified Name
-> DeclOrBuiltin v a
-> Pretty (SyntaxText' TypeReference)
DeclPrinter.prettyDeclOrBuiltinHeader RenderUniqueTypeGuids
DeclPrinter.RenderUniqueTypeGuids'No (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.fromName Name
name) DeclOrBuiltin Symbol Ann
decl)

    let renderTerm :: PPE.PrettyPrintEnv -> (Pretty -> Pretty) -> Name -> Type Symbol Ann -> (Pretty, Pretty)
        renderTerm :: PrettyPrintEnv
-> (Pretty -> Pretty)
-> Name
-> Type Symbol Ann
-> (Pretty, Pretty)
renderTerm PrettyPrintEnv
ppe Pretty -> Pretty
colored Name
name Type Symbol Ann
ty =
          (Pretty -> Pretty
colored (Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyNameParens Name
name), Pretty
": " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentNAfterNewline Width
2 (PrettyPrintEnv -> Type Symbol Ann -> Pretty
forall v a. Var v => PrettyPrintEnv -> Type v a -> Pretty
TypePrinter.pretty PrettyPrintEnv
ppe Type Symbol Ann
ty))

    let renderedNewTypes :: Pretty
        renderedNewTypes :: Pretty
renderedNewTypes =
          [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines (((Name, DeclOrBuiltin Symbol Ann) -> Pretty)
-> [(Name, DeclOrBuiltin Symbol Ann)] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
name, DeclOrBuiltin Symbol Ann
decl) -> Pretty -> Pretty
P.green (Pretty
"+ " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> DeclOrBuiltin Symbol Ann -> Pretty
renderType Name
name DeclOrBuiltin Symbol Ann
decl)) [(Name, DeclOrBuiltin Symbol Ann)]
newTypes)

    let renderedUpdatedTypes :: Pretty
        renderedUpdatedTypes :: Pretty
renderedUpdatedTypes =
          [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines (((Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)
 -> Pretty)
-> [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
-> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
name, DeclOrBuiltin Symbol Ann
_oldDecl, DeclOrBuiltin Symbol Ann
newDecl) -> Pretty -> Pretty
P.yellow (Pretty
"~ " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> DeclOrBuiltin Symbol Ann -> Pretty
renderType Name
name DeclOrBuiltin Symbol Ann
newDecl)) [(Name, DeclOrBuiltin Symbol Ann, DeclOrBuiltin Symbol Ann)]
updatedTypes)

    let renderedDeletedTypes :: Pretty
        renderedDeletedTypes :: Pretty
renderedDeletedTypes =
          [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines (((Name, DeclOrBuiltin Symbol Ann) -> Pretty)
-> [(Name, DeclOrBuiltin Symbol Ann)] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
name, DeclOrBuiltin Symbol Ann
decl) -> Pretty -> Pretty
P.red (Pretty
"- " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> DeclOrBuiltin Symbol Ann -> Pretty
renderType Name
name DeclOrBuiltin Symbol Ann
decl)) [(Name, DeclOrBuiltin Symbol Ann)]
deletedTypes)

    let mentionAliases :: Bool -> [Name] -> Pretty
mentionAliases Bool
old = \case
          [] -> Pretty
forall a. Monoid a => a
mempty
          [Name]
aliases ->
            Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
4 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
              Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
                Pretty -> Pretty
P.hiBlack (if Bool
old then Pretty
"(was also named" else Pretty
"(also named")
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.oxfordCommasWith (Pretty -> Pretty
P.hiBlack Pretty
")") ((Name -> Pretty) -> [Name] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyNameParens [Name]
aliases)

    let renderedNewTerms :: Pretty
        renderedNewTerms :: Pretty
renderedNewTerms =
          [(Name, Type Symbol Ann, [Name])]
newTerms
            [(Name, Type Symbol Ann, [Name])]
-> ([(Name, Type Symbol Ann, [Name])] -> [(Pretty, Pretty)])
-> [(Pretty, Pretty)]
forall a b. a -> (a -> b) -> b
& ((Name, Type Symbol Ann, [Name]) -> (Pretty, Pretty))
-> [(Name, Type Symbol Ann, [Name])] -> [(Pretty, Pretty)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
name, Type Symbol Ann
ty, [Name]
_aliases) -> PrettyPrintEnv
-> (Pretty -> Pretty)
-> Name
-> Type Symbol Ann
-> (Pretty, Pretty)
renderTerm PrettyPrintEnv
newPpe (Pretty -> Pretty
P.green (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty
"+ " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<>)) Name
name Type Symbol Ann
ty)
            [(Pretty, Pretty)] -> ([(Pretty, Pretty)] -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& [(Pretty, Pretty)] -> [Pretty]
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> [Pretty s]
P.align
            [Pretty] -> ([Pretty] -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& (Pretty -> Pretty) -> [Pretty] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group
            [Pretty] -> ([Pretty] -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& ((Name, Type Symbol Ann, [Name]) -> Pretty -> Pretty)
-> [(Name, Type Symbol Ann, [Name])] -> [Pretty] -> [Pretty]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
              ( \(Name
_name, Type Symbol Ann
_ty, [Name]
aliases) Pretty
doc ->
                  [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.linesNonEmpty
                    [ Pretty
doc,
                      Bool -> [Name] -> Pretty
mentionAliases Bool
False [Name]
aliases
                    ]
              )
              [(Name, Type Symbol Ann, [Name])]
newTerms
            [Pretty] -> ([Pretty] -> Pretty) -> Pretty
forall a b. a -> (a -> b) -> b
& [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines

    let renderedUpdatedTerms :: Pretty
        renderedUpdatedTerms :: Pretty
renderedUpdatedTerms =
          [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
updatedTerms
            [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
-> ([(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
    -> [(Pretty, Pretty)])
-> [(Pretty, Pretty)]
forall a b. a -> (a -> b) -> b
& ((Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])
 -> (Pretty, Pretty))
-> [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
-> [(Pretty, Pretty)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
name, Type Symbol Ann
_oldTy, [Name]
_oldAliases, Type Symbol Ann
newTy, [Name]
_newAliases) -> PrettyPrintEnv
-> (Pretty -> Pretty)
-> Name
-> Type Symbol Ann
-> (Pretty, Pretty)
renderTerm PrettyPrintEnv
newPpe (Pretty -> Pretty
P.yellow (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty
"~ " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<>)) Name
name Type Symbol Ann
newTy)
            [(Pretty, Pretty)] -> ([(Pretty, Pretty)] -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& [(Pretty, Pretty)] -> [Pretty]
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> [Pretty s]
P.align
            [Pretty] -> ([Pretty] -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& (Pretty -> Pretty) -> [Pretty] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group
            [Pretty] -> ([Pretty] -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& ((Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])
 -> Pretty -> Pretty)
-> [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
-> [Pretty]
-> [Pretty]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
              ( \(Name
_name, Type Symbol Ann
_oldTy, [Name]
oldAliases, Type Symbol Ann
_newTy, [Name]
newAliases) Pretty
doc ->
                  [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.linesNonEmpty
                    [ Pretty
doc,
                      Bool -> [Name] -> Pretty
mentionAliases Bool
True [Name]
oldAliases,
                      Bool -> [Name] -> Pretty
mentionAliases Bool
False [Name]
newAliases
                    ]
              )
              [(Name, Type Symbol Ann, [Name], Type Symbol Ann, [Name])]
updatedTerms
            [Pretty] -> ([Pretty] -> Pretty) -> Pretty
forall a b. a -> (a -> b) -> b
& [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines

    let renderedDeletedTerms :: Pretty
        renderedDeletedTerms :: Pretty
renderedDeletedTerms =
          [(Name, Type Symbol Ann, [Name])]
deletedTerms
            [(Name, Type Symbol Ann, [Name])]
-> ([(Name, Type Symbol Ann, [Name])] -> [(Pretty, Pretty)])
-> [(Pretty, Pretty)]
forall a b. a -> (a -> b) -> b
& ((Name, Type Symbol Ann, [Name]) -> (Pretty, Pretty))
-> [(Name, Type Symbol Ann, [Name])] -> [(Pretty, Pretty)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Name
name, Type Symbol Ann
ty, [Name]
_aliases) -> PrettyPrintEnv
-> (Pretty -> Pretty)
-> Name
-> Type Symbol Ann
-> (Pretty, Pretty)
renderTerm PrettyPrintEnv
oldPpe (Pretty -> Pretty
P.red (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty
"- " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<>)) Name
name Type Symbol Ann
ty)
            [(Pretty, Pretty)] -> ([(Pretty, Pretty)] -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& [(Pretty, Pretty)] -> [Pretty]
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> [Pretty s]
P.align
            [Pretty] -> ([Pretty] -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& (Pretty -> Pretty) -> [Pretty] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group
            [Pretty] -> ([Pretty] -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& ((Name, Type Symbol Ann, [Name]) -> Pretty -> Pretty)
-> [(Name, Type Symbol Ann, [Name])] -> [Pretty] -> [Pretty]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
              ( \(Name
_name, Type Symbol Ann
_ty, [Name]
aliases) Pretty
doc ->
                  [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.linesNonEmpty
                    [ Pretty
doc,
                      Bool -> [Name] -> Pretty
mentionAliases Bool
True [Name]
aliases
                    ]
              )
              [(Name, Type Symbol Ann, [Name])]
deletedTerms
            [Pretty] -> ([Pretty] -> Pretty) -> Pretty
forall a b. a -> (a -> b) -> b
& [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines

    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      if Bool
existChanges
        then
          Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty
            Pretty
"\n\n"
            [ [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.linesNonEmpty
                [ Pretty
renderedNewTypes,
                  Pretty
renderedUpdatedTypes,
                  Pretty
renderedDeletedTypes
                ],
              [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.linesNonEmpty
                [ Pretty
renderedNewTerms,
                  Pretty
renderedUpdatedTerms,
                  Pretty
renderedDeletedTerms
                ],
              Pretty -> Pretty
P.hiBlack case (Int
numUnchangedTypes, Int
numUnchangedTerms) of
                (Int
0, Int
0) -> Pretty
forall a. Monoid a => a
mempty
                (Int
0, Int
_) ->
                  Pretty
"(and "
                    Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Int -> Pretty
forall n s. (Show n, Num n, IsString s) => n -> Pretty s
P.num Int
numUnchangedTerms
                    Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" unchanged term"
                    Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> if Int
numUnchangedTerms Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Pretty
")" else Pretty
"s)"
                (Int
_, Int
0) ->
                  Pretty
"(and "
                    Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Int -> Pretty
forall n s. (Show n, Num n, IsString s) => n -> Pretty s
P.num Int
numUnchangedTypes
                    Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" unchanged type"
                    Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> if Int
numUnchangedTypes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Pretty
")" else Pretty
"s)"
                (Int, Int)
_ ->
                  Pretty
"(and "
                    Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Int -> Pretty
forall n s. (Show n, Num n, IsString s) => n -> Pretty s
P.num Int
numUnchangedTypes
                    Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" unchanged type"
                    Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> (if Int
numUnchangedTypes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Pretty
" and " else Pretty
"s and ")
                    Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Int -> Pretty
forall n s. (Show n, Num n, IsString s) => n -> Pretty s
P.num Int
numUnchangedTerms
                    Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" unchanged term"
                    Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> (if Int
numUnchangedTerms Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Pretty
")" else Pretty
"s)"),
              ( case Bool -> Bool -> Bool -> Maybe Pretty
prettyAddUpdateDeleteLegend Bool
existAdds Bool
existUpdates Bool
existDeletes of
                  Just Pretty
legend -> Pretty
legend Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                  Maybe Pretty
Nothing -> Pretty
forall a. Monoid a => a
mempty
              )
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
                  ( Pretty
"Run"
                      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
makeExample' InputPattern
IP.update
                      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to apply these changes to your codebase."
                  )
            ]
        else Pretty
"No changes found."
  BustedBuiltins (Set TypeReference -> [TypeReference]
forall a. Set a -> [a]
Set.toList -> [TypeReference]
new) (Set TypeReference -> [TypeReference]
forall a. Set a -> [a]
Set.toList -> [TypeReference]
old) ->
    -- todo: this could be prettier!  Have a nice list like `find` gives, but
    -- that requires querying the codebase to determine term types.  Probably
    -- the only built-in types will be primitive types like `Int`, so no need
    -- to look up decl types.
    -- When we add builtin terms, they may depend on new derived types, so
    -- these derived types should be added to the branch too; but not
    -- necessarily ever be automatically deprecated.  (A library curator might
    -- deprecate them; more work needs to go into the idea of sharing deprecations and stuff.
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      case ([TypeReference]
new, [TypeReference]
old) of
        ([], []) -> String -> [Pretty]
forall a. HasCallStack => String -> a
error String
"BustedBuiltins busted, as there were no busted builtins."
        ([], [TypeReference]
old) ->
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty
"This codebase includes some builtins that are considered deprecated. Use the " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
makeExample' InputPattern
IP.updateBuiltins Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" command when you're ready to work on eliminating them from your codebase:")
            Pretty -> [Pretty] -> [Pretty]
forall a. a -> [a] -> [a]
: Pretty
""
            Pretty -> [Pretty] -> [Pretty]
forall a. a -> [a] -> [a]
: (TypeReference -> Pretty) -> [TypeReference] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty)
-> (TypeReference -> Text) -> TypeReference -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> Text
Reference.toText) [TypeReference]
old
        ([TypeReference]
new, []) ->
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty
"This version of Unison provides builtins that are not part of your codebase. Use " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
makeExample' InputPattern
IP.updateBuiltins Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" to add them:")
            Pretty -> [Pretty] -> [Pretty]
forall a. a -> [a] -> [a]
: Pretty
""
            Pretty -> [Pretty] -> [Pretty]
forall a. a -> [a] -> [a]
: (TypeReference -> Pretty) -> [TypeReference] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty)
-> (TypeReference -> Text) -> TypeReference -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> Text
Reference.toText) [TypeReference]
new
        (new :: [TypeReference]
new@(TypeReference
_ : [TypeReference]
_), old :: [TypeReference]
old@(TypeReference
_ : [TypeReference]
_)) ->
          [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
              ( Pretty
"Sorry and/or good news!  This version of Unison supports a different set of builtins than this codebase uses.  You can use "
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
makeExample' InputPattern
IP.updateBuiltins
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" to add the ones you're missing and deprecate the ones I'm missing. 😉"
              ),
            Pretty
"You're missing:" Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
`P.hang` [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ((TypeReference -> Pretty) -> [TypeReference] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty)
-> (TypeReference -> Text) -> TypeReference -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> Text
Reference.toText) [TypeReference]
new),
            Pretty
"I'm missing:" Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
`P.hang` [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ((TypeReference -> Pretty) -> [TypeReference] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty)
-> (TypeReference -> Text) -> TypeReference -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> Text
Reference.toText) [TypeReference]
old)
          ]
  NoConfiguredRemoteMapping PushPull
pp Absolute
p -> do
    let (Text
localPathExample, Text
sharePathExample) =
          if Absolute -> Bool
Path.isRoot Absolute
p
            then (Text
"myproject", Text
"myuser.public.myproject")
            else (Path -> Text
forall path. Pathy path => path -> Text
Path.toText (Absolute -> Path
Path.unabsolute Absolute
p), Text
"myuser.public." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Path -> Text
forall path. Pathy path => path -> Text
Path.toText (Absolute -> Path
Path.unabsolute Absolute
p))
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.fatalCallout (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty
"I don't know where to " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty -> PushPull -> Pretty
forall a. a -> a -> PushPull -> a
PushPull.fold Pretty
"push to." Pretty
"pull from." PushPull
pp,
          Pretty
"Add a `RemoteMapping` configuration to your .unisonConfig file. E.g.",
          Pretty
"",
          Pretty
"```",
          Pretty
"RemoteMapping {",
          Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text
"  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
localPathExample Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sharePathExample Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""),
          Pretty
"}",
          Pretty
"```",
          Pretty
"",
          Pretty
"Type `help " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty -> PushPull -> Pretty
forall a. a -> a -> PushPull -> a
PushPull.fold Pretty
"push" Pretty
"pull" PushPull
pp Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"` for more information."
        ]

  --  | ConfiguredRemoteMappingParseError PushPull Path' Text String
  ConfiguredRemoteMappingParseError PushPull
pp Absolute
p Text
url String
err ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.fatalCallout (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
          Pretty
"I couldn't understand the RemoteMapping that's set for"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Absolute -> Pretty
forall path. Pathy path => path -> Pretty
prettyPath Absolute
p
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"in .unisonConfig",
        Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
          Pretty
"The value I found was"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> (Pretty -> Pretty
forall s. IsString s => Pretty s -> Pretty s
P.backticked (Pretty -> Pretty) -> (Text -> Pretty) -> Text -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
P.blue (Pretty -> Pretty) -> (Text -> Pretty) -> Text -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text) Text
url
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"but I encountered the following error when trying to parse it:",
        Pretty
"",
        String -> Pretty
forall s. IsString s => String -> Pretty s
P.string String
err,
        Pretty
"",
        Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
          Pretty
"Type"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. IsString s => Pretty s -> Pretty s
P.backticked (Pretty
"help " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty -> PushPull -> Pretty
forall a. a -> a -> PushPull -> a
PushPull.fold Pretty
"push" Pretty
"pull" PushPull
pp)
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"for more information."
      ]
  NoBranchWithHash ShortCausalHash
_h ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"😶" (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
"I don't know of a namespace with that hash."
  Output
NotImplemented -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"That's not implemented yet. Sorry! 😬"
  BranchAlreadyExists Path'
p ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"The namespace" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Path' -> Pretty
forall path. Pathy path => path -> Pretty
prettyPath Path'
p Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"already exists."
  LabeledReferenceNotFound HashQualified Name
hq ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> (Pretty (SyntaxText' TypeReference) -> Pretty)
-> Pretty (SyntaxText' TypeReference)
-> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"\129300" (Pretty -> Pretty)
-> (Pretty (SyntaxText' TypeReference) -> Pretty)
-> Pretty (SyntaxText' TypeReference)
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty)
-> (Pretty (SyntaxText' TypeReference) -> Pretty)
-> Pretty (SyntaxText' TypeReference)
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> IO Pretty)
-> Pretty (SyntaxText' TypeReference) -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty (SyntaxText' TypeReference)
"Sorry, I couldn't find anything named" Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified HashQualified Name
hq Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' TypeReference)
"."
  LabeledReferenceAmbiguous Int
hashLen HashQualified Name
hq (Set LabeledDependency -> ([TypeReference], [Referent])
forall (t :: * -> *).
Foldable t =>
t LabeledDependency -> ([TypeReference], [Referent])
LD.partition -> ([TypeReference]
tps, [Referent]
tms)) ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"\129300" (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"That name is ambiguous. It could refer to any of the following definitions:",
        Pretty
"",
        Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 ([Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ((Referent -> Pretty) -> [Referent] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map Referent -> Pretty
qualifyTerm [Referent]
tms [Pretty] -> [Pretty] -> [Pretty]
forall a. [a] -> [a] -> [a]
++ (TypeReference -> Pretty) -> [TypeReference] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map TypeReference -> Pretty
qualifyType [TypeReference]
tps))
      ]
    where
      qualifyTerm :: Referent -> Pretty
      qualifyTerm :: Referent -> Pretty
qualifyTerm =
        Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> (Referent -> Pretty (SyntaxText' TypeReference))
-> Referent
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case HashQualified Name
hq of
          HQ.NameOnly Name
n -> Int -> Name -> Referent -> Pretty (SyntaxText' TypeReference)
prettyNamedReferent Int
hashLen Name
n
          HQ.HashQualified Name
n ShortHash
_ -> Int -> Name -> Referent -> Pretty (SyntaxText' TypeReference)
prettyNamedReferent Int
hashLen Name
n
          HQ.HashOnly ShortHash
_ -> Int -> Referent -> Pretty (SyntaxText' TypeReference)
prettyReferent Int
hashLen
      qualifyType :: Reference -> Pretty
      qualifyType :: TypeReference -> Pretty
qualifyType =
        Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> (TypeReference -> Pretty (SyntaxText' TypeReference))
-> TypeReference
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case HashQualified Name
hq of
          HQ.NameOnly Name
n -> Int -> Name -> TypeReference -> Pretty (SyntaxText' TypeReference)
prettyNamedReference Int
hashLen Name
n
          HQ.HashQualified Name
n ShortHash
_ -> Int -> Name -> TypeReference -> Pretty (SyntaxText' TypeReference)
prettyNamedReference Int
hashLen Name
n
          HQ.HashOnly ShortHash
_ -> Int -> TypeReference -> Pretty (SyntaxText' TypeReference)
prettyReference Int
hashLen
  DeleteNameAmbiguous Int
hashLen HashQualified (Split Path')
p Set Referent
tms Set TypeReference
tys ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"\129300" (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"I wasn't sure which of these you meant to delete:",
        Pretty
"",
        Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 ([Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ((Referent -> Pretty) -> [Referent] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map Referent -> Pretty
qualifyTerm (Set Referent -> [Referent]
forall a. Set a -> [a]
Set.toList Set Referent
tms) [Pretty] -> [Pretty] -> [Pretty]
forall a. [a] -> [a] -> [a]
++ (TypeReference -> Pretty) -> [TypeReference] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map TypeReference -> Pretty
qualifyType (Set TypeReference -> [TypeReference]
forall a. Set a -> [a]
Set.toList Set TypeReference
tys))),
        Pretty
"",
        Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"You may:",
        Pretty
"",
        Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
f (Pretty s) -> Pretty s
P.bulleted ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
          [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Delete one by an unambiguous name, given above.",
            Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Delete them all by re-issuing the previous command."
          ]
      ]
    where
      name :: Name
      name :: Name
name = Split Path' -> Name
forall path. Namey path => Split path -> Name
Path.nameFromSplit (Split Path' -> Name) -> Split Path' -> Name
forall a b. (a -> b) -> a -> b
$ HashQualified (Split Path') -> Split Path'
forall n. HashQualified n -> n
HQ'.toName HashQualified (Split Path')
p
      qualifyTerm :: Referent -> Pretty
      qualifyTerm :: Referent -> Pretty
qualifyTerm = Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> (Referent -> Pretty (SyntaxText' TypeReference))
-> Referent
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Name -> Referent -> Pretty (SyntaxText' TypeReference)
prettyNamedReferent Int
hashLen Name
name
      qualifyType :: Reference -> Pretty
      qualifyType :: TypeReference -> Pretty
qualifyType = Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> (TypeReference -> Pretty (SyntaxText' TypeReference))
-> TypeReference
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Name -> TypeReference -> Pretty (SyntaxText' TypeReference)
prettyNamedReference Int
hashLen Name
name
  TermAmbiguous PrettyPrintEnv
_ HashQualified Name
_ Set Referent
tms | Set Referent -> Bool
forall a. Set a -> Bool
Set.null Set Referent
tms -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
"I couldn't find any term by that name."
  TermAmbiguous PrettyPrintEnv
ppe HashQualified Name
_n Set Referent
tms ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"🤔" (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"I wasn't sure which of these you meant:",
        Pretty
"",
        Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 ([Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ((Referent -> Pretty) -> [Referent] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map (HashQualified Name -> Pretty
phq (HashQualified Name -> Pretty)
-> (Referent -> HashQualified Name) -> Referent -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termNameOrHashOnly PrettyPrintEnv
ppe) (Set Referent -> [Referent]
forall a. Set a -> [a]
Set.toList Set Referent
tms))),
        Pretty
"",
        Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip Pretty
"Try again, using one of the unambiguous choices above."
      ]
    where
      phq :: HashQualified Name -> Pretty
phq = Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> (HashQualified Name -> Pretty (SyntaxText' TypeReference))
-> HashQualified Name
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified
  HashAmbiguous ShortHash
h Set Referent
rs ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"\129300" (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
          Pretty
"The hash"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ShortHash -> Pretty
forall s. IsString s => ShortHash -> Pretty s
prettyShortHash ShortHash
h
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"is ambiguous."
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"Did you mean one of these hashes?",
        Pretty
"",
        Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines (Referent -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown (Referent -> Pretty) -> [Referent] -> [Pretty]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Referent -> [Referent]
forall a. Set a -> [a]
Set.toList Set Referent
rs),
        Pretty
"",
        Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Try again with a few more hash characters to disambiguate."
      ]
  BranchHashAmbiguous ShortCausalHash
h Set ShortCausalHash
rs ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"\129300" (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
          Pretty
"The namespace hash"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ShortCausalHash -> Pretty
forall s. IsString s => ShortCausalHash -> Pretty s
prettySCH ShortCausalHash
h
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"is ambiguous."
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"Did you mean one of these hashes?",
        Pretty
"",
        Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines (ShortCausalHash -> Pretty
forall s. IsString s => ShortCausalHash -> Pretty s
prettySCH (ShortCausalHash -> Pretty) -> [ShortCausalHash] -> [Pretty]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set ShortCausalHash -> [ShortCausalHash]
forall a. Set a -> [a]
Set.toList Set ShortCausalHash
rs),
        Pretty
"",
        Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Try again with a few more hash characters to disambiguate."
      ]
  BadName Text
n -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
n Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" is not a kind of name I understand."
  TermNotFound' ShortHash
sh ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"I could't find a term with hash "
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> (ShortHash -> Pretty
forall s. IsString s => ShortHash -> Pretty s
prettyShortHash ShortHash
sh)
  TypeNotFound' ShortHash
sh ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"I could't find a type with hash "
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> (ShortHash -> Pretty
forall s. IsString s => ShortHash -> Pretty s
prettyShortHash ShortHash
sh)
  PatchInvolvesExternalDependents PrettyPrintEnv
_ Set TypeReference
_ ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
"That patch involves external dependents."
  ShowReflog [] -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"The reflog is empty"
  ShowReflog [(Maybe UTCTime, ShortCausalHash, Text)]
entries -> do
    UTCTime
now <- IO UTCTime
getCurrentTime
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty
header,
          [Pretty] -> [[Pretty]] -> Pretty
P.numberedColumnNHeader [Pretty
"When", Pretty
"Root Hash", Pretty
"Action"] ([[Pretty]] -> Pretty) -> [[Pretty]] -> Pretty
forall a b. (a -> b) -> a -> b
$ [(Maybe UTCTime, ShortCausalHash, Text)]
entries [(Maybe UTCTime, ShortCausalHash, Text)]
-> ((Maybe UTCTime, ShortCausalHash, Text) -> [Pretty])
-> [[Pretty]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> UTCTime -> (Maybe UTCTime, ShortCausalHash, Text) -> [Pretty]
renderEntry3Column UTCTime
now,
          Pretty
"",
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Use " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.diffNamespace [Pretty
"1", Pretty
"7"] Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" to compare namespaces between two points in history."
        ]
    where
      header :: Pretty
header =
        case [(Maybe UTCTime, ShortCausalHash, Text)]
entries of
          ((Maybe UTCTime, ShortCausalHash, Text)
_head : (Maybe UTCTime
_, ShortCausalHash
prevSCH, Text
_) : [(Maybe UTCTime, ShortCausalHash, Text)]
_) ->
            [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
              [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
                  Pretty
"Here is a log of the root namespace hashes,"
                    Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"starting with the most recent,"
                    Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"along with the command that got us there."
                    Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"Try:",
                Pretty
"",
                ( Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty)
-> ([(Pretty, Pretty)] -> Pretty) -> [(Pretty, Pretty)] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Pretty, Pretty)] -> Pretty
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2 ([(Pretty, Pretty)] -> Pretty) -> [(Pretty, Pretty)] -> Pretty
forall a b. (a -> b) -> a -> b
$
                    [ ( InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.forkLocal [Pretty
"2", Pretty
".old"],
                        Pretty
""
                      ),
                      ( InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.forkLocal [ShortCausalHash -> Pretty
forall s. IsString s => ShortCausalHash -> Pretty s
prettySCH ShortCausalHash
prevSCH, Pretty
".old"],
                        Pretty
"to make an old namespace accessible again,"
                      ),
                      (Pretty
forall a. Monoid a => a
mempty, Pretty
forall a. Monoid a => a
mempty),
                      ( InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.reset [ShortCausalHash -> Pretty
forall s. IsString s => ShortCausalHash -> Pretty s
prettySCH ShortCausalHash
prevSCH],
                        Pretty
"to reset the current namespace and its history to that of the specified"
                          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"namespace."
                      )
                    ]
                ),
                Pretty
""
              ]
          [(Maybe UTCTime, ShortCausalHash, Text)]
_ -> Pretty
forall a. Monoid a => a
mempty
      renderEntry3Column :: UTCTime -> (Maybe UTCTime, SCH.ShortCausalHash, Text) -> [Pretty]
      renderEntry3Column :: UTCTime -> (Maybe UTCTime, ShortCausalHash, Text) -> [Pretty]
renderEntry3Column UTCTime
now (Maybe UTCTime
mayTime, ShortCausalHash
sch, Text
reason) =
        [Pretty -> (UTCTime -> Pretty) -> Maybe UTCTime -> Pretty
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Pretty
"" (UTCTime -> UTCTime -> Pretty
prettyHumanReadableTime UTCTime
now) Maybe UTCTime
mayTime, Pretty -> Pretty
P.blue (ShortCausalHash -> Pretty
forall s. IsString s => ShortCausalHash -> Pretty s
prettySCH ShortCausalHash
sch), Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty) -> Text -> Pretty
forall a b. (a -> b) -> a -> b
$ Text -> Text
truncateReason Text
reason]
      truncateReason :: Text -> Text
      truncateReason :: Text -> Text
truncateReason Text
txt = case Int -> Text -> (Text, Text)
Text.splitAt Int
60 Text
txt of
        (Text
short, Text
"") -> Text
short
        (Text
short, Text
_) -> Text
short Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"..."
  Output
StartOfCurrentPathHistory ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"You're already at the very beginning! 🙂"
  PullAlreadyUpToDate ReadRemoteNamespace RemoteProjectBranch
ns ProjectAndBranch Project ProjectBranch
dest ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"😶" (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectAndBranch Project ProjectBranch
dest.project.name ProjectAndBranch Project ProjectBranch
dest.branch.name)
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"was already up-to-date with"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ReadRemoteNamespace RemoteProjectBranch -> Pretty
prettyReadRemoteNamespace ReadRemoteNamespace RemoteProjectBranch
ns Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
  PullSuccessful ReadRemoteNamespace RemoteProjectBranch
ns ProjectAndBranch Project ProjectBranch
dest ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.okCallout (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
"Successfully updated"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectAndBranch Project ProjectBranch
dest.project.name ProjectAndBranch Project ProjectBranch
dest.branch.name)
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"from"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ReadRemoteNamespace RemoteProjectBranch -> Pretty
prettyReadRemoteNamespace ReadRemoteNamespace RemoteProjectBranch
ns Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
  MergeOverEmpty ProjectAndBranch Project ProjectBranch
dest ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.okCallout (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
"Successfully pulled into "
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group
            ( ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectAndBranch Project ProjectBranch
dest.project.name ProjectAndBranch Project ProjectBranch
dest.branch.name)
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
", which was empty."
            )
  MergeAlreadyUpToDate2 MergeSourceAndTarget
aliceAndBob ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"😶" (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName MergeSourceAndTarget
aliceAndBob.alice
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"was already up-to-date with"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (MergeSource -> Pretty
prettyMergeSource MergeSourceAndTarget
aliceAndBob.bob Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
  MergeConflictedAliases MergeSourceOrTarget
aliceOrBob Defn (Name, Name) (Name, Name)
defn ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Sorry, I wasn't able to perform the merge:"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
          ( Pretty
"On the merge ancestor,"
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ( let (Bool
isTerm, Name
name1, Name
name2) =
                         case Defn (Name, Name) (Name, Name)
defn of
                           TermDefn (Name
n1, Name
n2) -> (Bool
True, Name
n1, Name
n2)
                           TypeDefn (Name
n1, Name
n2) -> (Bool
False, Name
n1, Name
n2)
                    in Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
name1
                         Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"and"
                         Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
name2
                         Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"were aliases for the same"
                         Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group ((if Bool
isTerm then Pretty
"term" else Pretty
"type") Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
",")
                 )
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"but on"
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> MergeSourceOrTarget -> Pretty
prettyMergeSourceOrTarget MergeSourceOrTarget
aliceOrBob
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"the names have different definitions currently. I'd need just a single new definition to use in their"
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"dependents when I merge."
          )
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty
"Please fix up" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> MergeSourceOrTarget -> Pretty
prettyMergeSourceOrTarget MergeSourceOrTarget
aliceOrBob Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to resolve this. For example,")
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN
          Width
2
          ( [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
f (Pretty s) -> Pretty s
P.bulleted
              [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
                  ( InputPattern -> Pretty
IP.makeExample' InputPattern
IP.update
                      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"the definitions to be the same again, so that there's nothing for me to decide."
                  ),
                Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
                  ( InputPattern -> Pretty
IP.makeExample' InputPattern
IP.moveAll
                      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"or"
                      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.delete
                      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"all but one of the definitions; I'll use the remaining name when propagating updates."
                      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"(You can"
                      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.moveAll
                      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"it back after the merge.)"
                  )
              ]
          )
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"and then try merging again."
  MergeConflictInvolvingBuiltin Defn Name Name
defn ->
    let (Bool
isTerm, Name
name) =
          case Defn Name Name
defn of
            TermDefn Name
n -> (Bool
True, Name
n)
            TypeDefn Name
n -> (Bool
False, Name
n)
     in Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$
          [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Sorry, I wasn't able to perform the merge:",
            Pretty
"",
            Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
              ( Pretty
"There's a merge conflict on"
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> (if Bool
isTerm then Pretty
"term" else Pretty
"type")
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
name Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
",")
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"but it's a builtin on one or both branches. I can't yet handle merge conflicts involving builtins."
              ),
            Pretty
"",
            Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
              ( Pretty
"Please eliminate this conflict by updating one branch or the other, making"
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
name
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"the same on both branches, or making neither of them a builtin, and then try the merge again."
              )
          ]
  -- Note [DefnsInLibMessage] If you change this, also change the other similar one
  MergeDefnsInLib MergeSourceOrTarget
aliceOrBob ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Sorry, I wasn't able to perform the merge:",
        Pretty
"",
        Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
          Pretty
"On"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (MergeSourceOrTarget -> Pretty
prettyMergeSourceOrTarget MergeSourceOrTarget
aliceOrBob Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
",")
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"there's a type or term at the top level of the `lib` namespace, where I only expect to find"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"subnamespaces representing library dependencies.",
        Pretty
"",
        Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Please move or remove it and then try merging again."
      ]
  DumpNumberedArgs Int
schLength NumberedArgs
args ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *). Foldable f => f Pretty -> Pretty
P.numberedList ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$ (StructuredArgument -> Pretty) -> NumberedArgs -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty)
-> (StructuredArgument -> Text) -> StructuredArgument -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> StructuredArgument -> Text
IP.formatStructuredArgument (Int -> Maybe Int
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
schLength)) NumberedArgs
args
  HelpMessage InputPattern
pat -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ InputPattern -> Pretty
IP.showPatternHelp InputPattern
pat
  Output
NoOp -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ String -> Pretty
forall s. IsString s => String -> Pretty s
P.string String
"I didn't make any changes."
  DumpBitBooster CausalHash
head Map CausalHash [CausalHash]
map ->
    let go :: [String] -> [CausalHash] -> [String]
go [String]
output [] = [String]
output
        go [String]
output (CausalHash
head : [CausalHash]
queue) = case CausalHash -> Map CausalHash [CausalHash] -> Maybe [CausalHash]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CausalHash
head Map CausalHash [CausalHash]
map of
          Maybe [CausalHash]
Nothing -> [String] -> [CausalHash] -> [String]
go (CausalHash -> [CausalHash] -> String
forall {t :: * -> *}.
Foldable t =>
CausalHash -> t CausalHash -> String
renderLine CausalHash
head [] String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
output) [CausalHash]
queue
          Just [CausalHash]
tails -> [String] -> [CausalHash] -> [String]
go (CausalHash -> [CausalHash] -> String
forall {t :: * -> *}.
Foldable t =>
CausalHash -> t CausalHash -> String
renderLine CausalHash
head [CausalHash]
tails String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
output) ([CausalHash]
queue [CausalHash] -> [CausalHash] -> [CausalHash]
forall a. [a] -> [a] -> [a]
++ [CausalHash]
tails)
          where
            renderHash :: CausalHash -> String
renderHash = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
10 (String -> String)
-> (CausalHash -> String) -> CausalHash -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> String) -> (CausalHash -> Text) -> CausalHash -> String
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
            renderLine :: CausalHash -> t CausalHash -> String
renderLine CausalHash
head t CausalHash
tail =
              (CausalHash -> String
renderHash CausalHash
head)
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|"
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> (CausalHash -> String) -> t CausalHash -> String
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap String
" " CausalHash -> String
renderHash t CausalHash
tail
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ case Text -> Map Text String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (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
head) Map Text String
tags of
                  Just String
t -> String
"|tag: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t
                  Maybe String
Nothing -> String
""
            -- some specific hashes that we want to label in the output
            tags :: Map Text String
            tags :: Map Text String
tags =
              [(Text, String)] -> Map Text String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, String)] -> Map Text String)
-> ([(String, Text)] -> [(Text, String)])
-> [(String, Text)]
-> Map Text String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Text) -> (Text, String))
-> [(String, Text)] -> [(Text, String)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, Text) -> (Text, String)
forall a b. (a, b) -> (b, a)
swap ([(String, Text)] -> Map Text String)
-> [(String, Text)] -> Map Text String
forall a b. (a -> b) -> a -> b
$
                [ (String
"unisonbase 2019/8/6", Text
"54s9qjhaonotuo4sp6ujanq7brngk32f30qt5uj61jb461h9fcca6vv5levnoo498bavne4p65lut6k6a7rekaruruh9fsl19agu8j8"),
                  (String
"unisonbase 2019/8/5", Text
"focmbmg7ca7ht7opvjaqen58fobu3lijfa9adqp7a1l1rlkactd7okoimpfmd0ftfmlch8gucleh54t3rd1e7f13fgei86hnsr6dt1g"),
                  (String
"unisonbase 2019/7/31", Text
"jm2ltsg8hh2b3c3re7aru6e71oepkqlc3skr2v7bqm4h1qgl3srucnmjcl1nb8c9ltdv56dpsgpdur1jhpfs6n5h43kig5bs4vs50co"),
                  (String
"unisonbase 2019/7/25", Text
"an1kuqsa9ca8tqll92m20tvrmdfk0eksplgjbda13evdlngbcn5q72h8u6nb86ojr7cvnemjp70h8cq1n95osgid1koraq3uk377g7g"),
                  (String
"ucm m1b", Text
"o6qocrqcqht2djicb1gcmm5ct4nr45f8g10m86bidjt8meqablp0070qae2tvutnvk4m9l7o1bkakg49c74gduo9eati20ojf0bendo"),
                  (String
"ucm m1, m1a", Text
"auheev8io1fns2pdcnpf85edsddj27crpo9ajdujum78dsncvfdcdu5o7qt186bob417dgmbd26m8idod86080bfivng1edminu3hug")
                ]
     in Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
          [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
            [ [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ((String -> Pretty) -> [String] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Pretty
forall a. IsString a => String -> a
fromString ([String] -> [Pretty])
-> ([String] -> [String]) -> [String] -> [Pretty]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [Pretty]) -> [String] -> [Pretty]
forall a b. (a -> b) -> a -> b
$ [String] -> [CausalHash] -> [String]
go [] [CausalHash
head]),
              Pretty
"",
              Pretty
"Paste that output into http://bit-booster.com/graph.html"
            ]
  ListDependents PrettyPrintEnv
ppe Set LabeledDependency
lds DefnsF
  []
  (HashQualified Name, HashQualified Name)
  (HashQualified Name, HashQualified Name)
defns ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      PrettyPrintEnv
-> Text
-> Text
-> Set LabeledDependency
-> [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
-> Pretty
listDependentsOrDependencies
        PrettyPrintEnv
ppe
        Text
"Dependents"
        Text
"dependents"
        Set LabeledDependency
lds
        (((HashQualified Name, HashQualified Name)
 -> (HashQualified Name, HashQualified Name))
-> [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
forall a b. (a -> b) -> [a] -> [b]
map (HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ (HashQualified Name -> HashQualified Name)
-> (HashQualified Name -> HashQualified Name)
-> (HashQualified Name, HashQualified Name)
-> (HashQualified Name, HashQualified Name)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ) DefnsF
  []
  (HashQualified Name, HashQualified Name)
  (HashQualified Name, HashQualified Name)
defns.types)
        (((HashQualified Name, HashQualified Name)
 -> (HashQualified Name, HashQualified Name))
-> [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
forall a b. (a -> b) -> [a] -> [b]
map (HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ (HashQualified Name -> HashQualified Name)
-> (HashQualified Name -> HashQualified Name)
-> (HashQualified Name, HashQualified Name)
-> (HashQualified Name, HashQualified Name)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ) DefnsF
  []
  (HashQualified Name, HashQualified Name)
  (HashQualified Name, HashQualified Name)
defns.terms)
  ListDependencies PrettyPrintEnv
ppe Set LabeledDependency
lds DefnsF
  []
  (HashQualified Name, HashQualified Name)
  (HashQualified Name, HashQualified Name)
defns ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      PrettyPrintEnv
-> Text
-> Text
-> Set LabeledDependency
-> [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
-> Pretty
listDependentsOrDependencies
        PrettyPrintEnv
ppe
        Text
"Dependencies"
        Text
"dependencies"
        Set LabeledDependency
lds
        DefnsF
  []
  (HashQualified Name, HashQualified Name)
  (HashQualified Name, HashQualified Name)
defns.types
        DefnsF
  []
  (HashQualified Name, HashQualified Name)
  (HashQualified Name, HashQualified Name)
defns.terms
  ListStructuredFind [HashQualified Name]
terms ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Pretty -> [HashQualified Name] -> Pretty
listFind Bool
False Maybe Pretty
forall a. Maybe a
Nothing [HashQualified Name]
terms
  ListTextFind Bool
True [HashQualified Name]
terms ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Pretty -> [HashQualified Name] -> Pretty
listFind Bool
True Maybe Pretty
forall a. Maybe a
Nothing [HashQualified Name]
terms
  ListTextFind Bool
False [HashQualified Name]
terms ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Pretty -> [HashQualified Name] -> Pretty
listFind Bool
False (Pretty -> Maybe Pretty
forall a. a -> Maybe a
Just Pretty
tip) [HashQualified Name]
terms
    where
      tip :: Pretty
tip = (InputPattern -> [Pretty] -> Pretty
IP.makeExample (Bool -> InputPattern
IP.textfind Bool
True) [] Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" will search `lib` as well.")
  DumpUnisonFileHashes Int
hqLength [(Name, TermReferenceId)]
datas [(Name, TermReferenceId)]
effects [(Name, TermReferenceId)]
terms ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty (SyntaxText' TypeReference)] -> Pretty)
-> [Pretty (SyntaxText' TypeReference)]
-> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> ([Pretty (SyntaxText' TypeReference)]
    -> Pretty (SyntaxText' TypeReference))
-> [Pretty (SyntaxText' TypeReference)]
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty (SyntaxText' TypeReference)]
-> Pretty (SyntaxText' TypeReference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty (SyntaxText' TypeReference)] -> IO Pretty)
-> [Pretty (SyntaxText' TypeReference)] -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      ( [(Name, TermReferenceId)]
effects [(Name, TermReferenceId)]
-> ((Name, TermReferenceId) -> Pretty (SyntaxText' TypeReference))
-> [Pretty (SyntaxText' TypeReference)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Name
n, TermReferenceId
r) ->
          Pretty (SyntaxText' TypeReference)
"ability "
            Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified' (Int -> HashQualified Name -> HashQualified Name
forall n. Int -> HashQualified n -> HashQualified n
HQ'.take Int
hqLength (HashQualified Name -> HashQualified Name)
-> (TypeReference -> HashQualified Name)
-> TypeReference
-> HashQualified Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> TypeReference -> HashQualified Name
forall n. n -> TypeReference -> HashQualified n
HQ'.fromNamedReference Name
n (TypeReference -> HashQualified Name)
-> TypeReference -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ TermReferenceId -> TypeReference
forall h t. Id' h -> Reference' t h
Reference.DerivedId TermReferenceId
r)
      )
        [Pretty (SyntaxText' TypeReference)]
-> [Pretty (SyntaxText' TypeReference)]
-> [Pretty (SyntaxText' TypeReference)]
forall a. Semigroup a => a -> a -> a
<> ( [(Name, TermReferenceId)]
datas [(Name, TermReferenceId)]
-> ((Name, TermReferenceId) -> Pretty (SyntaxText' TypeReference))
-> [Pretty (SyntaxText' TypeReference)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Name
n, TermReferenceId
r) ->
               Pretty (SyntaxText' TypeReference)
"type "
                 Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified' (Int -> HashQualified Name -> HashQualified Name
forall n. Int -> HashQualified n -> HashQualified n
HQ'.take Int
hqLength (HashQualified Name -> HashQualified Name)
-> (TypeReference -> HashQualified Name)
-> TypeReference
-> HashQualified Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> TypeReference -> HashQualified Name
forall n. n -> TypeReference -> HashQualified n
HQ'.fromNamedReference Name
n (TypeReference -> HashQualified Name)
-> TypeReference -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ TermReferenceId -> TypeReference
forall h t. Id' h -> Reference' t h
Reference.DerivedId TermReferenceId
r)
           )
        [Pretty (SyntaxText' TypeReference)]
-> [Pretty (SyntaxText' TypeReference)]
-> [Pretty (SyntaxText' TypeReference)]
forall a. Semigroup a => a -> a -> a
<> ( [(Name, TermReferenceId)]
terms [(Name, TermReferenceId)]
-> ((Name, TermReferenceId) -> Pretty (SyntaxText' TypeReference))
-> [Pretty (SyntaxText' TypeReference)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Name
n, TermReferenceId
r) ->
               HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified' (Int -> HashQualified Name -> HashQualified Name
forall n. Int -> HashQualified n -> HashQualified n
HQ'.take Int
hqLength (HashQualified Name -> HashQualified Name)
-> (TypeReference -> HashQualified Name)
-> TypeReference
-> HashQualified Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> TypeReference -> HashQualified Name
forall n. n -> TypeReference -> HashQualified n
HQ'.fromNamedReference Name
n (TypeReference -> HashQualified Name)
-> TypeReference -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ TermReferenceId -> TypeReference
forall h t. Id' h -> Reference' t h
Reference.DerivedId TermReferenceId
r)
           )
  GistCreated ReadRemoteNamespace Void
remoteNamespace ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty
"Gist created. Pull via:",
          Pretty
"",
          Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (InputPattern -> Pretty
IP.patternName InputPattern
IP.pull Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> (Void -> Text) -> ReadRemoteNamespace Void -> Pretty
forall a. (a -> Text) -> ReadRemoteNamespace a -> Pretty
prettyReadRemoteNamespaceWith Void -> Text
forall a. Void -> a
absurd ReadRemoteNamespace Void
remoteNamespace)
        ]
  InitiateAuthFlow URI
authURI -> do
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
"Please navigate to " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> URI -> Pretty
prettyURI URI
authURI Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" to authorize UCM with the codebase server."
  UnknownCodeServer Text
codeServerName -> do
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"No host configured for code server " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.red (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
codeServerName) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".",
          Pretty
"You can configure code server hosts in your .unisonConfig file."
        ]
  CredentialFailureMsg CredentialFailure
err -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ case CredentialFailure
err of
    Auth.ReauthRequired CodeserverId
host ->
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty
"Authentication for host " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.red (CodeserverId -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown CodeserverId
host) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" is required.",
          Pretty
"Run "
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.help [InputPattern -> Pretty
IP.patternName InputPattern
IP.authLogin]
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" to learn how."
        ]
    Auth.CredentialParseFailure String
fp Text
txt ->
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty
"Failed to parse the credentials file at " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> String -> Pretty
prettyFilePath String
fp Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
", with error: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
txt Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".",
          Pretty
"You can attempt to fix the issue, or may simply delete the credentials file and run " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.authLogin [] Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."
        ]
    Auth.InvalidDiscoveryDocument URI
uri Text
txt ->
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty
"Failed to parse the discover document from " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> URI -> Pretty
prettyURI URI
uri Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
", with error: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
txt Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."
        ]
    Auth.InvalidJWT Text
txt ->
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty
"Failed to validate JWT from authentication server: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
txt
        ]
    Auth.RefreshFailure Text
txt ->
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty
"Failed to refresh access token with authentication server: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
txt
        ]
    Auth.InvalidTokenResponse URI
uri Text
txt ->
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty
"Failed to parse token response from authentication server: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> URI -> Pretty
prettyURI URI
uri,
          Pretty
"The error was: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
txt
        ]
    Auth.InvalidHost CodeserverURI
host ->
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty
"Failed to parse a URI from the hostname: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> CodeserverURI -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown CodeserverURI
host Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".",
          Pretty
"Host names should NOT include a schema or path."
        ]
    Auth.FailedToFetchUserInfo URI
userInfoEndpoint Text
err ->
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty
"Failed to parse the response from user info endpoint: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> URI -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown URI
userInfoEndpoint,
          Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
err,
          Pretty
"Please `auth.login` then try again, if this error persists please file a bug report and include the above error message."
        ]
  PrintVersion Text
ucmVersion -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
ucmVersion)
  ShareError ShareError
shareError -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShareError -> Pretty
prettyShareError ShareError
shareError)
  ViewOnShare (URI, ProjectName, ProjectBranchName)
shareRef ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"View it here: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> (URI, ProjectName, ProjectBranchName) -> Pretty
prettyRemoteBranchInfo (URI, ProjectName, ProjectBranchName)
shareRef
  IntegrityCheck IntegrityResult
result -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ case IntegrityResult
result of
    IntegrityResult
NoIntegrityErrors -> Pretty
"🎉 No issues detected 🎉"
    IntegrityErrorDetected NESet IntegrityError
ns -> NESet IntegrityError -> Pretty
forall (f :: * -> *). Foldable f => f IntegrityError -> Pretty
prettyPrintIntegrityErrors NESet IntegrityError
ns
  DebugTerm Bool
verbose Either Text (Term Symbol Ann)
builtinOrTerm -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ case Either Text (Term Symbol Ann)
builtinOrTerm of
    Left Text
builtin -> Pretty
"Builtin term: ##" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
builtin
    Right Term Symbol Ann
trm ->
      if Bool
verbose
        then Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty) -> (String -> Text) -> String -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pStringNoColor (String -> Pretty) -> String -> Pretty
forall a b. (a -> b) -> a -> b
$ Term Symbol Ann -> String
forall a. a -> String
RTTI.anythingToString Term Symbol Ann
trm
        else Term Symbol Ann -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown Term Symbol Ann
trm
  DebugDecl Either Text (Decl Symbol Ann)
typ Maybe ConstructorId
mayConId -> do
    let constructorMsg :: Pretty
constructorMsg = case Maybe ConstructorId
mayConId of
          Maybe ConstructorId
Nothing -> Pretty
""
          Just ConstructorId
conId -> Pretty
"Constructor #" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ConstructorId -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown ConstructorId
conId Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" of the following type:\n"
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
constructorMsg
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> case Either Text (Decl Symbol Ann)
typ of
          Left Text
builtinTxt -> Pretty
"Builtin type: ##" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
builtinTxt
          Right Decl Symbol Ann
decl -> (EffectDeclaration Symbol Ann -> Pretty)
-> (DataDeclaration Symbol Ann -> Pretty)
-> Decl Symbol Ann
-> Pretty
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty)
-> (EffectDeclaration Symbol Ann -> Text)
-> EffectDeclaration Symbol Ann
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict (Text -> Text)
-> (EffectDeclaration Symbol Ann -> Text)
-> EffectDeclaration Symbol Ann
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EffectDeclaration Symbol Ann -> Text
forall a. Show a => a -> Text
pShowNoColor) (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty)
-> (DataDeclaration Symbol Ann -> Text)
-> DataDeclaration Symbol Ann
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict (Text -> Text)
-> (DataDeclaration Symbol Ann -> Text)
-> DataDeclaration Symbol Ann
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDeclaration Symbol Ann -> Text
forall a. Show a => a -> Text
pShowNoColor) Decl Symbol Ann
decl
  AnnotatedFoldRanges Text
txt -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
txt
  DisplayDebugNameDiff NameChanges {[(Name, Referent)]
termNameAdds :: [(Name, Referent)]
$sel:termNameAdds:NameChanges :: NameChanges -> [(Name, Referent)]
termNameAdds, [(Name, Referent)]
termNameRemovals :: [(Name, Referent)]
$sel:termNameRemovals:NameChanges :: NameChanges -> [(Name, Referent)]
termNameRemovals, [(Name, TypeReference)]
typeNameAdds :: [(Name, TypeReference)]
$sel:typeNameAdds:NameChanges :: NameChanges -> [(Name, TypeReference)]
typeNameAdds, [(Name, TypeReference)]
typeNameRemovals :: [(Name, TypeReference)]
$sel:typeNameRemovals:NameChanges :: NameChanges -> [(Name, TypeReference)]
typeNameRemovals} -> do
    let referentText :: Referent -> Pretty
referentText =
          -- We don't use the constructor type in the actual output here, so there's no
          -- point in looking up the correct one.
          Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty) -> (Referent -> Text) -> Referent -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Referent -> Text
Referent.toText (Referent -> Text) -> (Referent -> Referent) -> Referent -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity Referent -> Referent
forall a. Identity a -> a
runIdentity (Identity Referent -> Referent)
-> (Referent -> Identity Referent) -> Referent -> Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeReference -> Identity ConstructorType)
-> Referent -> Identity Referent
forall (m :: * -> *).
Applicative m =>
(TypeReference -> m ConstructorType) -> Referent -> m Referent
Cv.referent2to1 (\TypeReference
_ref -> ConstructorType -> Identity ConstructorType
forall a. a -> Identity a
Identity ConstructorType
CT.Data)
    let referenceText :: TypeReference -> Pretty
referenceText = Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty)
-> (TypeReference -> Text) -> TypeReference -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> Text
Reference.toText (TypeReference -> Text)
-> (TypeReference -> TypeReference) -> TypeReference -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> TypeReference
Cv.reference2to1
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [Pretty] -> [[Pretty]] -> Pretty
P.columnNHeader
        [Pretty
"Kind", Pretty
"Name", Pretty
"Change", Pretty
"Ref"]
        ( ([(Name, Referent)]
termNameAdds [(Name, Referent)] -> ((Name, Referent) -> [Pretty]) -> [[Pretty]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Name
n, Referent
ref) -> [Pretty
"Term", Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
n, Pretty
"Added", Referent -> Pretty
referentText Referent
ref])
            [[Pretty]] -> [[Pretty]] -> [[Pretty]]
forall a. Semigroup a => a -> a -> a
<> ([(Name, Referent)]
termNameRemovals [(Name, Referent)] -> ((Name, Referent) -> [Pretty]) -> [[Pretty]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Name
n, Referent
ref) -> [Pretty
"Term", Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
n, Pretty
"Removed", Referent -> Pretty
referentText Referent
ref])
            [[Pretty]] -> [[Pretty]] -> [[Pretty]]
forall a. Semigroup a => a -> a -> a
<> ([(Name, TypeReference)]
typeNameAdds [(Name, TypeReference)]
-> ((Name, TypeReference) -> [Pretty]) -> [[Pretty]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Name
n, TypeReference
ref) -> [Pretty
"Type", Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
n, Pretty
"Added", TypeReference -> Pretty
referenceText TypeReference
ref])
            [[Pretty]] -> [[Pretty]] -> [[Pretty]]
forall a. Semigroup a => a -> a -> a
<> ([(Name, TypeReference)]
typeNameRemovals [(Name, TypeReference)]
-> ((Name, TypeReference) -> [Pretty]) -> [[Pretty]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Name
n, TypeReference
ref) -> [Pretty
"Type", Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
n, Pretty
"Removed", TypeReference -> Pretty
referenceText TypeReference
ref])
        )
  DisplayDebugCompletions [Completion]
completions ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [(Pretty, Pretty)] -> Pretty
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2
        ( [Completion]
completions [Completion]
-> (Completion -> (Pretty, Pretty)) -> [(Pretty, Pretty)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Completion
comp ->
            let isCompleteTxt :: Pretty
isCompleteTxt =
                  if Completion -> Bool
Completion.isFinished Completion
comp
                    then Pretty
"*"
                    else Pretty
""
             in (Pretty
isCompleteTxt, String -> Pretty
forall s. IsString s => String -> Pretty s
P.string (Completion -> String
Completion.replacement Completion
comp))
        )
  DisplayDebugLSPNameCompletions [(Text, Name, LabeledDependency)]
completions ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [Pretty] -> [[Pretty]] -> Pretty
P.columnNHeader
        [Pretty
"Matching Path", Pretty
"Name", Pretty
"Hash"]
        ( [(Text, Name, LabeledDependency)]
completions [(Text, Name, LabeledDependency)]
-> ((Text, Name, LabeledDependency) -> [Pretty]) -> [[Pretty]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Text
pathText, Name
fqn, LabeledDependency
ld) ->
            let ldRef :: Pretty (SyntaxText' TypeReference)
ldRef = case LabeledDependency
ld of
                  LD.TermReferent Referent
ref -> Int -> Referent -> Pretty (SyntaxText' TypeReference)
prettyReferent Int
10 Referent
ref
                  LD.TypeReference TypeReference
ref -> Int -> TypeReference -> Pretty (SyntaxText' TypeReference)
prettyReference Int
10 TypeReference
ref
             in [Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
pathText, Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
fqn, Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor Pretty (SyntaxText' TypeReference)
ldRef]
        )
  DebugDisplayFuzzyOptions Text
argDesc [String]
fuzzyOptions ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [(Text -> Pretty
FZFResolvers.fuzzySelectHeader Text
argDesc), Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
f (Pretty s) -> Pretty s
P.bulleted (String -> Pretty
forall s. IsString s => String -> Pretty s
P.string (String -> Pretty) -> [String] -> [Pretty]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
fuzzyOptions)]
  DebugFuzzyOptionsIncorrectArgs NonEmpty String
_ -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ String -> Pretty
forall s. IsString s => String -> Pretty s
P.string String
"Too many arguments were provided."
  DebugFuzzyOptionsNoCommand String
command -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"The command “" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> String -> Pretty
forall s. IsString s => String -> Pretty s
P.string String
command Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"” doesn’t exist."
  Output
DebugFuzzyOptionsNoResolver -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
"No resolver found for fuzzy options in this slot."
  Output
ClearScreen -> do
    IO ()
ANSI.clearScreen
    Int -> Int -> IO ()
ANSI.setCursorPosition Int
0 Int
0
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty
  PulledEmptyBranch ReadRemoteNamespace RemoteProjectBranch
remote ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ReadRemoteNamespace RemoteProjectBranch -> Pretty
prettyReadRemoteNamespace ReadRemoteNamespace RemoteProjectBranch
remote) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"has some history, but is currently empty."
  CreatedProject Bool
nameWasRandomlyGenerated ProjectName
projectName ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      if Bool
nameWasRandomlyGenerated
        then
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
            Pretty
"🎉 I've created the project with the randomly-chosen name"
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectName -> Pretty
prettyProjectName ProjectName
projectName
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"(use"
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.projectRenameInputPattern [Pretty
"<new-name>"]
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to change it)."
        else
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
            Pretty
"🎉 I've created the project" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectName -> Pretty
prettyProjectName ProjectName
projectName Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
  CreatedProjectBranch CreatedProjectBranchFrom
from ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch ->
    case CreatedProjectBranchFrom
from of
      CreatedProjectBranchFrom'LooseCode Absolute
path ->
        Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
            ( Pretty
"Done. I've created the"
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"branch from the namespace"
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Absolute -> Pretty
forall path. Pathy path => path -> Pretty
prettyPath Absolute
path
            )
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."
      CreatedProjectBranchFrom
CreatedProjectBranchFrom'Nothingness ->
        Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty
"Done. I've created an empty branch" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch)
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip
              ( Pretty
"Use"
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.mergeInputPattern [ProjectBranchName -> Pretty
prettySlashProjectBranchName (Text -> ProjectBranchName
UnsafeProjectBranchName Text
"somebranch")]
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to initialize this branch."
              )
      CreatedProjectBranchFrom'OtherBranch (ProjectAndBranch Project
otherProject ProjectBranch
otherBranch) ->
        Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
            ( Pretty
"Done. I've created the"
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"branch based off"
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch (Project
otherProject Project -> Getting ProjectName Project ProjectName -> ProjectName
forall s a. s -> Getting a s a -> a
^. Getting ProjectName Project ProjectName
#name) (ProjectBranch
otherBranch ProjectBranch
-> Getting ProjectBranchName ProjectBranch ProjectBranchName
-> ProjectBranchName
forall s a. s -> Getting a s a -> a
^. Getting ProjectBranchName ProjectBranch ProjectBranchName
#name))
            )
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."
      CreatedProjectBranchFrom'ParentBranch ProjectBranchName
parentBranch ->
        Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
            ( Pretty
"Done. I've created the"
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Pretty
prettyProjectBranchName (ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch ProjectAndBranch ProjectName ProjectBranchName
-> Getting
     ProjectBranchName
     (ProjectAndBranch ProjectName ProjectBranchName)
     ProjectBranchName
-> ProjectBranchName
forall s a. s -> Getting a s a -> a
^. Getting
  ProjectBranchName
  (ProjectAndBranch ProjectName ProjectBranchName)
  ProjectBranchName
#branch)
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"branch based off of"
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Pretty
prettyProjectBranchName ProjectBranchName
parentBranch
            )
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip
              ( Pretty
"To merge your work back into the"
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Pretty
prettyProjectBranchName ProjectBranchName
parentBranch
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"branch, first"
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.projectSwitch [ProjectBranchName -> Pretty
prettySlashProjectBranchName ProjectBranchName
parentBranch]
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"then"
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.mergeInputPattern [ProjectBranchName -> Pretty
prettySlashProjectBranchName (ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch ProjectAndBranch ProjectName ProjectBranchName
-> Getting
     ProjectBranchName
     (ProjectAndBranch ProjectName ProjectBranchName)
     ProjectBranchName
-> ProjectBranchName
forall s a. s -> Getting a s a -> a
^. Getting
  ProjectBranchName
  (ProjectAndBranch ProjectName ProjectBranchName)
  ProjectBranchName
#branch)] Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
              )
  CreatedRemoteProject URI
host (ProjectAndBranch ProjectName
projectName ProjectBranchName
_) ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"I just created"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectName -> Pretty
prettyProjectName ProjectName
projectName
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"on"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> URI -> Pretty
prettyShareURI URI
host
  CreatedRemoteProjectBranch URI
host ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"I just created" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"on" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> URI -> Pretty
prettyShareURI URI
host
  RemoteProjectBranchIsUpToDate URI
host ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"on"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> URI -> Pretty
prettyShareURI URI
host
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"is already up-to-date."
  InvalidProjectName Text
name -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
name Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"is not a valid project name."))
  InvalidProjectBranchName Text
name -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
name Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"is not a valid branch name."))
  ProjectNameAlreadyExists ProjectName
name ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"Project" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectName -> Pretty
prettyProjectName ProjectName
name Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"already exists."
  ProjectNameRequiresUserSlug ProjectName
name ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      ProjectName -> Pretty
prettyProjectName ProjectName
name
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"requires a username, as in"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectName -> Pretty
prettyProjectName (forall source target.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeFrom @Text Text
"@unison/base")
  ProjectAndBranchNameAlreadyExists ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"already exists."
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"You can switch to it with "
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExampleEOS InputPattern
IP.projectSwitch [ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch]
  Output
NotOnProjectBranch -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"You are not currently on a branch.")
  NoAssociatedRemoteProject URI
host ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"isn't associated with any project on" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> URI -> Pretty
prettyShareURI URI
host
  NoAssociatedRemoteProjectBranch URI
host (ProjectAndBranch Project
project ProjectBranch
branch) ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      ProjectAndBranch ProjectName ProjectBranchName -> Pretty
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))
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"isn't associated with any branch on"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> URI -> Pretty
prettyShareURI URI
host
  LocalProjectDoesntExist ProjectName
project ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      ProjectName -> Pretty
prettyProjectName ProjectName
project Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"does not exist."
  LocalProjectBranchDoesntExist ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"does not exist."
  LocalProjectNorProjectBranchExist ProjectName
project ProjectBranchName
branch ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"Neither project"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectName -> Pretty
prettyProjectName ProjectName
project
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"nor branch"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Pretty
prettySlashProjectBranchName ProjectBranchName
branch
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"exists."
  RemoteProjectDoesntExist URI
host ProjectName
project ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      ProjectName -> Pretty
prettyProjectName ProjectName
project Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"does not exist on" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> URI -> Pretty
prettyShareURI URI
host
  RemoteProjectBranchDoesntExist URI
host ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"does not exist on" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> URI -> Pretty
prettyShareURI URI
host
  RemoteProjectBranchDoesntExist'Push URI
host ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch ->
    let push :: Pretty
push = Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty -> Pretty)
-> (InputPattern -> Pretty) -> InputPattern -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. IsString s => Pretty s -> Pretty s
P.backticked (Pretty -> Pretty)
-> (InputPattern -> Pretty) -> InputPattern -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputPattern -> Pretty
IP.patternName (InputPattern -> Pretty) -> InputPattern -> Pretty
forall a b. (a -> b) -> a -> b
$ InputPattern
IP.push
     in Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
          Pretty
"The previous push target named"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"has been deleted from"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (URI -> Pretty
prettyShareURI URI
host Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"I've deleted the invalid push target."
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"Run the"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
push
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"command again to push to a new target."
  RemoteProjectBranchHeadMismatch URI
host ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"on"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> URI -> Pretty
prettyShareURI URI
host
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"has some history that I don't know about."
  RemoteProjectPublishedReleaseCannotBeChanged URI
host ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"The release"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"on"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> URI -> Pretty
prettyShareURI URI
host
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"has already been published and cannot be changed."
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"Consider making a new release instead."
  RemoteProjectReleaseIsDeprecated URI
host ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"The release"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"on"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> URI -> Pretty
prettyShareURI URI
host
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"has been deprecated."
  Unauthorized Text
message ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text
"Unauthorized: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
message)
  ServantClientError ClientError
err ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure case ClientError
err of
      Servant.ConnectionError SomeException
exception ->
        Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
          Pretty -> Maybe Pretty -> Pretty
forall a. a -> Maybe a -> a
fromMaybe Pretty
"Something went wrong with the connection. Try again?" do
            case SomeException -> ConnectionError
ServantClientUtils.classifyConnectionError SomeException
exception of
              ConnectionError
ServantClientUtils.ConnectionError'Offline -> Pretty -> Maybe Pretty
forall a. a -> Maybe a
Just Pretty
"You appear to be offline."
              ServantClientUtils.ConnectionError'SomethingElse HttpExceptionContent
_ -> Maybe Pretty
forall a. Maybe a
Nothing
              ServantClientUtils.ConnectionError'SomethingEntirelyUnexpected SomeException
_ -> Maybe Pretty
forall a. Maybe a
Nothing
      Servant.DecodeFailure Text
message Response
response ->
        Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Huh, I failed to decode a response from the server."
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
message)
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Here is the full response."
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Response -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.pshown Response
response)
      Servant.FailureResponse RequestF () (BaseUrl, ByteString)
request Response
response ->
        Response -> Pretty
unexpectedServerResponse Response
response
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Here is the request:"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (RequestF () (BaseUrl, ByteString) -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.pshown RequestF () (BaseUrl, ByteString)
request)
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Here is the full response:"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Response -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.pshown Response
response)
      Servant.InvalidContentTypeHeader Response
response -> Response -> Pretty
forall {s} {a}.
(Item s ~ Char, ListLike s Char, IsString s, Show a) =>
a -> Pretty s
wrongContentType Response
response
      Servant.UnsupportedContentType MediaType
_mediaType Response
response -> Response -> Pretty
forall {s} {a}.
(Item s ~ Char, ListLike s Char, IsString s, Show a) =>
a -> Pretty s
wrongContentType Response
response
    where
      wrongContentType :: a -> Pretty s
wrongContentType a
response =
        Pretty s -> Pretty s
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty s
"Huh, the server sent me the wrong content type."
          Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
forall s. IsString s => Pretty s
P.newline
          Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
forall s. IsString s => Pretty s
P.newline
          Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Pretty s
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty s
"Here is the full response."
          Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
forall s. IsString s => Pretty s
P.newline
          Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
forall s. IsString s => Pretty s
P.newline
          Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (a -> Pretty s
forall a s. (Show a, IsString s) => a -> Pretty s
P.pshown a
response)
  MarkdownOut Text
md -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
md
  DownloadedEntities Int
n -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty
"Downloaded" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Int -> Pretty
forall n s. (Show n, Num n, IsString s) => n -> Pretty s
P.num Int
n Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"entities."))
  UploadedEntities Int
n -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty
"Uploaded" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Int -> Pretty
forall n s. (Show n, Num n, IsString s) => n -> Pretty s
P.num Int
n Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"entities."))
  NotImplementedYet Text
message -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty
"Not implemented:" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
message))
  DraftingRelease ProjectBranchName
branch Semver
ver ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty
"😎 Great! I've created a draft release for you at " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Pretty
prettySlashProjectBranchName ProjectBranchName
branch)
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
          ( Pretty
"You can create a"
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty -> Pretty
forall s. IsString s => Pretty s -> Pretty s
P.backticked Pretty
"ReleaseNotes : Doc")
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"in this branch to give an overview of the release."
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"It'll automatically show up on Unison Share when you publish."
          )
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
          ( Pretty
"When ready to release"
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Semver -> Pretty
prettySemver Semver
ver
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to the world,"
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.push
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"the release to Unison Share, navigate to the release, and click \"Publish\"."
          )
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip
          ( Pretty
"if you get pulled away from drafting your release, you can always get back to it with "
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.projectSwitch [ProjectBranchName -> Pretty
prettySlashProjectBranchName ProjectBranchName
branch]
          )
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."
  CannotCreateReleaseBranchWithBranchCommand ProjectBranchName
branch Semver
ver ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty
"Branch names like" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Pretty
prettyProjectBranchName ProjectBranchName
branch Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"are reserved for releases.")
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip
          ( Pretty
"to download an existing release, try "
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.clone [ProjectBranchName -> Pretty
prettySlashProjectBranchName ProjectBranchName
branch]
          )
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip (Pretty
"to draft a new release, try " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.releaseDraft [Semver -> Pretty
prettySemver Semver
ver])
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."
  AmbiguousCloneLocal ProjectAndBranch ProjectName ProjectBranchName
project ProjectAndBranch ProjectName ProjectBranchName
branch -> do
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
        ( Pretty
"I'm not sure if you wanted to clone as the branch"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
branch
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"or as the branch"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
project Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"Could you be more specific?"
        )
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip
          ( ProjectBranchName -> Pretty
prettySlashProjectBranchName (ProjectAndBranch ProjectName ProjectBranchName
branch ProjectAndBranch ProjectName ProjectBranchName
-> Getting
     ProjectBranchName
     (ProjectAndBranch ProjectName ProjectBranchName)
     ProjectBranchName
-> ProjectBranchName
forall s a. s -> Getting a s a -> a
^. Getting
  ProjectBranchName
  (ProjectAndBranch ProjectName ProjectBranchName)
  ProjectBranchName
#branch)
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"refers to the branch"
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
branch Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
          )
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip
          ( ProjectName -> Pretty
prettyProjectNameSlash (ProjectAndBranch ProjectName ProjectBranchName
project ProjectAndBranch ProjectName ProjectBranchName
-> Getting
     ProjectName
     (ProjectAndBranch ProjectName ProjectBranchName)
     ProjectName
-> ProjectName
forall s a. s -> Getting a s a -> a
^. Getting
  ProjectName
  (ProjectAndBranch ProjectName ProjectBranchName)
  ProjectName
#project)
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"refers to"
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"the branch"
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
project Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
          )
  AmbiguousCloneRemote ProjectName
project (ProjectAndBranch ProjectName
currentProject ProjectBranchName
branch) ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
        ( Pretty
"I'm not sure if you wanted to clone the branch"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
currentProject ProjectBranchName
branch)
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"or the project"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectName -> Pretty
prettyProjectName ProjectName
project Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"Could you be more specific?"
        )
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip
          ( ProjectBranchName -> Pretty
prettySlashProjectBranchName ProjectBranchName
branch
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"refers to the branch"
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
currentProject ProjectBranchName
branch) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
          )
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip (ProjectName -> Pretty
prettyProjectNameSlash ProjectName
project Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"refers to the project" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectName -> Pretty
prettyProjectName ProjectName
project Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."))
  ClonedProjectBranch ProjectAndBranch ProjectName ProjectBranchName
remote ProjectAndBranch ProjectName ProjectBranchName
local ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"Cloned"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> if ProjectAndBranch ProjectName ProjectBranchName
remote ProjectAndBranch ProjectName ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName -> Bool
forall a. Eq a => a -> a -> Bool
== ProjectAndBranch ProjectName ProjectBranchName
local
          then Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
remote Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
          else ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
remote Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"as" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
local Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
  RenamedProject ProjectName
oldName ProjectName
newName ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      if ProjectName
oldName ProjectName -> ProjectName -> Bool
forall a. Eq a => a -> a -> Bool
== ProjectName
newName
        then ProjectName -> Pretty
prettyProjectName ProjectName
oldName Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"is already named" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectName -> Pretty
prettyProjectName ProjectName
oldName Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"!") Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"😄"
        else Pretty
"Ok, I renamed" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectName -> Pretty
prettyProjectName ProjectName
oldName Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectName -> Pretty
prettyProjectName ProjectName
newName Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
  RenamedProjectBranch ProjectName
projectName ProjectBranchName
oldBranchName ProjectBranchName
newBranchName ->
    let oldProjectAndBranchName :: Pretty
oldProjectAndBranchName = ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
projectName ProjectBranchName
oldBranchName)
        newProjectAndBranchName :: Pretty
newProjectAndBranchName = ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
projectName ProjectBranchName
newBranchName)
     in Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
          if ProjectBranchName
oldBranchName ProjectBranchName -> ProjectBranchName -> Bool
forall a. Eq a => a -> a -> Bool
== ProjectBranchName
newBranchName
            then Pretty
oldProjectAndBranchName Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"is already named" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty
newProjectAndBranchName Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"!") Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"😄"
            else Pretty
"Ok, I renamed" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
oldProjectAndBranchName Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty
newProjectAndBranchName Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
  CantRenameBranchTo ProjectBranchName
branch ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"You can't rename a branch to" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectBranchName -> Pretty
prettyProjectBranchName ProjectBranchName
branch Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
  Output
FetchingLatestReleaseOfBase ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"I'll now fetch the latest version of the base Unison library..."
  Output
FailedToFetchLatestReleaseOfBase ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Sorry something went wrong while fetching the library."
  Output
HappyCoding -> do
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"🎨 Type `ui` to explore this project's code in your browser."
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty
"🔭 Discover libraries at https://share.unison-lang.org")
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"📖 Use `help-topic projects` to learn more about projects."
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Write your first Unison code with UCM:"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN
          Width
2
          ( Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"1. Open scratch.u."
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"2. Write some Unison code and save the file."
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"3. In UCM, type `update` to save it to your new project."
          )
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"🎉 🥳 Happy coding!"
  ProjectHasNoReleases ProjectName
projectName ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ ProjectName -> Pretty
prettyProjectName ProjectName
projectName Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"has no releases."
  DeleteFailure String
scratchFile0 ProjectBranchName
baseBranch -> do
    Pretty
scratchFile <- String -> IO Pretty
renderFileName String
scratchFile0
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"I couldn't complete the delete, because some definitions are still in use."
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall {s}.
(Item s ~ Char, ListLike s Char, IsString s) =>
Pretty s -> Pretty s
iveCreatedATemporaryBranch Pretty
scratchFile
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Pretty
onceYoureHappy ProjectBranchName
baseBranch
  Output
UpdateTypecheckingFailure ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"Typechecking failed. I've updated your scratch file with the definitions that need fixing."
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"Once the file is compiling, try"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
makeExample' InputPattern
IP.update
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"again."
  UpdateTypecheckingFailure2 String
scratchFile0 ProjectBranchName
baseBranch -> do
    Pretty
scratchFile <- String -> IO Pretty
renderFileName String
scratchFile0
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"I couldn't complete the update, because some existing definitions would no longer typecheck."
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall {s}.
(Item s ~ Char, ListLike s Char, IsString s) =>
Pretty s -> Pretty s
iveCreatedATemporaryBranch Pretty
scratchFile
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Pretty
onceYoureHappy ProjectBranchName
baseBranch
  UpgradeFailure ProjectBranchName
baseBranch String
scratchFile0 NonEmpty (NameSegment, NameSegment)
names -> do
    Pretty
scratchFile <- String -> IO Pretty
renderFileName String
scratchFile0
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
        ( Pretty
"I couldn't automatically upgrade"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ( NonEmpty (NameSegment, NameSegment)
names
                   NonEmpty (NameSegment, NameSegment)
-> (NonEmpty (NameSegment, NameSegment) -> NonEmpty Pretty)
-> NonEmpty Pretty
forall a b. a -> (a -> b) -> b
& ((NameSegment, NameSegment) -> Pretty)
-> NonEmpty (NameSegment, NameSegment) -> NonEmpty Pretty
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                     ( \(NameSegment
old, NameSegment
new) ->
                         Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
                           NameSegment -> Pretty
prettyLibdepName NameSegment
old
                             Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to"
                             Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> NameSegment -> Pretty
prettyLibdepName NameSegment
new
                     )
                   NonEmpty Pretty -> (NonEmpty Pretty -> Pretty) -> Pretty
forall a b. a -> (a -> b) -> b
& Pretty -> NonEmpty Pretty -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.oxfordCommasWith Pretty
"."
               )
        )
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall {s}.
(Item s ~ Char, ListLike s Char, IsString s) =>
Pretty s -> Pretty s
iveCreatedATemporaryBranch Pretty
scratchFile
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Pretty
onceYoureHappy ProjectBranchName
baseBranch
  UpgradeSuccess NonEmpty (NameSegment, NameSegment)
names Map NameSegment NameSegment
unmanglings ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
"I upgraded"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ( NonEmpty (NameSegment, NameSegment)
names
                 NonEmpty (NameSegment, NameSegment)
-> (NonEmpty (NameSegment, NameSegment) -> NonEmpty Pretty)
-> NonEmpty Pretty
forall a b. a -> (a -> b) -> b
& ((NameSegment, NameSegment) -> Pretty)
-> NonEmpty (NameSegment, NameSegment) -> NonEmpty Pretty
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                   ( \(NameSegment
old, NameSegment
new) ->
                       let oldToNew :: Pretty
oldToNew =
                             NameSegment -> Pretty
prettyLibdepName NameSegment
old
                               Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to"
                               Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> NameSegment -> Pretty
prettyLibdepName NameSegment
new
                        in Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap case NameSegment -> Map NameSegment NameSegment -> Maybe NameSegment
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
new Map NameSegment NameSegment
unmanglings of
                             Maybe NameSegment
Nothing -> Pretty
oldToNew
                             Just NameSegment
new1 -> Pretty
oldToNew Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"(renamed to" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (NameSegment -> Pretty
prettyLibdepName NameSegment
new1 Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
")")
                   )
                 NonEmpty Pretty -> (NonEmpty Pretty -> Pretty) -> Pretty
forall a b. a -> (a -> b) -> b
& Pretty -> NonEmpty Pretty -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.oxfordCommasWith Pretty
"."
             )
  MergeFailure String
path MergeSourceAndTarget
aliceAndBob ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
        [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
            Pretty
"I couldn't automatically merge"
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> MergeSource -> Pretty
prettyMergeSource MergeSourceAndTarget
aliceAndBob.bob
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"into"
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName MergeSourceAndTarget
aliceAndBob.alice Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"However, I've added the definitions that need attention to the top of"
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (String -> Pretty
prettyFilePath String
path Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."),
          Pretty
"",
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"When you're done, you can run",
          Pretty
"",
          Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (InputPattern -> [Pretty] -> Pretty
IP.makeExampleNoBackticks InputPattern
IP.update []),
          Pretty
"",
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
            Pretty
"to merge your changes back into"
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Pretty
prettyProjectBranchName MergeSourceAndTarget
aliceAndBob.alice.branch
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"and delete the temporary branch. Or, if you decide to cancel the merge instead, you can run",
          Pretty
"",
          Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (InputPattern -> [Pretty] -> Pretty
IP.makeExampleNoBackticks InputPattern
IP.cancelInputPattern []),
          Pretty
"",
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
            Pretty
"to delete the temporary branch and switch back to"
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectBranchName -> Pretty
prettyProjectBranchName MergeSourceAndTarget
aliceAndBob.alice.branch Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
        ]
  MergeFailureWithMergetool MergeSourceAndTarget
aliceAndBob Text
mergetool ExitCode
exitCode ->
    case ExitCode
exitCode of
      ExitCode
ExitSuccess ->
        Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
          [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
            [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
                Pretty
"I couldn't automatically merge"
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> MergeSource -> Pretty
prettyMergeSource MergeSourceAndTarget
aliceAndBob.bob
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"into"
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName MergeSourceAndTarget
aliceAndBob.alice Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
",")
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"so I'm running your UCM_MERGETOOL environment variable as",
              Pretty
"",
              Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
mergetool),
              Pretty
"",
              Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"When you're done, you can run",
              Pretty
"",
              Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (InputPattern -> [Pretty] -> Pretty
IP.makeExampleNoBackticks InputPattern
IP.update []),
              Pretty
"",
              Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
                Pretty
"to merge your changes back into"
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectBranchName -> Pretty
prettyProjectBranchName MergeSourceAndTarget
aliceAndBob.alice.branch
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"and delete the temporary branch. Or, if you decide to cancel the merge instead, you can run",
              Pretty
"",
              Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (InputPattern -> [Pretty] -> Pretty
IP.makeExampleNoBackticks InputPattern
IP.cancelInputPattern []),
              Pretty
"",
              Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
                Pretty
"to delete the temporary branch and switch back to"
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectBranchName -> Pretty
prettyProjectBranchName MergeSourceAndTarget
aliceAndBob.alice.branch Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
            ]
      ExitFailure Int
code ->
        Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
          [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
            [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
                Pretty
"I couldn't automatically merge"
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> MergeSource -> Pretty
prettyMergeSource MergeSourceAndTarget
aliceAndBob.bob
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"into"
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName MergeSourceAndTarget
aliceAndBob.alice Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
",")
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"so I tried to run your UCM_MERGETOOL environment variable as",
              Pretty
"",
              Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
mergetool),
              Pretty
"",
              Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty
"but it failed with exit code" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Int -> Pretty
forall n s. (Show n, Num n, IsString s) => n -> Pretty s
P.num Int
code Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."))
            ]
  MergeSuccess MergeSourceAndTarget
aliceAndBob ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"I merged"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> MergeSource -> Pretty
prettyMergeSource MergeSourceAndTarget
aliceAndBob.bob
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"into"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName MergeSourceAndTarget
aliceAndBob.alice Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
  MergeSuccessFastForward MergeSourceAndTarget
aliceAndBob ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"I fast-forward merged"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> MergeSource -> Pretty
prettyMergeSource MergeSourceAndTarget
aliceAndBob.bob
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"into"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName MergeSourceAndTarget
aliceAndBob.alice Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
  InstalledLibdep ProjectAndBranch ProjectName ProjectBranchName
libdep NameSegment
segment ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"I installed"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
libdep
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"into"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty) -> Text -> Pretty
forall a b. (a -> b) -> a -> b
$ forall target source. From source target => source -> target
into @Text (Path -> Text) -> Path -> Text
forall a b. (a -> b) -> a -> b
$ [NameSegment] -> Path
Path.fromList [NameSegment
NameSegment.libSegment, NameSegment
segment])
  UseLibInstallNotPull ProjectAndBranch ProjectName ProjectBranchName
libdep ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"The use of"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.pull
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to install libraries is now deprecated. Going forward, you can use"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.libInstallInputPattern [ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
libdep] Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
  PullIntoMissingBranch ReadRemoteNamespace RemoteProjectBranch
source (ProjectAndBranch Maybe ProjectName
maybeTargetProject ProjectBranchName
targetBranch) ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"I think you want to merge"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
sourcePretty
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"into the"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
targetPretty
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"branch, but it doesn't exist. If you want, you can create it with"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.branchEmptyInputPattern [Pretty
targetPretty] Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
",")
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"and then"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.pull
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"again."
    where
      sourcePretty :: Pretty
sourcePretty = ReadRemoteNamespace RemoteProjectBranch -> Pretty
prettyReadRemoteNamespace ReadRemoteNamespace RemoteProjectBranch
source
      targetPretty :: Pretty
targetPretty =
        case Maybe ProjectName
maybeTargetProject of
          Maybe ProjectName
Nothing -> ProjectBranchName -> Pretty
prettyProjectBranchName ProjectBranchName
targetBranch
          Just ProjectName
targetProject -> ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
targetProject ProjectBranchName
targetBranch)
  Output
NoMergeInProgress ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"It doesn't look like there's a merge in progress."
  Output'DebugSynhashTerm TypeReference
ref Hash
synhash Text
filename ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"Hash: "
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Int -> TypeReference -> Pretty (SyntaxText' TypeReference)
prettyReference Int
120 TypeReference
ref)
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"Synhash: "
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Hash -> Pretty
forall s. IsString s => Hash -> Pretty s
prettyHash Hash
synhash
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"Synhash tokens: "
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
filename
  ConflictedDefn Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
defn ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      ( Pretty
"Sorry, I can't do that right now, because there's more than one" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> case Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
defn of
          TermDefn (Conflicted Name
name NESet Referent
_refs) -> Pretty
"term with the name" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty -> Pretty
forall s. IsString s => Pretty s -> Pretty s
P.backticked (Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
name) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
          TypeDefn (Conflicted Name
name NESet TypeReference
_refs) -> Pretty
"type with the name" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty -> Pretty
forall s. IsString s => Pretty s -> Pretty s
P.backticked (Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
name) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
      )
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"Please"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ( InputPattern -> Pretty
IP.makeExample' case Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
defn of
               TermDefn Conflicted Name Referent
_ -> InputPattern
IP.renameTerm
               TypeDefn Conflicted Name TypeReference
_ -> InputPattern
IP.renameType
           )
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"or"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ( InputPattern -> Pretty
IP.makeExample' case Defn (Conflicted Name Referent) (Conflicted Name TypeReference)
defn of
               TermDefn Conflicted Name Referent
_ -> InputPattern
IP.deleteTermForce
               TypeDefn Conflicted Name TypeReference
_ -> InputPattern
IP.deleteTypeForce
           )
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"all but one of them, then try again."
  IncoherentDeclDuringDelete DeleteTarget
target IncoherentDeclReason
reason ->
    let command :: Pretty
command =
          case DeleteTarget
target of
            DeleteTarget
Input.DeleteTarget'TermOrType -> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.delete
            DeleteTarget
Input.DeleteTarget'Term -> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.deleteTerm
            DeleteTarget
Input.DeleteTarget'Type -> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.deleteType
     in case IncoherentDeclReason
reason of
          IncoherentDeclReason'ConstructorAlias Name
typeName Name
conName1 Name
conName2 ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty -> Name -> Name -> Name -> Pretty
constructorAliasError Pretty
command Pretty
"The type" Name
typeName Name
conName1 Name
conName2
          IncoherentDeclReason'MissingConstructorName Name
name ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty -> Name -> Pretty
missingConstructorNameError Pretty
command Pretty
"The type" Name
name
          IncoherentDeclReason'NestedDeclAlias Name
shorterName Name
longerName ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty -> Name -> Name -> Pretty
nestedDeclAliasError Pretty
"The type" Pretty
command Name
shorterName Name
longerName
          IncoherentDeclReason'StrayConstructor TermReferenceId
_typeRef Name
name ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty -> Name -> Pretty
strayConstructorError Pretty
command Pretty
"The constructor" Name
name
  IncoherentDeclDuringDiffBranch DiffBranchArg
diffBranchArg IncoherentDeclReason
reason ->
    let command :: Pretty
command = InputPattern -> Pretty
IP.makeExample' InputPattern
IP.diffBranch
        which :: Pretty
which =
          case DiffBranchArg
diffBranchArg of
            Input.DiffBranchArg'Branch ProjectAndBranch (Maybe ProjectName) ProjectBranchName
branch -> ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Pretty
prettyMaybeProjectAndBranchName ProjectAndBranch (Maybe ProjectName) ProjectBranchName
branch
            Input.DiffBranchArg'Hash ShortCausalHash
hash -> ShortCausalHash -> Pretty
forall s. IsString s => ShortCausalHash -> Pretty s
prettySCH ShortCausalHash
hash
     in case IncoherentDeclReason
reason of
          IncoherentDeclReason'ConstructorAlias Name
typeName Name
conName1 Name
conName2 ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
              Pretty -> Pretty -> Name -> Name -> Name -> Pretty
constructorAliasError
                Pretty
command
                (Pretty
"On" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty
which Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
",") Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"the type")
                Name
typeName
                Name
conName1
                Name
conName2
          IncoherentDeclReason'MissingConstructorName Name
name ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
              Pretty -> Pretty -> Name -> Pretty
missingConstructorNameError
                Pretty
command
                (Pretty
"On" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty
which Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
",") Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"the type")
                Name
name
          IncoherentDeclReason'NestedDeclAlias Name
shorterName Name
longerName ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
              Pretty -> Pretty -> Name -> Name -> Pretty
nestedDeclAliasError
                (Pretty
"On" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty
which Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
",") Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"the type")
                Pretty
command
                Name
shorterName
                Name
longerName
          IncoherentDeclReason'StrayConstructor TermReferenceId
_typeRef Name
name ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
              Pretty -> Pretty -> Name -> Pretty
strayConstructorError
                Pretty
command
                (Pretty
"On" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty
which Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
",") Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"the constructor")
                Name
name
  IncoherentDeclDuringMerge MergeSourceOrTarget
aliceOrBob IncoherentDeclReason
reason ->
    let command :: Pretty
command = InputPattern -> Pretty
IP.makeExample' InputPattern
IP.mergeInputPattern
     in case IncoherentDeclReason
reason of
          IncoherentDeclReason'ConstructorAlias Name
typeName Name
conName1 Name
conName2 ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
              Pretty -> Pretty -> Name -> Name -> Name -> Pretty
constructorAliasError
                Pretty
command
                (Pretty
"On" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (MergeSourceOrTarget -> Pretty
prettyMergeSourceOrTarget MergeSourceOrTarget
aliceOrBob Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
",") Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"the type")
                Name
typeName
                Name
conName1
                Name
conName2
          IncoherentDeclReason'MissingConstructorName Name
name ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
              Pretty -> Pretty -> Name -> Pretty
missingConstructorNameError
                Pretty
command
                (Pretty
"On" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (MergeSourceOrTarget -> Pretty
prettyMergeSourceOrTarget MergeSourceOrTarget
aliceOrBob Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
",") Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"the type")
                Name
name
          IncoherentDeclReason'NestedDeclAlias Name
shorterName Name
longerName ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
              Pretty -> Pretty -> Name -> Name -> Pretty
nestedDeclAliasError
                (Pretty
"On" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (MergeSourceOrTarget -> Pretty
prettyMergeSourceOrTarget MergeSourceOrTarget
aliceOrBob Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
",") Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"the type")
                Pretty
command
                Name
shorterName
                Name
longerName
          IncoherentDeclReason'StrayConstructor TermReferenceId
_typeRef Name
name ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
              Pretty -> Pretty -> Name -> Pretty
strayConstructorError
                Pretty
command
                (Pretty
"On" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (MergeSourceOrTarget -> Pretty
prettyMergeSourceOrTarget MergeSourceOrTarget
aliceOrBob Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
",") Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"the constructor")
                Name
name
  IncoherentDeclDuringUpdate IncoherentDeclReason
reason ->
    let command :: Pretty
command = InputPattern -> Pretty
IP.makeExample' InputPattern
IP.update
     in case IncoherentDeclReason
reason of
          IncoherentDeclReason'ConstructorAlias Name
typeName Name
conName1 Name
conName2 ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty -> Name -> Name -> Name -> Pretty
constructorAliasError Pretty
command Pretty
"The type" Name
typeName Name
conName1 Name
conName2
          IncoherentDeclReason'MissingConstructorName Name
name ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty -> Name -> Pretty
missingConstructorNameError Pretty
command Pretty
"The type" Name
name
          IncoherentDeclReason'NestedDeclAlias Name
shorterName Name
longerName ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty -> Name -> Name -> Pretty
nestedDeclAliasError Pretty
"The type" Pretty
command Name
shorterName Name
longerName
          IncoherentDeclReason'StrayConstructor TermReferenceId
_typeRef Name
name ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty -> Name -> Pretty
strayConstructorError Pretty
command Pretty
"The constructor" Name
name
  IncoherentDeclDuringUpgrade IncoherentDeclReason
reason ->
    let command :: Pretty
command = InputPattern -> Pretty
IP.makeExample' InputPattern
IP.upgrade
     in case IncoherentDeclReason
reason of
          IncoherentDeclReason'ConstructorAlias Name
typeName Name
conName1 Name
conName2 ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty -> Name -> Name -> Name -> Pretty
constructorAliasError Pretty
command Pretty
"The type" Name
typeName Name
conName1 Name
conName2
          IncoherentDeclReason'MissingConstructorName Name
name ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty -> Name -> Pretty
missingConstructorNameError Pretty
command Pretty
"The type" Name
name
          IncoherentDeclReason'NestedDeclAlias Name
shorterName Name
longerName ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty -> Name -> Name -> Pretty
nestedDeclAliasError Pretty
"The type" Pretty
command Name
shorterName Name
longerName
          IncoherentDeclReason'StrayConstructor TermReferenceId
_typeRef Name
name ->
            Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty -> Name -> Pretty
strayConstructorError Pretty
command Pretty
"The constructor" Name
name
  Literal Pretty
message -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
message
  SyncPullError SyncError PullError
syncErr ->
    case SyncError PullError
syncErr of
      Sync.TransportError CodeserverTransportError
te -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CodeserverTransportError -> Pretty
prettyTransportError CodeserverTransportError
te)
      Sync.SyncError PullError
pullErr -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PullError -> Pretty
prettyPullV2Error PullError
pullErr)
  SyncFromCodebaseMissingProjectBranch ProjectAndBranch ProjectName ProjectBranchName
projectBranch ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"I couldn't sync from the codebase because the project branch"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
projectBranch
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"doesn't exist."
  OpenCodebaseError String
codebasePath OpenCodebaseError
err -> case OpenCodebaseError
err of
    OpenCodebaseError
CodebaseInit.OpenCodebaseDoesntExist ->
      Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> (Pretty -> Pretty) -> Pretty -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"I couldn't find a valid codebase at " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> String -> Pretty
prettyFilePath String
codebasePath
    CodebaseInit.OpenCodebaseUnknownSchemaVersion SchemaVersion
schemaVersion ->
      Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$
        [ Pretty
"I couldn't open the codebase at " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> String -> Pretty
prettyFilePath String
codebasePath Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".",
          Pretty
"The schema version appears to be newer than the current UCM version can support.",
          Pretty
"You may need to upgrade UCM. The codebase is at schema version: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> SchemaVersion -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown SchemaVersion
schemaVersion
        ]
    OpenCodebaseError
CodebaseInit.OpenCodebaseFileLockFailed -> do
      Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$
        [ Pretty
"I couldn't open the codebase at " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> String -> Pretty
prettyFilePath String
codebasePath,
          Pretty
"It appears another process is using that codebase, please close other UCM instances and try again."
        ]
    CodebaseInit.OpenCodebaseRequiresMigration SchemaVersion
currentSV SchemaVersion
requiredSV ->
      Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$
        [ Pretty
"I couldn't open the codebase at " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> String -> Pretty
prettyFilePath String
codebasePath,
          Pretty
"The codebase is at schema version " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> SchemaVersion -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown SchemaVersion
currentSV Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" but UCM requires schema version " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> SchemaVersion -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown SchemaVersion
requiredSV Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".",
          Pretty
"Please open the other codebase with UCM directly to upgrade it to the latest version, then try again."
        ]
  Output
UCMServerNotRunning -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"The UCM server is not running.")
  BranchSquashSuccess ProjectAndBranch Project ProjectBranch
srcPAB ProjectAndBranch Project ProjectBranch
destPAB -> do
    let sourceName :: Pretty
sourceName = ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectAndBranch Project ProjectBranch
srcPAB.project.name ProjectAndBranch Project ProjectBranch
srcPAB.branch.name)
    let destName :: Pretty
destName = ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectAndBranch Project ProjectBranch
destPAB.project.name ProjectAndBranch Project ProjectBranch
destPAB.branch.name)
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"I squashed " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
sourceName Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" into " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
destName
        ]
  Output
BranchUpdate'BranchChanged -> do
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Another process updated the codebase while your command was running, so I didn't apply the update. Please run the command again."
  SyncingFromTo CausalHash
fromCausalHash CausalHash
toCausalHash -> do
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
"Updating branch from"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.green (ShortCausalHash -> Pretty
forall s. IsString s => ShortCausalHash -> Pretty s
prettySCH (ShortCausalHash -> Pretty) -> ShortCausalHash -> Pretty
forall a b. (a -> b) -> a -> b
$ Int -> CausalHash -> ShortCausalHash
SCH.fromHash Int
10 CausalHash
fromCausalHash)
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty -> Pretty
P.green (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ ShortCausalHash -> Pretty
forall s. IsString s => ShortCausalHash -> Pretty s
prettySCH (ShortCausalHash -> Pretty) -> ShortCausalHash -> Pretty
forall a b. (a -> b) -> a -> b
$ Int -> CausalHash -> ShortCausalHash
SCH.fromHash Int
10 CausalHash
toCausalHash)
  CantDeleteConstructor NESet Name
names ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        ( case NonEmpty Name -> [Name]
forall a. NonEmpty a -> [a]
NEList.toList (NESet Name -> NonEmpty Name
forall a. NESet a -> NonEmpty a
Set.NonEmpty.toList NESet Name
names) of
            [Name
name] -> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty
"I can't delete the constructor" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
name Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."))
            [Name]
names ->
              Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty
"I can't delete the constructors" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group ([Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.commas ((Name -> Pretty) -> [Name] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName [Name]
names) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."))
        )
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
            ( Pretty
"You may only delete terms and types with"
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (InputPattern -> Pretty
IP.makeExample' InputPattern
IP.delete Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"Use"
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.deleteForce
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"instead."
            )
  CantDoThatDuring Text
aVerb Text
verb ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
"Sorry, I can't do that during"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> (Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
aVerb) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"Please complete the"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> (Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
verb) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
",")
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"then try again."
  Output
ShowEmptyBranchDiff -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
prettyEmptyBranchDiff
  ShowBranchDiff TwoWay DiffBranchArg
branchArgs TwoWay PrettyPrintEnv
ppes TwoWay (Map NameSegment (DiffOp CausalHash))
libdepsDiffs TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
diffs Maybe (Text, ExitCode)
_maybeDifftoolResult -> do
    let isEmpty :: Map k a
-> Defns (Map k a, Map k a, Map k a) (Map k a, Map k a, Map k a)
-> Bool
isEmpty
          Map k a
libdepsDiff
          Defns
            { $sel:terms:Defns :: forall terms types. Defns terms types -> terms
terms = (Map k a
newTerms, Map k a
updatedTerms, Map k a
deletedTerms),
              $sel:types:Defns :: forall terms types. Defns terms types -> types
types = (Map k a
newTypes, Map k a
updatedTypes, Map k a
deletedTypes)
            } =
            Map k a -> Bool
forall k a. Map k a -> Bool
Map.null Map k a
libdepsDiff
              Bool -> Bool -> Bool
&& Map k a -> Bool
forall k a. Map k a -> Bool
Map.null Map k a
newTerms
              Bool -> Bool -> Bool
&& Map k a -> Bool
forall k a. Map k a -> Bool
Map.null Map k a
updatedTerms
              Bool -> Bool -> Bool
&& Map k a -> Bool
forall k a. Map k a -> Bool
Map.null Map k a
deletedTerms
              Bool -> Bool -> Bool
&& Map k a -> Bool
forall k a. Map k a -> Bool
Map.null Map k a
newTypes
              Bool -> Bool -> Bool
&& Map k a -> Bool
forall k a. Map k a -> Bool
Map.null Map k a
updatedTypes
              Bool -> Bool -> Bool
&& Map k a -> Bool
forall k a. Map k a -> Bool
Map.null Map k a
deletedTypes

    let showBranchDiff ::
          PPE.PrettyPrintEnv ->
          Input.DiffBranchArg ->
          Map NameSegment (Merge.DiffOp CausalHash) ->
          ( Defns
              ( Map Name (Type Symbol Ann),
                Map Name (Type Symbol Ann),
                Map Name (Type Symbol Ann)
              )
              ( Map Name (DeclOrBuiltin Symbol Ann),
                Map Name (DeclOrBuiltin Symbol Ann),
                Map Name (DeclOrBuiltin Symbol Ann)
              )
          ) ->
          Pretty
        showBranchDiff :: PrettyPrintEnv
-> DiffBranchArg
-> Map NameSegment (DiffOp CausalHash)
-> Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann))
-> Pretty
showBranchDiff PrettyPrintEnv
_ DiffBranchArg
_ Map NameSegment (DiffOp CausalHash)
libdepsDiff Defns
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
diff | Map NameSegment (DiffOp CausalHash)
-> Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann))
-> Bool
forall {k} {a} {k} {a} {k} {a} {k} {a} {k} {a} {k} {a} {k} {a}.
Map k a
-> Defns (Map k a, Map k a, Map k a) (Map k a, Map k a, Map k a)
-> Bool
isEmpty Map NameSegment (DiffOp CausalHash)
libdepsDiff Defns
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
diff = Pretty
forall a. Monoid a => a
mempty
        showBranchDiff PrettyPrintEnv
ppe DiffBranchArg
branchArg Map NameSegment (DiffOp CausalHash)
libdepsDiff Defns
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
diff = do
          let colorAdd :: Pretty -> Pretty
colorAdd = Pretty -> Pretty
P.green (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty
"+ " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<>)
              colorUpdate :: Pretty -> Pretty
colorUpdate = Pretty -> Pretty
P.yellow (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty
"~ " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<>)
              colorDelete :: Pretty -> Pretty
colorDelete = Pretty -> Pretty
P.red (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty
"- " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<>)

          let renderLibdep :: NameSegment -> CausalHash -> Pretty
              renderLibdep :: NameSegment -> CausalHash -> Pretty
renderLibdep NameSegment
name CausalHash
_hash =
                Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName (NonEmpty NameSegment -> Name
Name.fromReverseSegments (NameSegment
name NameSegment -> [NameSegment] -> NonEmpty NameSegment
forall a. a -> [a] -> NonEmpty a
NEList.:| [NameSegment
NameSegment.libSegment]))

          let renderLibdeps :: (Pretty -> Pretty) -> [(NameSegment, CausalHash)] -> Pretty
              renderLibdeps :: (Pretty -> Pretty) -> [(NameSegment, CausalHash)] -> Pretty
renderLibdeps Pretty -> Pretty
colored [(NameSegment, CausalHash)]
libdeps =
                [(NameSegment, CausalHash)]
libdeps
                  [(NameSegment, CausalHash)]
-> ([(NameSegment, CausalHash)] -> [(NameSegment, CausalHash)])
-> [(NameSegment, CausalHash)]
forall a b. a -> (a -> b) -> b
& ((NameSegment, CausalHash) -> NameSegment)
-> [(NameSegment, CausalHash)] -> [(NameSegment, CausalHash)]
forall a b. Alphabetical a => (b -> a) -> [b] -> [b]
sortAlphabeticallyOn (Getting NameSegment (NameSegment, CausalHash) NameSegment
-> (NameSegment, CausalHash) -> NameSegment
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting NameSegment (NameSegment, CausalHash) NameSegment
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (NameSegment, CausalHash)
  (NameSegment, CausalHash)
  NameSegment
  NameSegment
_1)
                  [(NameSegment, CausalHash)]
-> ([(NameSegment, CausalHash)] -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& ((NameSegment, CausalHash) -> Pretty)
-> [(NameSegment, CausalHash)] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map (\(NameSegment
name, CausalHash
hash) -> Pretty -> Pretty
colored (NameSegment -> CausalHash -> Pretty
renderLibdep NameSegment
name CausalHash
hash))
                  [Pretty] -> ([Pretty] -> Pretty) -> Pretty
forall a b. a -> (a -> b) -> b
& [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines

          let renderedNewLibdeps :: Pretty
              renderedNewLibdeps :: Pretty
renderedNewLibdeps =
                Map NameSegment (DiffOp CausalHash)
libdepsDiff
                  Map NameSegment (DiffOp CausalHash)
-> (Map NameSegment (DiffOp CausalHash)
    -> [(NameSegment, DiffOp CausalHash)])
-> [(NameSegment, DiffOp CausalHash)]
forall a b. a -> (a -> b) -> b
& Map NameSegment (DiffOp CausalHash)
-> [(NameSegment, DiffOp CausalHash)]
forall k a. Map k a -> [(k, a)]
Map.toList
                  [(NameSegment, DiffOp CausalHash)]
-> ([(NameSegment, DiffOp CausalHash)]
    -> [(NameSegment, CausalHash)])
-> [(NameSegment, CausalHash)]
forall a b. a -> (a -> b) -> b
& ((NameSegment, DiffOp CausalHash)
 -> Maybe (NameSegment, CausalHash))
-> [(NameSegment, DiffOp CausalHash)]
-> [(NameSegment, CausalHash)]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe
                    ( \case
                        (NameSegment
name, Merge.DiffOp'Add CausalHash
hash) -> (NameSegment, CausalHash) -> Maybe (NameSegment, CausalHash)
forall a. a -> Maybe a
Just (NameSegment
name, CausalHash
hash)
                        (NameSegment, DiffOp CausalHash)
_ -> Maybe (NameSegment, CausalHash)
forall a. Maybe a
Nothing
                    )
                  [(NameSegment, CausalHash)]
-> ([(NameSegment, CausalHash)] -> Pretty) -> Pretty
forall a b. a -> (a -> b) -> b
& (Pretty -> Pretty) -> [(NameSegment, CausalHash)] -> Pretty
renderLibdeps Pretty -> Pretty
colorAdd

          let renderedUpdatedLibdeps :: Pretty
              renderedUpdatedLibdeps :: Pretty
renderedUpdatedLibdeps =
                Map NameSegment (DiffOp CausalHash)
libdepsDiff
                  Map NameSegment (DiffOp CausalHash)
-> (Map NameSegment (DiffOp CausalHash)
    -> [(NameSegment, DiffOp CausalHash)])
-> [(NameSegment, DiffOp CausalHash)]
forall a b. a -> (a -> b) -> b
& Map NameSegment (DiffOp CausalHash)
-> [(NameSegment, DiffOp CausalHash)]
forall k a. Map k a -> [(k, a)]
Map.toList
                  [(NameSegment, DiffOp CausalHash)]
-> ([(NameSegment, DiffOp CausalHash)]
    -> [(NameSegment, CausalHash)])
-> [(NameSegment, CausalHash)]
forall a b. a -> (a -> b) -> b
& ((NameSegment, DiffOp CausalHash)
 -> Maybe (NameSegment, CausalHash))
-> [(NameSegment, DiffOp CausalHash)]
-> [(NameSegment, CausalHash)]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe
                    ( \case
                        (NameSegment
name, Merge.DiffOp'Update Updated CausalHash
hashes) -> (NameSegment, CausalHash) -> Maybe (NameSegment, CausalHash)
forall a. a -> Maybe a
Just (NameSegment
name, Updated CausalHash
hashes.new)
                        (NameSegment, DiffOp CausalHash)
_ -> Maybe (NameSegment, CausalHash)
forall a. Maybe a
Nothing
                    )
                  [(NameSegment, CausalHash)]
-> ([(NameSegment, CausalHash)] -> Pretty) -> Pretty
forall a b. a -> (a -> b) -> b
& (Pretty -> Pretty) -> [(NameSegment, CausalHash)] -> Pretty
renderLibdeps Pretty -> Pretty
colorUpdate

          let renderedDeletedLibdeps :: Pretty
              renderedDeletedLibdeps :: Pretty
renderedDeletedLibdeps =
                Map NameSegment (DiffOp CausalHash)
libdepsDiff
                  Map NameSegment (DiffOp CausalHash)
-> (Map NameSegment (DiffOp CausalHash)
    -> [(NameSegment, DiffOp CausalHash)])
-> [(NameSegment, DiffOp CausalHash)]
forall a b. a -> (a -> b) -> b
& Map NameSegment (DiffOp CausalHash)
-> [(NameSegment, DiffOp CausalHash)]
forall k a. Map k a -> [(k, a)]
Map.toList
                  [(NameSegment, DiffOp CausalHash)]
-> ([(NameSegment, DiffOp CausalHash)]
    -> [(NameSegment, CausalHash)])
-> [(NameSegment, CausalHash)]
forall a b. a -> (a -> b) -> b
& ((NameSegment, DiffOp CausalHash)
 -> Maybe (NameSegment, CausalHash))
-> [(NameSegment, DiffOp CausalHash)]
-> [(NameSegment, CausalHash)]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe
                    ( \case
                        (NameSegment
name, Merge.DiffOp'Delete CausalHash
hash) -> (NameSegment, CausalHash) -> Maybe (NameSegment, CausalHash)
forall a. a -> Maybe a
Just (NameSegment
name, CausalHash
hash)
                        (NameSegment, DiffOp CausalHash)
_ -> Maybe (NameSegment, CausalHash)
forall a. Maybe a
Nothing
                    )
                  [(NameSegment, CausalHash)]
-> ([(NameSegment, CausalHash)] -> Pretty) -> Pretty
forall a b. a -> (a -> b) -> b
& (Pretty -> Pretty) -> [(NameSegment, CausalHash)] -> Pretty
renderLibdeps Pretty -> Pretty
colorDelete

          let renderTypes :: (Pretty -> Pretty) -> Map Name (DeclOrBuiltin Symbol Ann) -> Pretty
              renderTypes :: (Pretty -> Pretty) -> Map Name (DeclOrBuiltin Symbol Ann) -> Pretty
renderTypes Pretty -> Pretty
colored Map Name (DeclOrBuiltin Symbol Ann)
types =
                Map Name (DeclOrBuiltin Symbol Ann)
types
                  Map Name (DeclOrBuiltin Symbol Ann)
-> (Map Name (DeclOrBuiltin Symbol Ann)
    -> [(Name, DeclOrBuiltin Symbol Ann)])
-> [(Name, DeclOrBuiltin Symbol Ann)]
forall a b. a -> (a -> b) -> b
& Map Name (DeclOrBuiltin Symbol Ann)
-> [(Name, DeclOrBuiltin Symbol Ann)]
forall k a. Map k a -> [(k, a)]
Map.toList
                  [(Name, DeclOrBuiltin Symbol Ann)]
-> ([(Name, DeclOrBuiltin Symbol Ann)]
    -> [(Name, DeclOrBuiltin Symbol Ann)])
-> [(Name, DeclOrBuiltin Symbol Ann)]
forall a b. a -> (a -> b) -> b
& ((Name, DeclOrBuiltin Symbol Ann) -> Name)
-> [(Name, DeclOrBuiltin Symbol Ann)]
-> [(Name, DeclOrBuiltin Symbol Ann)]
forall a b. Alphabetical a => (b -> a) -> [b] -> [b]
sortAlphabeticallyOn (Getting Name (Name, DeclOrBuiltin Symbol Ann) Name
-> (Name, DeclOrBuiltin Symbol Ann) -> Name
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Name (Name, DeclOrBuiltin Symbol Ann) Name
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Name, DeclOrBuiltin Symbol Ann)
  (Name, DeclOrBuiltin Symbol Ann)
  Name
  Name
_1)
                  [(Name, DeclOrBuiltin Symbol Ann)]
-> ([(Name, DeclOrBuiltin Symbol Ann)] -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& ((Name, DeclOrBuiltin Symbol Ann) -> Pretty)
-> [(Name, DeclOrBuiltin Symbol Ann)] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map
                    ( \(Name
name, DeclOrBuiltin Symbol Ann
decl) ->
                        Pretty -> Pretty
colored (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
                          Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> Pretty (SyntaxText' TypeReference) -> Pretty
forall a b. (a -> b) -> a -> b
$
                            RenderUniqueTypeGuids
-> HashQualified Name
-> DeclOrBuiltin Symbol Ann
-> Pretty (SyntaxText' TypeReference)
forall v a.
Var v =>
RenderUniqueTypeGuids
-> HashQualified Name
-> DeclOrBuiltin v a
-> Pretty (SyntaxText' TypeReference)
DeclPrinter.prettyDeclOrBuiltinHeader
                              RenderUniqueTypeGuids
DeclPrinter.RenderUniqueTypeGuids'No
                              (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.fromName Name
name)
                              DeclOrBuiltin Symbol Ann
decl
                    )
                  [Pretty] -> ([Pretty] -> Pretty) -> Pretty
forall a b. a -> (a -> b) -> b
& [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines

          let renderTerms :: (Pretty -> Pretty) -> Map Name (Type Symbol Ann) -> Pretty
              renderTerms :: (Pretty -> Pretty) -> Map Name (Type Symbol Ann) -> Pretty
renderTerms Pretty -> Pretty
colored Map Name (Type Symbol Ann)
terms =
                Map Name (Type Symbol Ann)
terms
                  Map Name (Type Symbol Ann)
-> (Map Name (Type Symbol Ann) -> [(Name, Type Symbol Ann)])
-> [(Name, Type Symbol Ann)]
forall a b. a -> (a -> b) -> b
& Map Name (Type Symbol Ann) -> [(Name, Type Symbol Ann)]
forall k a. Map k a -> [(k, a)]
Map.toList
                  [(Name, Type Symbol Ann)]
-> ([(Name, Type Symbol Ann)] -> [(Name, Type Symbol Ann)])
-> [(Name, Type Symbol Ann)]
forall a b. a -> (a -> b) -> b
& ((Name, Type Symbol Ann) -> Name)
-> [(Name, Type Symbol Ann)] -> [(Name, Type Symbol Ann)]
forall a b. Alphabetical a => (b -> a) -> [b] -> [b]
sortAlphabeticallyOn (Getting Name (Name, Type Symbol Ann) Name
-> (Name, Type Symbol Ann) -> Name
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Name (Name, Type Symbol Ann) Name
forall s t a b. Field1 s t a b => Lens s t a b
Lens (Name, Type Symbol Ann) (Name, Type Symbol Ann) Name Name
_1)
                  [(Name, Type Symbol Ann)]
-> ([(Name, Type Symbol Ann)] -> [(Pretty, Pretty)])
-> [(Pretty, Pretty)]
forall a b. a -> (a -> b) -> b
& ((Name, Type Symbol Ann) -> (Pretty, Pretty))
-> [(Name, Type Symbol Ann)] -> [(Pretty, Pretty)]
forall a b. (a -> b) -> [a] -> [b]
map
                    ( \(Name
name, Type Symbol Ann
ty) ->
                        ( Pretty -> Pretty
colored (Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyNameParens Name
name),
                          Pretty
": " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentNAfterNewline Width
2 (PrettyPrintEnv -> Type Symbol Ann -> Pretty
forall v a. Var v => PrettyPrintEnv -> Type v a -> Pretty
TypePrinter.pretty PrettyPrintEnv
ppe Type Symbol Ann
ty)
                        )
                    )
                  [(Pretty, Pretty)] -> ([(Pretty, Pretty)] -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& [(Pretty, Pretty)] -> [Pretty]
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> [Pretty s]
P.align
                  [Pretty] -> ([Pretty] -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& (Pretty -> Pretty) -> [Pretty] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group
                  [Pretty] -> ([Pretty] -> Pretty) -> Pretty
forall a b. a -> (a -> b) -> b
& [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
           in Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty
                Pretty
"\n\n"
                [ let prettyBranchArg :: Pretty
prettyBranchArg =
                        case DiffBranchArg
branchArg of
                          Input.DiffBranchArg'Branch ProjectAndBranch (Maybe ProjectName) ProjectBranchName
branch -> ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Pretty
prettyMaybeProjectAndBranchName ProjectAndBranch (Maybe ProjectName) ProjectBranchName
branch
                          Input.DiffBranchArg'Hash ShortCausalHash
hash -> ShortCausalHash -> Pretty
forall s. IsString s => ShortCausalHash -> Pretty s
prettySCH ShortCausalHash
hash
                   in Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty
"Changes on " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty
prettyBranchArg Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
":")),
                  [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.linesNonEmpty
                    [ Pretty
renderedNewLibdeps,
                      Pretty
renderedUpdatedLibdeps,
                      Pretty
renderedDeletedLibdeps
                    ],
                  [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.linesNonEmpty
                    [ (Pretty -> Pretty) -> Map Name (DeclOrBuiltin Symbol Ann) -> Pretty
renderTypes Pretty -> Pretty
colorAdd (Getting
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
-> (Map Name (DeclOrBuiltin Symbol Ann),
    Map Name (DeclOrBuiltin Symbol Ann),
    Map Name (DeclOrBuiltin Symbol Ann))
-> Map Name (DeclOrBuiltin Symbol Ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
_1 Defns
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
diff.types),
                      (Pretty -> Pretty) -> Map Name (DeclOrBuiltin Symbol Ann) -> Pretty
renderTypes Pretty -> Pretty
colorUpdate (Getting
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
-> (Map Name (DeclOrBuiltin Symbol Ann),
    Map Name (DeclOrBuiltin Symbol Ann),
    Map Name (DeclOrBuiltin Symbol Ann))
-> Map Name (DeclOrBuiltin Symbol Ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
_2 Defns
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
diff.types),
                      (Pretty -> Pretty) -> Map Name (DeclOrBuiltin Symbol Ann) -> Pretty
renderTypes Pretty -> Pretty
colorDelete (Getting
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
-> (Map Name (DeclOrBuiltin Symbol Ann),
    Map Name (DeclOrBuiltin Symbol Ann),
    Map Name (DeclOrBuiltin Symbol Ann))
-> Map Name (DeclOrBuiltin Symbol Ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
_3 Defns
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
diff.types)
                    ],
                  [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.linesNonEmpty
                    [ (Pretty -> Pretty) -> Map Name (Type Symbol Ann) -> Pretty
renderTerms Pretty -> Pretty
colorAdd (Getting
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
-> (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
    Map Name (Type Symbol Ann))
-> Map Name (Type Symbol Ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
_1 Defns
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
diff.terms),
                      (Pretty -> Pretty) -> Map Name (Type Symbol Ann) -> Pretty
renderTerms Pretty -> Pretty
colorUpdate (Getting
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
-> (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
    Map Name (Type Symbol Ann))
-> Map Name (Type Symbol Ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
_2 Defns
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
diff.terms),
                      (Pretty -> Pretty) -> Map Name (Type Symbol Ann) -> Pretty
renderTerms Pretty -> Pretty
colorDelete (Getting
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
-> (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
    Map Name (Type Symbol Ann))
-> Map Name (Type Symbol Ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
_3 Defns
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
diff.terms)
                    ]
                ]

    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      if Map NameSegment (DiffOp CausalHash)
-> Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann))
-> Bool
forall {k} {a} {k} {a} {k} {a} {k} {a} {k} {a} {k} {a} {k} {a}.
Map k a
-> Defns (Map k a, Map k a, Map k a) (Map k a, Map k a, Map k a)
-> Bool
isEmpty TwoWay (Map NameSegment (DiffOp CausalHash))
libdepsDiffs.alice TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
diffs.alice Bool -> Bool -> Bool
&& Map NameSegment (DiffOp CausalHash)
-> Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann))
-> Bool
forall {k} {a} {k} {a} {k} {a} {k} {a} {k} {a} {k} {a} {k} {a}.
Map k a
-> Defns (Map k a, Map k a, Map k a) (Map k a, Map k a, Map k a)
-> Bool
isEmpty TwoWay (Map NameSegment (DiffOp CausalHash))
libdepsDiffs.bob TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
diffs.bob
        then Pretty
prettyEmptyBranchDiff
        else
          Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty
            Pretty
"\n\n"
            [ PrettyPrintEnv
-> DiffBranchArg
-> Map NameSegment (DiffOp CausalHash)
-> Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann))
-> Pretty
showBranchDiff TwoWay PrettyPrintEnv
ppes.alice TwoWay DiffBranchArg
branchArgs.alice TwoWay (Map NameSegment (DiffOp CausalHash))
libdepsDiffs.alice TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
diffs.alice,
              PrettyPrintEnv
-> DiffBranchArg
-> Map NameSegment (DiffOp CausalHash)
-> Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann))
-> Pretty
showBranchDiff TwoWay PrettyPrintEnv
ppes.bob TwoWay DiffBranchArg
branchArgs.bob TwoWay (Map NameSegment (DiffOp CausalHash))
libdepsDiffs.bob TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
diffs.bob,
              let existAdds :: Bool
existAdds =
                    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
                      [ Bool -> Bool
not (Map Name (Type Symbol Ann) -> Bool
forall k a. Map k a -> Bool
Map.null (Getting
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
-> (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
    Map Name (Type Symbol Ann))
-> Map Name (Type Symbol Ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
_1 TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
diffs.alice.terms)),
                        Bool -> Bool
not (Map Name (DeclOrBuiltin Symbol Ann) -> Bool
forall k a. Map k a -> Bool
Map.null (Getting
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
-> (Map Name (DeclOrBuiltin Symbol Ann),
    Map Name (DeclOrBuiltin Symbol Ann),
    Map Name (DeclOrBuiltin Symbol Ann))
-> Map Name (DeclOrBuiltin Symbol Ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
_1 TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
diffs.alice.types)),
                        Bool -> Bool
not (Map Name (Type Symbol Ann) -> Bool
forall k a. Map k a -> Bool
Map.null (Getting
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
-> (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
    Map Name (Type Symbol Ann))
-> Map Name (Type Symbol Ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
_1 TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
diffs.bob.terms)),
                        Bool -> Bool
not (Map Name (DeclOrBuiltin Symbol Ann) -> Bool
forall k a. Map k a -> Bool
Map.null (Getting
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
-> (Map Name (DeclOrBuiltin Symbol Ann),
    Map Name (DeclOrBuiltin Symbol Ann),
    Map Name (DeclOrBuiltin Symbol Ann))
-> Map Name (DeclOrBuiltin Symbol Ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
_1 TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
diffs.bob.types)),
                        (DiffOp CausalHash -> Bool)
-> Map NameSegment (DiffOp CausalHash) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any DiffOp CausalHash -> Bool
forall a. DiffOp a -> Bool
Merge.DiffOp.isAdd TwoWay (Map NameSegment (DiffOp CausalHash))
libdepsDiffs.alice,
                        (DiffOp CausalHash -> Bool)
-> Map NameSegment (DiffOp CausalHash) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any DiffOp CausalHash -> Bool
forall a. DiffOp a -> Bool
Merge.DiffOp.isAdd TwoWay (Map NameSegment (DiffOp CausalHash))
libdepsDiffs.bob
                      ]
                  existUpdates :: Bool
existUpdates =
                    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
                      [ Bool -> Bool
not (Map Name (Type Symbol Ann) -> Bool
forall k a. Map k a -> Bool
Map.null (Getting
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
-> (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
    Map Name (Type Symbol Ann))
-> Map Name (Type Symbol Ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
_2 TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
diffs.alice.terms)),
                        Bool -> Bool
not (Map Name (DeclOrBuiltin Symbol Ann) -> Bool
forall k a. Map k a -> Bool
Map.null (Getting
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
-> (Map Name (DeclOrBuiltin Symbol Ann),
    Map Name (DeclOrBuiltin Symbol Ann),
    Map Name (DeclOrBuiltin Symbol Ann))
-> Map Name (DeclOrBuiltin Symbol Ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
_2 TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
diffs.alice.types)),
                        Bool -> Bool
not (Map Name (Type Symbol Ann) -> Bool
forall k a. Map k a -> Bool
Map.null (Getting
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
-> (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
    Map Name (Type Symbol Ann))
-> Map Name (Type Symbol Ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
_2 TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
diffs.bob.terms)),
                        Bool -> Bool
not (Map Name (DeclOrBuiltin Symbol Ann) -> Bool
forall k a. Map k a -> Bool
Map.null (Getting
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
-> (Map Name (DeclOrBuiltin Symbol Ann),
    Map Name (DeclOrBuiltin Symbol Ann),
    Map Name (DeclOrBuiltin Symbol Ann))
-> Map Name (DeclOrBuiltin Symbol Ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
_2 TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
diffs.bob.types)),
                        (DiffOp CausalHash -> Bool)
-> Map NameSegment (DiffOp CausalHash) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any DiffOp CausalHash -> Bool
forall a. DiffOp a -> Bool
Merge.DiffOp.isUpdate TwoWay (Map NameSegment (DiffOp CausalHash))
libdepsDiffs.alice,
                        (DiffOp CausalHash -> Bool)
-> Map NameSegment (DiffOp CausalHash) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any DiffOp CausalHash -> Bool
forall a. DiffOp a -> Bool
Merge.DiffOp.isUpdate TwoWay (Map NameSegment (DiffOp CausalHash))
libdepsDiffs.bob
                      ]
                  existDeletes :: Bool
existDeletes =
                    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
                      [ Bool -> Bool
not (Map Name (Type Symbol Ann) -> Bool
forall k a. Map k a -> Bool
Map.null (Getting
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
-> (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
    Map Name (Type Symbol Ann))
-> Map Name (Type Symbol Ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
_3 TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
diffs.alice.terms)),
                        Bool -> Bool
not (Map Name (DeclOrBuiltin Symbol Ann) -> Bool
forall k a. Map k a -> Bool
Map.null (Getting
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
-> (Map Name (DeclOrBuiltin Symbol Ann),
    Map Name (DeclOrBuiltin Symbol Ann),
    Map Name (DeclOrBuiltin Symbol Ann))
-> Map Name (DeclOrBuiltin Symbol Ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
_3 TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
diffs.alice.types)),
                        Bool -> Bool
not (Map Name (Type Symbol Ann) -> Bool
forall k a. Map k a -> Bool
Map.null (Getting
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
-> (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
    Map Name (Type Symbol Ann))
-> Map Name (Type Symbol Ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
   Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
  (Map Name (Type Symbol Ann))
_3 TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
diffs.bob.terms)),
                        Bool -> Bool
not (Map Name (DeclOrBuiltin Symbol Ann) -> Bool
forall k a. Map k a -> Bool
Map.null (Getting
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
-> (Map Name (DeclOrBuiltin Symbol Ann),
    Map Name (DeclOrBuiltin Symbol Ann),
    Map Name (DeclOrBuiltin Symbol Ann))
-> Map Name (DeclOrBuiltin Symbol Ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann),
   Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
  (Map Name (DeclOrBuiltin Symbol Ann))
_3 TwoWay
  (Defns
     (Map Name (Type Symbol Ann), Map Name (Type Symbol Ann),
      Map Name (Type Symbol Ann))
     (Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann),
      Map Name (DeclOrBuiltin Symbol Ann)))
diffs.bob.types)),
                        (DiffOp CausalHash -> Bool)
-> Map NameSegment (DiffOp CausalHash) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any DiffOp CausalHash -> Bool
forall a. DiffOp a -> Bool
Merge.DiffOp.isDelete TwoWay (Map NameSegment (DiffOp CausalHash))
libdepsDiffs.alice,
                        (DiffOp CausalHash -> Bool)
-> Map NameSegment (DiffOp CausalHash) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any DiffOp CausalHash -> Bool
forall a. DiffOp a -> Bool
Merge.DiffOp.isDelete TwoWay (Map NameSegment (DiffOp CausalHash))
libdepsDiffs.bob
                      ]
               in case Bool -> Bool -> Bool -> Maybe Pretty
prettyAddUpdateDeleteLegend Bool
existAdds Bool
existUpdates Bool
existDeletes of
                    Just Pretty
legend -> Pretty
legend
                    Maybe Pretty
Nothing -> Pretty
forall a. Monoid a => a
mempty
            ]
  StaleRun PrettyPrintEnv
ppe Name
main (Defn TypeReference TypeReference
endOfPath NEList.:| [Defn TypeReference TypeReference]
reversePath) Bool
inFile ->
    let path :: [(Bool, Defn TypeReference TypeReference)]
path = [(Bool, Defn TypeReference TypeReference)]
-> [(Bool, Defn TypeReference TypeReference)]
forall a. [a] -> [a]
reverse ((Bool
True, Defn TypeReference TypeReference
endOfPath) (Bool, Defn TypeReference TypeReference)
-> [(Bool, Defn TypeReference TypeReference)]
-> [(Bool, Defn TypeReference TypeReference)]
forall a. a -> [a] -> [a]
: (Defn TypeReference TypeReference
 -> (Bool, Defn TypeReference TypeReference))
-> [Defn TypeReference TypeReference]
-> [(Bool, Defn TypeReference TypeReference)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
False,) [Defn TypeReference TypeReference]
reversePath)
     in Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
            ( Pretty
"Sorry, I don't want to run"
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
prettyMain
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"because it depends on something that hasn't been committed to the codebase yet:"
            )
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ( [(Bool, Defn TypeReference TypeReference)]
path
                   [(Bool, Defn TypeReference TypeReference)]
-> ([(Bool, Defn TypeReference TypeReference)] -> [Pretty])
-> [Pretty]
forall a b. a -> (a -> b) -> b
& ((Bool, Defn TypeReference TypeReference) -> Pretty)
-> [(Bool, Defn TypeReference TypeReference)] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map (\(Bool
end, Defn TypeReference TypeReference
defn) -> Defn TypeReference TypeReference -> Pretty
prettyDefn Defn TypeReference TypeReference
defn Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Bool -> Pretty
prettyWhere Bool
end)
                   [Pretty] -> ([Pretty] -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& (if Bool
inFile then ((Pretty
prettyMain Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Bool -> Pretty
prettyWhere Bool
True) Pretty -> [Pretty] -> [Pretty]
forall a. a -> [a] -> [a]
:) else [Pretty] -> [Pretty]
forall a. a -> a
id)
                   [Pretty] -> ([Pretty] -> (Width, Pretty)) -> (Width, Pretty)
forall a b. a -> (a -> b) -> b
& ((Width, Pretty) -> Pretty -> (Width, Pretty))
-> (Width, Pretty) -> [Pretty] -> (Width, Pretty)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
                     ( \(Width
n, Pretty
acc) Pretty
defn ->
                         (Width
n Width -> Width -> Width
forall a. Num a => a -> a -> a
+ Width
2, Pretty
acc Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> if Width
n Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
> Width
2 then Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN (Width
n Width -> Width -> Width
forall a. Num a => a -> a -> a
- Width
2) (Pretty
"└ " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
defn) else Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
n Pretty
defn)
                     )
                     (Width
2, Pretty
forall a. Monoid a => a
mempty)
                   (Width, Pretty) -> ((Width, Pretty) -> Pretty) -> Pretty
forall a b. a -> (a -> b) -> b
& (Width, Pretty) -> Pretty
forall a b. (a, b) -> b
snd
               )
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
              ( Pretty
"You can"
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.update
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to save and propagate these changes into your branch."
              )
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
              ( Pretty
"If you don't want that, you can run"
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ( if Bool
inFile
                         then
                           let dependency :: Pretty
dependency = Defn TypeReference TypeReference -> Pretty
prettyDefn Defn TypeReference TypeReference
endOfPath
                            in InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.editDependents [Pretty
dependency]
                                 Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to add all callers of"
                                 Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
dependency
                         else
                           InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.edit [Pretty
prettyMain]
                             Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to add"
                             Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
prettyMain
                     )
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to the scratch file without performing an"
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (InputPattern -> Pretty
IP.makeExample' InputPattern
IP.update Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
              )
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
              ( Pretty
"Then, you can try"
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.execute [Pretty
prettyMain]
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"again for an up-to-date result."
              )
    where
      prettyWhere :: Bool -> Pretty
      prettyWhere :: Bool -> Pretty
prettyWhere = \case
        Bool
True -> Pretty
" (in file)"
        Bool
False -> Pretty
" (in codebase)"

      prettyDefn :: Defn TermReference TypeReference -> Pretty
      prettyDefn :: Defn TypeReference TypeReference -> Pretty
prettyDefn =
        Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> (Defn TypeReference TypeReference
    -> Pretty (SyntaxText' TypeReference))
-> Defn TypeReference TypeReference
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified (HashQualified Name -> Pretty (SyntaxText' TypeReference))
-> (Defn TypeReference TypeReference -> HashQualified Name)
-> Defn TypeReference TypeReference
-> Pretty (SyntaxText' TypeReference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
          TermDefn TypeReference
ref -> PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName PrettyPrintEnv
ppe (TypeReference -> Referent
Referent.fromTermReference TypeReference
ref)
          TypeDefn TypeReference
ref -> PrettyPrintEnv -> TypeReference -> HashQualified Name
PPE.typeName PrettyPrintEnv
ppe TypeReference
ref

      prettyMain :: Pretty
      prettyMain :: Pretty
prettyMain =
        Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
main
  InvalidCommentTarget Text
msg -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Annotation failed, " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
msg)
  Output
CommentedSuccessfully -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty
P.bold Pretty
"Done."
  Output
CommentAborted -> Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Annotation aborted.")
  Output
AuthorNameRequired ->
    Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.hang Pretty
"Please configure your a display name for your user." (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
          [ Pretty
"You can do so with: ",
            InputPattern -> [Pretty] -> Pretty
IP.makeExampleNoBackticks InputPattern
IP.configSet [Pretty
"author.name", Pretty
"<your name>"]
          ]
  ConfigValueGet ConfigKey
key Maybe Text
value ->
    case Maybe Text
value of
      Maybe Text
Nothing ->
        Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
            Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (ConfigKey -> Text
Config.keyToText ConfigKey
key)
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" is unset"
      Just Text
value ->
        Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
            Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (ConfigKey -> Text
Config.keyToText ConfigKey
key)
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" = "
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
value Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"")
  where
    iveCreatedATemporaryBranch :: Pretty s -> Pretty s
iveCreatedATemporaryBranch Pretty s
scratchFile =
      Pretty s -> Pretty s
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty s -> Pretty s) -> Pretty s -> Pretty s
forall a b. (a -> b) -> a -> b
$
        Pretty s
"I've created a temporary branch and added the affected definitions to"
          Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s -> Pretty s
forall s. Pretty s -> Pretty s
P.group (Pretty s
scratchFile Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
",")
          Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
"where you can fix them up or remove any that are obsolete."

    onceYoureHappy :: ProjectBranchName -> Pretty
onceYoureHappy ProjectBranchName
baseBranch =
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
"Once you're happy with the results, use"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
makeExample' InputPattern
IP.update
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to merge them back into"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (ProjectBranchName -> Pretty
prettyProjectBranchName ProjectBranchName
baseBranch Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
",")
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"or"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
makeExample' InputPattern
IP.cancelInputPattern
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"if you change your mind."

prettyAddUpdateDeleteLegend :: Bool -> Bool -> Bool -> Maybe Pretty
prettyAddUpdateDeleteLegend :: Bool -> Bool -> Bool -> Maybe Pretty
prettyAddUpdateDeleteLegend Bool
existAdds Bool
existUpdates Bool
existDeletes
  | Bool -> Bool
not Bool
existUpdates Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
existDeletes = Maybe Pretty
forall a. Maybe a
Nothing
  | Bool
otherwise =
      Pretty -> Maybe Pretty
forall a. a -> Maybe a
Just (Pretty -> Maybe Pretty) -> Pretty -> Maybe Pretty
forall a b. (a -> b) -> a -> b
$
        [Pretty] -> Pretty
forall a. Monoid a => [a] -> a
mconcat
          ( Pretty -> [Pretty] -> [Pretty]
forall a. a -> [a] -> [a]
List.intersperse
              Pretty
", "
              ( [Maybe Pretty] -> [Pretty]
forall a. [Maybe a] -> [a]
catMaybes
                  [ if Bool
existAdds then Pretty -> Maybe Pretty
forall a. a -> Maybe a
Just Pretty
legendAdded else Maybe Pretty
forall a. Maybe a
Nothing,
                    if Bool
existUpdates then Pretty -> Maybe Pretty
forall a. a -> Maybe a
Just Pretty
legendModified else Maybe Pretty
forall a. Maybe a
Nothing,
                    if Bool
existDeletes then Pretty -> Maybe Pretty
forall a. a -> Maybe a
Just Pretty
legendDeleted else Maybe Pretty
forall a. Maybe a
Nothing
                  ]
              )
          )
  where
    legendAdded :: Pretty
legendAdded = Pretty -> Pretty
P.green Pretty
"+" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" (added)"
    legendModified :: Pretty
legendModified = Pretty -> Pretty
P.yellow Pretty
"~" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" (modified)"
    legendDeleted :: Pretty
legendDeleted = Pretty -> Pretty
P.red Pretty
"-" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" (deleted)"

prettyShareError :: ShareError -> Pretty
prettyShareError :: ShareError -> Pretty
prettyShareError =
  Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.fatalCallout (Pretty -> Pretty)
-> (ShareError -> Pretty) -> ShareError -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    ShareErrorDownloadEntities DownloadEntitiesError
err -> DownloadEntitiesError -> Pretty
prettyDownloadEntitiesError DownloadEntitiesError
err
    ShareErrorGetCausalHashByPath GetCausalHashByPathError
err -> GetCausalHashByPathError -> Pretty
prettyGetCausalHashByPathError GetCausalHashByPathError
err
    ShareErrorPull PullError
err -> PullError -> Pretty
prettyPullError PullError
err
    ShareErrorPullV2 PullError
err -> PullError -> Pretty
prettyPullV2Error PullError
err
    ShareErrorTransport CodeserverTransportError
err -> CodeserverTransportError -> Pretty
prettyTransportError CodeserverTransportError
err
    ShareErrorUploadEntities UploadEntitiesError
err -> UploadEntitiesError -> Pretty
prettyUploadEntitiesError UploadEntitiesError
err
    ShareError
ShareExpectedSquashedHead -> Pretty
"The server failed to provide a squashed branch head when requested. Please report this as a bug to the Unison team."

prettyDownloadEntitiesError :: Share.DownloadEntitiesError -> Pretty
prettyDownloadEntitiesError :: DownloadEntitiesError -> Pretty
prettyDownloadEntitiesError = \case
  Share.DownloadEntitiesNoReadPermission RepoInfo
repoInfo -> RepoInfo -> Pretty
noReadPermissionForRepo RepoInfo
repoInfo
  Share.DownloadEntitiesInvalidRepoInfo Text
err RepoInfo
repoInfo -> Text -> RepoInfo -> Pretty
invalidRepoInfo Text
err RepoInfo
repoInfo
  Share.DownloadEntitiesUserNotFound Text
userHandle -> RepoInfo -> Pretty
shareUserNotFound (Text -> RepoInfo
Share.RepoInfo Text
userHandle)
  Share.DownloadEntitiesProjectNotFound Text
project -> Text -> Pretty
shareProjectNotFound Text
project
  Share.DownloadEntitiesEntityValidationFailure EntityValidationError
err -> EntityValidationError -> Pretty
prettyEntityValidationFailure EntityValidationError
err

prettyBranchRef :: SyncV2.BranchRef -> Pretty
prettyBranchRef :: BranchRef -> Pretty
prettyBranchRef (SyncV2.BranchRef Text
txt) = Pretty -> Pretty
P.blue (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
txt)

prettyDownloadEntitiesErrorV2 :: SyncV2.DownloadEntitiesError -> Pretty
prettyDownloadEntitiesErrorV2 :: DownloadEntitiesError -> Pretty
prettyDownloadEntitiesErrorV2 = \case
  SyncV2.DownloadEntitiesNoReadPermission BranchRef
branchRef -> BranchRef -> Pretty
prettyBranchRef BranchRef
branchRef
  SyncV2.DownloadEntitiesUserNotFound Text
userHandle -> RepoInfo -> Pretty
shareUserNotFound (Text -> RepoInfo
Share.RepoInfo Text
userHandle)
  SyncV2.DownloadEntitiesProjectNotFound Text
project -> Text -> Pretty
shareProjectNotFound Text
project
  SyncV2.DownloadEntitiesEntityValidationFailure EntityValidationError
err -> EntityValidationError -> Pretty
prettyEntityValidationFailure EntityValidationError
err
  SyncV2.DownloadEntitiesInvalidBranchRef Text
msg BranchRef
ref -> Text -> BranchRef -> Pretty
prettyInvalidBranchRef Text
msg BranchRef
ref

prettyInvalidBranchRef :: Text -> SyncV2.BranchRef -> Pretty
prettyInvalidBranchRef :: Text -> BranchRef -> Pretty
prettyInvalidBranchRef Text
msg (SyncV2.BranchRef Text
txt) =
  Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
    Pretty
"The server sent an invalid branch reference."
      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"The error was:"
      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
msg
      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"The branch reference was:"
      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
txt

prettyGetCausalHashByPathError :: Share.GetCausalHashByPathError -> Pretty
prettyGetCausalHashByPathError :: GetCausalHashByPathError -> Pretty
prettyGetCausalHashByPathError = \case
  Share.GetCausalHashByPathErrorNoReadPermission Path
sharePath -> Path -> Pretty
noReadPermissionForPath Path
sharePath
  Share.GetCausalHashByPathErrorInvalidRepoInfo Text
err RepoInfo
repoInfo -> Text -> RepoInfo -> Pretty
invalidRepoInfo Text
err RepoInfo
repoInfo
  Share.GetCausalHashByPathErrorUserNotFound RepoInfo
repoInfo -> RepoInfo -> Pretty
shareUserNotFound RepoInfo
repoInfo

prettyPullError :: Share.PullError -> Pretty
prettyPullError :: PullError -> Pretty
prettyPullError = \case
  Share.PullError'DownloadEntities DownloadEntitiesError
err -> DownloadEntitiesError -> Pretty
prettyDownloadEntitiesError DownloadEntitiesError
err
  Share.PullError'GetCausalHash GetCausalHashByPathError
err -> GetCausalHashByPathError -> Pretty
prettyGetCausalHashByPathError GetCausalHashByPathError
err
  Share.PullError'NoHistoryAtPath Path
sharePath ->
    Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
"The server didn't find anything at" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Path -> Pretty
prettySharePath Path
sharePath

prettyPullV2Error :: SyncV2.PullError -> Pretty
prettyPullV2Error :: PullError -> Pretty
prettyPullV2Error = \case
  SyncV2.PullError'DownloadEntities DownloadEntitiesError
err -> DownloadEntitiesError -> Pretty
prettyDownloadEntitiesErrorV2 DownloadEntitiesError
err
  SyncV2.PullError'Sync SyncError
syncErr -> SyncError -> Pretty
prettySyncErrorV2 SyncError
syncErr

prettySyncErrorV2 :: SyncV2.SyncError -> Pretty
prettySyncErrorV2 :: SyncError -> Pretty
prettySyncErrorV2 = \case
  SyncV2.SyncErrorExpectedResultNotInMain CausalHash
hash ->
    Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"The sync finished, but I'm missing an entity I expected."
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"The missing hash is:"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> CausalHash -> Pretty
forall s. IsString s => CausalHash -> Pretty s
prettyCausalHash CausalHash
hash
  SyncV2.SyncErrorDeserializationFailure DeserialiseFailure
failure ->
    Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"Failed to decode a response from the server."
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"The error was:"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> DeserialiseFailure -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown DeserialiseFailure
failure
  SyncError
SyncV2.SyncErrorMissingInitialChunk ->
    Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"The server didn't send the initial chunk of the response."
  SyncError
SyncV2.SyncErrorMisplacedInitialChunk ->
    Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"The server sent the initial chunk of the response in the wrong place."
  SyncV2.SyncErrorStreamFailure Text
msg ->
    Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"Failed to stream data from the server."
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"The error was:"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
msg
  SyncV2.SyncErrorUnsupportedVersion Version
version ->
    Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty
"The server sent a response with an unsupported version."
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"The version was:"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Version -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown Version
version

prettyUploadEntitiesError :: Share.UploadEntitiesError -> Pretty
prettyUploadEntitiesError :: UploadEntitiesError -> Pretty
prettyUploadEntitiesError = \case
  Share.UploadEntitiesError'EntityValidationFailure EntityValidationError
validationFailureErr -> EntityValidationError -> Pretty
prettyEntityValidationFailure EntityValidationError
validationFailureErr
  Share.UploadEntitiesError'HashMismatchForEntity (Share.HashMismatchForEntity {Hash32
supplied :: Hash32
$sel:supplied:HashMismatchForEntity :: HashMismatchForEntity -> Hash32
supplied, Hash32
computed :: Hash32
$sel:computed:HashMismatchForEntity :: HashMismatchForEntity -> Hash32
computed}) ->
    Hash32 -> Hash32 -> Pretty
hashMismatchFromShare Hash32
supplied Hash32
computed
  Share.UploadEntitiesError'InvalidRepoInfo Text
err RepoInfo
repoInfo -> Text -> RepoInfo -> Pretty
invalidRepoInfo Text
err RepoInfo
repoInfo
  Share.UploadEntitiesError'NeedDependencies NeedDependencies Hash32
dependencies -> NeedDependencies Hash32 -> Pretty
needDependencies NeedDependencies Hash32
dependencies
  Share.UploadEntitiesError'NoWritePermission RepoInfo
repoInfo -> RepoInfo -> Pretty
noWritePermissionForRepo RepoInfo
repoInfo
  Share.UploadEntitiesError'ProjectNotFound Text
project -> Text -> Pretty
shareProjectNotFound Text
project
  Share.UploadEntitiesError'UserNotFound Text
userHandle -> RepoInfo -> Pretty
shareUserNotFound (Text -> RepoInfo
Share.RepoInfo Text
userHandle)

prettyEntityValidationFailure :: Share.EntityValidationError -> Pretty
prettyEntityValidationFailure :: EntityValidationError -> Pretty
prettyEntityValidationFailure = \case
  Share.EntityHashMismatch EntityType
entityType (Share.HashMismatchForEntity {Hash32
$sel:supplied:HashMismatchForEntity :: HashMismatchForEntity -> Hash32
supplied :: Hash32
supplied, Hash32
$sel:computed:HashMismatchForEntity :: HashMismatchForEntity -> Hash32
computed :: Hash32
computed}) ->
    [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
      [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"The hash associated with the given " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> EntityType -> Pretty
prettyEntityType EntityType
entityType Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" entity is incorrect.",
        Pretty
"",
        Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"The associated hash is: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Hash32 -> Pretty
forall s. IsString s => Hash32 -> Pretty s
prettyHash32 Hash32
supplied,
        Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"The computed hash is: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Hash32 -> Pretty
forall s. IsString s => Hash32 -> Pretty s
prettyHash32 Hash32
computed,
        Pretty
"",
        Pretty
"Please create an issue and report this to the Unison team."
      ]
  Share.UnsupportedEntityType Hash32
hash32 EntityType
entityType ->
    [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
      [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"The entity with hash " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Hash32 -> Pretty
forall s. IsString s => Hash32 -> Pretty s
prettyHash32 Hash32
hash32 Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" of type " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> EntityType -> Pretty
prettyEntityType EntityType
entityType Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" is not supported by your version of ucm.",
        Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Try upgrading to the latest version of ucm."
      ]
  Share.InvalidByteEncoding Hash32
hash32 EntityType
entityType Text
msg ->
    [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
      [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Failed to decode a " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> EntityType -> Pretty
prettyEntityType EntityType
entityType Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" entity with the hash " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Hash32 -> Pretty
forall s. IsString s => Hash32 -> Pretty s
prettyHash32 Hash32
hash32 Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".",
        Pretty
"Please create an issue and report this to the Unison team",
        Pretty
"",
        Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"The error was: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
msg
      ]
  Share.HashResolutionFailure Hash32
hash32 ->
    -- See https://github.com/unisonweb/unison/pull/4381#discussion_r1452652087 for discussion.
    [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
      [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Failed to resolve a referenced hash when validating the hash for " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Hash32 -> Pretty
forall s. IsString s => Hash32 -> Pretty s
prettyHash32 Hash32
hash32 Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".",
        Pretty
"Please create an issue and report this to the Unison team"
      ]
  where
    prettyEntityType :: EntityType -> Pretty
prettyEntityType = \case
      EntityType
Share.TermComponentType -> Pretty
"term component"
      EntityType
Share.DeclComponentType -> Pretty
"type component"
      EntityType
Share.PatchType -> Pretty
"patch"
      EntityType
Share.PatchDiffType -> Pretty
"patch diff"
      EntityType
Share.NamespaceType -> Pretty
"namespace"
      EntityType
Share.NamespaceDiffType -> Pretty
"namespace diff"
      EntityType
Share.CausalType -> Pretty
"causal"

prettyTransportError :: Share.CodeserverTransportError -> Pretty
prettyTransportError :: CodeserverTransportError -> Pretty
prettyTransportError = \case
  Share.DecodeFailure Text
msg Response
resp ->
    ([Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty)
-> ([Maybe Pretty] -> [Pretty]) -> [Maybe Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Pretty] -> [Pretty]
forall a. [Maybe a] -> [a]
catMaybes)
      [ Pretty -> Maybe Pretty
forall a. a -> Maybe a
Just (Pretty
"The server sent a response that we couldn't decode: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
msg),
        Response -> Maybe Text
responseRequestId Response
resp Maybe Text -> (Text -> Pretty) -> Maybe Pretty
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
responseId -> Pretty
forall s. IsString s => Pretty s
P.newline Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"Request ID: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.blue (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
responseId)
      ]
  Share.Unauthenticated BaseUrl
codeServerURL ->
    Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
      [ Pretty
"Authentication with this code server (" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> String -> Pretty
forall s. IsString s => String -> Pretty s
P.string (BaseUrl -> String
Servant.showBaseUrl BaseUrl
codeServerURL) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
") is missing or expired.",
        Pretty
"Please run " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
makeExample' InputPattern
IP.authLogin Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."
      ]
  Share.PermissionDenied Text
msg -> Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.hang Pretty
"Permission denied:" (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
msg)
  Share.UnreachableCodeserver BaseUrl
codeServerURL ->
    [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
      [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Unable to reach the code server hosted at:" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> String -> Pretty
forall s. IsString s => String -> Pretty s
P.string (BaseUrl -> String
Servant.showBaseUrl BaseUrl
codeServerURL),
        Pretty
"",
        Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Please check your network, ensure you've provided the correct location, or try again later."
      ]
  CodeserverTransportError
Share.RateLimitExceeded -> Pretty
"Rate limit exceeded, please try again later."
  CodeserverTransportError
Share.Timeout -> Pretty
"The code server timed-out when responding to your request. Please try again later or report an issue if the problem persists."
  Share.UnexpectedResponse Response
resp ->
    Response -> Pretty
unexpectedServerResponse Response
resp
  Share.StreamingError Text
err ->
    [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
      [ (Pretty
"We encountered an error while streaming data from the code server: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
err),
        Pretty -> Pretty
P.red (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
err)
      ]

unexpectedServerResponse :: Servant.ResponseF LazyByteString.ByteString -> Pretty
unexpectedServerResponse :: Response -> Pretty
unexpectedServerResponse Response
resp =
  ([Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty)
-> ([Maybe Pretty] -> [Pretty]) -> [Maybe Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Pretty] -> [Pretty]
forall a. [Maybe a] -> [a]
catMaybes)
    [ Pretty -> Maybe Pretty
forall a. a -> Maybe a
Just
        ( Pretty
"I received an unexpected status code from the server: "
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.red (Int -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown (Status -> Int
Http.statusCode (Response -> Status
forall a. ResponseF a -> Status
Servant.responseStatusCode Response
resp)))
        ),
      let body :: Text
body = ByteString -> Text
Text.decodeUtf8 (ByteString -> ByteString
LazyByteString.toStrict (Response -> ByteString
forall a. ResponseF a -> a
Servant.responseBody Response
resp))
       in if Text -> Bool
Text.null Text
body then Maybe Pretty
forall a. Maybe a
Nothing else Pretty -> Maybe Pretty
forall a. a -> Maybe a
Just (Pretty
forall s. IsString s => Pretty s
P.newline Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"Response body: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
body),
      Response -> Maybe Text
responseRequestId Response
resp Maybe Text -> (Text -> Pretty) -> Maybe Pretty
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
responseId -> Pretty
forall s. IsString s => Pretty s
P.newline Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"Request ID: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.blue (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
responseId)
    ]

-- | Dig the request id out of a response header.
responseRequestId :: Servant.Response -> Maybe Text
responseRequestId :: Response -> Maybe Text
responseRequestId =
  (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
Text.decodeUtf8 (Maybe ByteString -> Maybe Text)
-> (Response -> Maybe ByteString) -> Response -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup HeaderName
"X-RequestId" ([(HeaderName, ByteString)] -> Maybe ByteString)
-> (Response -> [(HeaderName, ByteString)])
-> Response
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList @Seq (Seq (HeaderName, ByteString) -> [(HeaderName, ByteString)])
-> (Response -> Seq (HeaderName, ByteString))
-> Response
-> [(HeaderName, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> Seq (HeaderName, ByteString)
forall a. ResponseF a -> Seq (HeaderName, ByteString)
Servant.responseHeaders

prettyEntityType :: Share.EntityType -> Pretty
prettyEntityType :: EntityType -> Pretty
prettyEntityType = \case
  EntityType
Share.TermComponentType -> Pretty
"term component"
  EntityType
Share.DeclComponentType -> Pretty
"type component"
  EntityType
Share.PatchType -> Pretty
"patch"
  EntityType
Share.PatchDiffType -> Pretty
"patch diff"
  EntityType
Share.NamespaceType -> Pretty
"namespace"
  EntityType
Share.NamespaceDiffType -> Pretty
"namespace diff"
  EntityType
Share.CausalType -> Pretty
"causal"

invalidRepoInfo :: Text -> Share.RepoInfo -> Pretty
invalidRepoInfo :: Text -> RepoInfo -> Pretty
invalidRepoInfo Text
err RepoInfo
repoInfo =
  [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
    [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
"The server doesn't recognize the codebase path UCM provided. This is probably a bug in UCM.",
      Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
"",
      Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
"The invalid path is:\n"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (RepoInfo -> Text
Share.unRepoInfo RepoInfo
repoInfo)),
      Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
err
    ]

hashMismatchFromShare :: Hash32 -> Hash32 -> Pretty
hashMismatchFromShare :: Hash32 -> Hash32 -> Pretty
hashMismatchFromShare Hash32
supplied Hash32
computed =
  [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
    [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Uh oh, Share double-checked the hash of something you're uploading and it didn't match.",
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Don't worry, you didn't do anything wrong, this is a bug in UCM, please report it and we'll do our best to sort it out 🤞",
      Pretty
reportBugURL,
      Pretty
"",
      Pretty
"Please include the following information in your report:",
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"The hash provided by your UCM is: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Hash32 -> Pretty
forall s. IsString s => Hash32 -> Pretty s
prettyHash32 Hash32
supplied,
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"The hash computed by Share is: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Hash32 -> Pretty
forall s. IsString s => Hash32 -> Pretty s
prettyHash32 Hash32
computed
    ]

pushPublicNote :: InputPattern -> Text -> [Text] -> Pretty
pushPublicNote :: InputPattern -> Text -> [Text] -> Pretty
pushPublicNote InputPattern
cmd Text
uname [Text]
ys =
  let msg :: Pretty
msg =
        [Pretty] -> Pretty
forall a. Monoid a => [a] -> a
mconcat
          [ Pretty
"Unison Share currently only supports sharing public code. ",
            Pretty
"This is done by hosting code in a public namespace under your handle.",
            Pretty
"It looks like you were trying to push directly to the" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. IsString s => Pretty s -> Pretty s
P.backticked (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
uname),
            Pretty
"handle. Try nesting under `public` like so: "
          ]
      pushCommand :: Pretty
pushCommand = InputPattern -> [Pretty] -> Pretty
IP.makeExampleNoBackticks InputPattern
cmd [Path -> Pretty
prettySharePath Path
exPath]
      exPath :: Path
exPath = NonEmpty Text -> Path
Share.Path (Text
uname Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
NEList.:| Text
"public" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ys)
   in [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
msg,
          Pretty
"",
          Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
4 Pretty
pushCommand
        ]

needDependencies :: Share.NeedDependencies Hash32 -> Pretty
needDependencies :: NeedDependencies Hash32 -> Pretty
needDependencies (Share.NeedDependencies NESet Hash32
hashes) =
  -- maybe todo: stuff in all the args to CheckAndSetPush
  [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
    [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
        ( Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
"The server was expecting to have received some stuff from UCM during that last command, but claims to have not received it."
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
"(This is probably a bug in UCM.)"
        ),
      Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
"",
      Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
"The hashes it expected are:\n"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 ([Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ((Hash32 -> Pretty) -> [Hash32] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map Hash32 -> Pretty
forall s. IsString s => Hash32 -> Pretty s
prettyHash32 (NESet Hash32 -> [Hash32]
forall a. NESet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NESet Hash32
hashes)))
    ]

noReadPermissionForPath :: Share.Path -> Pretty
noReadPermissionForPath :: Path -> Pretty
noReadPermissionForPath Path
sharePath =
  Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
"The server said you don't have permission to read" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Path -> Pretty
prettySharePath Path
sharePath Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")

noReadPermissionForRepo :: Share.RepoInfo -> Pretty
noReadPermissionForRepo :: RepoInfo -> Pretty
noReadPermissionForRepo RepoInfo
repoInfo =
  Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
"The server said you don't have permission to read" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (RepoInfo -> Pretty
prettyRepoInfo RepoInfo
repoInfo Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")

noWritePermissionForPath :: Share.Path -> Pretty
noWritePermissionForPath :: Path -> Pretty
noWritePermissionForPath Path
sharePath =
  case Path -> NonEmpty Text
Share.pathSegments Path
sharePath of
    Text
_ NEList.:| Text
"public" : [Text]
_ -> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
"The server said you don't have permission to write" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Path -> Pretty
prettySharePath Path
sharePath Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
    Text
uname NEList.:| [Text]
ys -> InputPattern -> Text -> [Text] -> Pretty
pushPublicNote InputPattern
IP.pushCreate Text
uname [Text]
ys

noWritePermissionForRepo :: Share.RepoInfo -> Pretty
noWritePermissionForRepo :: RepoInfo -> Pretty
noWritePermissionForRepo RepoInfo
repoInfo =
  Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
"The server said you don't have permission to write" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (RepoInfo -> Pretty
prettyRepoInfo RepoInfo
repoInfo Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")

notFastForward :: Share.Path -> Pretty
notFastForward :: Path -> Pretty
notFastForward Path
path =
  [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
    [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
"There are some changes at" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Path -> Pretty
prettySharePath Path
path Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"that aren't in the history you pushed.",
      Pretty
"",
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
"If you're sure you got the right paths, try"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
pull
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to merge these changes locally, then"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
push
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"again."
    ]
  where
    push :: Pretty
push = Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty -> Pretty)
-> (InputPattern -> Pretty) -> InputPattern -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. IsString s => Pretty s -> Pretty s
P.backticked (Pretty -> Pretty)
-> (InputPattern -> Pretty) -> InputPattern -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputPattern -> Pretty
IP.patternName (InputPattern -> Pretty) -> InputPattern -> Pretty
forall a b. (a -> b) -> a -> b
$ InputPattern
IP.push
    pull :: Pretty
pull = Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty -> Pretty)
-> (InputPattern -> Pretty) -> InputPattern -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. IsString s => Pretty s -> Pretty s
P.backticked (Pretty -> Pretty)
-> (InputPattern -> Pretty) -> InputPattern -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputPattern -> Pretty
IP.patternName (InputPattern -> Pretty) -> InputPattern -> Pretty
forall a b. (a -> b) -> a -> b
$ InputPattern
IP.pull

shareProjectNotFound :: Text -> Pretty
shareProjectNotFound :: Text -> Pretty
shareProjectNotFound Text
projectShortHand =
  [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
    [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
"This project does not exist: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
projectShortHand
    ]

shareUserNotFound :: Share.RepoInfo -> Pretty
shareUserNotFound :: RepoInfo -> Pretty
shareUserNotFound RepoInfo
repoInfo =
  Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty
"User" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> RepoInfo -> Pretty
prettyRepoInfo RepoInfo
repoInfo Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"does not exist.")

formatMissingStuff ::
  (Show tm, Show typ) =>
  [(HQ.HashQualified Name, tm)] ->
  [(HQ.HashQualified Name, typ)] ->
  Pretty
formatMissingStuff :: forall tm typ.
(Show tm, Show typ) =>
[(HashQualified Name, tm)] -> [(HashQualified Name, typ)] -> Pretty
formatMissingStuff [(HashQualified Name, tm)]
terms [(HashQualified Name, typ)]
types =
  ( Bool -> Pretty -> Pretty
forall a. Monoid a => Bool -> a -> a
Monoid.unlessM ([(HashQualified Name, tm)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HashQualified Name, tm)]
terms) (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.fatalCallout (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"The following terms have a missing or corrupted type signature:"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"\n\n"
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> [(Pretty, Pretty)] -> Pretty
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2 [(Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> Pretty (SyntaxText' TypeReference) -> Pretty
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified HashQualified Name
name, String -> Pretty
forall a. IsString a => String -> a
fromString (tm -> String
forall a. Show a => a -> String
show tm
ref)) | (HashQualified Name
name, tm
ref) <- [(HashQualified Name, tm)]
terms]
  )
    Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> ( Bool -> Pretty -> Pretty
forall a. Monoid a => Bool -> a -> a
Monoid.unlessM ([(HashQualified Name, typ)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HashQualified Name, typ)]
types) (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.fatalCallout (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
           Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"The following types weren't found in the codebase:"
             Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"\n\n"
             Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> [(Pretty, Pretty)] -> Pretty
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2 [(Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> Pretty (SyntaxText' TypeReference) -> Pretty
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified HashQualified Name
name, String -> Pretty
forall a. IsString a => String -> a
fromString (typ -> String
forall a. Show a => a -> String
show typ
ref)) | (HashQualified Name
name, typ
ref) <- [(HashQualified Name, typ)]
types]
       )

displayOutputRewrittenFile :: (Var v) => FilePath -> [v] -> IO Pretty
displayOutputRewrittenFile :: forall v. Var v => String -> [v] -> IO Pretty
displayOutputRewrittenFile String
_fp [] =
  Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
"😶️ I couldn't find any matches in the file."
displayOutputRewrittenFile String
fp [v]
vs = do
  let modifiedDefs :: Pretty
modifiedDefs = Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty
" " (Pretty -> Pretty
P.blue (Pretty -> Pretty) -> (v -> Pretty) -> v -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Pretty
forall v. Var v => v -> Pretty
prettyVar (v -> Pretty) -> [v] -> [Pretty]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
vs)
  Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$
    Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"☝️" (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
      [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"I found and replaced matches in these definitions: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
modifiedDefs,
        Pretty
"",
        Pretty
"The rewritten file has been added to the top of " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> String -> Pretty
forall a. IsString a => String -> a
fromString String
fp
      ]

displayDefinitions' ::
  (Var v) =>
  (Ord a1) =>
  PPED.PrettyPrintEnvDecl ->
  Map Reference.Reference (DisplayObject () (DD.Decl v a1)) ->
  Map Reference.Reference (DisplayObject (Type v a1) (Term v a1)) ->
  Pretty
displayDefinitions' :: forall v a1.
(Var v, Ord a1) =>
PrettyPrintEnvDecl
-> Map TypeReference (DisplayObject () (Decl v a1))
-> Map TypeReference (DisplayObject (Type v a1) (Term v a1))
-> Pretty
displayDefinitions' PrettyPrintEnvDecl
ppe0 Map TypeReference (DisplayObject () (Decl v a1))
types Map TypeReference (DisplayObject (Type v a1) (Term v a1))
terms = Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> Pretty (SyntaxText' TypeReference) -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty (SyntaxText' TypeReference)
-> [Pretty (SyntaxText' TypeReference)]
-> Pretty (SyntaxText' TypeReference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty (SyntaxText' TypeReference)
"\n\n" ([Pretty (SyntaxText' TypeReference)]
prettyTypes [Pretty (SyntaxText' TypeReference)]
-> [Pretty (SyntaxText' TypeReference)]
-> [Pretty (SyntaxText' TypeReference)]
forall a. Semigroup a => a -> a -> a
<> [Pretty (SyntaxText' TypeReference)]
prettyTerms)
  where
    ppeBody :: TypeReference -> PrettyPrintEnv
ppeBody TypeReference
r = PrettyPrintEnvDecl -> TypeReference -> PrettyPrintEnv
PPE.declarationPPE PrettyPrintEnvDecl
ppe0 TypeReference
r
    ppeDecl :: PrettyPrintEnv
ppeDecl = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
ppe0
    prettyTerms :: [Pretty (SyntaxText' TypeReference)]
prettyTerms =
      (((HashQualified Name, TypeReference),
  DisplayObject (Type v a1) (Term v a1))
 -> Pretty (SyntaxText' TypeReference))
-> [((HashQualified Name, TypeReference),
     DisplayObject (Type v a1) (Term v a1))]
-> [Pretty (SyntaxText' TypeReference)]
forall a b. (a -> b) -> [a] -> [b]
map ((HashQualified Name, TypeReference),
 DisplayObject (Type v a1) (Term v a1))
-> Pretty (SyntaxText' TypeReference)
go ([((HashQualified Name, TypeReference),
   DisplayObject (Type v a1) (Term v a1))]
 -> [Pretty (SyntaxText' TypeReference)])
-> (Map
      (HashQualified Name, TypeReference)
      (DisplayObject (Type v a1) (Term v a1))
    -> [((HashQualified Name, TypeReference),
         DisplayObject (Type v a1) (Term v a1))])
-> Map
     (HashQualified Name, TypeReference)
     (DisplayObject (Type v a1) (Term v a1))
-> [Pretty (SyntaxText' TypeReference)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map
  (HashQualified Name, TypeReference)
  (DisplayObject (Type v a1) (Term v a1))
-> [((HashQualified Name, TypeReference),
     DisplayObject (Type v a1) (Term v a1))]
forall k a. Map k a -> [(k, a)]
Map.toList
      -- sort by name
      (Map
   (HashQualified Name, TypeReference)
   (DisplayObject (Type v a1) (Term v a1))
 -> [Pretty (SyntaxText' TypeReference)])
-> Map
     (HashQualified Name, TypeReference)
     (DisplayObject (Type v a1) (Term v a1))
-> [Pretty (SyntaxText' TypeReference)]
forall a b. (a -> b) -> a -> b
$
        (TypeReference -> (HashQualified Name, TypeReference))
-> Map TypeReference (DisplayObject (Type v a1) (Term v a1))
-> Map
     (HashQualified Name, TypeReference)
     (DisplayObject (Type v a1) (Term v a1))
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys ((TypeReference -> HashQualified Name)
-> (TypeReference, TypeReference)
-> (HashQualified Name, TypeReference)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName PrettyPrintEnv
ppeDecl (Referent -> HashQualified Name)
-> (TypeReference -> Referent)
-> TypeReference
-> HashQualified Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> Referent
Referent.Ref) ((TypeReference, TypeReference)
 -> (HashQualified Name, TypeReference))
-> (TypeReference -> (TypeReference, TypeReference))
-> TypeReference
-> (HashQualified Name, TypeReference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> (TypeReference, TypeReference)
forall a. a -> (a, a)
dupe) Map TypeReference (DisplayObject (Type v a1) (Term v a1))
terms
    prettyTypes :: [Pretty (SyntaxText' TypeReference)]
prettyTypes =
      (((HashQualified Name, TypeReference),
  DisplayObject () (Decl v a1))
 -> Pretty (SyntaxText' TypeReference))
-> [((HashQualified Name, TypeReference),
     DisplayObject () (Decl v a1))]
-> [Pretty (SyntaxText' TypeReference)]
forall a b. (a -> b) -> [a] -> [b]
map ((HashQualified Name, TypeReference), DisplayObject () (Decl v a1))
-> Pretty (SyntaxText' TypeReference)
go2 ([((HashQualified Name, TypeReference),
   DisplayObject () (Decl v a1))]
 -> [Pretty (SyntaxText' TypeReference)])
-> (Map
      (HashQualified Name, TypeReference) (DisplayObject () (Decl v a1))
    -> [((HashQualified Name, TypeReference),
         DisplayObject () (Decl v a1))])
-> Map
     (HashQualified Name, TypeReference) (DisplayObject () (Decl v a1))
-> [Pretty (SyntaxText' TypeReference)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map
  (HashQualified Name, TypeReference) (DisplayObject () (Decl v a1))
-> [((HashQualified Name, TypeReference),
     DisplayObject () (Decl v a1))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map
   (HashQualified Name, TypeReference) (DisplayObject () (Decl v a1))
 -> [Pretty (SyntaxText' TypeReference)])
-> Map
     (HashQualified Name, TypeReference) (DisplayObject () (Decl v a1))
-> [Pretty (SyntaxText' TypeReference)]
forall a b. (a -> b) -> a -> b
$
        (TypeReference -> (HashQualified Name, TypeReference))
-> Map TypeReference (DisplayObject () (Decl v a1))
-> Map
     (HashQualified Name, TypeReference) (DisplayObject () (Decl v a1))
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys ((TypeReference -> HashQualified Name)
-> (TypeReference, TypeReference)
-> (HashQualified Name, TypeReference)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (PrettyPrintEnv -> TypeReference -> HashQualified Name
PPE.typeName PrettyPrintEnv
ppeDecl) ((TypeReference, TypeReference)
 -> (HashQualified Name, TypeReference))
-> (TypeReference -> (TypeReference, TypeReference))
-> TypeReference
-> (HashQualified Name, TypeReference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> (TypeReference, TypeReference)
forall a. a -> (a, a)
dupe) Map TypeReference (DisplayObject () (Decl v a1))
types
    go :: ((HashQualified Name, TypeReference),
 DisplayObject (Type v a1) (Term v a1))
-> Pretty (SyntaxText' TypeReference)
go ((HashQualified Name
n, TypeReference
r), DisplayObject (Type v a1) (Term v a1)
dt) =
      case DisplayObject (Type v a1) (Term v a1)
dt of
        MissingObject ShortHash
r -> HashQualified Name
-> ShortHash -> Pretty (SyntaxText' TypeReference)
forall {a}.
Show a =>
HashQualified Name -> a -> Pretty (SyntaxText' TypeReference)
missing HashQualified Name
n ShortHash
r
        BuiltinObject Type v a1
typ ->
          Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.hang
            (Pretty (SyntaxText' TypeReference)
"builtin " Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified HashQualified Name
n Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' TypeReference)
" :")
            (PrettyPrintEnv -> Type v a1 -> Pretty (SyntaxText' TypeReference)
forall v a.
Var v =>
PrettyPrintEnv -> Type v a -> Pretty (SyntaxText' TypeReference)
TypePrinter.prettySyntax (TypeReference -> PrettyPrintEnv
ppeBody TypeReference
r) Type v a1
typ)
        UserObject Term v a1
tm -> PrettyPrintEnv
-> HashQualified Name
-> Term v a1
-> Pretty (SyntaxText' TypeReference)
forall v at ap a.
Var v =>
PrettyPrintEnv
-> HashQualified Name
-> Term2 v at ap v a
-> Pretty (SyntaxText' TypeReference)
TermPrinter.prettyBinding (TypeReference -> PrettyPrintEnv
ppeBody TypeReference
r) HashQualified Name
n Term v a1
tm
    go2 :: ((HashQualified Name, TypeReference), DisplayObject () (Decl v a1))
-> Pretty (SyntaxText' TypeReference)
go2 ((HashQualified Name
n, TypeReference
r), DisplayObject () (Decl v a1)
dt) =
      case DisplayObject () (Decl v a1)
dt of
        MissingObject ShortHash
r -> HashQualified Name
-> ShortHash -> Pretty (SyntaxText' TypeReference)
forall {a}.
Show a =>
HashQualified Name -> a -> Pretty (SyntaxText' TypeReference)
missing HashQualified Name
n ShortHash
r
        BuiltinObject ()
_ -> HashQualified Name -> Pretty (SyntaxText' TypeReference)
builtin HashQualified Name
n
        UserObject Decl v a1
decl -> PrettyPrintEnvDecl
-> RenderUniqueTypeGuids
-> TypeReference
-> HashQualified Name
-> Decl v a1
-> Pretty (SyntaxText' TypeReference)
forall v a.
Var v =>
PrettyPrintEnvDecl
-> RenderUniqueTypeGuids
-> TypeReference
-> HashQualified Name
-> Decl v a
-> Pretty (SyntaxText' TypeReference)
DeclPrinter.prettyDecl PrettyPrintEnvDecl
ppe0 RenderUniqueTypeGuids
DeclPrinter.RenderUniqueTypeGuids'No TypeReference
r HashQualified Name
n Decl v a1
decl
    builtin :: HashQualified Name -> Pretty (SyntaxText' TypeReference)
builtin HashQualified Name
n = Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty (SyntaxText' TypeReference)
 -> Pretty (SyntaxText' TypeReference))
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall a b. (a -> b) -> a -> b
$ Pretty (SyntaxText' TypeReference)
"--" Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified HashQualified Name
n Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' TypeReference)
" is built-in."
    missing :: HashQualified Name -> a -> Pretty (SyntaxText' TypeReference)
missing HashQualified Name
n a
r =
      Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
        ( Pretty (SyntaxText' TypeReference)
"-- The name "
            Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified HashQualified Name
n
            Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' TypeReference)
" is assigned to the "
            Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' TypeReference)
"reference "
            Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall a. Semigroup a => a -> a -> a
<> String -> Pretty (SyntaxText' TypeReference)
forall a. IsString a => String -> a
fromString (a -> String
forall a. Show a => a -> String
show a
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
",")
            Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' TypeReference)
"which is missing from the codebase."
        )
        Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' TypeReference)
forall s. IsString s => Pretty s
P.newline
        Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' TypeReference)
-> Pretty (SyntaxText' TypeReference)
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip Pretty (SyntaxText' TypeReference)
"You might need to repair the codebase manually."

displayRendered :: Maybe FilePath -> Pretty -> IO Pretty
displayRendered :: Maybe String -> Pretty -> IO Pretty
displayRendered Maybe String
outputLoc Pretty
pp =
  Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> (String -> Pretty) -> Maybe String -> Pretty
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Pretty
pp String -> Pretty
scratchMessage Maybe String
outputLoc
  where
    scratchMessage :: String -> Pretty
scratchMessage String
path =
      Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"☝️" (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
          [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"I added this to the top of " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> String -> Pretty
forall a. IsString a => String -> a
fromString String
path,
            Pretty
"",
            Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 Pretty
pp
          ]

displayTestResults ::
  Bool -> -- whether to show the tip
  [(HQ.HashQualified Name, [Text])] ->
  [(HQ.HashQualified Name, [Text])] ->
  Pretty
displayTestResults :: Bool
-> [(HashQualified Name, [Text])]
-> [(HashQualified Name, [Text])]
-> Pretty
displayTestResults Bool
showTip [(HashQualified Name, [Text])]
oks [(HashQualified Name, [Text])]
fails =
  let name :: HashQualified Name -> Pretty
name = Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty)
-> (HashQualified Name -> Text) -> HashQualified Name -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Text
HQ.toText
      okMsg :: Pretty
okMsg =
        if [(HashQualified Name, [Text])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HashQualified Name, [Text])]
oks
          then Pretty
forall a. Monoid a => a
mempty
          else
            Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
              Int -> [(Pretty, Pretty)] -> Pretty
forall (f :: * -> *).
Foldable f =>
Int -> f (Pretty, Pretty) -> Pretty
P.numberedColumn2ListFrom Int
0 [(HashQualified Name -> Pretty
name HashQualified Name
r, [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty
P.green (Pretty -> Pretty) -> (Text -> Pretty) -> Text -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty
"  ◉ " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<>) (Pretty -> Pretty) -> (Text -> Pretty) -> Text -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty) -> [Text] -> [Pretty]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
msgs) | (HashQualified Name
r, [Text]
msgs) <- [(HashQualified Name, [Text])]
oks]
      okSummary :: Pretty
okSummary =
        if [(HashQualified Name, [Text])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HashQualified Name, [Text])]
oks
          then Pretty
forall a. Monoid a => a
mempty
          else Pretty
"✅ " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.bold (Int -> Pretty
forall n s. (Show n, Num n, IsString s) => n -> Pretty s
P.num ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((HashQualified Name, [Text]) -> Int)
-> [(HashQualified Name, [Text])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Int)
-> ((HashQualified Name, [Text]) -> [Text])
-> (HashQualified Name, [Text])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashQualified Name, [Text]) -> [Text]
forall a b. (a, b) -> b
snd) [(HashQualified Name, [Text])]
oks)) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.green Pretty
" test(s) passing"
      failMsg :: Pretty
failMsg =
        if [(HashQualified Name, [Text])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HashQualified Name, [Text])]
fails
          then Pretty
forall a. Monoid a => a
mempty
          else
            Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
              Int -> [(Pretty, Pretty)] -> Pretty
forall (f :: * -> *).
Foldable f =>
Int -> f (Pretty, Pretty) -> Pretty
P.numberedColumn2ListFrom
                ([(HashQualified Name, [Text])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(HashQualified Name, [Text])]
oks)
                [(HashQualified Name -> Pretty
name HashQualified Name
r, [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty
P.red (Pretty -> Pretty) -> (Text -> Pretty) -> Text -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty
"  ✗ " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<>) (Pretty -> Pretty) -> (Text -> Pretty) -> Text -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty) -> [Text] -> [Pretty]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
msgs) | (HashQualified Name
r, [Text]
msgs) <- [(HashQualified Name, [Text])]
fails]
      failSummary :: Pretty
failSummary =
        if [(HashQualified Name, [Text])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HashQualified Name, [Text])]
fails
          then Pretty
forall a. Monoid a => a
mempty
          else Pretty
"🚫 " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.bold (Int -> Pretty
forall n s. (Show n, Num n, IsString s) => n -> Pretty s
P.num ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((HashQualified Name, [Text]) -> Int)
-> [(HashQualified Name, [Text])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Int)
-> ((HashQualified Name, [Text]) -> [Text])
-> (HashQualified Name, [Text])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashQualified Name, [Text]) -> [Text]
forall a b. (a, b) -> b
snd) [(HashQualified Name, [Text])]
fails)) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.red Pretty
" test(s) failing"
      tipMsg :: Pretty
tipMsg =
        if Bool -> Bool
not Bool
showTip Bool -> Bool -> Bool
|| ([(HashQualified Name, [Text])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HashQualified Name, [Text])]
oks Bool -> Bool -> Bool
&& [(HashQualified Name, [Text])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HashQualified Name, [Text])]
fails)
          then Pretty
forall a. Monoid a => a
mempty
          else Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Use " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.blue Pretty
"view 1" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to view the source of a test."
   in if [(HashQualified Name, [Text])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HashQualified Name, [Text])]
oks Bool -> Bool -> Bool
&& [(HashQualified Name, [Text])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HashQualified Name, [Text])]
fails
        then Pretty
"😶 No tests available."
        else
          Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty
"\n\n" ([Pretty] -> Pretty)
-> ([Pretty] -> [Pretty]) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> [Pretty]
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> [Pretty s]
P.nonEmpty ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
            [ Pretty
okMsg,
              Pretty
failMsg,
              Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty
", " ([Pretty] -> Pretty)
-> ([Pretty] -> [Pretty]) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> [Pretty]
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> [Pretty s]
P.nonEmpty ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$ [Pretty
failSummary, Pretty
okSummary],
              Pretty
tipMsg
            ]

unsafePrettyTermResultSig' ::
  (Var v) =>
  PPE.PrettyPrintEnv ->
  SR'.TermResult' v a ->
  Pretty
unsafePrettyTermResultSig' :: forall v a. Var v => PrettyPrintEnv -> TermResult' v a -> Pretty
unsafePrettyTermResultSig' PrettyPrintEnv
ppe = \case
  SR'.TermResult' HashQualified Name
name (Just Type v a
typ) Referent
r Set (HashQualified Name)
_aliases ->
    [Pretty] -> Pretty
forall a. HasCallStack => [a] -> a
head (PrettyPrintEnv
-> [(Referent, HashQualified Name, Type v a)] -> [Pretty]
forall v a.
Var v =>
PrettyPrintEnv
-> [(Referent, HashQualified Name, Type v a)] -> [Pretty]
TypePrinter.prettySignaturesCT PrettyPrintEnv
ppe [(Referent
r, HashQualified Name
name, Type v a
typ)])
  TermResult' v a
_ -> String -> Pretty
forall a. HasCallStack => String -> a
error String
"Don't pass Nothing"

renderNameConflicts :: Int -> Names -> Numbered Pretty
renderNameConflicts :: Int -> Names -> Numbered Pretty
renderNameConflicts Int
hashLen Names
conflictedNames = do
  let conflictedTypeNames :: Map Name [HQ.HashQualified Name]
      conflictedTypeNames :: Map Name [HashQualified Name]
conflictedTypeNames =
        Names
conflictedNames
          Names
-> (Names -> Relation Name TypeReference)
-> Relation Name TypeReference
forall a b. a -> (a -> b) -> b
& Names -> Relation Name TypeReference
Names.types
          Relation Name TypeReference
-> (Relation Name TypeReference -> Map Name (Set TypeReference))
-> Map Name (Set TypeReference)
forall a b. a -> (a -> b) -> b
& Relation Name TypeReference -> Map Name (Set TypeReference)
forall a b. Relation a b -> Map a (Set b)
R.domain
          Map Name (Set TypeReference)
-> (Map Name (Set TypeReference) -> Map Name [HashQualified Name])
-> Map Name [HashQualified Name]
forall a b. a -> (a -> b) -> b
& (Name -> Set TypeReference -> [HashQualified Name])
-> Map Name (Set TypeReference) -> Map Name [HashQualified Name]
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey \Name
name -> (TypeReference -> HashQualified Name)
-> [TypeReference] -> [HashQualified Name]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> HashQualified Name -> HashQualified Name
forall n. Int -> HashQualified n -> HashQualified n
HQ.take Int
hashLen (HashQualified Name -> HashQualified Name)
-> (TypeReference -> HashQualified Name)
-> TypeReference
-> HashQualified Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> ShortHash -> HashQualified Name
forall n. n -> ShortHash -> HashQualified n
HQ.HashQualified Name
name (ShortHash -> HashQualified Name)
-> (TypeReference -> ShortHash)
-> TypeReference
-> HashQualified Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> ShortHash
Reference.toShortHash) ([TypeReference] -> [HashQualified Name])
-> (Set TypeReference -> [TypeReference])
-> Set TypeReference
-> [HashQualified Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set TypeReference -> [TypeReference]
forall a. Set a -> [a]
Set.toList
  let conflictedTermNames :: Map Name [HQ.HashQualified Name]
      conflictedTermNames :: Map Name [HashQualified Name]
conflictedTermNames =
        Names
conflictedNames
          Names
-> (Names -> Relation Name Referent) -> Relation Name Referent
forall a b. a -> (a -> b) -> b
& Names -> Relation Name Referent
Names.terms
          Relation Name Referent
-> (Relation Name Referent -> Map Name (Set Referent))
-> Map Name (Set Referent)
forall a b. a -> (a -> b) -> b
& Relation Name Referent -> Map Name (Set Referent)
forall a b. Relation a b -> Map a (Set b)
R.domain
          Map Name (Set Referent)
-> (Map Name (Set Referent) -> Map Name [HashQualified Name])
-> Map Name [HashQualified Name]
forall a b. a -> (a -> b) -> b
& (Name -> Set Referent -> [HashQualified Name])
-> Map Name (Set Referent) -> Map Name [HashQualified Name]
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey \Name
name -> (Referent -> HashQualified Name)
-> [Referent] -> [HashQualified Name]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> HashQualified Name -> HashQualified Name
forall n. Int -> HashQualified n -> HashQualified n
HQ.take Int
hashLen (HashQualified Name -> HashQualified Name)
-> (Referent -> HashQualified Name)
-> Referent
-> HashQualified Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> ShortHash -> HashQualified Name
forall n. n -> ShortHash -> HashQualified n
HQ.HashQualified Name
name (ShortHash -> HashQualified Name)
-> (Referent -> ShortHash) -> Referent -> HashQualified Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Referent -> ShortHash
Referent.toShortHash) ([Referent] -> [HashQualified Name])
-> (Set Referent -> [Referent])
-> Set Referent
-> [HashQualified Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Referent -> [Referent]
forall a. Set a -> [a]
Set.toList
  let allConflictedNames :: [Name]
      allConflictedNames :: [Name]
allConflictedNames = Set Name -> [Name]
forall a. Set a -> [a]
Set.toList (Map Name [HashQualified Name] -> Set Name
forall k a. Map k a -> Set k
Map.keysSet Map Name [HashQualified Name]
conflictedTermNames Set Name -> Set Name -> Set Name
forall a. Semigroup a => a -> a -> a
<> Map Name [HashQualified Name] -> Set Name
forall k a. Map k a -> Set k
Map.keysSet Map Name [HashQualified Name]
conflictedTypeNames)
  Pretty
prettyConflictedTypes <- Pretty -> Map Name [HashQualified Name] -> Numbered Pretty
showConflictedNames Pretty
"type" Map Name [HashQualified Name]
conflictedTypeNames
  Pretty
prettyConflictedTerms <- Pretty -> Map Name [HashQualified Name] -> Numbered Pretty
showConflictedNames Pretty
"term" Map Name [HashQualified Name]
conflictedTermNames
  Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty) -> Pretty -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$
    Bool -> Pretty -> Pretty
forall a. Monoid a => Bool -> a -> a
Monoid.unlessM ([Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
allConflictedNames) (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
      Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"❓" (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.linesSpaced ([Pretty] -> Pretty)
-> ([Pretty] -> [Pretty]) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> [Pretty]
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> [Pretty s]
P.nonEmpty ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
        [ Pretty
prettyConflictedTypes,
          Pretty
prettyConflictedTerms,
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
            Pretty
"Use "
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
makeExample'
                ( if (Bool -> Bool
not (Bool -> Bool)
-> (Map Name [HashQualified Name] -> Bool)
-> Map Name [HashQualified Name]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name [HashQualified Name] -> Bool
forall a. Map Name a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) Map Name [HashQualified Name]
conflictedTypeNames
                    then InputPattern
IP.renameType
                    else InputPattern
IP.renameTerm
                )
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" or "
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
makeExample'
                ( if (Bool -> Bool
not (Bool -> Bool)
-> (Map Name [HashQualified Name] -> Bool)
-> Map Name [HashQualified Name]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name [HashQualified Name] -> Bool
forall a. Map Name a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) Map Name [HashQualified Name]
conflictedTypeNames
                    then InputPattern
IP.deleteTypeForce
                    else InputPattern
IP.deleteTermForce
                )
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to resolve the conflicts."
        ]
  where
    showConflictedNames :: Pretty -> Map Name [HQ.HashQualified Name] -> Numbered Pretty
    showConflictedNames :: Pretty -> Map Name [HashQualified Name] -> Numbered Pretty
showConflictedNames Pretty
thingKind Map Name [HashQualified Name]
conflictedNames =
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.linesSpaced ([Pretty] -> Pretty)
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
-> Numbered Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        [(Name, [HashQualified Name])]
-> ((Name, [HashQualified Name]) -> Numbered Pretty)
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Map Name [HashQualified Name] -> [(Name, [HashQualified Name])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Name [HashQualified Name]
conflictedNames) \(Name
name, [HashQualified Name]
hashes) -> do
          [Pretty]
prettyConflicts <- [HashQualified Name]
-> (HashQualified Name -> Numbered Pretty)
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [HashQualified Name]
hashes \HashQualified Name
hash -> do
            Int
n <- StructuredArgument -> Numbered Int
addNumberedArg (StructuredArgument -> Numbered Int)
-> StructuredArgument -> Numbered Int
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> StructuredArgument
SA.HashQualified HashQualified Name
hash
            Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty) -> Pretty -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$ Int -> Pretty
formatNum Int
n Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> (Pretty -> Pretty
P.blue (Pretty -> Pretty)
-> (HashQualified Name -> Pretty) -> HashQualified Name -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> (HashQualified Name -> Pretty (SyntaxText' TypeReference))
-> HashQualified Name
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified (HashQualified Name -> Pretty) -> HashQualified Name -> Pretty
forall a b. (a -> b) -> a -> b
$ HashQualified Name
hash)
          Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty) -> Pretty -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$
            Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
              ( Pretty
"The "
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
thingKind
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" "
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.green (Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
name)
                  Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" has conflicting definitions:"
              )
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 ([Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines [Pretty]
prettyConflicts)

type Numbered = State.State (Int, Seq.Seq StructuredArgument)

addNumberedArg :: StructuredArgument -> Numbered Int
addNumberedArg :: StructuredArgument -> Numbered Int
addNumberedArg StructuredArgument
s = do
  (Int
n, Seq StructuredArgument
args) <- StateT
  (Int, Seq StructuredArgument)
  Identity
  (Int, Seq StructuredArgument)
forall s (m :: * -> *). MonadState s m => m s
State.get
  let !n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  (Int, Seq StructuredArgument)
-> StateT (Int, Seq StructuredArgument) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put (Int
n', Seq StructuredArgument
args Seq StructuredArgument
-> StructuredArgument -> Seq StructuredArgument
forall a. Seq a -> a -> Seq a
Seq.|> StructuredArgument
s)
  Int -> Numbered Int
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
n'

formatNum :: Int -> Pretty
formatNum :: Int -> Pretty
formatNum Int
n = String -> Pretty
forall s. IsString s => String -> Pretty s
P.string (Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
". ")

runNumbered :: Numbered a -> (a, NumberedArgs)
runNumbered :: forall a. Numbered a -> (a, NumberedArgs)
runNumbered Numbered a
m =
  let (a
a, (Int
_, Seq StructuredArgument
args)) = Numbered a
-> (Int, Seq StructuredArgument)
-> (a, (Int, Seq StructuredArgument))
forall s a. State s a -> s -> (a, s)
State.runState Numbered a
m (Int
0, Seq StructuredArgument
forall a. Monoid a => a
mempty)
   in (a
a, Seq StructuredArgument -> NumberedArgs
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq StructuredArgument
args)

handleTodoOutput :: TodoOutput -> Numbered Pretty
handleTodoOutput :: TodoOutput -> Numbered Pretty
handleTodoOutput TodoOutput
todo
  | TodoOutput -> Bool
todoOutputIsEmpty TodoOutput
todo = Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
"You have no pending todo items. Good work! ✅"
  | Bool
otherwise = do
      Pretty
prettyDependentsOfTodo <- do
        if Set TermReferenceId -> Bool
forall a. Set a -> Bool
Set.null TodoOutput
todo.dependentsOfTodo
          then Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty
          else do
            [Pretty]
terms <-
              [TermReferenceId]
-> (TermReferenceId -> Numbered Pretty)
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Set TermReferenceId -> [TermReferenceId]
forall a. Set a -> [a]
Set.toList TodoOutput
todo.dependentsOfTodo) \TermReferenceId
term -> do
                Int
n <- StructuredArgument -> Numbered Int
addNumberedArg (HashQualified Name -> StructuredArgument
SA.HashQualified (ShortHash -> HashQualified Name
forall n. ShortHash -> HashQualified n
HQ.HashOnly (TermReferenceId -> ShortHash
Reference.idToShortHash TermReferenceId
term)))
                let name :: Pretty
name =
                      TermReferenceId
term
                        TermReferenceId -> (TermReferenceId -> Referent) -> Referent
forall a b. a -> (a -> b) -> b
& TermReferenceId -> Referent
Referent.fromTermReferenceId
                        Referent -> (Referent -> HashQualified Name) -> HashQualified Name
forall a b. a -> (a -> b) -> b
& PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName TodoOutput
todo.ppe.suffixifiedPPE
                        HashQualified Name
-> (HashQualified Name -> Pretty (SyntaxText' TypeReference))
-> Pretty (SyntaxText' TypeReference)
forall a b. a -> (a -> b) -> b
& HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified
                        Pretty (SyntaxText' TypeReference)
-> (Pretty (SyntaxText' TypeReference) -> Pretty) -> Pretty
forall a b. a -> (a -> b) -> b
& Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor
                Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Pretty
formatNum Int
n Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
name)
            Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty) -> Pretty -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$
              Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"These terms call `todo`:"
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 ([Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines [Pretty]
terms)

      Pretty
prettyDirectTermDependenciesWithoutNames <- do
        if Set TypeReference -> Bool
forall a. Set a -> Bool
Set.null TodoOutput
todo.directDependenciesWithoutNames.terms
          then Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty
          else do
            [Pretty]
terms <-
              [TypeReference]
-> (TypeReference -> Numbered Pretty)
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Set TypeReference -> [TypeReference]
forall a. Set a -> [a]
Set.toList TodoOutput
todo.directDependenciesWithoutNames.terms) \TypeReference
term -> do
                Int
n <- StructuredArgument -> Numbered Int
addNumberedArg (HashQualified Name -> StructuredArgument
SA.HashQualified (ShortHash -> HashQualified Name
forall n. ShortHash -> HashQualified n
HQ.HashOnly (TypeReference -> ShortHash
Reference.toShortHash TypeReference
term)))
                Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Pretty
formatNum Int
n Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Int -> TypeReference -> Pretty (SyntaxText' TypeReference)
prettyReference TodoOutput
todo.hashLen TypeReference
term))
            Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty) -> Pretty -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$
              Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"These terms do not have any names in the current namespace:"
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 ([Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines [Pretty]
terms)

      Pretty
prettyDirectTypeDependenciesWithoutNames <- do
        if Set TypeReference -> Bool
forall a. Set a -> Bool
Set.null TodoOutput
todo.directDependenciesWithoutNames.types
          then Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty
          else do
            [Pretty]
types <-
              [TypeReference]
-> (TypeReference -> Numbered Pretty)
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Set TypeReference -> [TypeReference]
forall a. Set a -> [a]
Set.toList TodoOutput
todo.directDependenciesWithoutNames.types) \TypeReference
typ -> do
                Int
n <- StructuredArgument -> Numbered Int
addNumberedArg (HashQualified Name -> StructuredArgument
SA.HashQualified (ShortHash -> HashQualified Name
forall n. ShortHash -> HashQualified n
HQ.HashOnly (TypeReference -> ShortHash
Reference.toShortHash TypeReference
typ)))
                Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Pretty
formatNum Int
n Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Int -> TypeReference -> Pretty (SyntaxText' TypeReference)
prettyReference TodoOutput
todo.hashLen TypeReference
typ))
            Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty) -> Pretty -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$
              Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"These types do not have any names in the current namespace:"
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 ([Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines [Pretty]
types)

      Pretty
prettyConflicts <-
        if TodoOutput
todo.nameConflicts Names -> Names -> Bool
forall a. Eq a => a -> a -> Bool
== Names
forall a. Monoid a => a
mempty
          then Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty
          else Int -> Names -> Numbered Pretty
renderNameConflicts TodoOutput
todo.hashLen TodoOutput
todo.nameConflicts

      let prettyDefnsInLib :: Pretty
prettyDefnsInLib =
            if TodoOutput
todo.defnsInLib
              then
                Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
                  -- Note [DefnsInLibMessage] If you change this, also change the other similar one
                  Pretty
"There's a type or term at the top level of the `lib` namespace, where I only expect to find"
                    Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"subnamespaces representing library dependencies. Please move or remove it."
              else Pretty
forall a. Monoid a => a
mempty

      Pretty
prettyConstructorAliases <-
        let -- We want to filter out constructor aliases whose types are part of a "nested decl alias" problem, because
            -- otherwise we'd essentially be reporting those issues twice.
            --
            -- That is, if we have two nested aliases like
            --
            --   Foo = #XYZ
            --   Foo.Bar = #XYZ#0
            --
            --   Foo.inner.Alias = #XYZ
            --   Foo.inner.Alias.Constructor = #XYZ#0
            --
            -- then we'd prefer to say "oh no Foo and Foo.inner.Alias are aliases" but *not* additionally say "oh no
            -- Foo.Bar and Foo.inner.Alias.Constructor are aliases".
            notNestedDeclAlias :: (Name, Name, Name) -> Bool
notNestedDeclAlias (Name
typeName, Name
_, Name
_) =
              ((Name, Name) -> Bool -> Bool) -> Bool -> [(Name, Name)] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                (\(Name
short, Name
long) Bool
acc -> Name
typeName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
short Bool -> Bool -> Bool
&& Name
typeName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
long Bool -> Bool -> Bool
&& Bool
acc)
                Bool
True
                ([(Name, Name)]
-> (IncoherentDeclReasons -> [(Name, Name)])
-> Maybe IncoherentDeclReasons
-> [(Name, Name)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Getting [(Name, Name)] IncoherentDeclReasons [(Name, Name)]
-> IncoherentDeclReasons -> [(Name, Name)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(Name, Name)] IncoherentDeclReasons [(Name, Name)]
#nestedDeclAliases) TodoOutput
todo.incoherentDeclReasons)
         in case ((Name, Name, Name) -> Bool)
-> [(Name, Name, Name)] -> [(Name, Name, Name)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name, Name, Name) -> Bool
notNestedDeclAlias ([(Name, Name, Name)]
-> (IncoherentDeclReasons -> [(Name, Name, Name)])
-> Maybe IncoherentDeclReasons
-> [(Name, Name, Name)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Getting
  [(Name, Name, Name)] IncoherentDeclReasons [(Name, Name, Name)]
-> IncoherentDeclReasons -> [(Name, Name, Name)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  [(Name, Name, Name)] IncoherentDeclReasons [(Name, Name, Name)]
#constructorAliases) TodoOutput
todo.incoherentDeclReasons) of
              [] -> Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty
              [(Name, Name, Name)]
aliases -> do
                [(Name, Pretty, Pretty)]
things <-
                  [(Name, Name, Name)]
-> ((Name, Name, Name)
    -> StateT
         (Int, Seq StructuredArgument) Identity (Name, Pretty, Pretty))
-> StateT
     (Int, Seq StructuredArgument) Identity [(Name, Pretty, Pretty)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Name, Name, Name)]
aliases \(Name
typeName, Name
conName1, Name
conName2) -> do
                    Int
n1 <- StructuredArgument -> Numbered Int
addNumberedArg (Name -> StructuredArgument
SA.Name Name
conName1)
                    Int
n2 <- StructuredArgument -> Numbered Int
addNumberedArg (Name -> StructuredArgument
SA.Name Name
conName2)
                    (Name, Pretty, Pretty)
-> StateT
     (Int, Seq StructuredArgument) Identity (Name, Pretty, Pretty)
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
typeName, Int -> Pretty
formatNum Int
n1 Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
conName1, Int -> Pretty
formatNum Int
n2 Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
conName2)
                Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty) -> Pretty -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$
                  [(Name, Pretty, Pretty)]
things
                    [(Name, Pretty, Pretty)]
-> ([(Name, Pretty, Pretty)] -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& ((Name, Pretty, Pretty) -> Pretty)
-> [(Name, Pretty, Pretty)] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map
                      ( \(Name
typeName, Pretty
prettyCon1, Pretty
prettyCon2) ->
                          -- Note [ConstructorAliasMessage] If you change this, also change the other similar ones
                          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty
"The type" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
typeName Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"has a constructor with multiple names.")
                            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 ([Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines [Pretty
prettyCon1, Pretty
prettyCon2])
                            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"Please delete all but one name for each constructor."
                      )
                    [Pretty] -> ([Pretty] -> Pretty) -> Pretty
forall a b. a -> (a -> b) -> b
& Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty
"\n\n"

      Pretty
prettyMissingConstructorNames <-
        case [Name] -> Maybe (NonEmpty Name)
forall a. [a] -> Maybe (NonEmpty a)
NEList.nonEmpty ([Name]
-> (IncoherentDeclReasons -> [Name])
-> Maybe IncoherentDeclReasons
-> [Name]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Getting [Name] IncoherentDeclReasons [Name]
-> IncoherentDeclReasons -> [Name]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Name] IncoherentDeclReasons [Name]
#missingConstructorNames) TodoOutput
todo.incoherentDeclReasons) of
          Maybe (NonEmpty Name)
Nothing -> Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty
          Just NonEmpty Name
types0 -> do
            NonEmpty (Int, Name)
stuff <-
              NonEmpty Name
-> (Name
    -> StateT (Int, Seq StructuredArgument) Identity (Int, Name))
-> StateT
     (Int, Seq StructuredArgument) Identity (NonEmpty (Int, Name))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for NonEmpty Name
types0 \Name
typ -> do
                Int
n <- StructuredArgument -> Numbered Int
addNumberedArg (Name -> StructuredArgument
SA.Name Name
typ)
                (Int, Name)
-> StateT (Int, Seq StructuredArgument) Identity (Int, Name)
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
n, Name
typ)
            -- Note [MissingConstructorNameMessage] If you change this, also change the other similar ones
            Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty) -> Pretty -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$
              Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
                Pretty
"These types have some constructors with missing names."
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (NonEmpty Pretty -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines (((Int, Name) -> Pretty) -> NonEmpty (Int, Name) -> NonEmpty Pretty
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
n, Name
typ) -> Int -> Pretty
formatNum Int
n Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
typ) NonEmpty (Int, Name)
stuff))
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
                  ( Pretty
"You can use"
                      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample
                        InputPattern
IP.view
                        [ let firstNum :: Int
firstNum = (Int, Name) -> Int
forall a b. (a, b) -> a
fst (NonEmpty (Int, Name) -> (Int, Name)
forall a. NonEmpty a -> a
NEList.head NonEmpty (Int, Name)
stuff)
                              lastNum :: Int
lastNum = (Int, Name) -> Int
forall a b. (a, b) -> a
fst (NonEmpty (Int, Name) -> (Int, Name)
forall a. NonEmpty a -> a
NEList.last NonEmpty (Int, Name)
stuff)
                           in if Int
firstNum Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lastNum
                                then String -> Pretty
forall s. IsString s => String -> Pretty s
P.string (Int -> String
forall a. Show a => a -> String
show Int
firstNum)
                                else String -> Pretty
forall s. IsString s => String -> Pretty s
P.string (Int -> String
forall a. Show a => a -> String
show Int
firstNum) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"-" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> String -> Pretty
forall s. IsString s => String -> Pretty s
P.string (Int -> String
forall a. Show a => a -> String
show Int
lastNum)
                        ]
                      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"and"
                      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.aliasTerm [Pretty
"<hash>", Pretty
"<TypeName>.<ConstructorName>"]
                      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to give names to each unnamed constructor."
                  )

      Pretty
prettyNestedDeclAliases <-
        case [(Name, Name)]
-> (IncoherentDeclReasons -> [(Name, Name)])
-> Maybe IncoherentDeclReasons
-> [(Name, Name)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Getting [(Name, Name)] IncoherentDeclReasons [(Name, Name)]
-> IncoherentDeclReasons -> [(Name, Name)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(Name, Name)] IncoherentDeclReasons [(Name, Name)]
#nestedDeclAliases) TodoOutput
todo.incoherentDeclReasons of
          [] -> Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty
          [(Name, Name)]
aliases0 -> do
            [(Pretty, Pretty)]
aliases1 <-
              [(Name, Name)]
-> ((Name, Name)
    -> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty))
-> StateT (Int, Seq StructuredArgument) Identity [(Pretty, Pretty)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Name, Name)]
aliases0 \(Name
short, Name
long) -> do
                Int
n1 <- StructuredArgument -> Numbered Int
addNumberedArg (Name -> StructuredArgument
SA.Name Name
short)
                Int
n2 <- StructuredArgument -> Numbered Int
addNumberedArg (Name -> StructuredArgument
SA.Name Name
long)
                (Pretty, Pretty)
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Pretty
formatNum Int
n1 Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
short, Int -> Pretty
formatNum Int
n2 Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
long)
            -- Note [NestedDeclAliasMessage] If you change this, also change the other similar ones
            Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty) -> Pretty -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$
              [(Pretty, Pretty)]
aliases1
                [(Pretty, Pretty)] -> ([(Pretty, Pretty)] -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& ((Pretty, Pretty) -> Pretty) -> [(Pretty, Pretty)] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map
                  ( \(Pretty
short, Pretty
long) ->
                      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
                        ( Pretty
"These types are aliases, but one is nested under the other. Please separate them or delete"
                            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"one copy."
                        )
                        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 ([Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines [Pretty
short, Pretty
long])
                  )
                [Pretty] -> ([Pretty] -> Pretty) -> Pretty
forall a b. a -> (a -> b) -> b
& Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty
"\n\n"

      Pretty
prettyStrayConstructors <-
        case [(TermReferenceId, Name)]
-> (IncoherentDeclReasons -> [(TermReferenceId, Name)])
-> Maybe IncoherentDeclReasons
-> [(TermReferenceId, Name)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Getting
  [(TermReferenceId, Name)]
  IncoherentDeclReasons
  [(TermReferenceId, Name)]
-> IncoherentDeclReasons -> [(TermReferenceId, Name)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  [(TermReferenceId, Name)]
  IncoherentDeclReasons
  [(TermReferenceId, Name)]
#strayConstructors) TodoOutput
todo.incoherentDeclReasons of
          [] -> Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty
          [(TermReferenceId, Name)]
constructors -> do
            [Int]
nums <-
              [(TermReferenceId, Name)]
-> ((TermReferenceId, Name) -> Numbered Int)
-> StateT (Int, Seq StructuredArgument) Identity [Int]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(TermReferenceId, Name)]
constructors \(TermReferenceId
_typeRef, Name
constructor) -> do
                StructuredArgument -> Numbered Int
addNumberedArg (Name -> StructuredArgument
SA.Name Name
constructor)
            -- Note [StrayConstructorMessage] If you change this, also change the other similar ones
            Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty) -> Pretty -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$
              Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"These constructors are not nested beneath their corresponding type names:"
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN
                  Width
2
                  ( [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
                      ( (Int -> (TermReferenceId, Name) -> Pretty)
-> [Int] -> [(TermReferenceId, Name)] -> [Pretty]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
                          (\Int
n (TermReferenceId
_typeRef, Name
constructor) -> Int -> Pretty
formatNum Int
n Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
constructor)
                          [Int]
nums
                          [(TermReferenceId, Name)]
constructors
                      )
                  )
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
forall s. IsString s => Pretty s
P.newline
                Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
                  ( Pretty
"For each one, please either use"
                      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.moveAll
                      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to move if, or if it's an extra copy, you can simply"
                      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.delete
                      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"it."
                  )

      (Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> Numbered Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty
"\n\n" ([Pretty] -> Pretty)
-> ([Pretty] -> [Pretty]) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> [Pretty]
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> [Pretty s]
P.nonEmpty)
        [ Pretty
prettyDependentsOfTodo,
          Pretty
prettyDirectTermDependenciesWithoutNames,
          Pretty
prettyDirectTypeDependenciesWithoutNames,
          Pretty
prettyConflicts,
          Pretty
prettyDefnsInLib,
          Pretty
prettyConstructorAliases,
          Pretty
prettyMissingConstructorNames,
          Pretty
prettyNestedDeclAliases,
          Pretty
prettyStrayConstructors
        ]

listOfDefinitions ::
  (Var v) => Input.FindScope -> PPE.PrettyPrintEnv -> E.ListDetailed -> [SR'.SearchResult' v a] -> IO Pretty
listOfDefinitions :: forall v a.
Var v =>
FindScope
-> PrettyPrintEnv -> Bool -> [SearchResult' v a] -> IO Pretty
listOfDefinitions FindScope
fscope PrettyPrintEnv
ppe Bool
detailed [SearchResult' v a]
results =
  Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty) -> Pretty -> IO Pretty
forall a b. (a -> b) -> a -> b
$ FindScope
-> PrettyPrintEnv -> Bool -> [SearchResult' v a] -> Pretty
forall v a.
Var v =>
FindScope
-> PrettyPrintEnv -> Bool -> [SearchResult' v a] -> Pretty
listOfDefinitions' FindScope
fscope PrettyPrintEnv
ppe Bool
detailed [SearchResult' v a]
results

listOfNames :: String -> Int -> [(Reference, [HQ'.HashQualified Name])] -> [(Referent, [HQ'.HashQualified Name])] -> IO Pretty
listOfNames :: String
-> Int
-> [(TypeReference, [HashQualified Name])]
-> [(Referent, [HashQualified Name])]
-> IO Pretty
listOfNames String
namesQuery Int
len [(TypeReference, [HashQualified Name])]
types [(Referent, [HashQualified Name])]
terms = do
  if [(TypeReference, [HashQualified Name])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(TypeReference, [HashQualified Name])]
types Bool -> Bool -> Bool
&& [(Referent, [HashQualified Name])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Referent, [HashQualified Name])]
terms
    then
      Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty Pretty
"\n"
        ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$ [ Pretty -> Pretty
P.red Pretty
prettyQuery,
            String -> Pretty
forall s. IsString s => String -> Pretty s
P.string String
"😶",
            Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty
"I couldn't find anything by that name."
          ]
    else
      Pretty -> IO Pretty
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> IO Pretty)
-> ([Pretty] -> Pretty) -> [Pretty] -> IO Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty Pretty
"\n" ([Pretty] -> IO Pretty) -> [Pretty] -> IO Pretty
forall a b. (a -> b) -> a -> b
$
        [ Pretty -> Pretty
P.green Pretty
prettyQuery,
          [(Pretty, Pretty, Pretty)] -> Pretty
makeTable [(Pretty, Pretty, Pretty)]
prettyRows
        ]
  where
    prettyQuery :: Pretty
prettyQuery = Pretty -> Pretty -> Pretty
forall s. IsString s => Pretty s -> Pretty s -> Pretty s
P.singleQuoted' (String -> Pretty
forall s. IsString s => String -> Pretty s
P.string String
namesQuery) Pretty
":"

    makeTable :: [(Pretty, Pretty, Pretty)] -> Pretty
makeTable =
      Pretty -> Pretty -> Pretty -> [(Pretty, Pretty, Pretty)] -> Pretty
P.column3Header Pretty
"Hash" Pretty
"Kind" Pretty
"Names"

    prettyRows :: [(Pretty, Pretty, Pretty)]
prettyRows = [(Pretty (SyntaxText' TypeReference), Pretty,
  [HashQualified Name])]
-> [(Pretty, Pretty, Pretty)]
forall {r}.
[(Pretty (SyntaxText' r), Pretty, [HashQualified Name])]
-> [(Pretty, Pretty, Pretty)]
makePrettyRows ([(Pretty (SyntaxText' TypeReference), Pretty,
   [HashQualified Name])]
 -> [(Pretty, Pretty, Pretty)])
-> [(Pretty (SyntaxText' TypeReference), Pretty,
     [HashQualified Name])]
-> [(Pretty, Pretty, Pretty)]
forall a b. (a -> b) -> a -> b
$ ((Pretty (SyntaxText' TypeReference), Pretty, [HashQualified Name])
 -> (Pretty (SyntaxText' TypeReference), Pretty,
     [HashQualified Name])
 -> Ordering)
-> [(Pretty (SyntaxText' TypeReference), Pretty,
     [HashQualified Name])]
-> [(Pretty (SyntaxText' TypeReference), Pretty,
     [HashQualified Name])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (Pretty (SyntaxText' TypeReference), Pretty, [HashQualified Name])
-> (Pretty (SyntaxText' TypeReference), Pretty,
    [HashQualified Name])
-> Ordering
forall a b.
(a, b, [HashQualified Name])
-> (a, b, [HashQualified Name]) -> Ordering
compareRows [(Pretty (SyntaxText' TypeReference), Pretty,
  [HashQualified Name])]
rows
    makePrettyRows :: [(Pretty (SyntaxText' r), Pretty, [HashQualified Name])]
-> [(Pretty, Pretty, Pretty)]
makePrettyRows =
      ((Pretty (SyntaxText' r), Pretty, [HashQualified Name])
 -> (Pretty, Pretty, Pretty))
-> [(Pretty (SyntaxText' r), Pretty, [HashQualified Name])]
-> [(Pretty, Pretty, Pretty)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ( \(Pretty (SyntaxText' r)
ref, Pretty
kind, [HashQualified Name]
hqs) ->
            ( Pretty (SyntaxText' r) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor Pretty (SyntaxText' r)
ref,
              Pretty -> Pretty
P.blue Pretty
kind,
              Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
                [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.commas ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
                  Pretty -> Pretty
P.bold (Pretty -> Pretty)
-> (HashQualified Name -> Pretty) -> HashQualified Name -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> (HashQualified Name -> Pretty (SyntaxText' TypeReference))
-> HashQualified Name
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified'
                    (HashQualified Name -> Pretty) -> [HashQualified Name] -> [Pretty]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HashQualified Name]
hqs
            )
        )

    -- Compare rows by their list of names, first by comparing each name in the list
    -- then by the length of the list of they share the same prefix
    compareRows :: (a, b, [HQ'.HashQualified Name]) -> (a, b, [HQ'.HashQualified Name]) -> Ordering
    compareRows :: forall a b.
(a, b, [HashQualified Name])
-> (a, b, [HashQualified Name]) -> Ordering
compareRows (a
_, b
_, [HashQualified Name]
hqs1) (a
_, b
_, [HashQualified Name]
hqs2) =
      [HashQualified Name] -> [HashQualified Name] -> Ordering
forall n. Alphabetical n => n -> n -> Ordering
Name.compareAlphabetical [HashQualified Name]
hqs1 [HashQualified Name]
hqs2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> ([HashQualified Name] -> Int)
-> [HashQualified Name] -> [HashQualified Name] -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing [HashQualified Name] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HashQualified Name]
hqs1 [HashQualified Name]
hqs2

    rows :: [(Pretty (SyntaxText' TypeReference), Pretty,
  [HashQualified Name])]
rows = [(Referent, [HashQualified Name])]
-> [(Pretty (SyntaxText' TypeReference), Pretty,
     [HashQualified Name])]
termRows [(Referent, [HashQualified Name])]
terms [(Pretty (SyntaxText' TypeReference), Pretty,
  [HashQualified Name])]
-> [(Pretty (SyntaxText' TypeReference), Pretty,
     [HashQualified Name])]
-> [(Pretty (SyntaxText' TypeReference), Pretty,
     [HashQualified Name])]
forall a. [a] -> [a] -> [a]
++ [(TypeReference, [HashQualified Name])]
-> [(Pretty (SyntaxText' TypeReference), Pretty,
     [HashQualified Name])]
typeRows [(TypeReference, [HashQualified Name])]
types

    termRows :: [(Referent, [HashQualified Name])]
-> [(Pretty (SyntaxText' TypeReference), Pretty,
     [HashQualified Name])]
termRows [(Referent, [HashQualified Name])]
terms =
      Pretty
-> (Pretty (SyntaxText' TypeReference), [HashQualified Name])
-> (Pretty (SyntaxText' TypeReference), Pretty,
    [HashQualified Name])
forall {a} {b} {a}. Alphabetical a => b -> (a, [a]) -> (a, b, [a])
makeSortedRow Pretty
"Term" ((Pretty (SyntaxText' TypeReference), [HashQualified Name])
 -> (Pretty (SyntaxText' TypeReference), Pretty,
     [HashQualified Name]))
-> [(Pretty (SyntaxText' TypeReference), [HashQualified Name])]
-> [(Pretty (SyntaxText' TypeReference), Pretty,
     [HashQualified Name])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Pretty (SyntaxText' TypeReference), [HashQualified Name])]
prettyTerms
      where
        prettyTerms :: [(Pretty (SyntaxText' TypeReference), [HashQualified Name])]
prettyTerms = [(Referent, [HashQualified Name])]
terms [(Referent, [HashQualified Name])]
-> ([(Referent, [HashQualified Name])]
    -> [(Pretty (SyntaxText' TypeReference), [HashQualified Name])])
-> [(Pretty (SyntaxText' TypeReference), [HashQualified Name])]
forall a b. a -> (a -> b) -> b
& ASetter
  [(Referent, [HashQualified Name])]
  [(Pretty (SyntaxText' TypeReference), [HashQualified Name])]
  Referent
  (Pretty (SyntaxText' TypeReference))
-> (Referent -> Pretty (SyntaxText' TypeReference))
-> [(Referent, [HashQualified Name])]
-> [(Pretty (SyntaxText' TypeReference), [HashQualified Name])]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (((Referent, [HashQualified Name])
 -> Identity
      (Pretty (SyntaxText' TypeReference), [HashQualified Name]))
-> [(Referent, [HashQualified Name])]
-> Identity
     [(Pretty (SyntaxText' TypeReference), [HashQualified Name])]
Setter
  [(Referent, [HashQualified Name])]
  [(Pretty (SyntaxText' TypeReference), [HashQualified Name])]
  (Referent, [HashQualified Name])
  (Pretty (SyntaxText' TypeReference), [HashQualified Name])
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped (((Referent, [HashQualified Name])
  -> Identity
       (Pretty (SyntaxText' TypeReference), [HashQualified Name]))
 -> [(Referent, [HashQualified Name])]
 -> Identity
      [(Pretty (SyntaxText' TypeReference), [HashQualified Name])])
-> ((Referent -> Identity (Pretty (SyntaxText' TypeReference)))
    -> (Referent, [HashQualified Name])
    -> Identity
         (Pretty (SyntaxText' TypeReference), [HashQualified Name]))
-> ASetter
     [(Referent, [HashQualified Name])]
     [(Pretty (SyntaxText' TypeReference), [HashQualified Name])]
     Referent
     (Pretty (SyntaxText' TypeReference))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Referent -> Identity (Pretty (SyntaxText' TypeReference)))
-> (Referent, [HashQualified Name])
-> Identity
     (Pretty (SyntaxText' TypeReference), [HashQualified Name])
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Referent, [HashQualified Name])
  (Pretty (SyntaxText' TypeReference), [HashQualified Name])
  Referent
  (Pretty (SyntaxText' TypeReference))
_1) (Int -> Referent -> Pretty (SyntaxText' TypeReference)
prettyReferent Int
len)

    typeRows :: [(TypeReference, [HashQualified Name])]
-> [(Pretty (SyntaxText' TypeReference), Pretty,
     [HashQualified Name])]
typeRows [(TypeReference, [HashQualified Name])]
types =
      Pretty
-> (Pretty (SyntaxText' TypeReference), [HashQualified Name])
-> (Pretty (SyntaxText' TypeReference), Pretty,
    [HashQualified Name])
forall {a} {b} {a}. Alphabetical a => b -> (a, [a]) -> (a, b, [a])
makeSortedRow Pretty
"Type" ((Pretty (SyntaxText' TypeReference), [HashQualified Name])
 -> (Pretty (SyntaxText' TypeReference), Pretty,
     [HashQualified Name]))
-> [(Pretty (SyntaxText' TypeReference), [HashQualified Name])]
-> [(Pretty (SyntaxText' TypeReference), Pretty,
     [HashQualified Name])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Pretty (SyntaxText' TypeReference), [HashQualified Name])]
prettyTypes
      where
        prettyTypes :: [(Pretty (SyntaxText' TypeReference), [HashQualified Name])]
prettyTypes = [(TypeReference, [HashQualified Name])]
types [(TypeReference, [HashQualified Name])]
-> ([(TypeReference, [HashQualified Name])]
    -> [(Pretty (SyntaxText' TypeReference), [HashQualified Name])])
-> [(Pretty (SyntaxText' TypeReference), [HashQualified Name])]
forall a b. a -> (a -> b) -> b
& ASetter
  [(TypeReference, [HashQualified Name])]
  [(Pretty (SyntaxText' TypeReference), [HashQualified Name])]
  TypeReference
  (Pretty (SyntaxText' TypeReference))
-> (TypeReference -> Pretty (SyntaxText' TypeReference))
-> [(TypeReference, [HashQualified Name])]
-> [(Pretty (SyntaxText' TypeReference), [HashQualified Name])]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (((TypeReference, [HashQualified Name])
 -> Identity
      (Pretty (SyntaxText' TypeReference), [HashQualified Name]))
-> [(TypeReference, [HashQualified Name])]
-> Identity
     [(Pretty (SyntaxText' TypeReference), [HashQualified Name])]
Setter
  [(TypeReference, [HashQualified Name])]
  [(Pretty (SyntaxText' TypeReference), [HashQualified Name])]
  (TypeReference, [HashQualified Name])
  (Pretty (SyntaxText' TypeReference), [HashQualified Name])
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped (((TypeReference, [HashQualified Name])
  -> Identity
       (Pretty (SyntaxText' TypeReference), [HashQualified Name]))
 -> [(TypeReference, [HashQualified Name])]
 -> Identity
      [(Pretty (SyntaxText' TypeReference), [HashQualified Name])])
-> ((TypeReference
     -> Identity (Pretty (SyntaxText' TypeReference)))
    -> (TypeReference, [HashQualified Name])
    -> Identity
         (Pretty (SyntaxText' TypeReference), [HashQualified Name]))
-> ASetter
     [(TypeReference, [HashQualified Name])]
     [(Pretty (SyntaxText' TypeReference), [HashQualified Name])]
     TypeReference
     (Pretty (SyntaxText' TypeReference))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeReference -> Identity (Pretty (SyntaxText' TypeReference)))
-> (TypeReference, [HashQualified Name])
-> Identity
     (Pretty (SyntaxText' TypeReference), [HashQualified Name])
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (TypeReference, [HashQualified Name])
  (Pretty (SyntaxText' TypeReference), [HashQualified Name])
  TypeReference
  (Pretty (SyntaxText' TypeReference))
_1) (Int -> TypeReference -> Pretty (SyntaxText' TypeReference)
prettyReference Int
len)

    makeSortedRow :: b -> (a, [a]) -> (a, b, [a])
makeSortedRow b
kind (a
ref, [a]
hqs) =
      ( a
ref,
        b
kind,
        (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy a -> a -> Ordering
forall n. Alphabetical n => n -> n -> Ordering
Name.compareAlphabetical [a]
hqs
      )

data ShowNumbers = ShowNumbers | HideNumbers

-- | `ppe` is just for rendering type signatures
--   `oldPath, newPath :: Path.Absolute` are just for producing fully-qualified
--                                       numbered args
showDiffNamespace ::
  forall v.
  (Var v) =>
  ShowNumbers ->
  PPE.PrettyPrintEnv ->
  Input.AbsBranchId ->
  Input.AbsBranchId ->
  OBD.BranchDiffOutput v Ann ->
  (Pretty, NumberedArgs)
showDiffNamespace :: forall v.
Var v =>
ShowNumbers
-> PrettyPrintEnv
-> AbsBranchId
-> AbsBranchId
-> BranchDiffOutput v Ann
-> (Pretty, NumberedArgs)
showDiffNamespace ShowNumbers
_ PrettyPrintEnv
_ AbsBranchId
_ AbsBranchId
_ BranchDiffOutput v Ann
diffOutput
  | BranchDiffOutput v Ann -> Bool
forall v a. BranchDiffOutput v a -> Bool
OBD.isEmpty BranchDiffOutput v Ann
diffOutput =
      (Pretty
"The namespaces are identical.", NumberedArgs
forall a. Monoid a => a
mempty)
showDiffNamespace ShowNumbers
sn PrettyPrintEnv
ppe AbsBranchId
oldPath AbsBranchId
newPath OBD.BranchDiffOutput {[RemovedTypeDisplay v Ann]
[RemovedTermDisplay v Ann]
[RenameTypeDisplay v Ann]
[RenameTermDisplay v Ann]
[UpdateTypeDisplay v Ann]
[UpdateTermDisplay v Ann]
updatedTypes :: [UpdateTypeDisplay v Ann]
updatedTerms :: [UpdateTermDisplay v Ann]
newTypeConflicts :: [UpdateTypeDisplay v Ann]
newTermConflicts :: [UpdateTermDisplay v Ann]
resolvedTypeConflicts :: [UpdateTypeDisplay v Ann]
resolvedTermConflicts :: [UpdateTermDisplay v Ann]
addedTypes :: [RemovedTypeDisplay v Ann]
addedTerms :: [RemovedTermDisplay v Ann]
removedTypes :: [RemovedTypeDisplay v Ann]
removedTerms :: [RemovedTermDisplay v Ann]
renamedTypes :: [RenameTypeDisplay v Ann]
renamedTerms :: [RenameTermDisplay v Ann]
$sel:updatedTypes:BranchDiffOutput :: forall v a. BranchDiffOutput v a -> [UpdateTypeDisplay v a]
$sel:updatedTerms:BranchDiffOutput :: forall v a. BranchDiffOutput v a -> [UpdateTermDisplay v a]
$sel:newTypeConflicts:BranchDiffOutput :: forall v a. BranchDiffOutput v a -> [UpdateTypeDisplay v a]
$sel:newTermConflicts:BranchDiffOutput :: forall v a. BranchDiffOutput v a -> [UpdateTermDisplay v a]
$sel:resolvedTypeConflicts:BranchDiffOutput :: forall v a. BranchDiffOutput v a -> [UpdateTypeDisplay v a]
$sel:resolvedTermConflicts:BranchDiffOutput :: forall v a. BranchDiffOutput v a -> [UpdateTermDisplay v a]
$sel:addedTypes:BranchDiffOutput :: forall v a. BranchDiffOutput v a -> [AddedTypeDisplay v a]
$sel:addedTerms:BranchDiffOutput :: forall v a. BranchDiffOutput v a -> [AddedTermDisplay v a]
$sel:removedTypes:BranchDiffOutput :: forall v a. BranchDiffOutput v a -> [AddedTypeDisplay v a]
$sel:removedTerms:BranchDiffOutput :: forall v a. BranchDiffOutput v a -> [AddedTermDisplay v a]
$sel:renamedTypes:BranchDiffOutput :: forall v a. BranchDiffOutput v a -> [RenameTypeDisplay v a]
$sel:renamedTerms:BranchDiffOutput :: forall v a. BranchDiffOutput v a -> [RenameTermDisplay v a]
..} =
  (Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty Pretty
"\n\n" [Pretty]
p, Seq StructuredArgument -> NumberedArgs
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq StructuredArgument
args)
  where
    ([Pretty]
p, (Int
menuSize, Seq StructuredArgument
args)) =
      (StateT (Int, Seq StructuredArgument) Identity [Pretty]
-> (Int, Seq StructuredArgument)
-> ([Pretty], (Int, Seq StructuredArgument))
forall s a. State s a -> s -> (a, s)
`State.runState` (Int
0 :: Int, Seq StructuredArgument
forall a. Seq a
Seq.empty)) (StateT (Int, Seq StructuredArgument) Identity [Pretty]
 -> ([Pretty], (Int, Seq StructuredArgument)))
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
-> ([Pretty], (Int, Seq StructuredArgument))
forall a b. (a -> b) -> a -> b
$
        [Numbered Pretty]
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
          [ if (Bool -> Bool
not (Bool -> Bool)
-> ([UpdateTypeDisplay v Ann] -> Bool)
-> [UpdateTypeDisplay v Ann]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UpdateTypeDisplay v Ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [UpdateTypeDisplay v Ann]
newTypeConflicts
              Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool)
-> ([UpdateTermDisplay v Ann] -> Bool)
-> [UpdateTermDisplay v Ann]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UpdateTermDisplay v Ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [UpdateTermDisplay v Ann]
newTermConflicts
              then do
                [Pretty]
prettyUpdatedTypes :: [Pretty] <- (UpdateTypeDisplay v Ann -> Numbered Pretty)
-> [UpdateTypeDisplay v Ann]
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
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 UpdateTypeDisplay v Ann -> Numbered Pretty
forall a. UpdateTypeDisplay v a -> Numbered Pretty
prettyUpdateType [UpdateTypeDisplay v Ann]
newTypeConflicts
                [Pretty]
prettyUpdatedTerms :: [Pretty] <- (UpdateTermDisplay v Ann -> Numbered Pretty)
-> [UpdateTermDisplay v Ann]
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
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 UpdateTermDisplay v Ann -> Numbered Pretty
forall a. UpdateTermDisplay v a -> Numbered Pretty
prettyUpdateTerm [UpdateTermDisplay v Ann]
newTermConflicts
                Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty) -> Pretty -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$
                  Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty
                    Pretty
"\n\n"
                    [ Pretty -> Pretty
P.red Pretty
"New name conflicts:",
                      Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty Pretty
"\n\n" ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$ [Pretty]
prettyUpdatedTypes [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [Pretty]
prettyUpdatedTerms
                    ]
              else Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty,
            if (Bool -> Bool
not (Bool -> Bool)
-> ([UpdateTypeDisplay v Ann] -> Bool)
-> [UpdateTypeDisplay v Ann]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UpdateTypeDisplay v Ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [UpdateTypeDisplay v Ann]
resolvedTypeConflicts
              Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool)
-> ([UpdateTermDisplay v Ann] -> Bool)
-> [UpdateTermDisplay v Ann]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UpdateTermDisplay v Ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [UpdateTermDisplay v Ann]
resolvedTermConflicts
              then do
                [Pretty]
prettyUpdatedTypes :: [Pretty] <- (UpdateTypeDisplay v Ann -> Numbered Pretty)
-> [UpdateTypeDisplay v Ann]
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
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 UpdateTypeDisplay v Ann -> Numbered Pretty
forall a. UpdateTypeDisplay v a -> Numbered Pretty
prettyUpdateType [UpdateTypeDisplay v Ann]
resolvedTypeConflicts
                [Pretty]
prettyUpdatedTerms :: [Pretty] <- (UpdateTermDisplay v Ann -> Numbered Pretty)
-> [UpdateTermDisplay v Ann]
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
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 UpdateTermDisplay v Ann -> Numbered Pretty
forall a. UpdateTermDisplay v a -> Numbered Pretty
prettyUpdateTerm [UpdateTermDisplay v Ann]
resolvedTermConflicts
                Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty) -> Pretty -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$
                  Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty
                    Pretty
"\n\n"
                    [ Pretty -> Pretty
P.bold Pretty
"Resolved name conflicts:",
                      Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty Pretty
"\n\n" ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$ [Pretty]
prettyUpdatedTypes [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [Pretty]
prettyUpdatedTerms
                    ]
              else Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty,
            if (Bool -> Bool
not (Bool -> Bool)
-> ([UpdateTypeDisplay v Ann] -> Bool)
-> [UpdateTypeDisplay v Ann]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UpdateTypeDisplay v Ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [UpdateTypeDisplay v Ann]
updatedTypes
              Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool)
-> ([UpdateTermDisplay v Ann] -> Bool)
-> [UpdateTermDisplay v Ann]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UpdateTermDisplay v Ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [UpdateTermDisplay v Ann]
updatedTerms
              then do
                [Pretty]
prettyUpdatedTypes :: [Pretty] <- (UpdateTypeDisplay v Ann -> Numbered Pretty)
-> [UpdateTypeDisplay v Ann]
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
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 UpdateTypeDisplay v Ann -> Numbered Pretty
forall a. UpdateTypeDisplay v a -> Numbered Pretty
prettyUpdateType [UpdateTypeDisplay v Ann]
updatedTypes
                [Pretty]
prettyUpdatedTerms :: [Pretty] <- (UpdateTermDisplay v Ann -> Numbered Pretty)
-> [UpdateTermDisplay v Ann]
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
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 UpdateTermDisplay v Ann -> Numbered Pretty
forall a. UpdateTermDisplay v a -> Numbered Pretty
prettyUpdateTerm [UpdateTermDisplay v Ann]
updatedTerms
                Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty) -> Pretty -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$
                  Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty
                    Pretty
"\n\n"
                    [ Pretty -> Pretty
P.bold Pretty
"Updates:",
                      Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentNonEmptyN Width
2 (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty Pretty
"\n\n" ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$ [Pretty]
prettyUpdatedTypes [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [Pretty]
prettyUpdatedTerms
                    ]
              else Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty,
            if (Bool -> Bool
not (Bool -> Bool)
-> ([RemovedTypeDisplay v Ann] -> Bool)
-> [RemovedTypeDisplay v Ann]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RemovedTypeDisplay v Ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [RemovedTypeDisplay v Ann]
addedTypes
              Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool)
-> ([RemovedTermDisplay v Ann] -> Bool)
-> [RemovedTermDisplay v Ann]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RemovedTermDisplay v Ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [RemovedTermDisplay v Ann]
addedTerms
              then do
                Pretty
prettyAddedTypes :: Pretty <- [RemovedTypeDisplay v Ann] -> Numbered Pretty
forall a. [AddedTypeDisplay v a] -> Numbered Pretty
prettyAddTypes [RemovedTypeDisplay v Ann]
addedTypes
                Pretty
prettyAddedTerms :: Pretty <- [RemovedTermDisplay v Ann] -> Numbered Pretty
forall a. [AddedTermDisplay v a] -> Numbered Pretty
prettyAddTerms [RemovedTermDisplay v Ann]
addedTerms
                Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty) -> Pretty -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$
                  Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty
                    Pretty
"\n\n"
                    [ Pretty -> Pretty
P.bold Pretty
"Added definitions:",
                      Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentNonEmptyN Width
2 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.linesNonEmpty [Pretty
prettyAddedTypes, Pretty
prettyAddedTerms]
                    ]
              else Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty,
            if (Bool -> Bool
not (Bool -> Bool)
-> ([RemovedTypeDisplay v Ann] -> Bool)
-> [RemovedTypeDisplay v Ann]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RemovedTypeDisplay v Ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [RemovedTypeDisplay v Ann]
removedTypes
              Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool)
-> ([RemovedTermDisplay v Ann] -> Bool)
-> [RemovedTermDisplay v Ann]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RemovedTermDisplay v Ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [RemovedTermDisplay v Ann]
removedTerms
              then do
                Pretty
prettyRemovedTypes :: Pretty <- [RemovedTypeDisplay v Ann] -> Numbered Pretty
forall a. [AddedTypeDisplay v a] -> Numbered Pretty
prettyRemoveTypes [RemovedTypeDisplay v Ann]
removedTypes
                Pretty
prettyRemovedTerms :: Pretty <- [RemovedTermDisplay v Ann] -> Numbered Pretty
forall a. [AddedTermDisplay v a] -> Numbered Pretty
prettyRemoveTerms [RemovedTermDisplay v Ann]
removedTerms
                Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty) -> Pretty -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$
                  Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty
                    Pretty
"\n\n"
                    [ Pretty -> Pretty
P.bold Pretty
"Removed definitions:",
                      Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
                        [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.linesNonEmpty
                          [ Pretty
prettyRemovedTypes,
                            Pretty
prettyRemovedTerms
                          ]
                    ]
              else Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty,
            if (Bool -> Bool
not (Bool -> Bool)
-> ([RenameTypeDisplay v Ann] -> Bool)
-> [RenameTypeDisplay v Ann]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RenameTypeDisplay v Ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [RenameTypeDisplay v Ann]
renamedTypes
              Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool)
-> ([RenameTermDisplay v Ann] -> Bool)
-> [RenameTermDisplay v Ann]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RenameTermDisplay v Ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [RenameTermDisplay v Ann]
renamedTerms
              then do
                [Pretty]
results <- [RenameTypeDisplay v Ann]
-> [RenameTermDisplay v Ann]
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
forall a.
[RenameTypeDisplay v a]
-> [RenameTermDisplay v a]
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
prettyRenameGroups [RenameTypeDisplay v Ann]
renamedTypes [RenameTermDisplay v Ann]
renamedTerms
                Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty) -> Pretty -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$
                  Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty
                    Pretty
"\n\n"
                    [ Pretty -> Pretty
P.bold Pretty
"Name changes:",
                      Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty Pretty
"\n\n" ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$ [Pretty]
results
                    ]
              else -- todo: change separator to just '\n' here if all the results are 1 to 1
                Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty
          ]

    {- new implementation
      23. X  ┐  =>  (added)   24. X'
      25. X2 ┘      (removed) 26. X2
    -}
    prettyRenameGroups ::
      [OBD.RenameTypeDisplay v a] ->
      [OBD.RenameTermDisplay v a] ->
      Numbered [Pretty]
    prettyRenameGroups :: forall a.
[RenameTypeDisplay v a]
-> [RenameTermDisplay v a]
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
prettyRenameGroups [(TypeReference, Maybe (DeclOrBuiltin v a),
  Set (HashQualified Name), Set (HashQualified Name))]
types [(Referent, Maybe (Type v a), Set (HashQualified Name),
  Set (HashQualified Name))]
terms =
      [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
(<>)
        ([Pretty] -> [Pretty] -> [Pretty])
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
-> StateT
     (Int, Seq StructuredArgument) Identity ([Pretty] -> [Pretty])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((TypeReference, Maybe (DeclOrBuiltin v a),
   Set (HashQualified Name), Set (HashQualified Name)),
  Int)
 -> Numbered Pretty)
-> [((TypeReference, Maybe (DeclOrBuiltin v a),
      Set (HashQualified Name), Set (HashQualified Name)),
     Int)]
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
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
          (((Referent, Maybe (DeclOrBuiltin v a), Set (HashQualified Name),
  Set (HashQualified Name)),
 Int)
-> Numbered Pretty
forall b.
((Referent, b, Set (HashQualified Name), Set (HashQualified Name)),
 Int)
-> Numbered Pretty
prettyGroup (((Referent, Maybe (DeclOrBuiltin v a), Set (HashQualified Name),
   Set (HashQualified Name)),
  Int)
 -> Numbered Pretty)
-> (((TypeReference, Maybe (DeclOrBuiltin v a),
      Set (HashQualified Name), Set (HashQualified Name)),
     Int)
    -> ((Referent, Maybe (DeclOrBuiltin v a), Set (HashQualified Name),
         Set (HashQualified Name)),
        Int))
-> ((TypeReference, Maybe (DeclOrBuiltin v a),
     Set (HashQualified Name), Set (HashQualified Name)),
    Int)
-> Numbered Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ASetter
  ((TypeReference, Maybe (DeclOrBuiltin v a),
    Set (HashQualified Name), Set (HashQualified Name)),
   Int)
  ((Referent, Maybe (DeclOrBuiltin v a), Set (HashQualified Name),
    Set (HashQualified Name)),
   Int)
  TypeReference
  Referent
-> (TypeReference -> Referent)
-> ((TypeReference, Maybe (DeclOrBuiltin v a),
     Set (HashQualified Name), Set (HashQualified Name)),
    Int)
-> ((Referent, Maybe (DeclOrBuiltin v a), Set (HashQualified Name),
     Set (HashQualified Name)),
    Int)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (((TypeReference, Maybe (DeclOrBuiltin v a),
  Set (HashQualified Name), Set (HashQualified Name))
 -> Identity
      (Referent, Maybe (DeclOrBuiltin v a), Set (HashQualified Name),
       Set (HashQualified Name)))
-> ((TypeReference, Maybe (DeclOrBuiltin v a),
     Set (HashQualified Name), Set (HashQualified Name)),
    Int)
-> Identity
     ((Referent, Maybe (DeclOrBuiltin v a), Set (HashQualified Name),
       Set (HashQualified Name)),
      Int)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  ((TypeReference, Maybe (DeclOrBuiltin v a),
    Set (HashQualified Name), Set (HashQualified Name)),
   Int)
  ((Referent, Maybe (DeclOrBuiltin v a), Set (HashQualified Name),
    Set (HashQualified Name)),
   Int)
  (TypeReference, Maybe (DeclOrBuiltin v a),
   Set (HashQualified Name), Set (HashQualified Name))
  (Referent, Maybe (DeclOrBuiltin v a), Set (HashQualified Name),
   Set (HashQualified Name))
_1 (((TypeReference, Maybe (DeclOrBuiltin v a),
   Set (HashQualified Name), Set (HashQualified Name))
  -> Identity
       (Referent, Maybe (DeclOrBuiltin v a), Set (HashQualified Name),
        Set (HashQualified Name)))
 -> ((TypeReference, Maybe (DeclOrBuiltin v a),
      Set (HashQualified Name), Set (HashQualified Name)),
     Int)
 -> Identity
      ((Referent, Maybe (DeclOrBuiltin v a), Set (HashQualified Name),
        Set (HashQualified Name)),
       Int))
-> ((TypeReference -> Identity Referent)
    -> (TypeReference, Maybe (DeclOrBuiltin v a),
        Set (HashQualified Name), Set (HashQualified Name))
    -> Identity
         (Referent, Maybe (DeclOrBuiltin v a), Set (HashQualified Name),
          Set (HashQualified Name)))
-> ASetter
     ((TypeReference, Maybe (DeclOrBuiltin v a),
       Set (HashQualified Name), Set (HashQualified Name)),
      Int)
     ((Referent, Maybe (DeclOrBuiltin v a), Set (HashQualified Name),
       Set (HashQualified Name)),
      Int)
     TypeReference
     Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeReference -> Identity Referent)
-> (TypeReference, Maybe (DeclOrBuiltin v a),
    Set (HashQualified Name), Set (HashQualified Name))
-> Identity
     (Referent, Maybe (DeclOrBuiltin v a), Set (HashQualified Name),
      Set (HashQualified Name))
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (TypeReference, Maybe (DeclOrBuiltin v a),
   Set (HashQualified Name), Set (HashQualified Name))
  (Referent, Maybe (DeclOrBuiltin v a), Set (HashQualified Name),
   Set (HashQualified Name))
  TypeReference
  Referent
_1) TypeReference -> Referent
Referent.Ref))
          ([(TypeReference, Maybe (DeclOrBuiltin v a),
  Set (HashQualified Name), Set (HashQualified Name))]
types [(TypeReference, Maybe (DeclOrBuiltin v a),
  Set (HashQualified Name), Set (HashQualified Name))]
-> [Int]
-> [((TypeReference, Maybe (DeclOrBuiltin v a),
      Set (HashQualified Name), Set (HashQualified Name)),
     Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Int
0 ..])
        StateT
  (Int, Seq StructuredArgument) Identity ([Pretty] -> [Pretty])
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
forall a b.
StateT (Int, Seq StructuredArgument) Identity (a -> b)
-> StateT (Int, Seq StructuredArgument) Identity a
-> StateT (Int, Seq StructuredArgument) Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (((Referent, Maybe (Type v a), Set (HashQualified Name),
   Set (HashQualified Name)),
  Int)
 -> Numbered Pretty)
-> [((Referent, Maybe (Type v a), Set (HashQualified Name),
      Set (HashQualified Name)),
     Int)]
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
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 ((Referent, Maybe (Type v a), Set (HashQualified Name),
  Set (HashQualified Name)),
 Int)
-> Numbered Pretty
forall b.
((Referent, b, Set (HashQualified Name), Set (HashQualified Name)),
 Int)
-> Numbered Pretty
prettyGroup ([(Referent, Maybe (Type v a), Set (HashQualified Name),
  Set (HashQualified Name))]
terms [(Referent, Maybe (Type v a), Set (HashQualified Name),
  Set (HashQualified Name))]
-> [Int]
-> [((Referent, Maybe (Type v a), Set (HashQualified Name),
      Set (HashQualified Name)),
     Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [[(TypeReference, Maybe (DeclOrBuiltin v a),
  Set (HashQualified Name), Set (HashQualified Name))]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(TypeReference, Maybe (DeclOrBuiltin v a),
  Set (HashQualified Name), Set (HashQualified Name))]
types ..])
      where
        Width
leftNamePad :: P.Width =
          (Width -> Width -> Width) -> [Width] -> Width
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Width -> Width -> Width
forall a. Ord a => a -> a -> a
max ([Width] -> Width) -> [Width] -> Width
forall a b. (a -> b) -> a -> b
$
            ((Referent, Maybe (Type v a), Set (HashQualified Name),
  Set (HashQualified Name))
 -> Width)
-> [(Referent, Maybe (Type v a), Set (HashQualified Name),
     Set (HashQualified Name))]
-> [Width]
forall a b. (a -> b) -> [a] -> [b]
map
              ((Width -> Width -> Width) -> [Width] -> Width
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Width -> Width -> Width
forall a. Ord a => a -> a -> a
max ([Width] -> Width)
-> ((Referent, Maybe (Type v a), Set (HashQualified Name),
     Set (HashQualified Name))
    -> [Width])
-> (Referent, Maybe (Type v a), Set (HashQualified Name),
    Set (HashQualified Name))
-> Width
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashQualified Name -> Width) -> [HashQualified Name] -> [Width]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Width
P.Width (Int -> Width)
-> (HashQualified Name -> Int) -> HashQualified Name -> Width
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Text) -> HashQualified Name -> Int
HQ'.nameLength Name -> Text
Name.toText) ([HashQualified Name] -> [Width])
-> ((Referent, Maybe (Type v a), Set (HashQualified Name),
     Set (HashQualified Name))
    -> [HashQualified Name])
-> (Referent, Maybe (Type v a), Set (HashQualified Name),
    Set (HashQualified Name))
-> [Width]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (HashQualified Name) -> [HashQualified Name]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set (HashQualified Name) -> [HashQualified Name])
-> ((Referent, Maybe (Type v a), Set (HashQualified Name),
     Set (HashQualified Name))
    -> Set (HashQualified Name))
-> (Referent, Maybe (Type v a), Set (HashQualified Name),
    Set (HashQualified Name))
-> [HashQualified Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Set (HashQualified Name))
  (Referent, Maybe (Type v a), Set (HashQualified Name),
   Set (HashQualified Name))
  (Set (HashQualified Name))
-> (Referent, Maybe (Type v a), Set (HashQualified Name),
    Set (HashQualified Name))
-> Set (HashQualified Name)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Set (HashQualified Name))
  (Referent, Maybe (Type v a), Set (HashQualified Name),
   Set (HashQualified Name))
  (Set (HashQualified Name))
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Referent, Maybe (Type v a), Set (HashQualified Name),
   Set (HashQualified Name))
  (Referent, Maybe (Type v a), Set (HashQualified Name),
   Set (HashQualified Name))
  (Set (HashQualified Name))
  (Set (HashQualified Name))
_3)
              [(Referent, Maybe (Type v a), Set (HashQualified Name),
  Set (HashQualified Name))]
terms
              [Width] -> [Width] -> [Width]
forall a. Semigroup a => a -> a -> a
<> ((TypeReference, Maybe (DeclOrBuiltin v a),
  Set (HashQualified Name), Set (HashQualified Name))
 -> Width)
-> [(TypeReference, Maybe (DeclOrBuiltin v a),
     Set (HashQualified Name), Set (HashQualified Name))]
-> [Width]
forall a b. (a -> b) -> [a] -> [b]
map
                ((Width -> Width -> Width) -> [Width] -> Width
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Width -> Width -> Width
forall a. Ord a => a -> a -> a
max ([Width] -> Width)
-> ((TypeReference, Maybe (DeclOrBuiltin v a),
     Set (HashQualified Name), Set (HashQualified Name))
    -> [Width])
-> (TypeReference, Maybe (DeclOrBuiltin v a),
    Set (HashQualified Name), Set (HashQualified Name))
-> Width
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashQualified Name -> Width) -> [HashQualified Name] -> [Width]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Width
P.Width (Int -> Width)
-> (HashQualified Name -> Int) -> HashQualified Name -> Width
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Text) -> HashQualified Name -> Int
HQ'.nameLength Name -> Text
Name.toText) ([HashQualified Name] -> [Width])
-> ((TypeReference, Maybe (DeclOrBuiltin v a),
     Set (HashQualified Name), Set (HashQualified Name))
    -> [HashQualified Name])
-> (TypeReference, Maybe (DeclOrBuiltin v a),
    Set (HashQualified Name), Set (HashQualified Name))
-> [Width]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (HashQualified Name) -> [HashQualified Name]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set (HashQualified Name) -> [HashQualified Name])
-> ((TypeReference, Maybe (DeclOrBuiltin v a),
     Set (HashQualified Name), Set (HashQualified Name))
    -> Set (HashQualified Name))
-> (TypeReference, Maybe (DeclOrBuiltin v a),
    Set (HashQualified Name), Set (HashQualified Name))
-> [HashQualified Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Set (HashQualified Name))
  (TypeReference, Maybe (DeclOrBuiltin v a),
   Set (HashQualified Name), Set (HashQualified Name))
  (Set (HashQualified Name))
-> (TypeReference, Maybe (DeclOrBuiltin v a),
    Set (HashQualified Name), Set (HashQualified Name))
-> Set (HashQualified Name)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Set (HashQualified Name))
  (TypeReference, Maybe (DeclOrBuiltin v a),
   Set (HashQualified Name), Set (HashQualified Name))
  (Set (HashQualified Name))
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (TypeReference, Maybe (DeclOrBuiltin v a),
   Set (HashQualified Name), Set (HashQualified Name))
  (TypeReference, Maybe (DeclOrBuiltin v a),
   Set (HashQualified Name), Set (HashQualified Name))
  (Set (HashQualified Name))
  (Set (HashQualified Name))
_3)
                [(TypeReference, Maybe (DeclOrBuiltin v a),
  Set (HashQualified Name), Set (HashQualified Name))]
types
        prettyGroup ::
          ( (Referent, b, Set (HQ'.HashQualified Name), Set (HQ'.HashQualified Name)),
            Int
          ) ->
          Numbered Pretty
        prettyGroup :: forall b.
((Referent, b, Set (HashQualified Name), Set (HashQualified Name)),
 Int)
-> Numbered Pretty
prettyGroup ((Referent
r, b
_, Set (HashQualified Name)
olds, Set (HashQualified Name)
news), Int
i) =
          let -- [ "peach  ┐"
              -- , "peach' ┘"]
              [Numbered Pretty]
olds' :: [Numbered Pretty] =
                let olds0 :: [HashQualified Name]
olds0 = (HashQualified Name -> HashQualified Name -> Ordering)
-> [HashQualified Name] -> [HashQualified Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy HashQualified Name -> HashQualified Name -> Ordering
forall n. Alphabetical n => n -> n -> Ordering
Name.compareAlphabetical (Set (HashQualified Name) -> [HashQualified Name]
forall a. Set a -> [a]
Set.toList Set (HashQualified Name)
olds)
                 in ((HashQualified Name, Pretty) -> Numbered Pretty)
-> [(HashQualified Name, Pretty)] -> [Numbered Pretty]
forall a b. (a -> b) -> [a] -> [b]
map (\(HashQualified Name
oldhq, Pretty
oldp) -> AbsBranchId -> HashQualified Name -> Referent -> Numbered Pretty
numHQ' AbsBranchId
oldPath HashQualified Name
oldhq Referent
r Numbered Pretty -> (Pretty -> Pretty) -> Numbered Pretty
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\Pretty
n -> Pretty
n Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
oldp))
                      ([(HashQualified Name, Pretty)] -> [Numbered Pretty])
-> ([HashQualified Name] -> [(HashQualified Name, Pretty)])
-> [HashQualified Name]
-> [Numbered Pretty]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [HashQualified Name] -> [Pretty] -> [(HashQualified Name, Pretty)]
forall a b. [a] -> [b] -> [(a, b)]
zip [HashQualified Name]
olds0
                      ([Pretty] -> [(HashQualified Name, Pretty)])
-> ([HashQualified Name] -> [Pretty])
-> [HashQualified Name]
-> [(HashQualified Name, Pretty)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> [Pretty]
forall s. (ListLike s Char, IsString s) => [Pretty s] -> [Pretty s]
P.boxRight
                      ([Pretty] -> [Pretty])
-> ([HashQualified Name] -> [Pretty])
-> [HashQualified Name]
-> [Pretty]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashQualified Name -> Pretty) -> [HashQualified Name] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map (Width -> Pretty -> Pretty
forall s. IsString s => Width -> Pretty s -> Pretty s
P.rightPad Width
leftNamePad (Pretty -> Pretty)
-> (HashQualified Name -> Pretty) -> HashQualified Name -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Pretty
phq')
                      ([HashQualified Name] -> [Numbered Pretty])
-> [HashQualified Name] -> [Numbered Pretty]
forall a b. (a -> b) -> a -> b
$ [HashQualified Name]
olds0

              added' :: [HashQualified Name]
added' = Set (HashQualified Name) -> [HashQualified Name]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set (HashQualified Name) -> [HashQualified Name])
-> Set (HashQualified Name) -> [HashQualified Name]
forall a b. (a -> b) -> a -> b
$ Set (HashQualified Name)
-> Set (HashQualified Name) -> Set (HashQualified Name)
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set (HashQualified Name)
news Set (HashQualified Name)
olds
              removed' :: [HashQualified Name]
removed' = Set (HashQualified Name) -> [HashQualified Name]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set (HashQualified Name) -> [HashQualified Name])
-> Set (HashQualified Name) -> [HashQualified Name]
forall a b. (a -> b) -> a -> b
$ Set (HashQualified Name)
-> Set (HashQualified Name) -> Set (HashQualified Name)
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set (HashQualified Name)
olds Set (HashQualified Name)
news
              -- [ "(added)   24. X'"
              -- , "(removed) 26. X2"
              -- ]

              [Numbered Pretty]
news' :: [Numbered Pretty] =
                (HashQualified Name -> Numbered Pretty)
-> [HashQualified Name] -> [Numbered Pretty]
forall a b. (a -> b) -> [a] -> [b]
map (Pretty -> HashQualified Name -> Numbered Pretty
number Pretty
addedLabel) [HashQualified Name]
added' [Numbered Pretty] -> [Numbered Pretty] -> [Numbered Pretty]
forall a. [a] -> [a] -> [a]
++ (HashQualified Name -> Numbered Pretty)
-> [HashQualified Name] -> [Numbered Pretty]
forall a b. (a -> b) -> [a] -> [b]
map (Pretty -> HashQualified Name -> Numbered Pretty
number Pretty
removedLabel) [HashQualified Name]
removed'
                where
                  addedLabel :: Pretty
addedLabel = Pretty
"(added)"
                  removedLabel :: Pretty
removedLabel = Pretty
"(removed)"
                  number :: Pretty -> HashQualified Name -> Numbered Pretty
number Pretty
label HashQualified Name
name =
                    AbsBranchId -> HashQualified Name -> Referent -> Numbered Pretty
numHQ' AbsBranchId
newPath HashQualified Name
name Referent
r
                      Numbered Pretty -> (Pretty -> Pretty) -> Numbered Pretty
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\Pretty
num -> Pretty
num Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Pretty
phq' HashQualified Name
name Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
label)

              buildTable :: [Numbered Pretty] -> [Numbered Pretty] -> Numbered Pretty
              buildTable :: [Numbered Pretty] -> [Numbered Pretty] -> Numbered Pretty
buildTable [Numbered Pretty]
lefts [Numbered Pretty]
rights =
                let hlefts :: [Numbered Pretty]
hlefts =
                      if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                        then Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Pretty
P.bold Pretty
"Original") Numbered Pretty -> [Numbered Pretty] -> [Numbered Pretty]
forall a. a -> [a] -> [a]
: [Numbered Pretty]
lefts
                        else [Numbered Pretty]
lefts
                    hrights :: [Numbered Pretty]
hrights = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Pretty
P.bold Pretty
"Changes") Numbered Pretty -> [Numbered Pretty] -> [Numbered Pretty]
forall a. a -> [a] -> [a]
: [Numbered Pretty]
rights else [Numbered Pretty]
rights
                 in forall (m :: * -> *) s.
(ListLike s Char, IsString s, Monad m) =>
Pretty s -> [m (Pretty s)] -> [m (Pretty s)] -> m (Pretty s)
P.column2UnzippedM @Numbered Pretty
forall a. Monoid a => a
mempty [Numbered Pretty]
hlefts [Numbered Pretty]
hrights
           in [Numbered Pretty] -> [Numbered Pretty] -> Numbered Pretty
buildTable [Numbered Pretty]
olds' [Numbered Pretty]
news'

    prettyUpdateType :: OBD.UpdateTypeDisplay v a -> Numbered Pretty
    {-
       1. ability Foo#pqr x y
          2. - AllRightsReserved : License
          3. + MIT               : License
       4. ability Foo#abc
          5. - apiDocs : License
          6. + MIT     : License
    -}
    prettyUpdateType :: forall a. UpdateTypeDisplay v a -> Numbered Pretty
prettyUpdateType (OBD.UpdateTypeDisplay Maybe [SimpleTypeDisplay v a]
Nothing [TypeDisplay v a]
mdUps) =
      [(Pretty, Pretty)] -> Pretty
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2 ([(Pretty, Pretty)] -> Pretty)
-> StateT (Int, Seq StructuredArgument) Identity [(Pretty, Pretty)]
-> Numbered Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeDisplay v a
 -> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty))
-> [TypeDisplay v a]
-> StateT (Int, Seq StructuredArgument) Identity [(Pretty, Pretty)]
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 (AbsBranchId
-> TypeDisplay v a
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
forall a.
AbsBranchId
-> TypeDisplay v a
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
mdTypeLine AbsBranchId
newPath) [TypeDisplay v a]
mdUps
    {-
        1. ┌ ability Foo#pqr x y
        2. └ ability Foo#xyz a b
           ⧩
        4. ┌ ability Foo#abc
           │  5. - apiDocs : Doc
           │  6. + MIT     : License
        7. └ ability Foo#def
              8. - apiDocs : Doc
              9. + MIT     : License

        1. ┌ foo#abc : Nat -> Nat -> Poop
        2. └ foo#xyz : Nat
           ↓
        4. foo	 : Poop
             5. + foo.docs : Doc
    -}
    prettyUpdateType (OBD.UpdateTypeDisplay (Just [SimpleTypeDisplay v a]
olds) [TypeDisplay v a]
news) =
      do
        [(Pretty, Pretty)]
olds <- (TypeDisplay v a
 -> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty))
-> [TypeDisplay v a]
-> StateT (Int, Seq StructuredArgument) Identity [(Pretty, Pretty)]
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 (AbsBranchId
-> TypeDisplay v a
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
forall a.
AbsBranchId
-> TypeDisplay v a
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
mdTypeLine AbsBranchId
oldPath) [HashQualified Name
-> TypeReference -> Maybe (DeclOrBuiltin v a) -> TypeDisplay v a
forall v a.
HashQualified Name
-> TypeReference -> Maybe (DeclOrBuiltin v a) -> TypeDisplay v a
OBD.TypeDisplay HashQualified Name
name TypeReference
r Maybe (DeclOrBuiltin v a)
decl | (HashQualified Name
name, TypeReference
r, Maybe (DeclOrBuiltin v a)
decl) <- [SimpleTypeDisplay v a]
olds]
        [(Pretty, Pretty)]
news <- (TypeDisplay v a
 -> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty))
-> [TypeDisplay v a]
-> StateT (Int, Seq StructuredArgument) Identity [(Pretty, Pretty)]
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 (AbsBranchId
-> TypeDisplay v a
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
forall a.
AbsBranchId
-> TypeDisplay v a
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
mdTypeLine AbsBranchId
newPath) [TypeDisplay v a]
news
        let ([Pretty]
oldnums, [Pretty]
olddatas) = [(Pretty, Pretty)] -> ([Pretty], [Pretty])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Pretty, Pretty)]
olds
        let ([Pretty]
newnums, [Pretty]
newdatas) = [(Pretty, Pretty)] -> ([Pretty], [Pretty])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Pretty, Pretty)]
news
        Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty)
-> ([(Pretty, Pretty)] -> Pretty)
-> [(Pretty, Pretty)]
-> Numbered Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Pretty, Pretty)] -> Pretty
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2 ([(Pretty, Pretty)] -> Numbered Pretty)
-> [(Pretty, Pretty)] -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$
          [Pretty] -> [Pretty] -> [(Pretty, Pretty)]
forall a b. [a] -> [b] -> [(a, b)]
zip
            ([Pretty]
oldnums [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [Pretty
""] [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [Pretty]
newnums)
            ([Pretty] -> [Pretty]
forall s. (ListLike s Char, IsString s) => [Pretty s] -> [Pretty s]
P.boxLeft [Pretty]
olddatas [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [Pretty
downArrow] [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [Pretty] -> [Pretty]
forall s. (ListLike s Char, IsString s) => [Pretty s] -> [Pretty s]
P.boxLeft [Pretty]
newdatas)

    {-
    13. ┌ability Yyz
    14. └ability copies.Yyz
    -}
    prettyAddTypes :: forall a. [OBD.AddedTypeDisplay v a] -> Numbered Pretty
    prettyAddTypes :: forall a. [AddedTypeDisplay v a] -> Numbered Pretty
prettyAddTypes = ([Pretty] -> Pretty)
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
-> Numbered Pretty
forall a b.
(a -> b)
-> StateT (Int, Seq StructuredArgument) Identity a
-> StateT (Int, Seq StructuredArgument) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines (StateT (Int, Seq StructuredArgument) Identity [Pretty]
 -> Numbered Pretty)
-> ([AddedTypeDisplay v a]
    -> StateT (Int, Seq StructuredArgument) Identity [Pretty])
-> [AddedTypeDisplay v a]
-> Numbered Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AddedTypeDisplay v a -> Numbered Pretty)
-> [AddedTypeDisplay v a]
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
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 AddedTypeDisplay v a -> Numbered Pretty
prettyGroup
      where
        prettyGroup :: OBD.AddedTypeDisplay v a -> Numbered Pretty
        prettyGroup :: AddedTypeDisplay v a -> Numbered Pretty
prettyGroup ([HashQualified Name]
hqs, TypeReference
r, Maybe (DeclOrBuiltin v a)
odecl) = do
          [(Pretty, Pretty)]
pairs <- (HashQualified Name
 -> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty))
-> [HashQualified Name]
-> StateT (Int, Seq StructuredArgument) Identity [(Pretty, Pretty)]
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 (TypeReference
-> Maybe (DeclOrBuiltin v a)
-> HashQualified Name
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
prettyLine TypeReference
r Maybe (DeclOrBuiltin v a)
odecl) [HashQualified Name]
hqs
          let ([Pretty]
nums, [Pretty]
decls) = [(Pretty, Pretty)] -> ([Pretty], [Pretty])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Pretty, Pretty)]
pairs
          let boxLeft :: [Pretty] -> [Pretty]
boxLeft = case [HashQualified Name]
hqs of
                HashQualified Name
_ : HashQualified Name
_ : [HashQualified Name]
_ -> [Pretty] -> [Pretty]
forall s. (ListLike s Char, IsString s) => [Pretty s] -> [Pretty s]
P.boxLeft
                [HashQualified Name]
_ -> [Pretty] -> [Pretty]
forall a. a -> a
id
          Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty)
-> ([(Pretty, Pretty)] -> Pretty)
-> [(Pretty, Pretty)]
-> Numbered Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Pretty, Pretty)] -> Pretty
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2 ([(Pretty, Pretty)] -> Numbered Pretty)
-> [(Pretty, Pretty)] -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$ [Pretty] -> [Pretty] -> [(Pretty, Pretty)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Pretty]
nums ([Pretty] -> [Pretty]
boxLeft [Pretty]
decls)
        prettyLine :: Reference -> Maybe (DD.DeclOrBuiltin v a) -> HQ'.HashQualified Name -> Numbered (Pretty, Pretty)
        prettyLine :: TypeReference
-> Maybe (DeclOrBuiltin v a)
-> HashQualified Name
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
prettyLine TypeReference
r Maybe (DeclOrBuiltin v a)
odecl HashQualified Name
hq = do
          Pretty
n <- AbsBranchId -> HashQualified Name -> Referent -> Numbered Pretty
numHQ' AbsBranchId
newPath HashQualified Name
hq (TypeReference -> Referent
Referent.Ref TypeReference
r)
          (Pretty, Pretty)
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Pretty, Pretty)
 -> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty))
-> (Pretty -> (Pretty, Pretty))
-> Pretty
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty
n,) (Pretty
 -> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty))
-> Pretty
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Maybe (DeclOrBuiltin v a) -> Pretty
forall {v} {a}.
Var v =>
HashQualified Name -> Maybe (DeclOrBuiltin v a) -> Pretty
prettyDecl HashQualified Name
hq Maybe (DeclOrBuiltin v a)
odecl

    prettyAddTerms :: forall a. [OBD.AddedTermDisplay v a] -> Numbered Pretty
    prettyAddTerms :: forall a. [AddedTermDisplay v a] -> Numbered Pretty
prettyAddTerms = ([[(Pretty, Pretty, Pretty)]] -> Pretty)
-> StateT
     (Int, Seq StructuredArgument) Identity [[(Pretty, Pretty, Pretty)]]
-> Numbered Pretty
forall a b.
(a -> b)
-> StateT (Int, Seq StructuredArgument) Identity a
-> StateT (Int, Seq StructuredArgument) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Pretty, Pretty, Pretty)] -> Pretty
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s, Pretty s)] -> Pretty s
P.column3 ([(Pretty, Pretty, Pretty)] -> Pretty)
-> ([[(Pretty, Pretty, Pretty)]] -> [(Pretty, Pretty, Pretty)])
-> [[(Pretty, Pretty, Pretty)]]
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Pretty, Pretty, Pretty)]] -> [(Pretty, Pretty, Pretty)]
forall a. Monoid a => [a] -> a
mconcat) (StateT
   (Int, Seq StructuredArgument) Identity [[(Pretty, Pretty, Pretty)]]
 -> Numbered Pretty)
-> ([AddedTermDisplay v a]
    -> StateT
         (Int, Seq StructuredArgument)
         Identity
         [[(Pretty, Pretty, Pretty)]])
-> [AddedTermDisplay v a]
-> Numbered Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AddedTermDisplay v a
 -> StateT
      (Int, Seq StructuredArgument) Identity [(Pretty, Pretty, Pretty)])
-> [AddedTermDisplay v a]
-> StateT
     (Int, Seq StructuredArgument) Identity [[(Pretty, Pretty, Pretty)]]
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 AddedTermDisplay v a
-> StateT
     (Int, Seq StructuredArgument) Identity [(Pretty, Pretty, Pretty)]
prettyGroup ([AddedTermDisplay v a]
 -> StateT
      (Int, Seq StructuredArgument)
      Identity
      [[(Pretty, Pretty, Pretty)]])
-> ([AddedTermDisplay v a] -> [AddedTermDisplay v a])
-> [AddedTermDisplay v a]
-> StateT
     (Int, Seq StructuredArgument) Identity [[(Pretty, Pretty, Pretty)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AddedTermDisplay v a] -> [AddedTermDisplay v a]
reorderTerms
      where
        reorderTerms :: [AddedTermDisplay v a] -> [AddedTermDisplay v a]
reorderTerms = (AddedTermDisplay v a -> Bool)
-> [AddedTermDisplay v a] -> [AddedTermDisplay v a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Bool -> Bool
not (Bool -> Bool)
-> (AddedTermDisplay v a -> Bool) -> AddedTermDisplay v a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Referent -> Bool
forall r. Referent' r -> Bool
Referent.isConstructor (Referent -> Bool)
-> (AddedTermDisplay v a -> Referent)
-> AddedTermDisplay v a
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Referent (AddedTermDisplay v a) Referent
-> AddedTermDisplay v a -> Referent
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Referent (AddedTermDisplay v a) Referent
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (AddedTermDisplay v a) (AddedTermDisplay v a) Referent Referent
_2)
        prettyGroup :: OBD.AddedTermDisplay v a -> Numbered [(Pretty, Pretty, Pretty)]
        prettyGroup :: AddedTermDisplay v a
-> StateT
     (Int, Seq StructuredArgument) Identity [(Pretty, Pretty, Pretty)]
prettyGroup ([HashQualified Name]
hqs, Referent
r, Maybe (Type v a)
otype) = do
          [(Pretty, Pretty, Pretty)]
pairs <- (HashQualified Name
 -> StateT
      (Int, Seq StructuredArgument) Identity (Pretty, Pretty, Pretty))
-> [HashQualified Name]
-> StateT
     (Int, Seq StructuredArgument) Identity [(Pretty, Pretty, Pretty)]
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 (Referent
-> Maybe (Type v a)
-> HashQualified Name
-> StateT
     (Int, Seq StructuredArgument) Identity (Pretty, Pretty, Pretty)
prettyLine Referent
r Maybe (Type v a)
otype) [HashQualified Name]
hqs
          let ([Pretty]
nums, [Pretty]
names, [Pretty]
decls) = [(Pretty, Pretty, Pretty)] -> ([Pretty], [Pretty], [Pretty])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(Pretty, Pretty, Pretty)]
pairs
              boxLeft :: [Pretty] -> [Pretty]
boxLeft =
                case [HashQualified Name]
hqs of
                  HashQualified Name
_ : HashQualified Name
_ : [HashQualified Name]
_ -> [Pretty] -> [Pretty]
forall s. (ListLike s Char, IsString s) => [Pretty s] -> [Pretty s]
P.boxLeft
                  [HashQualified Name]
_ -> [Pretty] -> [Pretty]
forall a. a -> a
id
          [(Pretty, Pretty, Pretty)]
-> StateT
     (Int, Seq StructuredArgument) Identity [(Pretty, Pretty, Pretty)]
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Pretty, Pretty, Pretty)]
 -> StateT
      (Int, Seq StructuredArgument) Identity [(Pretty, Pretty, Pretty)])
-> [(Pretty, Pretty, Pretty)]
-> StateT
     (Int, Seq StructuredArgument) Identity [(Pretty, Pretty, Pretty)]
forall a b. (a -> b) -> a -> b
$ [Pretty] -> [Pretty] -> [Pretty] -> [(Pretty, Pretty, Pretty)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Pretty]
nums ([Pretty] -> [Pretty]
boxLeft [Pretty]
names) [Pretty]
decls
        prettyLine ::
          Referent ->
          Maybe (Type v a) ->
          HQ'.HashQualified Name ->
          Numbered (Pretty, Pretty, Pretty)
        prettyLine :: Referent
-> Maybe (Type v a)
-> HashQualified Name
-> StateT
     (Int, Seq StructuredArgument) Identity (Pretty, Pretty, Pretty)
prettyLine Referent
r Maybe (Type v a)
otype HashQualified Name
hq = do
          Pretty
n <- AbsBranchId -> HashQualified Name -> Referent -> Numbered Pretty
numHQ' AbsBranchId
newPath HashQualified Name
hq Referent
r
          (Pretty, Pretty, Pretty)
-> StateT
     (Int, Seq StructuredArgument) Identity (Pretty, Pretty, Pretty)
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Pretty, Pretty, Pretty)
 -> StateT
      (Int, Seq StructuredArgument) Identity (Pretty, Pretty, Pretty))
-> (Pretty -> (Pretty, Pretty, Pretty))
-> Pretty
-> StateT
     (Int, Seq StructuredArgument) Identity (Pretty, Pretty, Pretty)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty
n,HashQualified Name -> Pretty
phq' HashQualified Name
hq,) (Pretty
 -> StateT
      (Int, Seq StructuredArgument) Identity (Pretty, Pretty, Pretty))
-> Pretty
-> StateT
     (Int, Seq StructuredArgument) Identity (Pretty, Pretty, Pretty)
forall a b. (a -> b) -> a -> b
$ Pretty
": " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Maybe (Type v a) -> Pretty
forall a. Maybe (Type v a) -> Pretty
prettyType Maybe (Type v a)
otype

    {-
     Removes:

       10. ┌ oldn'busted : Nat -> Nat -> Poop
       11. └ oldn'busted'
       12.  ability BadType
       13.  patch defunctThingy
    -}
    prettyRemoveTypes :: forall a. [OBD.RemovedTypeDisplay v a] -> Numbered Pretty
    prettyRemoveTypes :: forall a. [AddedTypeDisplay v a] -> Numbered Pretty
prettyRemoveTypes = ([Pretty] -> Pretty)
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
-> Numbered Pretty
forall a b.
(a -> b)
-> StateT (Int, Seq StructuredArgument) Identity a
-> StateT (Int, Seq StructuredArgument) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines (StateT (Int, Seq StructuredArgument) Identity [Pretty]
 -> Numbered Pretty)
-> ([RemovedTypeDisplay v a]
    -> StateT (Int, Seq StructuredArgument) Identity [Pretty])
-> [RemovedTypeDisplay v a]
-> Numbered Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RemovedTypeDisplay v a -> Numbered Pretty)
-> [RemovedTypeDisplay v a]
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
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 RemovedTypeDisplay v a -> Numbered Pretty
prettyGroup
      where
        prettyGroup :: OBD.RemovedTypeDisplay v a -> Numbered Pretty
        prettyGroup :: RemovedTypeDisplay v a -> Numbered Pretty
prettyGroup ([HashQualified Name]
hqs, TypeReference
r, Maybe (DeclOrBuiltin v a)
odecl) = do
          [(Pretty, Pretty)]
lines <- (HashQualified Name
 -> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty))
-> [HashQualified Name]
-> StateT (Int, Seq StructuredArgument) Identity [(Pretty, Pretty)]
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 (TypeReference
-> Maybe (DeclOrBuiltin v a)
-> HashQualified Name
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
prettyLine TypeReference
r Maybe (DeclOrBuiltin v a)
odecl) [HashQualified Name]
hqs
          let ([Pretty]
nums, [Pretty]
decls) = [(Pretty, Pretty)] -> ([Pretty], [Pretty])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Pretty, Pretty)]
lines
              boxLeft :: [Pretty] -> [Pretty]
boxLeft = case [HashQualified Name]
hqs of HashQualified Name
_ : HashQualified Name
_ : [HashQualified Name]
_ -> [Pretty] -> [Pretty]
forall s. (ListLike s Char, IsString s) => [Pretty s] -> [Pretty s]
P.boxLeft; [HashQualified Name]
_ -> [Pretty] -> [Pretty]
forall a. a -> a
id
          Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty)
-> ([(Pretty, Pretty)] -> Pretty)
-> [(Pretty, Pretty)]
-> Numbered Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Pretty, Pretty)] -> Pretty
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2 ([(Pretty, Pretty)] -> Numbered Pretty)
-> [(Pretty, Pretty)] -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$ [Pretty] -> [Pretty] -> [(Pretty, Pretty)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Pretty]
nums ([Pretty] -> [Pretty]
boxLeft [Pretty]
decls)
        prettyLine :: Reference -> Maybe (DD.DeclOrBuiltin v a) -> HQ'.HashQualified Name -> Numbered (Pretty, Pretty)
        prettyLine :: TypeReference
-> Maybe (DeclOrBuiltin v a)
-> HashQualified Name
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
prettyLine TypeReference
r Maybe (DeclOrBuiltin v a)
odecl HashQualified Name
hq = do
          Pretty
n <- AbsBranchId -> HashQualified Name -> Referent -> Numbered Pretty
numHQ' AbsBranchId
newPath HashQualified Name
hq (TypeReference -> Referent
Referent.Ref TypeReference
r)
          (Pretty, Pretty)
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty
n, HashQualified Name -> Maybe (DeclOrBuiltin v a) -> Pretty
forall {v} {a}.
Var v =>
HashQualified Name -> Maybe (DeclOrBuiltin v a) -> Pretty
prettyDecl HashQualified Name
hq Maybe (DeclOrBuiltin v a)
odecl)

    prettyRemoveTerms :: forall a. [OBD.RemovedTermDisplay v a] -> Numbered Pretty
    prettyRemoveTerms :: forall a. [AddedTermDisplay v a] -> Numbered Pretty
prettyRemoveTerms = ([[(Pretty, Pretty, Pretty)]] -> Pretty)
-> StateT
     (Int, Seq StructuredArgument) Identity [[(Pretty, Pretty, Pretty)]]
-> Numbered Pretty
forall a b.
(a -> b)
-> StateT (Int, Seq StructuredArgument) Identity a
-> StateT (Int, Seq StructuredArgument) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Pretty, Pretty, Pretty)] -> Pretty
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s, Pretty s)] -> Pretty s
P.column3 ([(Pretty, Pretty, Pretty)] -> Pretty)
-> ([[(Pretty, Pretty, Pretty)]] -> [(Pretty, Pretty, Pretty)])
-> [[(Pretty, Pretty, Pretty)]]
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Pretty, Pretty, Pretty)]] -> [(Pretty, Pretty, Pretty)]
forall a. Monoid a => [a] -> a
mconcat) (StateT
   (Int, Seq StructuredArgument) Identity [[(Pretty, Pretty, Pretty)]]
 -> Numbered Pretty)
-> ([RemovedTermDisplay v a]
    -> StateT
         (Int, Seq StructuredArgument)
         Identity
         [[(Pretty, Pretty, Pretty)]])
-> [RemovedTermDisplay v a]
-> Numbered Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RemovedTermDisplay v a
 -> StateT
      (Int, Seq StructuredArgument) Identity [(Pretty, Pretty, Pretty)])
-> [RemovedTermDisplay v a]
-> StateT
     (Int, Seq StructuredArgument) Identity [[(Pretty, Pretty, Pretty)]]
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 RemovedTermDisplay v a
-> StateT
     (Int, Seq StructuredArgument) Identity [(Pretty, Pretty, Pretty)]
prettyGroup ([RemovedTermDisplay v a]
 -> StateT
      (Int, Seq StructuredArgument)
      Identity
      [[(Pretty, Pretty, Pretty)]])
-> ([RemovedTermDisplay v a] -> [RemovedTermDisplay v a])
-> [RemovedTermDisplay v a]
-> StateT
     (Int, Seq StructuredArgument) Identity [[(Pretty, Pretty, Pretty)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RemovedTermDisplay v a] -> [RemovedTermDisplay v a]
reorderTerms
      where
        reorderTerms :: [RemovedTermDisplay v a] -> [RemovedTermDisplay v a]
reorderTerms = (RemovedTermDisplay v a -> Bool)
-> [RemovedTermDisplay v a] -> [RemovedTermDisplay v a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Bool -> Bool
not (Bool -> Bool)
-> (RemovedTermDisplay v a -> Bool)
-> RemovedTermDisplay v a
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Referent -> Bool
forall r. Referent' r -> Bool
Referent.isConstructor (Referent -> Bool)
-> (RemovedTermDisplay v a -> Referent)
-> RemovedTermDisplay v a
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Referent (RemovedTermDisplay v a) Referent
-> RemovedTermDisplay v a -> Referent
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Referent (RemovedTermDisplay v a) Referent
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (RemovedTermDisplay v a) (RemovedTermDisplay v a) Referent Referent
_2)
        prettyGroup :: OBD.RemovedTermDisplay v a -> Numbered [(Pretty, Pretty, Pretty)]
        prettyGroup :: RemovedTermDisplay v a
-> StateT
     (Int, Seq StructuredArgument) Identity [(Pretty, Pretty, Pretty)]
prettyGroup ([], Referent
r, Maybe (Type v a)
_) =
          String
-> StateT
     (Int, Seq StructuredArgument) Identity [(Pretty, Pretty, Pretty)]
forall a. HasCallStack => String -> a
error (String
 -> StateT
      (Int, Seq StructuredArgument) Identity [(Pretty, Pretty, Pretty)])
-> String
-> StateT
     (Int, Seq StructuredArgument) Identity [(Pretty, Pretty, Pretty)]
forall a b. (a -> b) -> a -> b
$ String
"trying to remove " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Referent -> String
forall a. Show a => a -> String
show Referent
r String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" without any names."
        prettyGroup (HashQualified Name
hq1 : [HashQualified Name]
hqs, Referent
r, Maybe (Type v a)
otype) = do
          (Pretty, Pretty, Pretty)
line1 <- Referent
-> Maybe (Type v a)
-> HashQualified Name
-> StateT
     (Int, Seq StructuredArgument) Identity (Pretty, Pretty, Pretty)
prettyLine1 Referent
r Maybe (Type v a)
otype HashQualified Name
hq1
          [(Pretty, Pretty, Pretty)]
lines <- (HashQualified Name
 -> StateT
      (Int, Seq StructuredArgument) Identity (Pretty, Pretty, Pretty))
-> [HashQualified Name]
-> StateT
     (Int, Seq StructuredArgument) Identity [(Pretty, Pretty, Pretty)]
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 (Referent
-> HashQualified Name
-> StateT
     (Int, Seq StructuredArgument) Identity (Pretty, Pretty, Pretty)
prettyLine Referent
r) [HashQualified Name]
hqs
          let ([Pretty]
nums, [Pretty]
names, [Pretty]
decls) = [(Pretty, Pretty, Pretty)] -> ([Pretty], [Pretty], [Pretty])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ((Pretty, Pretty, Pretty)
line1 (Pretty, Pretty, Pretty)
-> [(Pretty, Pretty, Pretty)] -> [(Pretty, Pretty, Pretty)]
forall a. a -> [a] -> [a]
: [(Pretty, Pretty, Pretty)]
lines)
              boxLeft :: [Pretty] -> [Pretty]
boxLeft = case [HashQualified Name]
hqs of HashQualified Name
_ : [HashQualified Name]
_ -> [Pretty] -> [Pretty]
forall s. (ListLike s Char, IsString s) => [Pretty s] -> [Pretty s]
P.boxLeft; [HashQualified Name]
_ -> [Pretty] -> [Pretty]
forall a. a -> a
id
          [(Pretty, Pretty, Pretty)]
-> StateT
     (Int, Seq StructuredArgument) Identity [(Pretty, Pretty, Pretty)]
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Pretty, Pretty, Pretty)]
 -> StateT
      (Int, Seq StructuredArgument) Identity [(Pretty, Pretty, Pretty)])
-> [(Pretty, Pretty, Pretty)]
-> StateT
     (Int, Seq StructuredArgument) Identity [(Pretty, Pretty, Pretty)]
forall a b. (a -> b) -> a -> b
$ [Pretty] -> [Pretty] -> [Pretty] -> [(Pretty, Pretty, Pretty)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Pretty]
nums ([Pretty] -> [Pretty]
boxLeft [Pretty]
names) [Pretty]
decls
        prettyLine1 :: Referent
-> Maybe (Type v a)
-> HashQualified Name
-> StateT
     (Int, Seq StructuredArgument) Identity (Pretty, Pretty, Pretty)
prettyLine1 Referent
r Maybe (Type v a)
otype HashQualified Name
hq = do
          Pretty
n <- AbsBranchId -> HashQualified Name -> Referent -> Numbered Pretty
numHQ' AbsBranchId
newPath HashQualified Name
hq Referent
r
          (Pretty, Pretty, Pretty)
-> StateT
     (Int, Seq StructuredArgument) Identity (Pretty, Pretty, Pretty)
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty
n, HashQualified Name -> Pretty
phq' HashQualified Name
hq, Pretty
": " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Maybe (Type v a) -> Pretty
forall a. Maybe (Type v a) -> Pretty
prettyType Maybe (Type v a)
otype)
        prettyLine :: Referent
-> HashQualified Name
-> StateT
     (Int, Seq StructuredArgument) Identity (Pretty, Pretty, Pretty)
prettyLine Referent
r HashQualified Name
hq = do
          Pretty
n <- AbsBranchId -> HashQualified Name -> Referent -> Numbered Pretty
numHQ' AbsBranchId
newPath HashQualified Name
hq Referent
r
          (Pretty, Pretty, Pretty)
-> StateT
     (Int, Seq StructuredArgument) Identity (Pretty, Pretty, Pretty)
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty
n, HashQualified Name -> Pretty
phq' HashQualified Name
hq, Pretty
forall a. Monoid a => a
mempty)

    downArrow :: Pretty
downArrow = Pretty -> Pretty
P.bold Pretty
"↓"
    mdTypeLine :: Input.AbsBranchId -> OBD.TypeDisplay v a -> Numbered (Pretty, Pretty)
    mdTypeLine :: forall a.
AbsBranchId
-> TypeDisplay v a
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
mdTypeLine AbsBranchId
p (OBD.TypeDisplay HashQualified Name
hq TypeReference
r Maybe (DeclOrBuiltin v a)
odecl) = do
      Pretty
n <- AbsBranchId -> HashQualified Name -> Referent -> Numbered Pretty
numHQ' AbsBranchId
p HashQualified Name
hq (TypeReference -> Referent
Referent.Ref TypeReference
r)
      ([Pretty] -> (Pretty, Pretty))
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
forall a b.
(a -> b)
-> StateT (Int, Seq StructuredArgument) Identity a
-> StateT (Int, Seq StructuredArgument) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Pretty
n,) (Pretty -> (Pretty, Pretty))
-> ([Pretty] -> Pretty) -> [Pretty] -> (Pretty, Pretty)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.linesNonEmpty) (StateT (Int, Seq StructuredArgument) Identity [Pretty]
 -> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty))
-> ([Numbered Pretty]
    -> StateT (Int, Seq StructuredArgument) Identity [Pretty])
-> [Numbered Pretty]
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Numbered Pretty]
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Numbered Pretty]
 -> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty))
-> [Numbered Pretty]
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
forall a b. (a -> b) -> a -> b
$
        [ Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty) -> Pretty -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Maybe (DeclOrBuiltin v a) -> Pretty
forall {v} {a}.
Var v =>
HashQualified Name -> Maybe (DeclOrBuiltin v a) -> Pretty
prettyDecl HashQualified Name
hq Maybe (DeclOrBuiltin v a)
odecl
        ]

    -- + 2. MIT               : License
    -- - 3. AllRightsReserved : License
    mdTermLine ::
      Input.AbsBranchId ->
      P.Width ->
      OBD.TermDisplay v a ->
      Numbered (Pretty, Pretty)
    mdTermLine :: forall a.
AbsBranchId
-> Width
-> TermDisplay v a
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
mdTermLine AbsBranchId
p Width
namesWidth (OBD.TermDisplay HashQualified Name
hq Referent
r Maybe (Type v a)
otype) = do
      Pretty
n <- AbsBranchId -> HashQualified Name -> Referent -> Numbered Pretty
numHQ' AbsBranchId
p HashQualified Name
hq Referent
r
      ([Pretty] -> (Pretty, Pretty))
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
forall a b.
(a -> b)
-> StateT (Int, Seq StructuredArgument) Identity a
-> StateT (Int, Seq StructuredArgument) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Pretty
n,) (Pretty -> (Pretty, Pretty))
-> ([Pretty] -> Pretty) -> [Pretty] -> (Pretty, Pretty)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.linesNonEmpty)
        (StateT (Int, Seq StructuredArgument) Identity [Pretty]
 -> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty))
-> ([Numbered Pretty]
    -> StateT (Int, Seq StructuredArgument) Identity [Pretty])
-> [Numbered Pretty]
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Numbered Pretty]
-> StateT (Int, Seq StructuredArgument) Identity [Pretty]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
        ([Numbered Pretty]
 -> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty))
-> [Numbered Pretty]
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
forall a b. (a -> b) -> a -> b
$ [ Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty) -> Pretty -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$ Width -> Pretty -> Pretty
forall s. IsString s => Width -> Pretty s -> Pretty s
P.rightPad Width
namesWidth (HashQualified Name -> Pretty
phq' HashQualified Name
hq) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" : " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Maybe (Type v a) -> Pretty
forall a. Maybe (Type v a) -> Pretty
prettyType Maybe (Type v a)
otype
          ]

    prettyUpdateTerm :: OBD.UpdateTermDisplay v a -> Numbered Pretty
    prettyUpdateTerm :: forall a. UpdateTermDisplay v a -> Numbered Pretty
prettyUpdateTerm (OBD.UpdateTermDisplay Maybe [(HashQualified Name, Referent, Maybe (Type v a))]
Nothing [TermDisplay v a]
newTerms) =
      if [TermDisplay v a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TermDisplay v a]
newTerms
        then String -> Numbered Pretty
forall a. HasCallStack => String -> a
error String
"Super invalid UpdateTermDisplay"
        else ([(Pretty, Pretty)] -> Pretty)
-> StateT (Int, Seq StructuredArgument) Identity [(Pretty, Pretty)]
-> Numbered Pretty
forall a b.
(a -> b)
-> StateT (Int, Seq StructuredArgument) Identity a
-> StateT (Int, Seq StructuredArgument) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Pretty, Pretty)] -> Pretty
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2 (StateT (Int, Seq StructuredArgument) Identity [(Pretty, Pretty)]
 -> Numbered Pretty)
-> StateT (Int, Seq StructuredArgument) Identity [(Pretty, Pretty)]
-> Numbered Pretty
forall a b. (a -> b) -> a -> b
$ (TermDisplay v a
 -> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty))
-> [TermDisplay v a]
-> StateT (Int, Seq StructuredArgument) Identity [(Pretty, Pretty)]
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 (AbsBranchId
-> Width
-> TermDisplay v a
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
forall a.
AbsBranchId
-> Width
-> TermDisplay v a
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
mdTermLine AbsBranchId
newPath Width
namesWidth) [TermDisplay v a]
newTerms
      where
        namesWidth :: Width
namesWidth = (Width -> Width -> Width) -> [Width] -> Width
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Width -> Width -> Width
forall a. Ord a => a -> a -> a
max ([Width] -> Width) -> [Width] -> Width
forall a b. (a -> b) -> a -> b
$ (TermDisplay v a -> Width) -> [TermDisplay v a] -> [Width]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Width
P.Width (Int -> Width)
-> (TermDisplay v a -> Int) -> TermDisplay v a -> Width
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Text) -> HashQualified Name -> Int
HQ'.nameLength Name -> Text
Name.toText (HashQualified Name -> Int)
-> (TermDisplay v a -> HashQualified Name)
-> TermDisplay v a
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (HashQualified Name) (TermDisplay v a) (HashQualified Name)
-> TermDisplay v a -> HashQualified Name
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (HashQualified Name) (TermDisplay v a) (HashQualified Name)
#name) [TermDisplay v a]
newTerms
    prettyUpdateTerm (OBD.UpdateTermDisplay (Just [(HashQualified Name, Referent, Maybe (Type v a))]
olds) [TermDisplay v a]
news) = ([(Pretty, Pretty)] -> Pretty)
-> StateT (Int, Seq StructuredArgument) Identity [(Pretty, Pretty)]
-> Numbered Pretty
forall a b.
(a -> b)
-> StateT (Int, Seq StructuredArgument) Identity a
-> StateT (Int, Seq StructuredArgument) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Pretty, Pretty)] -> Pretty
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2 (StateT (Int, Seq StructuredArgument) Identity [(Pretty, Pretty)]
 -> Numbered Pretty)
-> StateT (Int, Seq StructuredArgument) Identity [(Pretty, Pretty)]
-> Numbered Pretty
forall a b. (a -> b) -> a -> b
$ do
      [(Pretty, Pretty)]
olds <-
        (TermDisplay v a
 -> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty))
-> [TermDisplay v a]
-> StateT (Int, Seq StructuredArgument) Identity [(Pretty, Pretty)]
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
          (AbsBranchId
-> Width
-> TermDisplay v a
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
forall a.
AbsBranchId
-> Width
-> TermDisplay v a
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
mdTermLine AbsBranchId
oldPath Width
namesWidth)
          [HashQualified Name
-> Referent -> Maybe (Type v a) -> TermDisplay v a
forall v a.
HashQualified Name
-> Referent -> Maybe (Type v a) -> TermDisplay v a
OBD.TermDisplay HashQualified Name
name Referent
r Maybe (Type v a)
typ | (HashQualified Name
name, Referent
r, Maybe (Type v a)
typ) <- [(HashQualified Name, Referent, Maybe (Type v a))]
olds]
      [(Pretty, Pretty)]
news <- (TermDisplay v a
 -> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty))
-> [TermDisplay v a]
-> StateT (Int, Seq StructuredArgument) Identity [(Pretty, Pretty)]
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 (AbsBranchId
-> Width
-> TermDisplay v a
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
forall a.
AbsBranchId
-> Width
-> TermDisplay v a
-> StateT (Int, Seq StructuredArgument) Identity (Pretty, Pretty)
mdTermLine AbsBranchId
newPath Width
namesWidth) [TermDisplay v a]
news
      let ([Pretty]
oldnums, [Pretty]
olddatas) = [(Pretty, Pretty)] -> ([Pretty], [Pretty])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Pretty, Pretty)]
olds
      let ([Pretty]
newnums, [Pretty]
newdatas) = [(Pretty, Pretty)] -> ([Pretty], [Pretty])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Pretty, Pretty)]
news
      [(Pretty, Pretty)]
-> StateT (Int, Seq StructuredArgument) Identity [(Pretty, Pretty)]
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Pretty, Pretty)]
 -> StateT
      (Int, Seq StructuredArgument) Identity [(Pretty, Pretty)])
-> [(Pretty, Pretty)]
-> StateT (Int, Seq StructuredArgument) Identity [(Pretty, Pretty)]
forall a b. (a -> b) -> a -> b
$
        [Pretty] -> [Pretty] -> [(Pretty, Pretty)]
forall a b. [a] -> [b] -> [(a, b)]
zip
          ([Pretty]
oldnums [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [Pretty
""] [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [Pretty]
newnums)
          ([Pretty] -> [Pretty]
forall s. (ListLike s Char, IsString s) => [Pretty s] -> [Pretty s]
P.boxLeft [Pretty]
olddatas [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [Pretty
downArrow] [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [Pretty] -> [Pretty]
forall s. (ListLike s Char, IsString s) => [Pretty s] -> [Pretty s]
P.boxLeft [Pretty]
newdatas)
      where
        namesWidth :: Width
namesWidth =
          (Width -> Width -> Width) -> [Width] -> Width
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Width -> Width -> Width
forall a. Ord a => a -> a -> a
max ([Width] -> Width) -> [Width] -> Width
forall a b. (a -> b) -> a -> b
$
            (TermDisplay v a -> Width) -> [TermDisplay v a] -> [Width]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Width
P.Width (Int -> Width)
-> (TermDisplay v a -> Int) -> TermDisplay v a -> Width
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Text) -> HashQualified Name -> Int
HQ'.nameLength Name -> Text
Name.toText (HashQualified Name -> Int)
-> (TermDisplay v a -> HashQualified Name)
-> TermDisplay v a
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (HashQualified Name) (TermDisplay v a) (HashQualified Name)
-> TermDisplay v a -> HashQualified Name
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (HashQualified Name) (TermDisplay v a) (HashQualified Name)
#name) [TermDisplay v a]
news
              [Width] -> [Width] -> [Width]
forall a. Semigroup a => a -> a -> a
<> ((HashQualified Name, Referent, Maybe (Type v a)) -> Width)
-> [(HashQualified Name, Referent, Maybe (Type v a))] -> [Width]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Width
P.Width (Int -> Width)
-> ((HashQualified Name, Referent, Maybe (Type v a)) -> Int)
-> (HashQualified Name, Referent, Maybe (Type v a))
-> Width
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Text) -> HashQualified Name -> Int
HQ'.nameLength Name -> Text
Name.toText (HashQualified Name -> Int)
-> ((HashQualified Name, Referent, Maybe (Type v a))
    -> HashQualified Name)
-> (HashQualified Name, Referent, Maybe (Type v a))
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (HashQualified Name)
  (HashQualified Name, Referent, Maybe (Type v a))
  (HashQualified Name)
-> (HashQualified Name, Referent, Maybe (Type v a))
-> HashQualified Name
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (HashQualified Name)
  (HashQualified Name, Referent, Maybe (Type v a))
  (HashQualified Name)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (HashQualified Name, Referent, Maybe (Type v a))
  (HashQualified Name, Referent, Maybe (Type v a))
  (HashQualified Name)
  (HashQualified Name)
_1) [(HashQualified Name, Referent, Maybe (Type v a))]
olds

    prettyType :: Maybe (Type v a) -> Pretty
    prettyType :: forall a. Maybe (Type v a) -> Pretty
prettyType = Pretty -> (Type v a -> Pretty) -> Maybe (Type v a) -> Pretty
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Pretty -> Pretty
P.red Pretty
"type not found") (PrettyPrintEnv -> Type v a -> Pretty
forall v a. Var v => PrettyPrintEnv -> Type v a -> Pretty
TypePrinter.pretty PrettyPrintEnv
ppe)
    prettyDecl :: HashQualified Name -> Maybe (DeclOrBuiltin v a) -> Pretty
prettyDecl HashQualified Name
hq =
      Pretty
-> (DeclOrBuiltin v a -> Pretty)
-> Maybe (DeclOrBuiltin v a)
-> Pretty
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (Pretty -> Pretty
P.red Pretty
"type not found")
        (Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> (DeclOrBuiltin v a -> Pretty (SyntaxText' TypeReference))
-> DeclOrBuiltin v a
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderUniqueTypeGuids
-> HashQualified Name
-> DeclOrBuiltin v a
-> Pretty (SyntaxText' TypeReference)
forall v a.
Var v =>
RenderUniqueTypeGuids
-> HashQualified Name
-> DeclOrBuiltin v a
-> Pretty (SyntaxText' TypeReference)
DeclPrinter.prettyDeclOrBuiltinHeader RenderUniqueTypeGuids
DeclPrinter.RenderUniqueTypeGuids'No (HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ HashQualified Name
hq))
    HashQualified Name -> Pretty
phq' :: HQ'.HashQualified Name -> Pretty = Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> (HashQualified Name -> Pretty (SyntaxText' TypeReference))
-> HashQualified Name
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified'

    numHQ' :: Input.AbsBranchId -> HQ'.HashQualified Name -> Referent -> Numbered Pretty
    numHQ' :: AbsBranchId -> HashQualified Name -> Referent -> Numbered Pretty
numHQ' AbsBranchId
prefix HashQualified Name
hq Referent
r =
      StructuredArgument -> Numbered Pretty
addNumberedArg' (StructuredArgument -> Numbered Pretty)
-> (HashQualified Name -> StructuredArgument)
-> HashQualified Name
-> Numbered Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsBranchId -> HashQualified Name -> StructuredArgument
SA.HashQualifiedWithBranchPrefix AbsBranchId
prefix (HashQualified Name -> Numbered Pretty)
-> HashQualified Name -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Referent -> HashQualified Name
HQ'.requalify HashQualified Name
hq Referent
r

    addNumberedArg' :: StructuredArgument -> Numbered Pretty
    addNumberedArg' :: StructuredArgument -> Numbered Pretty
addNumberedArg' StructuredArgument
s = case ShowNumbers
sn of
      ShowNumbers
ShowNumbers -> do
        Int
n <- StructuredArgument -> Numbered Int
addNumberedArg StructuredArgument
s
        Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pretty -> Numbered Pretty) -> Pretty -> Numbered Pretty
forall a b. (a -> b) -> a -> b
$ Int -> Pretty
padNumber Int
n
      ShowNumbers
HideNumbers -> Pretty -> Numbered Pretty
forall a. a -> StateT (Int, Seq StructuredArgument) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pretty
forall a. Monoid a => a
mempty

    padNumber :: Int -> Pretty
    padNumber :: Int -> Pretty
padNumber Int
n = Pretty -> Pretty
P.hiBlack (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty -> Pretty
forall s. IsString s => Width -> Pretty s -> Pretty s
P.rightPad Width
leftNumsWidth (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Int -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown Int
n Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."

    leftNumsWidth :: Width
leftNumsWidth = Int -> Width
P.Width (Int -> Width) -> Int -> Width
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> String
forall a. Show a => a -> String
show Int
menuSize) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String
"." :: String)

noResults :: Input.FindScope -> Pretty
noResults :: FindScope -> Pretty
noResults FindScope
fscope =
  Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"😶" (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
    [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
      [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
          Pretty
"No results. Check your spelling, or try using tab completion "
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to supply command arguments.",
        Pretty
""
      ]
        [Pretty] -> [Pretty] -> [Pretty]
forall a. [a] -> [a] -> [a]
++ case FindScope
fscope of
          FindScope
Input.FindGlobal -> []
          FindScope
_ -> [Pretty
suggestFindGlobal]
  where
    suggestFindGlobal :: Pretty
suggestFindGlobal =
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.findGlobal []
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"can be used to search outside the current namespace."

listOfDefinitions' ::
  (Var v) =>
  Input.FindScope ->
  PPE.PrettyPrintEnv -> -- for printing types of terms :-\
  E.ListDetailed ->
  [SR'.SearchResult' v a] ->
  Pretty
listOfDefinitions' :: forall v a.
Var v =>
FindScope
-> PrettyPrintEnv -> Bool -> [SearchResult' v a] -> Pretty
listOfDefinitions' FindScope
fscope PrettyPrintEnv
ppe Bool
detailed [SearchResult' v a]
results =
  if [SearchResult' v a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SearchResult' v a]
results
    then FindScope -> Pretty
noResults FindScope
fscope
    else
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        ([Pretty] -> Pretty)
-> ([Pretty] -> [Pretty]) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> [Pretty]
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> [Pretty s]
P.nonEmpty
        ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
prettyNumberedResults
          Pretty -> [Pretty] -> [Pretty]
forall a. a -> [a] -> [a]
: [ [(HashQualified Name, ShortHash)]
-> [(HashQualified Name, ShortHash)] -> Pretty
forall tm typ.
(Show tm, Show typ) =>
[(HashQualified Name, tm)] -> [(HashQualified Name, typ)] -> Pretty
formatMissingStuff [(HashQualified Name, ShortHash)]
termsWithMissingTypes [(HashQualified Name, ShortHash)]
missingTypes,
              Bool -> Pretty -> Pretty
forall a. Monoid a => Bool -> a -> a
Monoid.unlessM ([(HashQualified Name, Referent)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HashQualified Name, Referent)]
missingBuiltins)
                (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
bigproblem
                (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
                  Pretty
"I encountered an inconsistency in the codebase; these definitions refer to built-ins that this version of unison doesn't know about:"
                  Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
`P.hang` [(Pretty, Pretty)] -> Pretty
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2
                    ( (Pretty -> Pretty
P.bold Pretty
"Name", Pretty -> Pretty
P.bold Pretty
"Built-in")
                        -- : ("-", "-")
                        (Pretty, Pretty) -> [(Pretty, Pretty)] -> [(Pretty, Pretty)]
forall a. a -> [a] -> [a]
: ((HashQualified Name, Referent) -> (Pretty, Pretty))
-> [(HashQualified Name, Referent)] -> [(Pretty, Pretty)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                          ( (HashQualified Name -> Pretty)
-> (Referent -> Pretty)
-> (HashQualified Name, Referent)
-> (Pretty, Pretty)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
                              (Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> (HashQualified Name -> Pretty (SyntaxText' TypeReference))
-> HashQualified Name
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified)
                              (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty) -> (Referent -> Text) -> Referent -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Referent -> Text
Referent.toText)
                          )
                          [(HashQualified Name, Referent)]
missingBuiltins
                    )
            ]
  where
    prettyNumberedResults :: Pretty
prettyNumberedResults = [Pretty] -> Pretty
forall (f :: * -> *). Foldable f => f Pretty -> Pretty
P.numberedList [Pretty]
prettyResults
    -- todo: group this by namespace
    prettyResults :: [Pretty]
prettyResults =
      (SearchResult' v a -> Pretty) -> [SearchResult' v a] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
map
        ((TermResult' v a -> Pretty)
-> (TypeResult' v a -> Pretty) -> SearchResult' v a -> Pretty
forall v a b.
(TermResult' v a -> b)
-> (TypeResult' v a -> b) -> SearchResult' v a -> b
SR'.foldResult' TermResult' v a -> Pretty
renderTerm TypeResult' v a -> Pretty
renderType)
        ((SearchResult' v a -> Bool)
-> [SearchResult' v a] -> [SearchResult' v a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (SearchResult' v a -> Bool) -> SearchResult' v a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchResult' v a -> Bool
forall {v} {a}. SearchResult' v a -> Bool
missingType) [SearchResult' v a]
results)
      where
        (TermResult' v a -> Pretty
renderTerm, TypeResult' v a -> Pretty
renderType) =
          if Bool
detailed
            then (PrettyPrintEnv -> TermResult' v a -> Pretty
forall v a. Var v => PrettyPrintEnv -> TermResult' v a -> Pretty
unsafePrettyTermResultSigFull' PrettyPrintEnv
ppe, TypeResult' v a -> Pretty
forall v a. Var v => TypeResult' v a -> Pretty
prettyTypeResultHeaderFull')
            else (PrettyPrintEnv -> TermResult' v a -> Pretty
forall v a. Var v => PrettyPrintEnv -> TermResult' v a -> Pretty
unsafePrettyTermResultSig' PrettyPrintEnv
ppe, TypeResult' v a -> Pretty
forall v a. Var v => TypeResult' v a -> Pretty
prettyTypeResultHeader')
    missingType :: SearchResult' v a -> Bool
missingType (SR'.Tm HashQualified Name
_ Maybe (Type v a)
Nothing Referent
_ Set (HashQualified Name)
_) = Bool
True
    missingType (SR'.Tp HashQualified Name
_ (MissingObject ShortHash
_) TypeReference
_ Set (HashQualified Name)
_) = Bool
True
    missingType SearchResult' v a
_ = Bool
False
    -- termsWithTypes = [(name,t) | (name, Just t) <- sigs0 ]
    --   where sigs0 = (\(name, _, typ) -> (name, typ)) <$> terms
    termsWithMissingTypes :: [(HashQualified Name, ShortHash)]
termsWithMissingTypes =
      [ (HashQualified Name
name, TermReferenceId -> ShortHash
Reference.idToShortHash TermReferenceId
r)
        | SR'.Tm HashQualified Name
name Maybe (Type v a)
Nothing (Referent.Ref (Reference.DerivedId TermReferenceId
r)) Set (HashQualified Name)
_ <- [SearchResult' v a]
results
      ]
    missingTypes :: [(HashQualified Name, ShortHash)]
missingTypes =
      ((HashQualified Name, ShortHash) -> ShortHash)
-> [(HashQualified Name, ShortHash)]
-> [(HashQualified Name, ShortHash)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn (HashQualified Name, ShortHash) -> ShortHash
forall a b. (a, b) -> b
snd ([(HashQualified Name, ShortHash)]
 -> [(HashQualified Name, ShortHash)])
-> [(HashQualified Name, ShortHash)]
-> [(HashQualified Name, ShortHash)]
forall a b. (a -> b) -> a -> b
$
        [(HashQualified Name
name, ShortHash
r) | SR'.Tp HashQualified Name
name (MissingObject ShortHash
r) TypeReference
_ Set (HashQualified Name)
_ <- [SearchResult' v a]
results]
          [(HashQualified Name, ShortHash)]
-> [(HashQualified Name, ShortHash)]
-> [(HashQualified Name, ShortHash)]
forall a. Semigroup a => a -> a -> a
<> [ (HashQualified Name
name, TypeReference -> ShortHash
Reference.toShortHash TypeReference
r)
               | SR'.Tm HashQualified Name
name Maybe (Type v a)
Nothing (Referent -> Maybe TypeReference
forall r. Referent' r -> Maybe r
Referent.toTypeReference -> Just TypeReference
r) Set (HashQualified Name)
_ <- [SearchResult' v a]
results
             ]
    missingBuiltins :: [(HashQualified Name, Referent)]
missingBuiltins =
      [SearchResult' v a]
results [SearchResult' v a]
-> (SearchResult' v a -> [(HashQualified Name, Referent)])
-> [(HashQualified Name, Referent)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        SR'.Tm HashQualified Name
name Maybe (Type v a)
Nothing r :: Referent
r@(Referent.Ref (Reference.Builtin Text
_)) Set (HashQualified Name)
_ ->
          [(HashQualified Name
name, Referent
r)]
        SearchResult' v a
_ -> []

watchPrinter ::
  (Var v) =>
  Text ->
  PPE.PrettyPrintEnv ->
  Ann ->
  WK.WatchKind ->
  Term v () ->
  Runtime.IsCacheHit ->
  Pretty
watchPrinter :: forall v.
Var v =>
Text
-> PrettyPrintEnv -> Ann -> String -> Term v () -> Bool -> Pretty
watchPrinter Text
src PrettyPrintEnv
ppe Ann
ann String
kind Term (F v () ()) v ()
term Bool
isHit =
  Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.bracket (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
    let lines :: [Text]
lines = Text -> [Text]
Text.lines Text
src
        lineNum :: Int
lineNum = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Ann -> Maybe Int
startingLine Ann
ann
        lineNumWidth :: Int
lineNumWidth = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> String
forall a. Show a => a -> String
show Int
lineNum)
        extra :: String
extra = String
"     " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> String
forall a. Int -> a -> [a]
replicate (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
kind) Char
' ' -- for the ` | > ` after the line number
        line :: Text
line = [Text]
lines [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! (Int
lineNum Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        addCache :: Pretty -> Pretty
addCache Pretty
p = if Bool
isHit then Pretty
p Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" (cached)" else Pretty
p
        renderTest :: Term (F v () ()) v () -> Pretty
renderTest (Term.App' (Term.Constructor' (ConstructorReference TypeReference
_ ConstructorId
id)) (Term.Text' Text
msg)) =
          Pretty
"\n"
            Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> if ConstructorId
id ConstructorId -> ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorId
DD.okConstructorId
              then
                Pretty -> Pretty
addCache
                  (Pretty -> Pretty
P.green Pretty
"✅ " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.bold Pretty
"Passed" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.green (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
msg'))
              else
                if ConstructorId
id ConstructorId -> ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorId
DD.failConstructorId
                  then
                    Pretty -> Pretty
addCache
                      (Pretty -> Pretty
P.red Pretty
"🚫 " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.bold Pretty
"FAILED" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
P.red (Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
msg'))
                  else Pretty -> Pretty
P.red Pretty
"❓ " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> PrettyPrintEnv -> Term (F v () ()) v () -> Pretty
forall v a.
(HasCallStack, Var v) =>
PrettyPrintEnv -> Term v a -> Pretty
TermPrinter.pretty PrettyPrintEnv
ppe Term (F v () ()) v ()
term
          where
            msg' :: Text
msg' =
              if Int -> Text -> Text
Text.take Int
1 Text
msg Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
" "
                then Text
msg
                else Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
        renderTest Term (F v () ()) v ()
x =
          String -> Pretty
forall a. IsString a => String -> a
fromString (String -> Pretty) -> String -> Pretty
forall a b. (a -> b) -> a -> b
$ String
"\n Unison bug: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Term (F v () ()) v () -> String
forall a. Show a => a -> String
show Term (F v () ()) v ()
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is not a test."
     in [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
          [ String -> Pretty
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
lineNum) Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" | " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
line,
            case (String
kind, Term (F v () ()) v ()
term) of
              (String
WK.TestWatch, Term.List' Seq (Term (F v () ()) v ())
tests) -> (Term (F v () ()) v () -> Pretty)
-> Seq (Term (F v () ()) v ()) -> Pretty
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term (F v () ()) v () -> Pretty
renderTest Seq (Term (F v () ()) v ())
tests
              (String, Term (F v () ()) v ())
_ ->
                [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
                  [ String -> Pretty
forall a. IsString a => String -> a
fromString (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
lineNumWidth Char
' ')
                      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> String -> Pretty
forall a. IsString a => String -> a
fromString String
extra
                      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> (if Bool
isHit then Pretty -> Pretty
forall a. a -> a
id else Pretty -> Pretty
P.purple) Pretty
"⧩",
                    Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN (Int -> Width
P.Width (Int
lineNumWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
extra))
                      (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
isHit then Pretty -> Pretty
forall a. a -> a
id else Pretty -> Pretty
P.bold)
                      (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> Term (F v () ()) v () -> Pretty
forall v a.
(HasCallStack, Var v) =>
PrettyPrintEnv -> Term v a -> Pretty
TermPrinter.pretty PrettyPrintEnv
ppe Term (F v () ()) v ()
term
                  ]
          ]

filestatusTip :: Pretty
filestatusTip :: Pretty
filestatusTip = Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip Pretty
"Use `help filestatus` to learn more."

prettyDiff :: Names.Diff -> Pretty
prettyDiff :: Diff -> Pretty
prettyDiff Diff
diff =
  let orig :: Names
orig = Diff -> Names
Names.originalNames Diff
diff
      adds :: Names
adds = Diff -> Names
Names.addedNames Diff
diff
      removes :: Names
removes = Diff -> Names
Names.removedNames Diff
diff

      addedTerms :: [(Name, Referent)]
addedTerms =
        [ (Name
n, Referent
r) | (Name
n, Referent
r) <- Relation Name Referent -> [(Name, Referent)]
forall a b. Relation a b -> [(a, b)]
R.toList (Names -> Relation Name Referent
Names.terms Names
adds), Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Referent -> Relation Name Referent -> Bool
forall b a. Ord b => b -> Relation a b -> Bool
R.memberRan Referent
r (Names -> Relation Name Referent
Names.terms Names
removes)
        ]
      addedTypes :: [(Name, TypeReference)]
addedTypes =
        [ (Name
n, TypeReference
r) | (Name
n, TypeReference
r) <- Relation Name TypeReference -> [(Name, TypeReference)]
forall a b. Relation a b -> [(a, b)]
R.toList (Names -> Relation Name TypeReference
Names.types Names
adds), Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TypeReference -> Relation Name TypeReference -> Bool
forall b a. Ord b => b -> Relation a b -> Bool
R.memberRan TypeReference
r (Names -> Relation Name TypeReference
Names.types Names
removes)
        ]
      added :: [HashQualified Name]
added = (HashQualified Name -> HashQualified Name -> Ordering)
-> [HashQualified Name] -> [HashQualified Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy HashQualified Name -> HashQualified Name -> Ordering
forall n. Alphabetical n => n -> n -> Ordering
Name.compareAlphabetical ([HashQualified Name]
hqTerms [HashQualified Name]
-> [HashQualified Name] -> [HashQualified Name]
forall a. [a] -> [a] -> [a]
++ [HashQualified Name]
hqTypes)
        where
          hqTerms :: [HashQualified Name]
hqTerms = [Names
-> Name -> Either TypeReference Referent -> HashQualified Name
Names.hqName Names
adds Name
n (Referent -> Either TypeReference Referent
forall a b. b -> Either a b
Right Referent
r) | (Name
n, Referent
r) <- [(Name, Referent)]
addedTerms]
          hqTypes :: [HashQualified Name]
hqTypes = [Names
-> Name -> Either TypeReference Referent -> HashQualified Name
Names.hqName Names
adds Name
n (TypeReference -> Either TypeReference Referent
forall a b. a -> Either a b
Left TypeReference
r) | (Name
n, TypeReference
r) <- [(Name, TypeReference)]
addedTypes]

      removedTerms :: [(Name, Referent)]
removedTerms =
        [ (Name
n, Referent
r) | (Name
n, Referent
r) <- Relation Name Referent -> [(Name, Referent)]
forall a b. Relation a b -> [(a, b)]
R.toList (Names -> Relation Name Referent
Names.terms Names
removes), Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Referent -> Relation Name Referent -> Bool
forall b a. Ord b => b -> Relation a b -> Bool
R.memberRan Referent
r (Names -> Relation Name Referent
Names.terms Names
adds), Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember Name
n Set Name
addedTermsSet
        ]
        where
          addedTermsSet :: Set Name
addedTermsSet = [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList (((Name, Referent) -> Name) -> [(Name, Referent)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Referent) -> Name
forall a b. (a, b) -> a
fst [(Name, Referent)]
addedTerms)
      removedTypes :: [(Name, TypeReference)]
removedTypes =
        [ (Name
n, TypeReference
r) | (Name
n, TypeReference
r) <- Relation Name TypeReference -> [(Name, TypeReference)]
forall a b. Relation a b -> [(a, b)]
R.toList (Names -> Relation Name TypeReference
Names.types Names
removes), Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TypeReference -> Relation Name TypeReference -> Bool
forall b a. Ord b => b -> Relation a b -> Bool
R.memberRan TypeReference
r (Names -> Relation Name TypeReference
Names.types Names
adds), Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember Name
n Set Name
addedTypesSet
        ]
        where
          addedTypesSet :: Set Name
addedTypesSet = [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList (((Name, TypeReference) -> Name)
-> [(Name, TypeReference)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, TypeReference) -> Name
forall a b. (a, b) -> a
fst [(Name, TypeReference)]
addedTypes)
      removed :: [HashQualified Name]
removed = (HashQualified Name -> HashQualified Name -> Ordering)
-> [HashQualified Name] -> [HashQualified Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy HashQualified Name -> HashQualified Name -> Ordering
forall n. Alphabetical n => n -> n -> Ordering
Name.compareAlphabetical ([HashQualified Name]
hqTerms [HashQualified Name]
-> [HashQualified Name] -> [HashQualified Name]
forall a. [a] -> [a] -> [a]
++ [HashQualified Name]
hqTypes)
        where
          hqTerms :: [HashQualified Name]
hqTerms = [Names
-> Name -> Either TypeReference Referent -> HashQualified Name
Names.hqName Names
removes Name
n (Referent -> Either TypeReference Referent
forall a b. b -> Either a b
Right Referent
r) | (Name
n, Referent
r) <- [(Name, Referent)]
removedTerms]
          hqTypes :: [HashQualified Name]
hqTypes = [Names
-> Name -> Either TypeReference Referent -> HashQualified Name
Names.hqName Names
removes Name
n (TypeReference -> Either TypeReference Referent
forall a b. a -> Either a b
Left TypeReference
r) | (Name
n, TypeReference
r) <- [(Name, TypeReference)]
removedTypes]

      movedTerms :: [(Name, Name)]
movedTerms =
        [ (Name
n, Name
n2) | (Name
n, Referent
r) <- Relation Name Referent -> [(Name, Referent)]
forall a b. Relation a b -> [(a, b)]
R.toList (Names -> Relation Name Referent
Names.terms Names
removes), Name
n2 <- Set Name -> [Name]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Referent -> Relation Name Referent -> Set Name
forall b a. Ord b => b -> Relation a b -> Set a
R.lookupRan Referent
r (Names -> Relation Name Referent
Names.terms Names
adds))
        ]
      movedTypes :: [(Name, Name)]
movedTypes =
        [ (Name
n, Name
n2) | (Name
n, TypeReference
r) <- Relation Name TypeReference -> [(Name, TypeReference)]
forall a b. Relation a b -> [(a, b)]
R.toList (Names -> Relation Name TypeReference
Names.types Names
removes), Name
n2 <- Set Name -> [Name]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (TypeReference -> Relation Name TypeReference -> Set Name
forall b a. Ord b => b -> Relation a b -> Set a
R.lookupRan TypeReference
r (Names -> Relation Name TypeReference
Names.types Names
adds))
        ]
      moved :: [(Name, Name)]
moved = (Name -> Text)
-> ((Name, Name) -> Name) -> [(Name, Name)] -> [(Name, Name)]
forall a. (Name -> Text) -> (a -> Name) -> [a] -> [a]
Name.sortNamed Name -> Text
Name.toText (Name, Name) -> Name
forall a b. (a, b) -> a
fst ([(Name, Name)] -> [(Name, Name)])
-> ([(Name, Name)] -> [(Name, Name)])
-> [(Name, Name)]
-> [(Name, Name)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Name, Name)] -> [(Name, Name)]
forall a. Ord a => [a] -> [a]
nubOrd ([(Name, Name)] -> [(Name, Name)])
-> [(Name, Name)] -> [(Name, Name)]
forall a b. (a -> b) -> a -> b
$ ([(Name, Name)]
movedTerms [(Name, Name)] -> [(Name, Name)] -> [(Name, Name)]
forall a. Semigroup a => a -> a -> a
<> [(Name, Name)]
movedTypes)

      copiedTerms :: Map Name [Name]
copiedTerms =
        [(Name, Name)] -> Map Name [Name]
forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
f (k, v) -> Map k [v]
List.multimap
          [ (Name
n, Name
n2) | (Name
n2, Referent
r) <- Relation Name Referent -> [(Name, Referent)]
forall a b. Relation a b -> [(a, b)]
R.toList (Names -> Relation Name Referent
Names.terms Names
adds), Bool -> Bool
not (Referent -> Relation Name Referent -> Bool
forall b a. Ord b => b -> Relation a b -> Bool
R.memberRan Referent
r (Names -> Relation Name Referent
Names.terms Names
removes)), Name
n <- Set Name -> [Name]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Referent -> Relation Name Referent -> Set Name
forall b a. Ord b => b -> Relation a b -> Set a
R.lookupRan Referent
r (Names -> Relation Name Referent
Names.terms Names
orig))
          ]
      copiedTypes :: Map Name [Name]
copiedTypes =
        [(Name, Name)] -> Map Name [Name]
forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
f (k, v) -> Map k [v]
List.multimap
          [ (Name
n, Name
n2) | (Name
n2, TypeReference
r) <- Relation Name TypeReference -> [(Name, TypeReference)]
forall a b. Relation a b -> [(a, b)]
R.toList (Names -> Relation Name TypeReference
Names.types Names
adds), Bool -> Bool
not (TypeReference -> Relation Name TypeReference -> Bool
forall b a. Ord b => b -> Relation a b -> Bool
R.memberRan TypeReference
r (Names -> Relation Name TypeReference
Names.types Names
removes)), Name
n <- Set Name -> [Name]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (TypeReference -> Relation Name TypeReference -> Set Name
forall b a. Ord b => b -> Relation a b -> Set a
R.lookupRan TypeReference
r (Names -> Relation Name TypeReference
Names.types Names
orig))
          ]
      copied :: [(Name, [Name])]
copied =
        (Name -> Text)
-> ((Name, [Name]) -> Name) -> [(Name, [Name])] -> [(Name, [Name])]
forall a. (Name -> Text) -> (a -> Name) -> [a] -> [a]
Name.sortNamed Name -> Text
Name.toText (Name, [Name]) -> Name
forall a b. (a, b) -> a
fst ([(Name, [Name])] -> [(Name, [Name])])
-> [(Name, [Name])] -> [(Name, [Name])]
forall a b. (a -> b) -> a -> b
$
          Map Name [Name] -> [(Name, [Name])]
forall k a. Map k a -> [(k, a)]
Map.toList (([Name] -> [Name] -> [Name])
-> Map Name [Name] -> Map Name [Name] -> Map Name [Name]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
(<>) Map Name [Name]
copiedTerms Map Name [Name]
copiedTypes)
   in Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty
        Pretty
"\n\n"
        [ if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [HashQualified Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HashQualified Name]
added
            then
              [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
                [ -- todo: split out updates
                  Pretty -> Pretty
P.green Pretty
"+ Adds / updates:",
                  Pretty
"",
                  Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
                    Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty
" " (Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> (HashQualified Name -> Pretty (SyntaxText' TypeReference))
-> HashQualified Name
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified' (HashQualified Name -> Pretty) -> [HashQualified Name] -> [Pretty]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HashQualified Name]
added)
                ]
            else Pretty
forall a. Monoid a => a
mempty,
          if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [HashQualified Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HashQualified Name]
removed
            then
              [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
                [ Pretty -> Pretty
P.hiBlack Pretty
"- Deletes:",
                  Pretty
"",
                  Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> (Pretty -> Pretty) -> Pretty -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
                    Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty
" " (Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> (HashQualified Name -> Pretty (SyntaxText' TypeReference))
-> HashQualified Name
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified' (HashQualified Name -> Pretty) -> [HashQualified Name] -> [Pretty]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HashQualified Name]
removed)
                ]
            else Pretty
forall a. Monoid a => a
mempty,
          if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Name, Name)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Name, Name)]
moved
            then
              [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
                [ Pretty -> Pretty
P.purple Pretty
"> Moves:",
                  Pretty
"",
                  Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
                    [(Pretty, Pretty)] -> Pretty
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2 ([(Pretty, Pretty)] -> Pretty) -> [(Pretty, Pretty)] -> Pretty
forall a b. (a -> b) -> a -> b
$
                      (Pretty -> Pretty
P.hiBlack Pretty
"Original name", Pretty -> Pretty
P.hiBlack Pretty
"New name")
                        (Pretty, Pretty) -> [(Pretty, Pretty)] -> [(Pretty, Pretty)]
forall a. a -> [a] -> [a]
: [(Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
n, Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
n2) | (Name
n, Name
n2) <- [(Name, Name)]
moved]
                ]
            else Pretty
forall a. Monoid a => a
mempty,
          if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Name, [Name])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Name, [Name])]
copied
            then
              [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
                [ Pretty -> Pretty
P.yellow Pretty
"= Copies:",
                  Pretty
"",
                  Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
                    [(Pretty, Pretty)] -> Pretty
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2 ([(Pretty, Pretty)] -> Pretty) -> [(Pretty, Pretty)] -> Pretty
forall a b. (a -> b) -> a -> b
$
                      (Pretty -> Pretty
P.hiBlack Pretty
"Original name", Pretty -> Pretty
P.hiBlack Pretty
"New name(s)")
                        (Pretty, Pretty) -> [(Pretty, Pretty)] -> [(Pretty, Pretty)]
forall a. a -> [a] -> [a]
: [ (Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
n, Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty
" " (Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName (Name -> Pretty) -> [Name] -> [Pretty]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
ns))
                            | (Name
n, [Name]
ns) <- [(Name, [Name])]
copied
                          ]
                ]
            else Pretty
forall a. Monoid a => a
mempty
        ]

-- | Get the list of numbered args corresponding to an endangerment map, which is used by a
-- few outputs. See 'endangeredDependentsTable'.
numberedArgsForEndangerments ::
  PPED.PrettyPrintEnvDecl ->
  Map LabeledDependency (NESet LabeledDependency) ->
  NumberedArgs
numberedArgsForEndangerments :: PrettyPrintEnvDecl
-> Map LabeledDependency (NESet LabeledDependency) -> NumberedArgs
numberedArgsForEndangerments (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE -> PrettyPrintEnv
ppe) Map LabeledDependency (NESet LabeledDependency)
m =
  Map LabeledDependency (NESet LabeledDependency)
m
    Map LabeledDependency (NESet LabeledDependency)
-> (Map LabeledDependency (NESet LabeledDependency)
    -> [NESet LabeledDependency])
-> [NESet LabeledDependency]
forall a b. a -> (a -> b) -> b
& Map LabeledDependency (NESet LabeledDependency)
-> [NESet LabeledDependency]
forall k a. Map k a -> [a]
Map.elems
    [NESet LabeledDependency]
-> ([NESet LabeledDependency] -> [LabeledDependency])
-> [LabeledDependency]
forall a b. a -> (a -> b) -> b
& (NESet LabeledDependency -> [LabeledDependency])
-> [NESet LabeledDependency] -> [LabeledDependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NESet LabeledDependency -> [LabeledDependency]
forall a. NESet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    [LabeledDependency]
-> ([LabeledDependency] -> NumberedArgs) -> NumberedArgs
forall a b. a -> (a -> b) -> b
& (LabeledDependency -> StructuredArgument)
-> [LabeledDependency] -> NumberedArgs
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HashQualified Name -> StructuredArgument
SA.HashQualified (HashQualified Name -> StructuredArgument)
-> (LabeledDependency -> HashQualified Name)
-> LabeledDependency
-> StructuredArgument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintEnv -> LabeledDependency -> HashQualified Name
PPE.labeledRefName PrettyPrintEnv
ppe)

-- | Format and render all dependents which are endangered by references going extinct.
endangeredDependentsTable ::
  PPED.PrettyPrintEnvDecl ->
  Map LabeledDependency (NESet LabeledDependency) ->
  P.Pretty P.ColorText
endangeredDependentsTable :: PrettyPrintEnvDecl
-> Map LabeledDependency (NESet LabeledDependency) -> Pretty
endangeredDependentsTable PrettyPrintEnvDecl
ppeDecl Map LabeledDependency (NESet LabeledDependency)
m =
  Map LabeledDependency (NESet LabeledDependency)
m
    Map LabeledDependency (NESet LabeledDependency)
-> (Map LabeledDependency (NESet LabeledDependency)
    -> [(LabeledDependency, NESet LabeledDependency)])
-> [(LabeledDependency, NESet LabeledDependency)]
forall a b. a -> (a -> b) -> b
& Map LabeledDependency (NESet LabeledDependency)
-> [(LabeledDependency, NESet LabeledDependency)]
forall k a. Map k a -> [(k, a)]
Map.toList
    [(LabeledDependency, NESet LabeledDependency)]
-> ([(LabeledDependency, NESet LabeledDependency)]
    -> [(LabeledDependency, [LabeledDependency])])
-> [(LabeledDependency, [LabeledDependency])]
forall a b. a -> (a -> b) -> b
& ((LabeledDependency, NESet LabeledDependency)
 -> (LabeledDependency, [LabeledDependency]))
-> [(LabeledDependency, NESet LabeledDependency)]
-> [(LabeledDependency, [LabeledDependency])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NESet LabeledDependency -> [LabeledDependency])
-> (LabeledDependency, NESet LabeledDependency)
-> (LabeledDependency, [LabeledDependency])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second NESet LabeledDependency -> [LabeledDependency]
forall a. NESet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList)
    [(LabeledDependency, [LabeledDependency])]
-> ([(LabeledDependency, [LabeledDependency])]
    -> [(LabeledDependency, [(Int, LabeledDependency)])])
-> [(LabeledDependency, [(Int, LabeledDependency)])]
forall a b. a -> (a -> b) -> b
& [(LabeledDependency, [LabeledDependency])]
-> [(LabeledDependency, [(Int, LabeledDependency)])]
forall x.
[(x, [LabeledDependency])] -> [(x, [(Int, LabeledDependency)])]
numberDependents
    [(LabeledDependency, [(Int, LabeledDependency)])]
-> ([(LabeledDependency, [(Int, LabeledDependency)])]
    -> [(Pretty, Pretty)])
-> [(Pretty, Pretty)]
forall a b. a -> (a -> b) -> b
& ((LabeledDependency, [(Int, LabeledDependency)])
 -> (Pretty, Pretty))
-> [(LabeledDependency, [(Int, LabeledDependency)])]
-> [(Pretty, Pretty)]
forall a b. (a -> b) -> [a] -> [b]
map
      ( \(LabeledDependency
dependency, [(Int, LabeledDependency)]
dependents) ->
          (PrettyPrintEnv -> LabeledDependency -> Pretty
prettyLabeled PrettyPrintEnv
suffixifiedEnv LabeledDependency
dependency, [(Int, LabeledDependency)] -> Pretty
prettyDependents [(Int, LabeledDependency)]
dependents)
      )
    [(Pretty, Pretty)]
-> ([(Pretty, Pretty)] -> [(Pretty, Pretty)]) -> [(Pretty, Pretty)]
forall a b. a -> (a -> b) -> b
& (Pretty, Pretty) -> [(Pretty, Pretty)] -> [(Pretty, Pretty)]
forall a. a -> [a] -> [a]
List.intersperse (Pretty, Pretty)
spacer
    [(Pretty, Pretty)] -> ([(Pretty, Pretty)] -> Pretty) -> Pretty
forall a b. a -> (a -> b) -> b
& Pretty -> Pretty -> [(Pretty, Pretty)] -> Pretty
P.column2Header Pretty
"Dependency" Pretty
"Referenced In"
  where
    numberDependents :: [(x, [LabeledDependency])] -> [(x, [(Int, LabeledDependency)])]
    numberDependents :: forall x.
[(x, [LabeledDependency])] -> [(x, [(Int, LabeledDependency)])]
numberDependents [(x, [LabeledDependency])]
xs =
      let (Int
_acc, [(x, [(Int, LabeledDependency)])]
numbered) =
            LensLike
  (StateT Int Identity)
  [(x, [LabeledDependency])]
  [(x, [(Int, LabeledDependency)])]
  LabeledDependency
  (Int, LabeledDependency)
-> (Int -> LabeledDependency -> (Int, (Int, LabeledDependency)))
-> Int
-> [(x, [LabeledDependency])]
-> (Int, [(x, [(Int, LabeledDependency)])])
forall acc s t a b.
LensLike (State acc) s t a b
-> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
mapAccumLOf
              (((x, [LabeledDependency])
 -> StateT Int Identity (x, [(Int, LabeledDependency)]))
-> [(x, [LabeledDependency])]
-> StateT Int Identity [(x, [(Int, LabeledDependency)])]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  [(x, [LabeledDependency])]
  [(x, [(Int, LabeledDependency)])]
  (x, [LabeledDependency])
  (x, [(Int, LabeledDependency)])
traversed (((x, [LabeledDependency])
  -> StateT Int Identity (x, [(Int, LabeledDependency)]))
 -> [(x, [LabeledDependency])]
 -> StateT Int Identity [(x, [(Int, LabeledDependency)])])
-> ((LabeledDependency -> State Int (Int, LabeledDependency))
    -> (x, [LabeledDependency])
    -> StateT Int Identity (x, [(Int, LabeledDependency)]))
-> LensLike
     (StateT Int Identity)
     [(x, [LabeledDependency])]
     [(x, [(Int, LabeledDependency)])]
     LabeledDependency
     (Int, LabeledDependency)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([LabeledDependency]
 -> StateT Int Identity [(Int, LabeledDependency)])
-> (x, [LabeledDependency])
-> StateT Int Identity (x, [(Int, LabeledDependency)])
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (x, [LabeledDependency])
  (x, [(Int, LabeledDependency)])
  [LabeledDependency]
  [(Int, LabeledDependency)]
_2 (([LabeledDependency]
  -> StateT Int Identity [(Int, LabeledDependency)])
 -> (x, [LabeledDependency])
 -> StateT Int Identity (x, [(Int, LabeledDependency)]))
-> ((LabeledDependency -> State Int (Int, LabeledDependency))
    -> [LabeledDependency]
    -> StateT Int Identity [(Int, LabeledDependency)])
-> (LabeledDependency -> State Int (Int, LabeledDependency))
-> (x, [LabeledDependency])
-> StateT Int Identity (x, [(Int, LabeledDependency)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LabeledDependency -> State Int (Int, LabeledDependency))
-> [LabeledDependency]
-> StateT Int Identity [(Int, LabeledDependency)]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  [LabeledDependency]
  [(Int, LabeledDependency)]
  LabeledDependency
  (Int, LabeledDependency)
traversed)
              (\Int
n LabeledDependency
ld -> (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, (Int
n, LabeledDependency
ld)))
              Int
1
              [(x, [LabeledDependency])]
xs
       in [(x, [(Int, LabeledDependency)])]
numbered
    spacer :: (Pretty, Pretty)
spacer = (Pretty
"", Pretty
"")
    suffixifiedEnv :: PrettyPrintEnv
suffixifiedEnv = (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
ppeDecl)
    fqnEnv :: PrettyPrintEnv
fqnEnv = (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
ppeDecl)
    prettyLabeled :: PrettyPrintEnv -> LabeledDependency -> Pretty
prettyLabeled PrettyPrintEnv
ppe = \case
      LD.TermReferent Referent
ref -> PrettyPrintEnv -> Referent -> Pretty
prettyTermName PrettyPrintEnv
ppe Referent
ref
      LD.TypeReference TypeReference
ref -> PrettyPrintEnv -> TypeReference -> Pretty
prettyTypeName PrettyPrintEnv
ppe TypeReference
ref
    numArg :: Int -> Pretty
numArg = (\Int
n -> Pretty -> Pretty
P.hiBlack (Pretty -> Pretty) -> (String -> Pretty) -> String -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Pretty
forall a. IsString a => String -> a
fromString (String -> Pretty) -> String -> Pretty
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
". ")
    prettyDependents :: [(Int, LabeledDependency)] -> Pretty
prettyDependents [(Int, LabeledDependency)]
refs =
      [(Int, LabeledDependency)]
refs
        [(Int, LabeledDependency)]
-> ([(Int, LabeledDependency)] -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& ((Int, LabeledDependency) -> Pretty)
-> [(Int, LabeledDependency)] -> [Pretty]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
n, LabeledDependency
dep) -> Int -> Pretty
numArg Int
n Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> PrettyPrintEnv -> LabeledDependency -> Pretty
prettyLabeled PrettyPrintEnv
fqnEnv LabeledDependency
dep)
        [Pretty] -> ([Pretty] -> Pretty) -> Pretty
forall a b. a -> (a -> b) -> b
& [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines

listFind :: Bool -> Maybe Pretty -> [HQ.HashQualified Name] -> Pretty
listFind :: Bool -> Maybe Pretty -> [HashQualified Name] -> Pretty
listFind Bool
_ Maybe Pretty
Nothing [] = Pretty
"😶 I couldn't find any matches."
listFind Bool
_ (Just Pretty
onMissing) [] = [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines [Pretty
"😶 I couldn't find any matches.", Pretty
"", Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip Pretty
onMissing]
listFind Bool
allowLib Maybe Pretty
_ [HashQualified Name]
tms =
  Pretty -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty
"🔎" (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
    [ Pretty
"These definitions from the current namespace " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
parenthetical Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"have matches:",
      Pretty
"",
      Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ [Pretty] -> Pretty
forall (f :: * -> *). Foldable f => f Pretty -> Pretty
P.numberedList ([HashQualified Name] -> [Pretty]
forall {f :: * -> *}.
Functor f =>
f (HashQualified Name) -> f Pretty
pnames [HashQualified Name]
tms),
      Pretty
"",
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip (Int -> Pretty
forall {a}. (Eq a, Num a, Show a) => a -> Pretty
msg ([HashQualified Name] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HashQualified Name]
tms))
    ]
  where
    parenthetical :: Pretty
parenthetical = if Bool
allowLib then Pretty
"" else Pretty
"(excluding `lib`) "
    pnames :: f (HashQualified Name) -> f Pretty
pnames f (HashQualified Name)
hqs = Pretty (SyntaxText' TypeReference) -> Pretty
forall r. Pretty (SyntaxText' r) -> Pretty
P.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty)
-> (HashQualified Name -> Pretty (SyntaxText' TypeReference))
-> HashQualified Name
-> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified (HashQualified Name -> Pretty)
-> f (HashQualified Name) -> f Pretty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (HashQualified Name)
hqs
    msg :: a -> Pretty
msg a
1 = Pretty
"Try " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.edit [Pretty
"1"] Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" to bring this into your scratch file."
    msg a
n =
      Pretty
"Try "
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.edit [Pretty
"1"]
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" or "
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.edit [Pretty
"1-" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> a -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown a
n]
        Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" to bring these into your scratch file."

listDependentsOrDependencies ::
  PPE.PrettyPrintEnv ->
  Text ->
  Text ->
  Set LabeledDependency ->
  [(HQ.HashQualified Name, HQ.HashQualified Name)] ->
  [(HQ.HashQualified Name, HQ.HashQualified Name)] ->
  Pretty
listDependentsOrDependencies :: PrettyPrintEnv
-> Text
-> Text
-> Set LabeledDependency
-> [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
-> Pretty
listDependentsOrDependencies PrettyPrintEnv
ppe Text
labelStart Text
label Set LabeledDependency
lds [(HashQualified Name, HashQualified Name)]
types [(HashQualified Name, HashQualified Name)]
terms =
  if [(HashQualified Name, HashQualified Name)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HashQualified Name, HashQualified Name)]
types Bool -> Bool -> Bool
&& [(HashQualified Name, HashQualified Name)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HashQualified Name, HashQualified Name)]
terms
    then PrettyPrintEnv -> Set LabeledDependency -> Pretty
prettyLabeledDependencies PrettyPrintEnv
ppe Set LabeledDependency
lds Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" has no " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
label Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"."
    else Pretty -> [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty Pretty
"\n\n" [Pretty
hdr, Pretty
typesOut, Pretty
termsOut, Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip Pretty
msg]
  where
    msg :: Pretty
msg = Pretty
"Try " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.view [Pretty]
args Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" to see the source of any numbered item in the above list."
    args :: [Pretty]
args = [Int -> Pretty
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown ([(HashQualified Name, HashQualified Name)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(HashQualified Name, HashQualified Name)]
types Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(HashQualified Name, HashQualified Name)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(HashQualified Name, HashQualified Name)]
terms)]
    hdr :: Pretty
hdr = Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text Text
labelStart Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" of: " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> PrettyPrintEnv -> Set LabeledDependency -> Pretty
prettyLabeledDependencies PrettyPrintEnv
ppe Set LabeledDependency
lds
    typesOut :: Pretty
typesOut =
      if [(HashQualified Name, HashQualified Name)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HashQualified Name, HashQualified Name)]
types
        then Pretty
forall a. Monoid a => a
mempty
        else
          [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
            [ Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty
P.bold Pretty
"Types:",
              Pretty
"",
              Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty] -> Pretty
forall (f :: * -> *). Foldable f => f Pretty -> Pretty
P.numberedList ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$ (HashQualified Name, HashQualified Name) -> Pretty
prettyHashQualifiedFull ((HashQualified Name, HashQualified Name) -> Pretty)
-> [(HashQualified Name, HashQualified Name)] -> [Pretty]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(HashQualified Name, HashQualified Name)]
types
            ]
    termsOut :: Pretty
termsOut =
      if [(HashQualified Name, HashQualified Name)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HashQualified Name, HashQualified Name)]
terms
        then Pretty
forall a. Monoid a => a
mempty
        else
          [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
            [ Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty -> Pretty
P.bold Pretty
"Terms:",
              Pretty
"",
              Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty -> Pretty) -> ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Pretty] -> Pretty
forall (f :: * -> *). Foldable f => Int -> f Pretty -> Pretty
P.numberedListFrom ([(HashQualified Name, HashQualified Name)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(HashQualified Name, HashQualified Name)]
types) ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$ (HashQualified Name, HashQualified Name) -> Pretty
prettyHashQualifiedFull ((HashQualified Name, HashQualified Name) -> Pretty)
-> [(HashQualified Name, HashQualified Name)] -> [Pretty]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(HashQualified Name, HashQualified Name)]
terms
            ]

displayProjectBranchReflogEntries ::
  Maybe UTCTime ->
  E.MoreEntriesThanShown ->
  [ProjectReflog.Entry Project ProjectBranch (CausalHash, ShortCausalHash)] ->
  (Pretty, NumberedArgs)
displayProjectBranchReflogEntries :: Maybe UTCTime
-> MoreEntriesThanShown
-> [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
-> (Pretty, NumberedArgs)
displayProjectBranchReflogEntries Maybe UTCTime
_ MoreEntriesThanShown
_ [] =
  (Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout Pretty
"The reflog is empty", NumberedArgs
forall a. Monoid a => a
mempty)
displayProjectBranchReflogEntries Maybe UTCTime
mayNow MoreEntriesThanShown
_ [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
entries =
  let ([[Pretty]]
entryRows, NumberedArgs
numberedArgs) = (Entry Project ProjectBranch (CausalHash, ShortCausalHash)
 -> ([[Pretty]], NumberedArgs))
-> [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
-> ([[Pretty]], NumberedArgs)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Entry Project ProjectBranch (CausalHash, ShortCausalHash)
-> ([[Pretty]], NumberedArgs)
renderEntry [Entry Project ProjectBranch (CausalHash, ShortCausalHash)]
entries
      rendered :: Pretty
rendered =
        [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
          [ Pretty
header,
            Pretty
"",
            [Pretty] -> [[Pretty]] -> Pretty
P.numberedColumnNHeader ([Pretty
"Branch"] [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> Bool -> [Pretty] -> [Pretty]
forall a. Monoid a => Bool -> a -> a
Monoid.whenM (Maybe UTCTime -> Bool
forall a. Maybe a -> Bool
isJust Maybe UTCTime
mayNow) [Pretty
"When"] [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [Pretty
"Hash", Pretty
"Description"]) [[Pretty]]
entryRows
          ]
   in (Pretty
rendered, NumberedArgs
numberedArgs)
  where
    header :: Pretty
header =
      [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
            Pretty
"Below is a record of recent changes, you can use "
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.reset [Pretty
"#abcdef"]
              Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" to reset the current branch to a previous state.",
          Pretty
"",
          Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Use " Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.diffNamespace [Pretty
"1", Pretty
"7"] Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
" to compare between points in history."
        ]
    renderEntry :: ProjectReflog.Entry Project ProjectBranch (CausalHash, SCH.ShortCausalHash) -> ([[Pretty]], NumberedArgs)
    renderEntry :: Entry Project ProjectBranch (CausalHash, ShortCausalHash)
-> ([[Pretty]], NumberedArgs)
renderEntry ProjectReflog.Entry {UTCTime
time :: UTCTime
$sel:time:Entry :: forall project branch causal.
Entry project branch causal -> UTCTime
time, Project
project :: Project
$sel:project:Entry :: forall project branch causal.
Entry project branch causal -> project
project, ProjectBranch
branch :: ProjectBranch
$sel:branch:Entry :: forall project branch causal. Entry project branch causal -> branch
branch, $sel:toRootCausalHash:Entry :: forall project branch causal. Entry project branch causal -> causal
toRootCausalHash = (CausalHash
toCH, ShortCausalHash
toSCH), Text
reason :: Text
$sel:reason:Entry :: forall project branch causal. Entry project branch causal -> Text
reason} =
      ( [ [ProjectAndBranch ProjectName ProjectBranchName -> Pretty
prettyProjectAndBranchName (ProjectAndBranch ProjectName ProjectBranchName -> Pretty)
-> ProjectAndBranch ProjectName ProjectBranchName -> Pretty
forall a b. (a -> b) -> a -> b
$ ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch Project
project.name ProjectBranch
branch.name]
            [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> ( Maybe UTCTime
mayNow
                   Maybe UTCTime -> (Maybe UTCTime -> [Pretty]) -> [Pretty]
forall a b. a -> (a -> b) -> b
& (UTCTime -> [Pretty]) -> Maybe UTCTime -> [Pretty]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\UTCTime
now -> [UTCTime -> UTCTime -> Pretty
prettyHumanReadableTime UTCTime
now UTCTime
time])
               )
            [Pretty] -> [Pretty] -> [Pretty]
forall a. Semigroup a => a -> a -> a
<> [Pretty -> Pretty
P.blue (ShortCausalHash -> Pretty
forall s. IsString s => ShortCausalHash -> Pretty s
prettySCH ShortCausalHash
toSCH), Text -> Pretty
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty) -> Text -> Pretty
forall a b. (a -> b) -> a -> b
$ Text -> Text
truncateReason Text
reason]
        ],
        [CausalHash -> StructuredArgument
SA.Namespace CausalHash
toCH]
      )
    truncateReason :: Text -> Text
    truncateReason :: Text -> Text
truncateReason Text
txt = case Int -> Text -> (Text, Text)
Text.splitAt Int
60 Text
txt of
      (Text
short, Text
"") -> Text
short
      (Text
short, Text
_) -> Text
short Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"..."

constructorAliasError :: Pretty -> Pretty -> Name -> Name -> Name -> Pretty
constructorAliasError :: Pretty -> Pretty -> Name -> Name -> Name -> Pretty
constructorAliasError Pretty
verb Pretty
theType Name
typeName Name
conName1 Name
conName2 =
  [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
    [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Sorry, I wasn't able to perform the" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty
verb Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
":"),
      Pretty
"",
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
theType
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
typeName
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"has a constructor with multiple names, and I can't"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
verb
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"in this situation:",
      Pretty
"",
      Width -> Pretty -> Pretty
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 ([Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
f (Pretty s) -> Pretty s
P.bulleted [Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
conName1, Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
conName2]),
      Pretty
"",
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
"Please"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.deleteForce
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"all but one name for each constructor, and then try"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
verb
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"again."
    ]

missingConstructorNameError :: Pretty -> Pretty -> Name -> Pretty
missingConstructorNameError :: Pretty -> Pretty -> Name -> Pretty
missingConstructorNameError Pretty
command Pretty
theType Name
name =
  [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty] -> Pretty) -> [Pretty] -> Pretty
forall a b. (a -> b) -> a -> b
$
    [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$ Pretty
"Sorry, I wasn't able to perform the" Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty
command Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
":"),
      Pretty
"",
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
theType
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
name
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"has some constructors with missing names, and I can't"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
command
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"in this situation.",
      Pretty
"",
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
"You can use"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.view [Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
name]
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"and"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty] -> Pretty
IP.makeExample InputPattern
IP.aliasTerm [Pretty
"<hash>", Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
name Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".<ConstructorName>"]
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to give names to each unnamed constructor, and then try"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
command
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"again."
    ]

nestedDeclAliasError :: Pretty -> Pretty -> Name -> Name -> Pretty
nestedDeclAliasError :: Pretty -> Pretty -> Name -> Name -> Pretty
nestedDeclAliasError Pretty
theType Pretty
verb Name
shorterName Name
longerName =
  Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
    Pretty
theType
      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
longerName
      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"is an alias of"
      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
shorterName Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
".")
      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"I'm not able to"
      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
verb
      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"when a type exists nested under an alias of itself. Please separate them or"
      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.deleteForce
      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"one copy, and then try"
      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
verb
      Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"again."

strayConstructorError :: Pretty -> Pretty -> Name -> Pretty
strayConstructorError :: Pretty -> Pretty -> Name -> Pretty
strayConstructorError Pretty
verb Pretty
theConstructor Name
name =
  [Pretty] -> Pretty
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
    [ Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
"Sorry, I wasn't able to perform the"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty -> Pretty
forall s. Pretty s -> Pretty s
P.group (Pretty
verb Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
",")
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"because I need all constructor names to be nested somewhere beneath the corresponding type name.",
      Pretty
"",
      Pretty -> Pretty
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty -> Pretty) -> Pretty -> Pretty
forall a b. (a -> b) -> a -> b
$
        Pretty
theConstructor
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Name -> Pretty
forall s. IsString s => Name -> Pretty s
prettyName Name
name
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"is not nested beneath the corresponding type name. Please either use"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.moveAll
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"to move it, or if it's an extra copy, you can simply"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty
IP.makeExample' InputPattern
IP.deleteForce
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"it. Then try"
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
verb
          Pretty -> Pretty -> Pretty
forall a. Semigroup a => a -> a -> a
<> Pretty
"again."
    ]

prettyEmptyBranchDiff :: Pretty
prettyEmptyBranchDiff :: Pretty
prettyEmptyBranchDiff =
  Pretty
"Those branches are the same."