diff --git a/parser-typechecker/src/Unison/CommandLine/OutputMessages.hs b/parser-typechecker/src/Unison/CommandLine/OutputMessages.hs index 354fc1603..69edea107 100644 --- a/parser-typechecker/src/Unison/CommandLine/OutputMessages.hs +++ b/parser-typechecker/src/Unison/CommandLine/OutputMessages.hs @@ -110,6 +110,7 @@ import qualified Unison.Util.List as List import qualified Unison.Util.Monoid as Monoid import Data.Tuple (swap) import Unison.Codebase.ShortBranchHash (ShortBranchHash) +import Control.Lens (view, _1) type Pretty = P.Pretty P.ColorText @@ -1209,7 +1210,7 @@ showDiffNamespace ppe d@OBD.BranchDiffOutput{..} = -- updateIndicator = " └─ " prettyUpdateType :: OBD.UpdateTypeDisplay v Ann -> _ Pretty - {- + {- 1. ability Foo#pqr x y 2. - AllRightsReserved : License 3. + MIT : License @@ -1217,9 +1218,9 @@ showDiffNamespace ppe d@OBD.BranchDiffOutput{..} = 5. - apiDocs : License 6. + MIT : License -} - prettyUpdateType (Nothing, mdUps) = + prettyUpdateType (Nothing, mdUps) = fmap P.linesNonEmpty $ traverse mdTypeLine mdUps - {- + {- 1. ┌ ability Foo#pqr x y 2. └ ability Foo#xyz a b ⧩ replaced with @@ -1238,32 +1239,50 @@ showDiffNamespace ppe d@OBD.BranchDiffOutput{..} = -} prettyUpdateType (Just olds, news) = fmap P.linesNonEmpty $ do - olds <- P.boxLeft <$> + olds <- P.boxLeft <$> traverse mdTypeLine [ (name,decl,mempty) | (name,decl) <- olds ] - news <- P.boxLeft <$> + news <- P.boxLeft <$> traverse mdTypeLine news pure $ olds <> [downArrow] <> news downArrow = P.bold "⧩ replaced with" mdTypeLine (hq, otype, mddiff) = do - n <- num - fmap P.linesNonEmpty . sequence $ + n <- num + fmap P.linesNonEmpty . sequence $ [ pure $ n <> prettyDecl hq otype , P.indentN leftNumsWidth <$> prettyMetadataDiff mddiff ] - - prettyUpdateTerm (Nothing, terms) = undefined + mdTermLine namesWidth (hq, otype, mddiff) = do + n <- num + fmap P.linesNonEmpty . sequence $ + [ pure $ P.rightPad namesWidth (phq' hq) <> " : " <> prettyType otype + , P.indentN leftNumsWidth <$> prettyMetadataDiff mddiff ] + + prettyUpdateTerm (Nothing, newTerms) = + if null newTerms then error "Super invalid UpdateTermDisplay" else + fmap P.linesNonEmpty $ traverse (mdTermLine namesWidth) newTerms + where namesWidth = foldl1' max $ fmap (HQ'.nameLength . view _1) newTerms + prettyUpdateTerm (Just olds, news) = + fmap P.linesNonEmpty $ do + olds <- P.boxLeft <$> + traverse (mdTermLine namesWidth) [ (name,typ,mempty) | (name,typ) <- olds ] + news <- P.boxLeft <$> + traverse (mdTermLine namesWidth) news + pure $ olds <> [downArrow] <> news + where namesWidth = foldl1' max $ fmap (HQ'.nameLength . view _1) news + <> fmap (HQ'.nameLength . view _1) olds + prettyMetadataDiff OBD.MetadataDiff{..} = P.column2M $ map (elem " - ") removedMetadata <> map (elem " + ") addedMetadata - where + where elem x (hq, otype) = do num <- num pure (x <> num <> phq' hq, " : " <> prettyType otype) - prettyType = maybe (P.red "type not found") (TypePrinter.pretty ppe) + prettyType = maybe (P.red "type not found") (TypePrinter.pretty ppe) prettyDecl hq = - maybe (P.red "type not found") + maybe (P.red "type not found") (P.syntaxToColor . DeclPrinter.prettyDeclOrBuiltinHeader (HQ'.toHQ hq)) phq' = P.syntaxToColor . prettyHashQualified' -- @@ -1277,7 +1296,7 @@ showDiffNamespace ppe d@OBD.BranchDiffOutput{..} = padNumber :: Int -> Pretty padNumber n = P.hiBlack . P.rightPad leftNumsWidth $ P.shown n <> ". " leftNumsWidth = 4 -- length (show . max d) + length ". " - + noResults :: Pretty noResults = P.callout "😶" $ P.wrap $ "No results. Check your spelling, or try using tab completion " diff --git a/parser-typechecker/src/Unison/Util/Pretty.hs b/parser-typechecker/src/Unison/Util/Pretty.hs index eb07d25d3..5894df9de 100644 --- a/parser-typechecker/src/Unison/Util/Pretty.hs +++ b/parser-typechecker/src/Unison/Util/Pretty.hs @@ -146,7 +146,7 @@ wrapImpl (p:ps) = wrap_ . Seq.fromList $ wrapString :: (LL.ListLike s Char, IsString s) => String -> Pretty s wrapString s = wrap (lit $ fromString s) --- 0. Preserve all leading and trailing whitespace +-- 0. Preserve all leading and trailing whitespace -- 1. Preserve all newlines -- 2. Wrap all text in between newlines paragraphyText :: (LL.ListLike s Char, IsString s) => Text -> Pretty s @@ -582,10 +582,10 @@ bracket :: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s bracket = indent " " boxLeft :: forall s . (LL.ListLike s Char, IsString s) => [Pretty s] -> [Pretty s] -boxLeft ps = go ps where - go [] = [] - go [p] = [decorate singleton p] - go (Seq.fromList -> a Seq.:<| (mid Seq.:|> b)) = +boxLeft ps = go (Seq.fromList ps) where + go Seq.Empty = [] + go (p Seq.:<| Seq.Empty) = [decorate singleton p] + go (a Seq.:<| (mid Seq.:|> b)) = [decorate first a] ++ toList (decorate middle <$> mid) ++ [decorate last b] decorate (first, mid) p = first <> indentAfterNewline mid p first = ("┌", "│") diff --git a/unison-core/src/Unison/HashQualified'.hs b/unison-core/src/Unison/HashQualified'.hs index c6ea9d327..7a5ab565f 100644 --- a/unison-core/src/Unison/HashQualified'.hs +++ b/unison-core/src/Unison/HashQualified'.hs @@ -34,13 +34,16 @@ fromHQ = \case HQ.HashOnly{} -> Nothing unsafeFromHQ :: HQ.HashQualified' n -> HashQualified' n -unsafeFromHQ = fromJust . fromHQ +unsafeFromHQ = fromJust . fromHQ toName :: HashQualified' n -> n toName = \case NameOnly name -> name HashQualified name _ -> name +nameLength :: HashQualified' Name -> Int +nameLength = Text.length . Name.toText . toName + take :: Int -> HashQualified' n -> HashQualified' n take i = \case n@(NameOnly _) -> n