newtype Width to avoid shenanigans

parser-typechecker/src/Unison/CommandLine/OutputMessages.hs

@@ -1557,10 +1557,16 @@ showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput{..} =
                       (types `zip` [0..])
          <*> traverse prettyGroup (terms `zip` [length types ..])
     where
-        leftNamePad :: Int = foldl1' max $
+        leftNamePad :: P.Width =
-          map (foldl1' max . map HQ'.nameLength . toList . view _3) terms <>
+          foldl1' max
-          map (foldl1' max . map HQ'.nameLength . toList . view _3) types
+            $  map (foldl1' max . map (P.Width . HQ'.nameLength) . toList . view _3)
-        prettyGroup :: ((Referent, b, Set (HQ'.HashQualified Name), Set (HQ'.HashQualified Name)), Int)
+                   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  ┐"
@@ -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 $
+    fmap ((n, ) . P.linesNonEmpty)
-      [ pure $ P.rightPad namesWidth (phq' hq) <> " : " <> prettyType otype
+      . sequence
-      , prettyMetadataDiff mddiff ]
+      $ [ pure $ P.rightPad namesWidth (phq' hq) <> " : " <> prettyType otype
-      -- , P.indentN 2 <$> prettyMetadataDiff mddiff ]
+        , prettyMetadataDiff mddiff
+        ]
 
   prettyUpdateTerm :: OBD.UpdateTermDisplay v a -> Numbered Pretty
-  prettyUpdateTerm (Nothing, newTerms) =
+  prettyUpdateTerm (Nothing, newTerms) = if null newTerms
-    if null newTerms then error "Super invalid UpdateTermDisplay" else
+    then error "Super invalid UpdateTermDisplay"
-    fmap P.column2 $ traverse (mdTermLine newPath namesWidth) newTerms
+    else fmap P.column2 $ traverse (mdTermLine newPath namesWidth) newTerms
-    where namesWidth = foldl1' max $ fmap (HQ'.nameLength . view _1) newTerms
+   where
-  prettyUpdateTerm (Just olds, news) =
+    namesWidth = foldl1' max $ fmap (P.Width . HQ'.nameLength . view _1) newTerms
-    fmap P.column2 $ do
+  prettyUpdateTerm (Just olds, news) = fmap P.column2 $ do
-      olds <- traverse (mdTermLine oldPath namesWidth) [ (name,r,typ,mempty) | (name,r,typ) <- olds ]
+    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
+   where
-                                   <> fmap (HQ'.nameLength . view _1) olds
+    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
               ]

parser-typechecker/src/Unison/PrettyTerminal.hs

@@ -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

parser-typechecker/src/Unison/Server/Backend.hs

@@ -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)

parser-typechecker/src/Unison/Server/Endpoints/FuzzyFind.hs

@@ -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)]
 

parser-typechecker/src/Unison/Server/Types.hs

@@ -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)

parser-typechecker/src/Unison/TermPrinter.hs

@@ -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

parser-typechecker/src/Unison/TypePrinter.hs

@@ -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' :: 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' (Just width) n t =
-pretty' Nothing      n t = toPlain $ PP.render maxBound $ PP.syntaxToColor $ pretty0 n Map.empty (-1) 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
 

parser-typechecker/src/Unison/Util/Pretty.hs

@@ -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 ::
+wrapColumn2
-  (LL.ListLike s Char, IsString s) => [(Pretty s, Pretty s)] -> Pretty s
+  :: (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
+  align rows =
+    let lwidth = foldl' max 0 (preferredWidth . fst <$> rows) + 2
     in  [ group (rightPad lwidth l <> indentNAfterNewline lwidth (wrap r))
-       | (l, r) <- rows]
+        | (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  ->
+        Just s  -> (rightPad col0Width col0, indentNAfterNewline col0Width 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
+  :: (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