Merge remote-tracking branch 'upstream/trunk' into parameterize-split

.github/workflows/ci.yaml

@@ -273,6 +273,10 @@ jobs:
           ${{env.transcripts}}
           # Fail if any transcripts cause git diffs.
           git diff --ignore-cr-at-eol --exit-code unison-src/transcripts
+      - name: shell-based regression tests
+        if: steps.cache-transcript-test-results.outputs.cache-hit != 'true' && runner.os == 'linux'
+        run: |
+          unison-src/tests/fix5507.sh ${{env.ucm}}
       - name: docs.to-html
         if: steps.cache-transcript-test-results.outputs.cache-hit != 'true'
         run: |

CONTRIBUTORS.markdown

@@ -89,3 +89,5 @@ The format for this list: name, GitHub handle
 * Eduard Nicodei (@neduard)
 * Brian McKenna (@puffnfresh)
 * Ruslan Simchuk (@SimaDovakin)
+* Brandon Barker (@bbarker)
+* Manish Bhasin (@xmbhasin)

README.md

@@ -10,6 +10,8 @@ The Unison language
 * [Codebase Server](#codebase-server)
 * [Configuration](./docs/configuration.md)
 
+![Alt](https://repobeats.axiom.co/api/embed/92b662a65fd842d49cb8d7d813043f5f5b4b550d.svg "Repobeats analytics image")
+
 Overview
 --------
 

lib/unison-pretty-printer/src/Unison/Util/AnnotatedText.hs

@@ -21,13 +21,13 @@ import Unison.Util.Monoid (intercalateMap)
 import Unison.Util.Range (Range (..), inRange)
 
 data Segment a = Segment {segment :: String, annotation :: Maybe a}
-  deriving (Eq, Show, Functor, Foldable, Generic)
+  deriving (Eq, Show, Ord, Functor, Foldable, Generic)
 
 toPair :: Segment a -> (String, Maybe a)
 toPair (Segment s a) = (s, a)
 
 newtype AnnotatedText a = AnnotatedText (Seq (Segment a))
-  deriving (Eq, Functor, Foldable, Show, Generic)
+  deriving (Eq, Functor, Foldable, Show, Ord, Generic)
 
 instance Semigroup (AnnotatedText a) where
   AnnotatedText (as :|> Segment "" _) <> bs = AnnotatedText as <> bs
@@ -204,7 +204,6 @@ snipWithContext margin source =
           -- if all annotations so far can be joined without .. separations
           if null rest
             then -- if this one can be joined to the new region without .. separation
-
               if withinMargin r0 r1
                 then -- add it to the first set and grow the compare region
                   (Just $ r0 <> r1, Map.insert r1 a1 taken, mempty)

parser-typechecker/package.yaml

@@ -103,6 +103,7 @@ default-extensions:
   - ApplicativeDo
   - BangPatterns
   - BlockArguments
+  - ConstraintKinds
   - DeriveAnyClass
   - DeriveFunctor
   - DeriveGeneric

parser-typechecker/src/Unison/PrettyPrintEnv/MonadPretty.hs

@@ -1,47 +1,47 @@
-{-# LANGUAGE ConstraintKinds #-}
-
-module Unison.PrettyPrintEnv.MonadPretty where
-
-import Control.Lens (views, _1, _2)
+module Unison.PrettyPrintEnv.MonadPretty
+  ( MonadPretty,
+    Env (..),
+    runPretty,
+    addTypeVars,
+    willCaptureType,
+  )
+where
+
+import Control.Lens (views)
 import Control.Monad.Reader (MonadReader, Reader, local, runReader)
 import Data.Set qualified as Set
 import Unison.Prelude
 import Unison.PrettyPrintEnv (PrettyPrintEnv)
+import Unison.Util.Set qualified as Set
 import Unison.Var (Var)
 
-type MonadPretty v m = (Var v, MonadReader (PrettyPrintEnv, Set v) m)
-
-getPPE :: (MonadPretty v m) => m PrettyPrintEnv
-getPPE = view _1
-
--- | Run a computation with a modified PrettyPrintEnv, restoring the original
-withPPE :: (MonadPretty v m) => PrettyPrintEnv -> m a -> m a
-withPPE p = local (set _1 p)
+type MonadPretty v m = (Var v, MonadReader (Env v) m)
 
-applyPPE :: (MonadPretty v m) => (PrettyPrintEnv -> a) -> m a
-applyPPE = views _1
-
-applyPPE2 :: (MonadPretty v m) => (PrettyPrintEnv -> a -> b) -> a -> m b
-applyPPE2 f a = views _1 (`f` a)
-
-applyPPE3 :: (MonadPretty v m) => (PrettyPrintEnv -> a -> b -> c) -> a -> b -> m c
-applyPPE3 f a b = views _1 (\ppe -> f ppe a b)
-
--- | Run a computation with a modified PrettyPrintEnv, restoring the original
-modifyPPE :: (MonadPretty v m) => (PrettyPrintEnv -> PrettyPrintEnv) -> m a -> m a
-modifyPPE = local . over _1
+data Env v = Env
+  { boundTerms :: !(Set v),
+    boundTypes :: !(Set v),
+    ppe :: !PrettyPrintEnv
+  }
+  deriving stock (Generic)
 
 modifyTypeVars :: (MonadPretty v m) => (Set v -> Set v) -> m a -> m a
-modifyTypeVars = local . over _2
+modifyTypeVars = local . over #boundTypes
 
 -- | Add type variables to the set of variables that need to be avoided
 addTypeVars :: (MonadPretty v m) => [v] -> m a -> m a
 addTypeVars = modifyTypeVars . Set.union . Set.fromList
 
 -- | Check if a list of type variables contains any variables that need to be
 -- avoided
-willCapture :: (MonadPretty v m) => [v] -> m Bool
-willCapture vs = views _2 (not . Set.null . Set.intersection (Set.fromList vs))
-
-runPretty :: (Var v) => PrettyPrintEnv -> Reader (PrettyPrintEnv, Set v) a -> a
-runPretty ppe m = runReader m (ppe, mempty)
+willCaptureType :: (MonadPretty v m) => [v] -> m Bool
+willCaptureType vs = views #boundTypes (Set.intersects (Set.fromList vs))
+
+runPretty :: (Var v) => PrettyPrintEnv -> Reader (Env v) a -> a
+runPretty ppe m =
+  runReader
+    m
+    Env
+      { boundTerms = Set.empty,
+        boundTypes = Set.empty,
+        ppe
+      }