⅄ trunk → merge-no-output

Author: mitchellwrosen

.github/workflows/ci.yaml

@@ -231,7 +231,7 @@ jobs:
         uses: actions/cache@d4323d4df104b026a6aa633fdb11d772146be0bf # v4
         with:
           path: ${{env.transcript_test_results}}
-          key: transcripts-results-${{ matrix.os }}-${{ hashFiles('**/ci.yaml', '**/stack.yaml', '**/package.yaml', '**/*.hs')}}-${{ hashFiles('**/unison-src/**/*.md', '**/unison-src/**/*.u') }}
+          key: transcripts-results-${{ matrix.os }}-${{ hashFiles('**/ci.yaml', '**/stack.yaml', '**/package.yaml', '**/*.hs')}}-${{ hashFiles('**/unison-src/**/*.md', '**/unison-src/**/*.u', '**/docs/*.md', '**/docs/*.markdown') }}
       - name: restore binaries
         uses: actions/download-artifact@cc203385981b70ca67e1cc392babf9cc229d5806 # v4
         if: steps.cache-transcript-test-results.outputs.cache-hit != 'true'

docs/mcp.md

@@ -30,10 +30,11 @@ E.g. on Mac this is likely `/opt/homebrew/bin/ucm`, you can run `which ucm` to f
       "command": "<path-to-ucm>",
       "args": ["mcp"]
     }
+  }
 }
 ```
 
-E.g. my complete file on Mac looks like this:
+_e.g._ my complete file on macOS looks like this:
 
 ``` json
 {

unison-cli/src/Unison/Codebase/Editor/HandleInput.hs

@@ -194,7 +194,7 @@ loop e = do
           pp <- Cli.getCurrentProjectPath
           whenJust env.serverBaseUrl \baseUrl ->
             Cli.respond $
-              PrintMessage $
+              Literal $
                 P.lines
                   [ "The API information is as follows:",
                     P.newline,
@@ -203,7 +203,7 @@ loop e = do
                     P.indentN 2 (P.hiBlue ("API: " <> Pretty.text (Server.urlFor Server.Api baseUrl)))
                   ]
         CreateMessage pretty ->
-          Cli.respond $ PrintMessage pretty
+          Cli.respond $ Literal pretty
         ShowRootReflogI -> do
           let numEntriesToShow = 500
           (schLength, entries) <-

unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs

@@ -452,7 +452,7 @@ evalUnisonFile mode ppe unisonFile args = do
             | not $ null errs ->
                 False <$ RuntimeUtils.displayDecompileErrors errs
           Runtime.Profile prof ->
-            True <$ Cli.respond (Output.PrintMessage prof)
+            True <$ Cli.respond (Output.Literal prof)
           _ -> pure True
         for_ (Map.elems map) \(_loc, kind, hash, _src, value, isHit) -> do
           -- only update the watch cache when there are no errors

unison-cli/src/Unison/Codebase/Editor/HandleInput/Names.hs

@@ -39,7 +39,7 @@ handleNames ::
   Cli ()
 handleNames _ (nameQuery, Left errMsg) = do
   Cli.respond $
-    PrintMessage $
+    Literal $
       P.lines [prettyNameQuery, errMsg]
   where
     prettyNameQuery =

unison-cli/src/Unison/Codebase/Editor/HandleInput/RuntimeUtils.hs

@@ -50,7 +50,7 @@ modeProfSpec (Permissive prof) = prof
 
 displayDecompileErrors :: [DecompError] -> Cli ()
 displayDecompileErrors =
-  Cli.respond . PrintMessage . msg . fmap (P.indentN 2 . P.indentN 2 . renderDecompError)
+  Cli.respond . Literal . msg . fmap (P.indentN 2 . P.indentN 2 . renderDecompError)
   where
     msg em = do
       P.lines $
@@ -97,7 +97,7 @@ evalUnisonTermE mode ppe useCache tm = do
 displayResponse :: Runtime.Response DecompError -> Cli ()
 displayResponse (Runtime.DecompErrs errs)
   | not $ null errs = displayDecompileErrors errs
-displayResponse (Runtime.Profile prof) = Cli.respond (PrintMessage msg)
+displayResponse (Runtime.Profile prof) = Cli.respond (Literal msg)
   where
     msg = P.lines ["Profile Results:", ""] <> prof
 displayResponse _ = pure ()

unison-cli/src/Unison/Codebase/Editor/Output.hs

@@ -178,8 +178,6 @@ data Output
     Success
   | -- User did `update` before typechecking a file?
     NoUnisonFile
-  | -- Used in Welcome module to instruct user
-    PrintMessage (P.Pretty P.ColorText)
   | InvalidSourceName String
   | SourceLoadFailed String
   | -- No main function, the [Type v Ann] are the allowed types
@@ -518,7 +516,6 @@ isFailure o = case o of
   SaveTermNameConflict {} -> True
   RunResult {} -> False
   Success {} -> False
-  PrintMessage {} -> False
   NoUnisonFile {} -> True
   InvalidSourceName {} -> True
   SourceLoadFailed {} -> True

unison-cli/src/Unison/CommandLine/Main.hs

@@ -21,6 +21,7 @@ import System.Console.Haskeline.History qualified as Line
 import System.FSNotify qualified as FSNotify
 import System.IO (hGetEcho, hPutStrLn, hSetEcho, stderr, stdin)
 import System.IO.Error (isDoesNotExistError)
+import U.Codebase.Sqlite.Queries qualified as Queries
 import Unison.Auth.CredentialManager qualified as AuthN
 import Unison.Auth.HTTPClient (AuthenticatedHttpClient)
 import Unison.Auth.HTTPClient qualified as AuthN
@@ -45,6 +46,7 @@ import Unison.CommandLine.Welcome qualified as Welcome
 import Unison.Parser.Ann (Ann)
 import Unison.Prelude
 import Unison.PrettyTerminal
+import Unison.Project qualified as Project
 import Unison.Runtime (Runtime)
 import Unison.Runtime.IOSource qualified as IOSource
 import Unison.Server.CodebaseServer qualified as Server
@@ -172,8 +174,38 @@ main dir welcome ppIds initialInputs runtime sbRuntime codebase serverBaseUrl uc
                 ShouldWatchFiles -> allow
           )
 
+      -- On startup, we tell the user about any existing project names that don't pass the new project name regex,
+      -- which isn't enforced yet.
+
+      invalidProjectNamesInputs <- do
+        projects <- Codebase.runTransaction codebase Queries.loadAllProjects
+        let invalidProjectNames =
+              mapMaybe
+                ( \project ->
+                    if Project.isValidNewProjectName project.name
+                      then Nothing
+                      else Just project.name
+                )
+                projects
+        pure case invalidProjectNames of
+          [] -> []
+          _ ->
+            [ Right . CreateMessage . P.warnCallout $
+                P.wrap "We're updating UCM's project naming rules, and these names won’t be supported much longer:"
+                  <> P.newline
+                  <> P.newline
+                  <> P.group (P.commas (map P.prettyProjectName invalidProjectNames))
+                  <> P.newline
+                  <> P.newline
+                  <> P.wrap
+                    ( "Please"
+                        <> IP.makeExample IP.projectRenameInputPattern []
+                        <> "them using only ASCII letters, numbers, and hyphens, of length 2-40 characters."
+                    )
+            ]
+
       let initialState = Cli.loopState0 ppIds
-      initialInputsRef <- newIORef $ Welcome.run welcome ++ initialInputs
+      initialInputsRef <- newIORef $ Welcome.run welcome ++ initialInputs ++ invalidProjectNamesInputs
       pageOutput <- newIORef True
 
       initialEcho <- hGetEcho stdin

unison-cli/src/Unison/CommandLine/OutputMessages.hs

@@ -559,7 +559,6 @@ notifyUser dir issueFn = \case
         <> "to evaluate something before attempting"
         <> "to save it."
   Success -> pure $ P.bold "Done."
-  PrintMessage pretty -> pure pretty
   NamespaceEmpty p ->
     case p of
       (p0 NEList.:| []) ->

unison-core/src/Unison/Project.hs

@@ -9,6 +9,7 @@ module Unison.Project
     projectNameUserSlug,
     projectNameToUserProjectSlugs,
     prependUserSlugToProjectName,
+    isValidNewProjectName,
     ProjectBranchName,
     projectBranchNameUserSlug,
     projectBranchNameToValidProjectBranchNameText,
@@ -34,6 +35,7 @@ where
 
 import Data.Char qualified as Char
 import Data.Kind (Type)
+import Data.Monoid qualified as Monoid
 import Data.Text qualified as Text
 import Data.Text.Read qualified as Text (decimal)
 import Data.These (These (..))
@@ -75,6 +77,56 @@ projectNameParser = do
         isStartChar c =
           Char.isAlpha c || c == '_'
 
+-- Parse a project name, and whether it ended in a forward slash (which is, of course, not part of the name)
+newProjectNameParser :: Megaparsec.Parsec Void Text (ProjectName, Bool)
+newProjectNameParser = do
+  userSlug <-
+    asum
+      [ do
+          user <- userSlugParser
+          pure (Text.Builder.char '@' <> user <> Text.Builder.char '/'),
+        pure mempty
+      ]
+  projectSlug <- projectSlugParser
+  hasTrailingSlash <- isJust <$> optional (Megaparsec.char '/')
+  pure (UnsafeProjectName (Text.Builder.run (userSlug <> projectSlug)), hasTrailingSlash)
+  where
+    -- Github project regular expression: ^[a-z\d](?:[a-z\d]|-(?=[a-z\d])){1,39}$
+    --
+    -- In English: a-z or 0-9, followed by 1-39 repetitions of a-z or 0-9 or hyphen, with the restriction that any
+    -- hyphen must be followed by a-z or 0-9
+    --
+    -- We implement that here, but with parser combinators: a-z or 0-9, followed by 1 or more chunks of [optional
+    -- hyphen followed by 1 or more a-z or 0-9], checking length at the end
+    projectSlugParser :: Megaparsec.Parsec Void Text Text.Builder
+    projectSlugParser = do
+      firstChar <- Megaparsec.satisfy isAsciiLowerOrDigit
+      chunks <- some ((,) <$> optional (Megaparsec.char '-') <*> Megaparsec.takeWhile1P Nothing isAsciiLowerOrDigit)
+      when (chunksLength chunks > 39) (fail "Project name must be 2-40 characters long.")
+      pure $
+        Text.Builder.char firstChar
+          <> foldMap
+            ( \(maybeHyphen, chunk) ->
+                maybe (mempty @Text.Builder) Text.Builder.char maybeHyphen <> Text.Builder.text chunk
+            )
+            chunks
+      where
+        isAsciiLowerOrDigit :: Char -> Bool
+        isAsciiLowerOrDigit c =
+          Char.isAsciiLower c || Char.isDigit c
+
+        chunksLength :: [(Maybe Char, Text)] -> Int
+        chunksLength =
+          Monoid.getSum . foldMap (Monoid.Sum . chunkLength)
+
+        chunkLength :: (Maybe Char, Text) -> Int
+        chunkLength (maybeHyphen, chunk) =
+          (if isJust maybeHyphen then 1 else 0) + Text.length chunk
+
+isValidNewProjectName :: ProjectName -> Bool
+isValidNewProjectName (UnsafeProjectName projectName) =
+  isRight (Megaparsec.parse newProjectNameParser "" projectName)
+
 -- | Get the user slug at the beginning of a project name, if there is one.
 --
 -- >>> projectNameUserSlug "@arya/lens"