mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-23 08:18:04 +03:00
newtype Width to avoid shenanigans
This commit is contained in:
Rúnar
parent
5b672cd815
commit
02aa20cdca
@ -1557,11 +1557,17 @@ showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput{..} =
|
||||
(types `zip` [0..])
|
||||
<*> traverse prettyGroup (terms `zip` [length types ..])
|
||||
where
|
||||
leftNamePad :: Int = foldl1' max $
|
||||
map (foldl1' max . map HQ'.nameLength . toList . view _3) terms <>
|
||||
map (foldl1' max . map HQ'.nameLength . toList . view _3) types
|
||||
prettyGroup :: ((Referent, b, Set (HQ'.HashQualified Name), Set (HQ'.HashQualified Name)), Int)
|
||||
-> Numbered Pretty
|
||||
leftNamePad :: P.Width =
|
||||
foldl1' max
|
||||
$ map (foldl1' max . map (P.Width . HQ'.nameLength) . toList . view _3)
|
||||
terms
|
||||
<> map (foldl1' max . map (P.Width . HQ'.nameLength) . toList . view _3)
|
||||
types
|
||||
prettyGroup
|
||||
:: ( (Referent, b, Set (HQ'.HashQualified Name), Set (HQ'.HashQualified Name))
|
||||
, Int
|
||||
)
|
||||
-> Numbered Pretty
|
||||
prettyGroup ((r, _, olds, news),i) = let
|
||||
-- [ "peach ┐"
|
||||
-- , "peach' ┘"]
|
||||
@ -1737,29 +1743,38 @@ showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput{..} =
|
||||
|
||||
-- + 2. MIT : License
|
||||
-- - 3. AllRightsReserved : License
|
||||
mdTermLine :: Path.Absolute -> Int -> OBD.TermDisplay v a -> Numbered (Pretty, Pretty)
|
||||
mdTermLine
|
||||
:: Path.Absolute
|
||||
-> P.Width
|
||||
-> OBD.TermDisplay v a
|
||||
-> Numbered (Pretty, Pretty)
|
||||
mdTermLine p namesWidth (hq, r, otype, mddiff) = do
|
||||
n <- numHQ' p hq r
|
||||
fmap ((n,) . P.linesNonEmpty) . sequence $
|
||||
[ pure $ P.rightPad namesWidth (phq' hq) <> " : " <> prettyType otype
|
||||
, prettyMetadataDiff mddiff ]
|
||||
-- , P.indentN 2 <$> prettyMetadataDiff mddiff ]
|
||||
fmap ((n, ) . P.linesNonEmpty)
|
||||
. sequence
|
||||
$ [ pure $ P.rightPad namesWidth (phq' hq) <> " : " <> prettyType otype
|
||||
, prettyMetadataDiff mddiff
|
||||
]
|
||||
|
||||
prettyUpdateTerm :: OBD.UpdateTermDisplay v a -> Numbered Pretty
|
||||
prettyUpdateTerm (Nothing, newTerms) =
|
||||
if null newTerms then error "Super invalid UpdateTermDisplay" else
|
||||
fmap P.column2 $ traverse (mdTermLine newPath namesWidth) newTerms
|
||||
where namesWidth = foldl1' max $ fmap (HQ'.nameLength . view _1) newTerms
|
||||
prettyUpdateTerm (Just olds, news) =
|
||||
fmap P.column2 $ do
|
||||
olds <- traverse (mdTermLine oldPath namesWidth) [ (name,r,typ,mempty) | (name,r,typ) <- olds ]
|
||||
news <- traverse (mdTermLine newPath namesWidth) news
|
||||
let (oldnums, olddatas) = unzip olds
|
||||
let (newnums, newdatas) = unzip news
|
||||
pure $ zip (oldnums <> [""] <> newnums)
|
||||
(P.boxLeft olddatas <> [downArrow] <> P.boxLeft newdatas)
|
||||
where namesWidth = foldl1' max $ fmap (HQ'.nameLength . view _1) news
|
||||
<> fmap (HQ'.nameLength . view _1) olds
|
||||
prettyUpdateTerm (Nothing, newTerms) = if null newTerms
|
||||
then error "Super invalid UpdateTermDisplay"
|
||||
else fmap P.column2 $ traverse (mdTermLine newPath namesWidth) newTerms
|
||||
where
|
||||
namesWidth = foldl1' max $ fmap (P.Width . HQ'.nameLength . view _1) newTerms
|
||||
prettyUpdateTerm (Just olds, news) = fmap P.column2 $ do
|
||||
olds <- traverse (mdTermLine oldPath namesWidth)
|
||||
[ (name, r, typ, mempty) | (name, r, typ) <- olds ]
|
||||
news <- traverse (mdTermLine newPath namesWidth) news
|
||||
let (oldnums, olddatas) = unzip olds
|
||||
let (newnums, newdatas) = unzip news
|
||||
pure $ zip (oldnums <> [""] <> newnums)
|
||||
(P.boxLeft olddatas <> [downArrow] <> P.boxLeft newdatas)
|
||||
where
|
||||
namesWidth =
|
||||
foldl1' max
|
||||
$ fmap (P.Width . HQ'.nameLength . view _1) news
|
||||
<> fmap (P.Width . HQ'.nameLength . view _1) olds
|
||||
|
||||
prettyMetadataDiff :: OBD.MetadataDiff (OBD.MetadataDisplay v a) -> Numbered Pretty
|
||||
prettyMetadataDiff OBD.MetadataDiff{..} = P.column2M $
|
||||
@ -1803,7 +1818,7 @@ showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput{..} =
|
||||
padNumber :: Int -> Pretty
|
||||
padNumber n = P.hiBlack . P.rightPad leftNumsWidth $ P.shown n <> "."
|
||||
|
||||
leftNumsWidth = length (show menuSize) + length ("." :: String)
|
||||
leftNumsWidth = P.Width $ length (show menuSize) + length ("." :: String)
|
||||
|
||||
noResults :: Pretty
|
||||
noResults = P.callout "😶" $
|
||||
@ -1907,7 +1922,7 @@ watchPrinter src ppe ann kind term isHit =
|
||||
[ fromString (replicate lineNumWidth ' ')
|
||||
<> fromString extra
|
||||
<> (if isHit then id else P.purple) "⧩"
|
||||
, P.indentN (lineNumWidth + length extra)
|
||||
, P.indentN (P.Width (lineNumWidth + length extra))
|
||||
. (if isHit then id else P.bold)
|
||||
$ TermPrinter.pretty ppe term
|
||||
]
|
||||
|
||||
@ -28,23 +28,23 @@ putPrettyLn' :: P.Pretty CT.ColorText -> IO ()
|
||||
putPrettyLn' p | p == mempty = pure ()
|
||||
putPrettyLn' p = do
|
||||
width <- getAvailableWidth
|
||||
less . P.toANSI width $ p
|
||||
less $ P.toANSI width p
|
||||
|
||||
clearCurrentLine :: IO ()
|
||||
clearCurrentLine = do
|
||||
width <- getAvailableWidth
|
||||
putStr "\r"
|
||||
putStr . replicate width $ ' '
|
||||
putStr $ replicate (P.widthToInt width) ' '
|
||||
putStr "\r"
|
||||
|
||||
putPretty' :: P.Pretty CT.ColorText -> IO ()
|
||||
putPretty' p = do
|
||||
width <- getAvailableWidth
|
||||
putStr . P.toANSI width $ p
|
||||
putStr $ P.toANSI width p
|
||||
|
||||
getAvailableWidth :: IO Int
|
||||
getAvailableWidth :: IO P.Width
|
||||
getAvailableWidth =
|
||||
maybe 80 (\s -> 100 `min` Terminal.width s) <$> Terminal.size
|
||||
maybe 80 (\s -> 100 `min` P.Width (Terminal.width s)) <$> Terminal.size
|
||||
|
||||
putPrettyNonempty :: P.Pretty P.ColorText -> IO ()
|
||||
putPrettyNonempty msg = do
|
||||
|
||||
@ -245,7 +245,7 @@ typeListEntry codebase r n = do
|
||||
pure $ TypeEntry r n tag
|
||||
|
||||
termEntryToNamedTerm
|
||||
:: Var v => PPE.PrettyPrintEnv -> Maybe Int -> TermEntry v a -> NamedTerm
|
||||
:: Var v => PPE.PrettyPrintEnv -> Maybe Width -> TermEntry v a -> NamedTerm
|
||||
termEntryToNamedTerm ppe typeWidth (TermEntry r name mayType tag) = NamedTerm
|
||||
{ termName = HQ'.toText name
|
||||
, termHash = Referent.toText r
|
||||
@ -660,7 +660,7 @@ definitionsBySuffixes relativeTo branch codebase query = do
|
||||
termsToSyntax
|
||||
:: Var v
|
||||
=> Ord a
|
||||
=> Int
|
||||
=> Width
|
||||
-> PPE.PrettyPrintEnvDecl
|
||||
-> Map Reference.Reference (DisplayObject (Term v a))
|
||||
-> Map Reference.Reference (DisplayObject SyntaxText)
|
||||
@ -677,7 +677,7 @@ termsToSyntax width ppe0 terms =
|
||||
typesToSyntax
|
||||
:: Var v
|
||||
=> Ord a
|
||||
=> Int
|
||||
=> Width
|
||||
-> PPE.PrettyPrintEnvDecl
|
||||
-> Map Reference.Reference (DisplayObject (DD.Decl v a))
|
||||
-> Map Reference.Reference (DisplayObject SyntaxText)
|
||||
|
||||
@ -57,8 +57,8 @@ import Unison.NameSegment
|
||||
type FuzzyFindAPI =
|
||||
"find" :> QueryParam "rootBranch" SBH.ShortBranchHash
|
||||
:> QueryParam "relativeTo" HashQualifiedName
|
||||
:> QueryParam "renderWidth" Width
|
||||
:> QueryParam "limit" Int
|
||||
:> QueryParam "renderWidth" Width
|
||||
:> QueryParam "query" String
|
||||
:> Get '[JSON] [(FZF.Alignment, FoundResult)]
|
||||
|
||||
|
||||
@ -23,7 +23,7 @@ import Unison.Name ( Name )
|
||||
import Unison.ShortHash ( ShortHash )
|
||||
import Unison.Codebase.ShortBranchHash
|
||||
( ShortBranchHash(..) )
|
||||
import Unison.Util.Pretty ( Width
|
||||
import Unison.Util.Pretty ( Width(..)
|
||||
, render
|
||||
)
|
||||
import Unison.Var ( Var )
|
||||
@ -50,6 +50,9 @@ deriving instance ToSchema Name
|
||||
deriving via Text instance FromHttpApiData ShortBranchHash
|
||||
deriving instance ToParamSchema ShortBranchHash
|
||||
|
||||
deriving via Int instance FromHttpApiData Width
|
||||
deriving instance ToParamSchema Width
|
||||
|
||||
instance ToJSON a => ToJSON (DisplayObject a) where
|
||||
toEncoding = genericToEncoding defaultOptions
|
||||
deriving instance ToSchema a => ToSchema (DisplayObject a)
|
||||
|
||||
@ -39,7 +39,7 @@ import qualified Unison.Var as Var
|
||||
import qualified Unison.Util.Bytes as Bytes
|
||||
import Unison.Util.Monoid ( intercalateMap )
|
||||
import qualified Unison.Util.Pretty as PP
|
||||
import Unison.Util.Pretty ( Pretty, ColorText )
|
||||
import Unison.Util.Pretty ( Pretty, ColorText, Width )
|
||||
import Unison.PrettyPrintEnv ( PrettyPrintEnv, Suffix, Prefix, Imports, elideFQN )
|
||||
import qualified Unison.PrettyPrintEnv as PrettyPrintEnv
|
||||
import qualified Unison.Builtin.Decls as DD
|
||||
@ -49,7 +49,7 @@ import qualified Unison.ConstructorType as CT
|
||||
pretty :: Var v => PrettyPrintEnv -> Term v a -> Pretty ColorText
|
||||
pretty env = PP.syntaxToColor . pretty0 env emptyAc . printAnnotate env
|
||||
|
||||
pretty' :: Var v => Maybe Int -> PrettyPrintEnv -> Term v a -> ColorText
|
||||
pretty' :: Var v => Maybe Width -> PrettyPrintEnv -> Term v a -> ColorText
|
||||
pretty' (Just width) n t =
|
||||
PP.render width $ PP.syntaxToColor $ pretty0 n emptyAc (printAnnotate n t)
|
||||
pretty' Nothing n t =
|
||||
@ -525,7 +525,7 @@ prettyBinding n = prettyBinding0 n $ ac (-1) Block Map.empty MaybeDoc
|
||||
|
||||
prettyBinding'
|
||||
:: Var v
|
||||
=> Int
|
||||
=> Width
|
||||
-> PrettyPrintEnv
|
||||
-> HQ.HashQualified Name
|
||||
-> Term v a
|
||||
|
||||
@ -13,7 +13,7 @@ import Unison.PrettyPrintEnv (PrettyPrintEnv, Imports, elideFQN)
|
||||
import qualified Unison.PrettyPrintEnv as PrettyPrintEnv
|
||||
import Unison.Reference (pattern Builtin)
|
||||
import Unison.Type
|
||||
import Unison.Util.Pretty (ColorText, Pretty)
|
||||
import Unison.Util.Pretty (ColorText, Pretty, Width)
|
||||
import Unison.Util.ColorText (toPlain)
|
||||
import qualified Unison.Util.SyntaxText as S
|
||||
import Unison.Util.SyntaxText (SyntaxText)
|
||||
@ -25,9 +25,11 @@ import qualified Unison.Builtin.Decls as DD
|
||||
pretty :: forall v a . (Var v) => PrettyPrintEnv -> Type v a -> Pretty ColorText
|
||||
pretty ppe = PP.syntaxToColor . pretty0 ppe mempty (-1)
|
||||
|
||||
pretty' :: Var v => Maybe Int -> PrettyPrintEnv -> Type v a -> String
|
||||
pretty' (Just width) n t = toPlain $ PP.render width $ PP.syntaxToColor $ pretty0 n Map.empty (-1) t
|
||||
pretty' Nothing n t = toPlain $ PP.render maxBound $ PP.syntaxToColor $ pretty0 n Map.empty (-1) t
|
||||
pretty' :: Var v => Maybe Width -> PrettyPrintEnv -> Type v a -> String
|
||||
pretty' (Just width) n t =
|
||||
toPlain $ PP.render width $ PP.syntaxToColor $ pretty0 n Map.empty (-1) t
|
||||
pretty' Nothing n t =
|
||||
toPlain $ PP.render maxBound $ PP.syntaxToColor $ pretty0 n Map.empty (-1) t
|
||||
|
||||
{- Explanation of precedence handling
|
||||
|
||||
|
||||
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveTraversable #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
@ -101,7 +103,7 @@ module Unison.Util.Pretty (
|
||||
wrapString,
|
||||
black, red, green, yellow, blue, purple, cyan, white, hiBlack, hiRed, hiGreen, hiYellow, hiBlue, hiPurple, hiCyan, hiWhite, bold,
|
||||
border,
|
||||
Width,
|
||||
Width(..),
|
||||
-- * Exported for testing
|
||||
delta,
|
||||
Delta,
|
||||
@ -122,7 +124,9 @@ import qualified Data.Sequence as Seq
|
||||
import qualified Data.Text as Text
|
||||
import Control.Monad.Identity (runIdentity, Identity(..))
|
||||
|
||||
type Width = Int
|
||||
newtype Width = Width {widthToInt :: Int}
|
||||
deriving (Eq, Ord, Show, Generic, Num, Bounded)
|
||||
|
||||
type ColorText = CT.ColorText
|
||||
|
||||
data Pretty s = Pretty { delta :: Delta, out :: F s (Pretty s) } deriving Eq
|
||||
@ -382,7 +386,7 @@ surroundCommas start stop fs =
|
||||
<> spaceIfBreak
|
||||
<> intercalateMap ("," <> softbreak <> align) id fs
|
||||
<> stop
|
||||
where align = spacesIfBreak (preferredWidth start + 1)
|
||||
where align = spacesIfBreak (widthToInt $ preferredWidth start + 1)
|
||||
|
||||
sepSpaced :: (Foldable f, IsString s) => Pretty s -> f (Pretty s) -> Pretty s
|
||||
sepSpaced between = sep (between <> softbreak)
|
||||
@ -487,13 +491,13 @@ numberedColumn2Header num ps = numberedHeader (maybe mempty num) (align $ toList
|
||||
numberedList :: Foldable f => f (Pretty ColorText) -> Pretty ColorText
|
||||
numberedList = numbered (\i -> hiBlack . fromString $ show i <> ".")
|
||||
|
||||
leftPad, rightPad :: IsString s => Int -> Pretty s -> Pretty s
|
||||
leftPad, rightPad :: IsString s => Width -> Pretty s -> Pretty s
|
||||
leftPad n p =
|
||||
let rem = n - preferredWidth p
|
||||
in if rem > 0 then fromString (replicate rem ' ') <> p else p
|
||||
in if rem > 0 then fromString (replicate (widthToInt rem) ' ') <> p else p
|
||||
rightPad n p =
|
||||
let rem = n - preferredWidth p
|
||||
in if rem > 0 then p <> fromString (replicate rem ' ') else p
|
||||
in if rem > 0 then p <> fromString (replicate (widthToInt rem) ' ') else p
|
||||
|
||||
excerptColumn2Headed
|
||||
:: (LL.ListLike s Char, IsString s)
|
||||
@ -589,12 +593,14 @@ column3sep sep rows = let
|
||||
abc = group <$> align [(a,sep <> bc) | ((a,_,_),bc) <- rows `zip` bc ]
|
||||
in lines abc
|
||||
|
||||
wrapColumn2 ::
|
||||
(LL.ListLike s Char, IsString s) => [(Pretty s, Pretty s)] -> Pretty s
|
||||
wrapColumn2
|
||||
:: (LL.ListLike s Char, IsString s) => [(Pretty s, Pretty s)] -> Pretty s
|
||||
wrapColumn2 rows = lines (align rows) where
|
||||
align rows = let lwidth = foldl' max 0 (preferredWidth . fst <$> rows) + 2
|
||||
in [ group (rightPad lwidth l <> indentNAfterNewline lwidth (wrap r))
|
||||
| (l, r) <- rows]
|
||||
align rows =
|
||||
let lwidth = foldl' max 0 (preferredWidth . fst <$> rows) + 2
|
||||
in [ group (rightPad lwidth l <> indentNAfterNewline lwidth (wrap r))
|
||||
| (l, r) <- rows
|
||||
]
|
||||
|
||||
align
|
||||
:: (LL.ListLike s Char, IsString s) => [(Pretty s, Pretty s)] -> [Pretty s]
|
||||
@ -622,8 +628,7 @@ align' rows = alignedRows
|
||||
col0Width = foldl' max 0 [ preferredWidth col1 | (col1, Just _) <- rows ] + 1
|
||||
alignedRows =
|
||||
[ case col1 of
|
||||
Just s ->
|
||||
(rightPad col0Width col0, indentNAfterNewline col0Width s)
|
||||
Just s -> (rightPad col0Width col0, indentNAfterNewline col0Width s)
|
||||
Nothing -> (col0, mempty)
|
||||
| (col0, col1) <- rows
|
||||
]
|
||||
@ -674,15 +679,17 @@ indent :: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s -> Pretty s
|
||||
indent by p = by <> indentAfterNewline by p
|
||||
|
||||
indentN :: (LL.ListLike s Char, IsString s) => Width -> Pretty s -> Pretty s
|
||||
indentN by = indent (fromString $ replicate by ' ')
|
||||
indentN by = indent (fromString $ replicate (widthToInt by) ' ')
|
||||
|
||||
indentNonEmptyN :: (LL.ListLike s Char, IsString s) => Width -> Pretty s -> Pretty s
|
||||
indentNonEmptyN _ (out -> Empty) = mempty
|
||||
indentNonEmptyN by p = indentN by p
|
||||
indentNonEmptyN
|
||||
:: (LL.ListLike s Char, IsString s) => Width -> Pretty s -> Pretty s
|
||||
indentNonEmptyN _ (out -> Empty) = mempty
|
||||
indentNonEmptyN by p = indentN by p
|
||||
|
||||
indentNAfterNewline
|
||||
:: (LL.ListLike s Char, IsString s) => Width -> Pretty s -> Pretty s
|
||||
indentNAfterNewline by = indentAfterNewline (fromString $ replicate by ' ')
|
||||
indentNAfterNewline by =
|
||||
indentAfterNewline (fromString $ replicate (widthToInt by) ' ')
|
||||
|
||||
indentAfterNewline
|
||||
:: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s -> Pretty s
|
||||
@ -784,7 +791,7 @@ plural f p = case length f of
|
||||
's' : _ -> "es"
|
||||
_ -> "s"
|
||||
|
||||
border :: (LL.ListLike s Char, IsString s) => Int -> Pretty s -> Pretty s
|
||||
border :: (LL.ListLike s Char, IsString s) => Width -> Pretty s -> Pretty s
|
||||
border n p = "\n" <> indentN n p <> "\n"
|
||||
|
||||
callout :: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s -> Pretty s
|
||||
|
||||
Loading…
Reference in New Issue
Block a user