{-# LANGUAGE RecordWildCards #-}

module Unison.Codebase.Editor.SlurpResult
  ( -- * Slurp result
    SlurpResult (..),
    Aliases (..),

    -- ** Predicates
    isOk,
    isAllDuplicates,
    hasAddsOrUpdates,

    -- ** Filtering a Unison file
    filterUnisonFile,

    -- ** Pretty-printing
    pretty,

    -- * Definion status
    Status (..),
    prettyStatus,
  )
where

import Data.List qualified as List
import Data.Map qualified as Map
import Data.Set qualified as Set
import Unison.Codebase.Editor.SlurpComponent (SlurpComponent (..))
import Unison.Codebase.Editor.SlurpComponent qualified as SC
import Unison.Name (Name)
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.Symbol (Symbol)
import Unison.Syntax.DeclPrinter qualified as DeclPrinter
import Unison.Syntax.HashQualified qualified as HQ (unsafeFromVar)
import Unison.Syntax.Name qualified as Name (toText)
import Unison.Syntax.TypePrinter qualified as TP
import Unison.UnisonFile qualified as UF
import Unison.Util.Pretty qualified as P
import Unison.Var (Var)
import Unison.Var qualified as Var

-- `oldRefNames` are the previously existing names for the old reference
--   (these names will all be pointed to a new reference)
-- `newRefNames` are the previously existing names for the new reference
--   (the reference that all the old names will point to after the update)
data Aliases
  = AddAliases (Set Name)
  | UpdateAliases
      { Aliases -> Set Name
oldRefNames :: Set Name,
        Aliases -> Set Name
newRefNames :: Set Name
      }
  deriving (Int -> Aliases -> ShowS
[Aliases] -> ShowS
Aliases -> String
(Int -> Aliases -> ShowS)
-> (Aliases -> String) -> ([Aliases] -> ShowS) -> Show Aliases
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Aliases -> ShowS
showsPrec :: Int -> Aliases -> ShowS
$cshow :: Aliases -> String
show :: Aliases -> String
$cshowList :: [Aliases] -> ShowS
showList :: [Aliases] -> ShowS
Show, Aliases -> Aliases -> Bool
(Aliases -> Aliases -> Bool)
-> (Aliases -> Aliases -> Bool) -> Eq Aliases
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Aliases -> Aliases -> Bool
== :: Aliases -> Aliases -> Bool
$c/= :: Aliases -> Aliases -> Bool
/= :: Aliases -> Aliases -> Bool
Eq, Eq Aliases
Eq Aliases =>
(Aliases -> Aliases -> Ordering)
-> (Aliases -> Aliases -> Bool)
-> (Aliases -> Aliases -> Bool)
-> (Aliases -> Aliases -> Bool)
-> (Aliases -> Aliases -> Bool)
-> (Aliases -> Aliases -> Aliases)
-> (Aliases -> Aliases -> Aliases)
-> Ord Aliases
Aliases -> Aliases -> Bool
Aliases -> Aliases -> Ordering
Aliases -> Aliases -> Aliases
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Aliases -> Aliases -> Ordering
compare :: Aliases -> Aliases -> Ordering
$c< :: Aliases -> Aliases -> Bool
< :: Aliases -> Aliases -> Bool
$c<= :: Aliases -> Aliases -> Bool
<= :: Aliases -> Aliases -> Bool
$c> :: Aliases -> Aliases -> Bool
> :: Aliases -> Aliases -> Bool
$c>= :: Aliases -> Aliases -> Bool
>= :: Aliases -> Aliases -> Bool
$cmax :: Aliases -> Aliases -> Aliases
max :: Aliases -> Aliases -> Aliases
$cmin :: Aliases -> Aliases -> Aliases
min :: Aliases -> Aliases -> Aliases
Ord)

data SlurpResult = SlurpResult
  { -- The file that we tried to add from
    SlurpResult -> TypecheckedUnisonFile Symbol Ann
originalFile :: UF.TypecheckedUnisonFile Symbol Ann,
    -- Extra definitions that were added to satisfy transitive closure,
    -- beyond what the user specified.
    SlurpResult -> SlurpComponent
extraDefinitions :: SlurpComponent,
    -- Previously existed only in the file; now added to the codebase.
    SlurpResult -> SlurpComponent
adds :: SlurpComponent,
    -- Exists in the branch and the file, with the same name and contents.
    SlurpResult -> SlurpComponent
duplicates :: SlurpComponent,
    -- Not added to codebase due to the name already existing
    -- in the branch with a different definition.
    -- I.e. an update is required but we're performing an add.
    SlurpResult -> SlurpComponent
collisions :: SlurpComponent,
    -- Names that already exist in the branch, but whose definitions
    -- in `originalFile` are treated as updates.
    SlurpResult -> SlurpComponent
updates :: SlurpComponent,
    -- Names of terms in `originalFile` that couldn't be updated because
    -- they refer to existing constructors. (User should instead do a find/replace,
    -- a constructor rename, or refactor the type that the name comes from).
    SlurpResult -> Set Symbol
termExistingConstructorCollisions :: Set Symbol,
    SlurpResult -> Set Symbol
constructorExistingTermCollisions :: Set Symbol,
    -- -- Already defined in the branch, but with a different name.
    SlurpResult -> Map Symbol Aliases
termAlias :: Map Symbol Aliases,
    SlurpResult -> Map Symbol Aliases
typeAlias :: Map Symbol Aliases,
    SlurpResult -> SlurpComponent
defsWithBlockedDependencies :: SlurpComponent
  }
  deriving (Int -> SlurpResult -> ShowS
[SlurpResult] -> ShowS
SlurpResult -> String
(Int -> SlurpResult -> ShowS)
-> (SlurpResult -> String)
-> ([SlurpResult] -> ShowS)
-> Show SlurpResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SlurpResult -> ShowS
showsPrec :: Int -> SlurpResult -> ShowS
$cshow :: SlurpResult -> String
show :: SlurpResult -> String
$cshowList :: [SlurpResult] -> ShowS
showList :: [SlurpResult] -> ShowS
Show)

hasAddsOrUpdates :: SlurpResult -> Bool
hasAddsOrUpdates :: SlurpResult -> Bool
hasAddsOrUpdates SlurpResult
s =
  -- We intentionally ignore constructors here since they are added as part of adding their
  -- types.
  let SC.SlurpComponent {$sel:terms:SlurpComponent :: SlurpComponent -> Set Symbol
terms = Set Symbol
termAdds, $sel:types:SlurpComponent :: SlurpComponent -> Set Symbol
types = Set Symbol
typeAdds} = SlurpResult -> SlurpComponent
adds SlurpResult
s
      SC.SlurpComponent {$sel:terms:SlurpComponent :: SlurpComponent -> Set Symbol
terms = Set Symbol
termUpdates, $sel:types:SlurpComponent :: SlurpComponent -> Set Symbol
types = Set Symbol
typeUpdates} = SlurpResult -> SlurpComponent
updates SlurpResult
s
   in Bool -> Bool
not (Bool -> Bool) -> (Set Symbol -> Bool) -> Set Symbol -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Symbol -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Set Symbol -> Bool) -> Set Symbol -> Bool
forall a b. (a -> b) -> a -> b
$ Set Symbol
termAdds Set Symbol -> Set Symbol -> Set Symbol
forall a. Semigroup a => a -> a -> a
<> Set Symbol
typeAdds Set Symbol -> Set Symbol -> Set Symbol
forall a. Semigroup a => a -> a -> a
<> Set Symbol
termUpdates Set Symbol -> Set Symbol -> Set Symbol
forall a. Semigroup a => a -> a -> a
<> Set Symbol
typeUpdates

data Status
  = Add
  | Update
  | Duplicate
  | Collision
  | TermExistingConstructorCollision
  | ConstructorExistingTermCollision
  | ExtraDefinition
  | BlockedDependency
  deriving (Eq Status
Eq Status =>
(Status -> Status -> Ordering)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Status)
-> (Status -> Status -> Status)
-> Ord Status
Status -> Status -> Bool
Status -> Status -> Ordering
Status -> Status -> Status
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Status -> Status -> Ordering
compare :: Status -> Status -> Ordering
$c< :: Status -> Status -> Bool
< :: Status -> Status -> Bool
$c<= :: Status -> Status -> Bool
<= :: Status -> Status -> Bool
$c> :: Status -> Status -> Bool
> :: Status -> Status -> Bool
$c>= :: Status -> Status -> Bool
>= :: Status -> Status -> Bool
$cmax :: Status -> Status -> Status
max :: Status -> Status -> Status
$cmin :: Status -> Status -> Status
min :: Status -> Status -> Status
Ord, Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
/= :: Status -> Status -> Bool
Eq, Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Status -> ShowS
showsPrec :: Int -> Status -> ShowS
$cshow :: Status -> String
show :: Status -> String
$cshowList :: [Status] -> ShowS
showList :: [Status] -> ShowS
Show)

prettyStatus :: Status -> P.Pretty P.ColorText
prettyStatus :: Status -> Pretty ColorText
prettyStatus Status
s = case Status
s of
  Status
Add -> Pretty ColorText
"added"
  Status
Update -> Pretty ColorText
"updated"
  Status
Collision -> Pretty ColorText
"needs update"
  Status
Duplicate -> Pretty ColorText
"duplicate"
  Status
TermExistingConstructorCollision -> Pretty ColorText
"term/ctor collision"
  Status
ConstructorExistingTermCollision -> Pretty ColorText
"ctor/term collision"
  Status
BlockedDependency -> Pretty ColorText
"blocked"
  Status
ExtraDefinition -> Pretty ColorText
"extra dependency"

type IsPastTense = Bool

prettyVar :: (Var v) => v -> P.Pretty P.ColorText
prettyVar :: forall v. Var v => v -> Pretty ColorText
prettyVar = Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty ColorText) -> (v -> Text) -> v -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Text
forall v. Var v => v -> Text
Var.name

aliasesToShow :: Int
aliasesToShow :: Int
aliasesToShow = Int
5

pretty ::
  IsPastTense ->
  PPE.PrettyPrintEnv ->
  SlurpResult ->
  P.Pretty P.ColorText
pretty :: Bool -> PrettyPrintEnv -> SlurpResult -> Pretty ColorText
pretty Bool
isPast PrettyPrintEnv
ppe SlurpResult
sr =
  let tms :: Map
  Symbol
  (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
tms = TypecheckedUnisonFile Symbol Ann
-> Map
     Symbol
     (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, Reference, Maybe String, Term v a, Type v a)
UF.hashTerms (SlurpResult -> TypecheckedUnisonFile Symbol Ann
originalFile SlurpResult
sr)
      goodIcon :: Pretty ColorText
goodIcon = Pretty ColorText -> Pretty ColorText
P.green Pretty ColorText
"⍟ "
      badIcon :: Pretty ColorText
badIcon = Pretty ColorText -> Pretty ColorText
P.red Pretty ColorText
"x "
      plus :: Pretty ColorText
plus = Pretty ColorText -> Pretty ColorText
P.green Pretty ColorText
"  "
      oxfordAliases :: [Pretty s] -> a -> Pretty s -> Pretty s
oxfordAliases [Pretty s]
shown a
sz Pretty s
end =
        Pretty s -> [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.oxfordCommasWith Pretty s
end ([Pretty s] -> Pretty s) -> [Pretty s] -> Pretty s
forall a b. (a -> b) -> a -> b
$
          [Pretty s]
shown [Pretty s] -> [Pretty s] -> [Pretty s]
forall a. [a] -> [a] -> [a]
++ case a
sz of
            a
0 -> []
            a
n -> [a -> Pretty s
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown a
n Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
" more"]
      okType :: Symbol -> Pretty ColorText
okType Symbol
v = (Pretty ColorText
plus Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<>) (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ case Symbol
-> TypecheckedUnisonFile Symbol Ann -> Maybe (Id, Decl Symbol Ann)
forall v a.
Ord v =>
v -> TypecheckedUnisonFile v a -> Maybe (Id, Decl v a)
UF.lookupDecl Symbol
v (SlurpResult -> TypecheckedUnisonFile Symbol Ann
originalFile SlurpResult
sr) of
        Just (Id
_, Decl Symbol Ann
dd) ->
          Pretty (SyntaxText' Reference) -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
P.syntaxToColor (HashQualified Name
-> Decl Symbol Ann -> Pretty (SyntaxText' Reference)
forall v a.
Var v =>
HashQualified Name
-> Either (EffectDeclaration v a) (DataDeclaration v a)
-> Pretty (SyntaxText' Reference)
DeclPrinter.prettyDeclHeader (Symbol -> HashQualified Name
forall v. Var v => v -> HashQualified Name
HQ.unsafeFromVar Symbol
v) Decl Symbol Ann
dd)
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> if [Pretty ColorText] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pretty ColorText]
aliases
              then Pretty ColorText
forall a. Monoid a => a
mempty
              else Pretty ColorText
forall s. IsString s => Pretty s
P.newline Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 ([Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines [Pretty ColorText]
aliases)
          where
            aliases :: [Pretty ColorText]
aliases = Maybe Aliases -> [Pretty ColorText]
aliasesMessage (Maybe Aliases -> [Pretty ColorText])
-> (Map Symbol Aliases -> Maybe Aliases)
-> Map Symbol Aliases
-> [Pretty ColorText]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Map Symbol Aliases -> Maybe Aliases
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Symbol
v (Map Symbol Aliases -> [Pretty ColorText])
-> Map Symbol Aliases -> [Pretty ColorText]
forall a b. (a -> b) -> a -> b
$ SlurpResult -> Map Symbol Aliases
typeAlias SlurpResult
sr
        Maybe (Id, Decl Symbol Ann)
Nothing -> Pretty ColorText -> Pretty ColorText
P.bold (Symbol -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar Symbol
v) Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
P.red Pretty ColorText
" (Unison bug, unknown type)"

      aliasesMessage :: Maybe Aliases -> [Pretty ColorText]
aliasesMessage Maybe Aliases
aliases = case Maybe Aliases
aliases of
        Maybe Aliases
Nothing -> []
        Just (AddAliases (Int -> [Name] -> ([Name], [Name])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
aliasesToShow ([Name] -> ([Name], [Name]))
-> (Set Name -> [Name]) -> Set Name -> ([Name], [Name])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Name -> [Name]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList -> ([Name]
shown, [Name]
rest))) ->
          [ Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
              Pretty ColorText -> Pretty ColorText
P.hiBlack Pretty ColorText
"(also named "
                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Pretty ColorText] -> Int -> Pretty ColorText -> Pretty ColorText
forall {s} {a}.
(IsString s, Eq a, Num a, Show a) =>
[Pretty s] -> a -> Pretty s -> Pretty s
oxfordAliases
                  (Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty ColorText)
-> (Name -> Text) -> Name -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
Name.toText (Name -> Pretty ColorText) -> [Name] -> [Pretty ColorText]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
shown)
                  ([Name] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
rest)
                  (Pretty ColorText -> Pretty ColorText
P.hiBlack Pretty ColorText
")")
          ]
        Just (UpdateAliases Set Name
oldNames Set Name
newNames) ->
          let oldMessage :: Pretty ColorText
oldMessage =
                let ([Name]
shown, [Name]
rest) = Int -> [Name] -> ([Name], [Name])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
aliasesToShow ([Name] -> ([Name], [Name])) -> [Name] -> ([Name], [Name])
forall a b. (a -> b) -> a -> b
$ Set Name -> [Name]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Name
oldNames
                 in Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN
                      Width
2
                      ( Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                          Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s
P.parenthesize (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                            Pretty ColorText -> Pretty ColorText
P.hiBlack
                              ( Pretty ColorText
"The old definition "
                                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> (if Bool
isPast then Pretty ColorText
"was" else Pretty ColorText
"is")
                                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" also named "
                              )
                              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Pretty ColorText] -> Int -> Pretty ColorText -> Pretty ColorText
forall {s} {a}.
(IsString s, Eq a, Num a, Show a) =>
[Pretty s] -> a -> Pretty s -> Pretty s
oxfordAliases (Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty ColorText)
-> (Name -> Text) -> Name -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
Name.toText (Name -> Pretty ColorText) -> [Name] -> [Pretty ColorText]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
shown) ([Name] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
rest) (Pretty ColorText -> Pretty ColorText
P.hiBlack Pretty ColorText
".")
                      )
              newMessage :: Pretty ColorText
newMessage =
                let ([Name]
shown, [Name]
rest) = Int -> [Name] -> ([Name], [Name])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
aliasesToShow ([Name] -> ([Name], [Name])) -> [Name] -> ([Name], [Name])
forall a b. (a -> b) -> a -> b
$ Set Name -> [Name]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Name
newNames
                    sz :: Int
sz = [Name] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
rest
                 in Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN
                      Width
2
                      ( Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                          Pretty ColorText -> Pretty ColorText
P.hiBlack Pretty ColorText
"(The new definition is already named "
                            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Pretty ColorText] -> Int -> Pretty ColorText -> Pretty ColorText
forall {s} {a}.
(IsString s, Eq a, Num a, Show a) =>
[Pretty s] -> a -> Pretty s -> Pretty s
oxfordAliases (Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty ColorText)
-> (Name -> Text) -> Name -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
Name.toText (Name -> Pretty ColorText) -> [Name] -> [Pretty ColorText]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
shown) Int
sz (Pretty ColorText -> Pretty ColorText
P.hiBlack Pretty ColorText
" as well.)")
                      )
           in (if Set Name -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Name
oldNames then [Pretty ColorText]
forall a. Monoid a => a
mempty else [Pretty ColorText
oldMessage])
                [Pretty ColorText] -> [Pretty ColorText] -> [Pretty ColorText]
forall a. [a] -> [a] -> [a]
++ (if Set Name -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Name
newNames then [Pretty ColorText]
forall a. Monoid a => a
mempty else [Pretty ColorText
newMessage])

      -- The second field in the result is an optional second column.
      okTerm :: Symbol -> [(P.Pretty P.ColorText, Maybe (P.Pretty P.ColorText))]
      okTerm :: Symbol -> [(Pretty ColorText, Maybe (Pretty ColorText))]
okTerm Symbol
v = case Symbol
-> Map
     Symbol
     (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
-> Maybe
     (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Symbol
v Map
  Symbol
  (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
tms of
        Maybe
  (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
Nothing ->
          [(Pretty ColorText -> Pretty ColorText
P.bold (Symbol -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar Symbol
v), Pretty ColorText -> Maybe (Pretty ColorText)
forall a. a -> Maybe a
Just (Pretty ColorText -> Maybe (Pretty ColorText))
-> Pretty ColorText -> Maybe (Pretty ColorText)
forall a b. (a -> b) -> a -> b
$ Pretty ColorText -> Pretty ColorText
P.red Pretty ColorText
"(Unison bug, unknown term)")]
        Just (Ann
_, Reference
_, Maybe String
_, Term Symbol Ann
_, Type Symbol Ann
ty) ->
          ( Pretty ColorText
plus Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
P.bold (Symbol -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar Symbol
v),
            Pretty ColorText -> Maybe (Pretty ColorText)
forall a. a -> Maybe a
Just (Pretty ColorText -> Maybe (Pretty ColorText))
-> Pretty ColorText -> Maybe (Pretty ColorText)
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
": " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentNAfterNewline Width
2 (PrettyPrintEnv -> Type Symbol Ann -> Pretty ColorText
forall v a. Var v => PrettyPrintEnv -> Type v a -> Pretty ColorText
TP.pretty PrettyPrintEnv
ppe Type Symbol Ann
ty)
          )
            (Pretty ColorText, Maybe (Pretty ColorText))
-> [(Pretty ColorText, Maybe (Pretty ColorText))]
-> [(Pretty ColorText, Maybe (Pretty ColorText))]
forall a. a -> [a] -> [a]
: ((,Maybe (Pretty ColorText)
forall a. Maybe a
Nothing) (Pretty ColorText -> (Pretty ColorText, Maybe (Pretty ColorText)))
-> [Pretty ColorText]
-> [(Pretty ColorText, Maybe (Pretty ColorText))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pretty ColorText]
aliases)
          where
            aliases :: [Pretty ColorText]
aliases = (Pretty ColorText -> Pretty ColorText)
-> [Pretty ColorText] -> [Pretty ColorText]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2) ([Pretty ColorText] -> [Pretty ColorText])
-> (Map Symbol Aliases -> [Pretty ColorText])
-> Map Symbol Aliases
-> [Pretty ColorText]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Aliases -> [Pretty ColorText]
aliasesMessage (Maybe Aliases -> [Pretty ColorText])
-> (Map Symbol Aliases -> Maybe Aliases)
-> Map Symbol Aliases
-> [Pretty ColorText]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Map Symbol Aliases -> Maybe Aliases
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Symbol
v (Map Symbol Aliases -> [Pretty ColorText])
-> Map Symbol Aliases -> [Pretty ColorText]
forall a b. (a -> b) -> a -> b
$ SlurpResult -> Map Symbol Aliases
termAlias SlurpResult
sr
      ok :: Pretty ColorText
-> Pretty ColorText -> SlurpComponent -> Pretty ColorText
ok Pretty ColorText
_ Pretty ColorText
_ SlurpComponent
sc | Set Symbol -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (SlurpComponent -> Set Symbol
SC.terms SlurpComponent
sc) Bool -> Bool -> Bool
&& Set Symbol -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (SlurpComponent -> Set Symbol
SC.types SlurpComponent
sc) = Pretty ColorText
forall a. Monoid a => a
mempty
      ok Pretty ColorText
past Pretty ColorText
present SlurpComponent
sc =
        let header :: Pretty ColorText
header =
              Pretty ColorText
goodIcon
                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentNAfterNewline
                  Width
2
                  (Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (if Bool
isPast then Pretty ColorText
past else Pretty ColorText
present))
            updatedTypes :: Pretty ColorText
updatedTypes = [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty ColorText] -> Pretty ColorText)
-> [Pretty ColorText] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Symbol -> Pretty ColorText
okType (Symbol -> Pretty ColorText) -> [Symbol] -> [Pretty ColorText]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Symbol -> [Symbol]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (SlurpComponent -> Set Symbol
SC.types SlurpComponent
sc)
            updatedTerms :: Pretty ColorText
updatedTerms = [(Pretty ColorText, Maybe (Pretty ColorText))] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Maybe (Pretty s))] -> Pretty s
P.mayColumn2 ([(Pretty ColorText, Maybe (Pretty ColorText))]
 -> Pretty ColorText)
-> (Set Symbol -> [(Pretty ColorText, Maybe (Pretty ColorText))])
-> Set Symbol
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol -> [(Pretty ColorText, Maybe (Pretty ColorText))])
-> [Symbol] -> [(Pretty ColorText, Maybe (Pretty ColorText))]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) Symbol -> [(Pretty ColorText, Maybe (Pretty ColorText))]
okTerm ([Symbol] -> [(Pretty ColorText, Maybe (Pretty ColorText))])
-> (Set Symbol -> [Symbol])
-> Set Symbol
-> [(Pretty ColorText, Maybe (Pretty ColorText))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Symbol -> [Symbol]
forall a. Set a -> [a]
Set.toList (Set Symbol -> Pretty ColorText) -> Set Symbol -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ SlurpComponent -> Set Symbol
SC.terms SlurpComponent
sc
         in Pretty ColorText
header Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"\n\n" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.linesNonEmpty [Pretty ColorText
updatedTypes, Pretty ColorText
updatedTerms]
      okToUpdate :: SlurpComponent -> Pretty ColorText
okToUpdate =
        Pretty ColorText
-> Pretty ColorText -> SlurpComponent -> Pretty ColorText
ok
          (Pretty ColorText -> Pretty ColorText
P.green Pretty ColorText
"I've updated these names to your new definition:")
          ( Pretty ColorText -> Pretty ColorText
P.green (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
              Pretty ColorText
"These names already exist. You can `update` them "
                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"to your new definition:"
          )
      okToAdd :: SlurpComponent -> Pretty ColorText
okToAdd =
        Pretty ColorText
-> Pretty ColorText -> SlurpComponent -> Pretty ColorText
ok
          (Pretty ColorText -> Pretty ColorText
P.green Pretty ColorText
"I've added these definitions:")
          (Pretty ColorText -> Pretty ColorText
P.green Pretty ColorText
"These new definitions are ok to `add`:")
      notOks :: Pretty ColorText
-> Pretty ColorText -> SlurpResult -> Pretty ColorText
notOks Pretty ColorText
_past Pretty ColorText
_present SlurpResult
sr | SlurpResult -> Bool
isOk SlurpResult
sr = Pretty ColorText
forall a. Monoid a => a
mempty
      notOks Pretty ColorText
past Pretty ColorText
present SlurpResult
sr =
        let header :: Pretty ColorText
header =
              Pretty ColorText
badIcon
                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentNAfterNewline
                  Width
2
                  (Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (if Bool
isPast then Pretty ColorText
past else Pretty ColorText
present))
            typeLineFor :: Status -> Symbol -> (Pretty ColorText, Pretty ColorText)
typeLineFor Status
status Symbol
v = case Symbol
-> TypecheckedUnisonFile Symbol Ann -> Maybe (Id, Decl Symbol Ann)
forall v a.
Ord v =>
v -> TypecheckedUnisonFile v a -> Maybe (Id, Decl v a)
UF.lookupDecl Symbol
v (SlurpResult -> TypecheckedUnisonFile Symbol Ann
originalFile SlurpResult
sr) of
              Just (Id
_, Decl Symbol Ann
dd) ->
                ( Status -> Pretty ColorText
prettyStatus Status
status,
                  Pretty (SyntaxText' Reference) -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
P.syntaxToColor (Pretty (SyntaxText' Reference) -> Pretty ColorText)
-> Pretty (SyntaxText' Reference) -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                    HashQualified Name
-> Decl Symbol Ann -> Pretty (SyntaxText' Reference)
forall v a.
Var v =>
HashQualified Name
-> Either (EffectDeclaration v a) (DataDeclaration v a)
-> Pretty (SyntaxText' Reference)
DeclPrinter.prettyDeclHeader (Symbol -> HashQualified Name
forall v. Var v => v -> HashQualified Name
HQ.unsafeFromVar Symbol
v) Decl Symbol Ann
dd
                )
              Maybe (Id, Decl Symbol Ann)
Nothing ->
                ( Status -> Pretty ColorText
prettyStatus Status
status,
                  Symbol -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar Symbol
v Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
P.red (Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty ColorText
" (Unison bug, unknown type)")
                )
            typeMsgs :: Pretty ColorText
typeMsgs =
              [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2 ([(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText)
-> [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                (Status -> Symbol -> (Pretty ColorText, Pretty ColorText)
typeLineFor Status
Collision (Symbol -> (Pretty ColorText, Pretty ColorText))
-> [Symbol] -> [(Pretty ColorText, Pretty ColorText)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Symbol -> [Symbol]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (SlurpComponent -> Set Symbol
types (SlurpResult -> SlurpComponent
collisions SlurpResult
sr)))
                  [(Pretty ColorText, Pretty ColorText)]
-> [(Pretty ColorText, Pretty ColorText)]
-> [(Pretty ColorText, Pretty ColorText)]
forall a. [a] -> [a] -> [a]
++ (Status -> Symbol -> (Pretty ColorText, Pretty ColorText)
typeLineFor Status
BlockedDependency (Symbol -> (Pretty ColorText, Pretty ColorText))
-> [Symbol] -> [(Pretty ColorText, Pretty ColorText)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Symbol -> [Symbol]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (SlurpComponent -> Set Symbol
types (SlurpResult -> SlurpComponent
defsWithBlockedDependencies SlurpResult
sr)))
            termLineFor :: Status
-> Symbol -> (Pretty ColorText, Pretty ColorText, Pretty ColorText)
termLineFor Status
status Symbol
v = case Symbol
-> Map
     Symbol
     (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
-> Maybe
     (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Symbol
v Map
  Symbol
  (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
tms of
              Just (Ann
_, Reference
_ref, Maybe String
_wk, Term Symbol Ann
_tm, Type Symbol Ann
ty) ->
                ( Status -> Pretty ColorText
prettyStatus Status
status,
                  Pretty ColorText -> Pretty ColorText
P.bold (Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty ColorText) -> Text -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Symbol -> Text
forall v. Var v => v -> Text
Var.name Symbol
v),
                  Pretty ColorText
": " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentNAfterNewline Width
6 (PrettyPrintEnv -> Type Symbol Ann -> Pretty ColorText
forall v a. Var v => PrettyPrintEnv -> Type v a -> Pretty ColorText
TP.pretty PrettyPrintEnv
ppe Type Symbol Ann
ty)
                )
              Maybe
  (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
Nothing -> (Status -> Pretty ColorText
prettyStatus Status
status, Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Symbol -> Text
forall v. Var v => v -> Text
Var.name Symbol
v), Pretty ColorText
"")
            termMsgs :: Pretty ColorText
termMsgs =
              Pretty ColorText
-> [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
-> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> [(Pretty s, Pretty s, Pretty s)] -> Pretty s
P.column3sep Pretty ColorText
"  " ([(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
 -> Pretty ColorText)
-> [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
-> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                (Status
-> Symbol -> (Pretty ColorText, Pretty ColorText, Pretty ColorText)
termLineFor Status
Collision (Symbol -> (Pretty ColorText, Pretty ColorText, Pretty ColorText))
-> [Symbol]
-> [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Symbol -> [Symbol]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (SlurpComponent -> Set Symbol
terms (SlurpResult -> SlurpComponent
collisions SlurpResult
sr)))
                  [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
-> [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
-> [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
forall a. [a] -> [a] -> [a]
++ ( Status
-> Symbol -> (Pretty ColorText, Pretty ColorText, Pretty ColorText)
termLineFor Status
TermExistingConstructorCollision
                         (Symbol -> (Pretty ColorText, Pretty ColorText, Pretty ColorText))
-> [Symbol]
-> [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Symbol -> [Symbol]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (SlurpResult -> Set Symbol
termExistingConstructorCollisions SlurpResult
sr)
                     )
                  [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
-> [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
-> [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
forall a. [a] -> [a] -> [a]
++ ( Status
-> Symbol -> (Pretty ColorText, Pretty ColorText, Pretty ColorText)
termLineFor Status
ConstructorExistingTermCollision
                         (Symbol -> (Pretty ColorText, Pretty ColorText, Pretty ColorText))
-> [Symbol]
-> [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Symbol -> [Symbol]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (SlurpResult -> Set Symbol
constructorExistingTermCollisions SlurpResult
sr)
                     )
                  [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
-> [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
-> [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
forall a. [a] -> [a] -> [a]
++ ( Status
-> Symbol -> (Pretty ColorText, Pretty ColorText, Pretty ColorText)
termLineFor Status
BlockedDependency
                         (Symbol -> (Pretty ColorText, Pretty ColorText, Pretty ColorText))
-> [Symbol]
-> [(Pretty ColorText, Pretty ColorText, Pretty ColorText)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Symbol -> [Symbol]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (SlurpComponent -> Set Symbol
terms (SlurpResult -> SlurpComponent
defsWithBlockedDependencies SlurpResult
sr))
                     )
         in Pretty ColorText
header
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"\n\n"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
P.hiBlack Pretty ColorText
"  Reason"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"\n"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 ([Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.linesNonEmpty [Pretty ColorText
typeMsgs, Pretty ColorText
termMsgs])
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"\n\n"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN
                Width
2
                ([(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2 [(Pretty ColorText
"Tip:", Pretty ColorText
"Use `help filestatus` to learn more.")])
      dups :: [Symbol]
dups = Set Symbol -> [Symbol]
forall a. Set a -> [a]
Set.toList (SlurpComponent -> Set Symbol
SC.terms (SlurpResult -> SlurpComponent
duplicates SlurpResult
sr) Set Symbol -> Set Symbol -> Set Symbol
forall a. Semigroup a => a -> a -> a
<> SlurpComponent -> Set Symbol
SC.types (SlurpResult -> SlurpComponent
duplicates SlurpResult
sr))
      more :: a -> Pretty ColorText
more a
i =
        Pretty ColorText
"... "
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
P.bold (a -> Pretty ColorText
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown a
i)
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
P.hiBlack Pretty ColorText
" more."
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"Try moving these below the `---` \"fold\" in your file."
   in Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sepNonEmpty
        Pretty ColorText
"\n\n"
        [ if Set Symbol -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (SlurpComponent -> Set Symbol
terms (SlurpResult -> SlurpComponent
duplicates SlurpResult
sr)) Bool -> Bool -> Bool
&& Set Symbol -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (SlurpComponent -> Set Symbol
types (SlurpResult -> SlurpComponent
duplicates SlurpResult
sr))
            then Pretty ColorText
forall a. Monoid a => a
mempty
            else
              ( if Bool
isPast
                  then Pretty ColorText
"⊡ Ignored previously added definitions: "
                  else Pretty ColorText
"⊡ Previously added definitions will be ignored: "
              )
                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentNAfterNewline
                  Width
2
                  ( Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                      Maybe Int
-> (Int -> Pretty ColorText)
-> Pretty ColorText
-> [Pretty ColorText]
-> Pretty ColorText
forall s.
IsString s =>
Maybe Int
-> (Int -> Pretty s) -> Pretty s -> [Pretty s] -> Pretty s
P.excerptSep'
                        (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
7)
                        Int -> Pretty ColorText
forall {a}. Show a => a -> Pretty ColorText
more
                        Pretty ColorText
" "
                        (Pretty ColorText -> Pretty ColorText
P.hiBlack (Pretty ColorText -> Pretty ColorText)
-> (Symbol -> Pretty ColorText) -> Symbol -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar (Symbol -> Pretty ColorText) -> [Symbol] -> [Pretty ColorText]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Symbol]
dups)
                  ),
          SlurpComponent -> Pretty ColorText
okToAdd (SlurpResult -> SlurpComponent
adds SlurpResult
sr),
          SlurpComponent -> Pretty ColorText
okToUpdate (SlurpResult -> SlurpComponent
updates SlurpResult
sr),
          Pretty ColorText
-> Pretty ColorText -> SlurpResult -> Pretty ColorText
notOks
            (Pretty ColorText -> Pretty ColorText
P.red Pretty ColorText
"These definitions failed:")
            (Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pretty ColorText -> Pretty ColorText
P.red Pretty ColorText
"These definitions would fail on `add` or `update`:")
            SlurpResult
sr
        ]

isOk :: SlurpResult -> Bool
isOk :: SlurpResult -> Bool
isOk SlurpResult {Map Symbol Aliases
Set Symbol
TypecheckedUnisonFile Symbol Ann
SlurpComponent
$sel:originalFile:SlurpResult :: SlurpResult -> TypecheckedUnisonFile Symbol Ann
$sel:extraDefinitions:SlurpResult :: SlurpResult -> SlurpComponent
$sel:adds:SlurpResult :: SlurpResult -> SlurpComponent
$sel:duplicates:SlurpResult :: SlurpResult -> SlurpComponent
$sel:collisions:SlurpResult :: SlurpResult -> SlurpComponent
$sel:updates:SlurpResult :: SlurpResult -> SlurpComponent
$sel:termExistingConstructorCollisions:SlurpResult :: SlurpResult -> Set Symbol
$sel:constructorExistingTermCollisions:SlurpResult :: SlurpResult -> Set Symbol
$sel:termAlias:SlurpResult :: SlurpResult -> Map Symbol Aliases
$sel:typeAlias:SlurpResult :: SlurpResult -> Map Symbol Aliases
$sel:defsWithBlockedDependencies:SlurpResult :: SlurpResult -> SlurpComponent
originalFile :: TypecheckedUnisonFile Symbol Ann
extraDefinitions :: SlurpComponent
adds :: SlurpComponent
duplicates :: SlurpComponent
collisions :: SlurpComponent
updates :: SlurpComponent
termExistingConstructorCollisions :: Set Symbol
constructorExistingTermCollisions :: Set Symbol
termAlias :: Map Symbol Aliases
typeAlias :: Map Symbol Aliases
defsWithBlockedDependencies :: SlurpComponent
..} =
  SlurpComponent -> Bool
SC.isEmpty SlurpComponent
collisions
    Bool -> Bool -> Bool
&& Set Symbol -> Bool
forall a. Set a -> Bool
Set.null Set Symbol
termExistingConstructorCollisions
    Bool -> Bool -> Bool
&& Set Symbol -> Bool
forall a. Set a -> Bool
Set.null Set Symbol
constructorExistingTermCollisions
    Bool -> Bool -> Bool
&& SlurpComponent -> Bool
SC.isEmpty SlurpComponent
defsWithBlockedDependencies

isAllDuplicates :: SlurpResult -> Bool
isAllDuplicates :: SlurpResult -> Bool
isAllDuplicates SlurpResult {Map Symbol Aliases
Set Symbol
TypecheckedUnisonFile Symbol Ann
SlurpComponent
$sel:originalFile:SlurpResult :: SlurpResult -> TypecheckedUnisonFile Symbol Ann
$sel:extraDefinitions:SlurpResult :: SlurpResult -> SlurpComponent
$sel:adds:SlurpResult :: SlurpResult -> SlurpComponent
$sel:duplicates:SlurpResult :: SlurpResult -> SlurpComponent
$sel:collisions:SlurpResult :: SlurpResult -> SlurpComponent
$sel:updates:SlurpResult :: SlurpResult -> SlurpComponent
$sel:termExistingConstructorCollisions:SlurpResult :: SlurpResult -> Set Symbol
$sel:constructorExistingTermCollisions:SlurpResult :: SlurpResult -> Set Symbol
$sel:termAlias:SlurpResult :: SlurpResult -> Map Symbol Aliases
$sel:typeAlias:SlurpResult :: SlurpResult -> Map Symbol Aliases
$sel:defsWithBlockedDependencies:SlurpResult :: SlurpResult -> SlurpComponent
originalFile :: TypecheckedUnisonFile Symbol Ann
extraDefinitions :: SlurpComponent
adds :: SlurpComponent
duplicates :: SlurpComponent
collisions :: SlurpComponent
updates :: SlurpComponent
termExistingConstructorCollisions :: Set Symbol
constructorExistingTermCollisions :: Set Symbol
termAlias :: Map Symbol Aliases
typeAlias :: Map Symbol Aliases
defsWithBlockedDependencies :: SlurpComponent
..} =
  SlurpComponent -> Bool
emptyIgnoringConstructors SlurpComponent
adds
    Bool -> Bool -> Bool
&& SlurpComponent -> Bool
emptyIgnoringConstructors SlurpComponent
updates
    Bool -> Bool -> Bool
&& SlurpComponent -> Bool
emptyIgnoringConstructors SlurpComponent
extraDefinitions
    Bool -> Bool -> Bool
&& SlurpComponent -> Bool
SC.isEmpty SlurpComponent
collisions
    Bool -> Bool -> Bool
&& Map Symbol Aliases -> Bool
forall k a. Map k a -> Bool
Map.null Map Symbol Aliases
typeAlias
    Bool -> Bool -> Bool
&& Map Symbol Aliases -> Bool
forall k a. Map k a -> Bool
Map.null Map Symbol Aliases
termAlias
    Bool -> Bool -> Bool
&& Set Symbol -> Bool
forall a. Set a -> Bool
Set.null Set Symbol
termExistingConstructorCollisions
    Bool -> Bool -> Bool
&& Set Symbol -> Bool
forall a. Set a -> Bool
Set.null Set Symbol
constructorExistingTermCollisions
    Bool -> Bool -> Bool
&& SlurpComponent -> Bool
emptyIgnoringConstructors SlurpComponent
defsWithBlockedDependencies
  where
    emptyIgnoringConstructors :: SlurpComponent -> Bool
    emptyIgnoringConstructors :: SlurpComponent -> Bool
emptyIgnoringConstructors SlurpComponent {Set Symbol
$sel:types:SlurpComponent :: SlurpComponent -> Set Symbol
types :: Set Symbol
types, Set Symbol
$sel:terms:SlurpComponent :: SlurpComponent -> Set Symbol
terms :: Set Symbol
terms} =
      Set Symbol -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Symbol
types Bool -> Bool -> Bool
&& Set Symbol -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Symbol
terms

filterUnisonFile ::
  SlurpResult ->
  UF.TypecheckedUnisonFile Symbol Ann ->
  UF.TypecheckedUnisonFile Symbol Ann
filterUnisonFile :: SlurpResult
-> TypecheckedUnisonFile Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
filterUnisonFile
  SlurpResult {SlurpComponent
$sel:adds:SlurpResult :: SlurpResult -> SlurpComponent
adds :: SlurpComponent
adds, SlurpComponent
$sel:updates:SlurpResult :: SlurpResult -> SlurpComponent
updates :: SlurpComponent
updates}
  ( UF.TypecheckedUnisonFileId
      Map Symbol (Id, DataDeclaration Symbol Ann)
dataDeclarations'
      Map Symbol (Id, EffectDeclaration Symbol Ann)
effectDeclarations'
      [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
topLevelComponents'
      [(String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
watchComponents
      Map
  Symbol (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)
hashTerms
    ) =
    Map Symbol (Id, DataDeclaration Symbol Ann)
-> Map Symbol (Id, EffectDeclaration Symbol Ann)
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
-> [(String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> Map
     Symbol (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)
-> TypecheckedUnisonFile Symbol Ann
forall v a.
Map v (Id, DataDeclaration v a)
-> Map v (Id, EffectDeclaration v a)
-> [[(v, a, Term v a, Type v a)]]
-> [(String, [(v, a, Term v a, Type v a)])]
-> Map v (a, Id, Maybe String, Term v a, Type v a)
-> TypecheckedUnisonFile v a
UF.TypecheckedUnisonFileId Map Symbol (Id, DataDeclaration Symbol Ann)
datas Map Symbol (Id, EffectDeclaration Symbol Ann)
effects [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
tlcs [(String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
watches Map
  Symbol (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)
hashTerms'
    where
      keep :: SlurpComponent
keep = SlurpComponent
updates SlurpComponent -> SlurpComponent -> SlurpComponent
forall a. Semigroup a => a -> a -> a
<> SlurpComponent
adds
      keepTerms :: Set Symbol
keepTerms = SlurpComponent -> Set Symbol
SC.terms SlurpComponent
keep
      keepTypes :: Set Symbol
keepTypes = SlurpComponent -> Set Symbol
SC.types SlurpComponent
keep
      hashTerms' :: Map
  Symbol (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)
hashTerms' = Map
  Symbol (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)
-> Set Symbol
-> Map
     Symbol (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map
  Symbol (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)
hashTerms Set Symbol
keepTerms
      datas :: Map Symbol (Id, DataDeclaration Symbol Ann)
datas = Map Symbol (Id, DataDeclaration Symbol Ann)
-> Set Symbol -> Map Symbol (Id, DataDeclaration Symbol Ann)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map Symbol (Id, DataDeclaration Symbol Ann)
dataDeclarations' Set Symbol
keepTypes
      effects :: Map Symbol (Id, EffectDeclaration Symbol Ann)
effects = Map Symbol (Id, EffectDeclaration Symbol Ann)
-> Set Symbol -> Map Symbol (Id, EffectDeclaration Symbol Ann)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map Symbol (Id, EffectDeclaration Symbol Ann)
effectDeclarations' Set Symbol
keepTypes
      tlcs :: [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
tlcs = ([(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)] -> Bool)
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ([(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)] -> Bool)
-> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
 -> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]])
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
forall a b. (a -> b) -> a -> b
$ ([(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
 -> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Symbol, Ann, Term Symbol Ann, Type Symbol Ann) -> Bool)
-> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
-> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (Symbol, Ann, Term Symbol Ann, Type Symbol Ann) -> Bool
filterTLC) [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
topLevelComponents'
      watches :: [(String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
watches = ((String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
 -> Bool)
-> [(String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> [(String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
    -> Bool)
-> (String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)] -> Bool)
-> ((String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
    -> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
-> (String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
-> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
forall a b. (a, b) -> b
snd) ([(String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
 -> [(String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])])
-> [(String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> [(String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
forall a b. (a -> b) -> a -> b
$ ((String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
 -> (String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]))
-> [(String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> [(String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
 -> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
-> (String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
-> (String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
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 (((Symbol, Ann, Term Symbol Ann, Type Symbol Ann) -> Bool)
-> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
-> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (Symbol, Ann, Term Symbol Ann, Type Symbol Ann) -> Bool
filterTLC)) [(String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
watchComponents
      filterTLC :: (Symbol, Ann, Term Symbol Ann, Type Symbol Ann) -> Bool
filterTLC (Symbol
v, Ann
_, Term Symbol Ann
_, Type Symbol Ann
_) = Symbol -> Set Symbol -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Symbol
v Set Symbol
keepTerms