diff --git a/CREDITS.md b/CREDITS.md index 321060f338..bd367b3aef 100644 --- a/CREDITS.md +++ b/CREDITS.md @@ -52,7 +52,6 @@ These are listed in alphabetical order. | [comonad-5.0.6](https://hackage.haskell.org/package/comonad-5.0.6) | [BSD3](https://hackage.haskell.org/package/comonad-5.0.6/src/LICENSE) | | [concurrent-supply-0.1.8](https://hackage.haskell.org/package/concurrent-supply-0.1.8) | [BSD3](https://hackage.haskell.org/package/concurrent-supply-0.1.8/src/LICENSE) | | [conduit-1.3.2](https://hackage.haskell.org/package/conduit-1.3.2) | [MIT](https://hackage.haskell.org/package/conduit-1.3.2/src/LICENSE) | -| [configurator-0.3.0.0](https://hackage.haskell.org/package/configurator-0.3.0.0) | [BSD3](https://hackage.haskell.org/package/configurator-0.3.0.0/src/LICENSE) | | [containers-0.6.2.1](https://hackage.haskell.org/package/containers-0.6.2.1) | [BSD3](https://hackage.haskell.org/package/containers-0.6.2.1/src/LICENSE) | | [contravariant-1.5.2](https://hackage.haskell.org/package/contravariant-1.5.2) | [BSD3](https://hackage.haskell.org/package/contravariant-1.5.2/src/LICENSE) | | [cryptohash-md5-0.11.100.1](https://hackage.haskell.org/package/cryptohash-md5-0.11.100.1) | [BSD3](https://hackage.haskell.org/package/cryptohash-md5-0.11.100.1/src/LICENSE) | diff --git a/contrib/cabal.project b/contrib/cabal.project index d23809d841..8f13162c7f 100644 --- a/contrib/cabal.project +++ b/contrib/cabal.project @@ -36,11 +36,6 @@ packages: unison-syntax yaks/easytest -source-repository-package - type: git - location: https://github.com/unisonweb/configurator.git - tag: e47e9e9fe1f576f8c835183b9def52d73c01327a - source-repository-package type: git location: https://github.com/unisonweb/haskeline.git diff --git a/nix/unison-project.nix b/nix/unison-project.nix index aa191a5a44..3ca79d706b 100644 --- a/nix/unison-project.nix +++ b/nix/unison-project.nix @@ -25,7 +25,6 @@ in } ]; branchMap = { - "https://github.com/unisonweb/configurator.git"."e47e9e9fe1f576f8c835183b9def52d73c01327a" = "unison"; "https://github.com/unisonweb/shellmet.git"."2fd348592c8f51bb4c0ca6ba4bc8e38668913746" = "topic/avoid-callCommand"; }; } diff --git a/parser-typechecker/package.yaml b/parser-typechecker/package.yaml index de5bbd70e3..5cc6ba5473 100644 --- a/parser-typechecker/package.yaml +++ b/parser-typechecker/package.yaml @@ -37,7 +37,6 @@ dependencies: - cereal - clock - concurrent-output - - configurator - containers >= 0.6.3 - cryptonite - data-default diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index b97cc70bb1..edc3182a5e 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -242,7 +242,6 @@ library , cereal , clock , concurrent-output - , configurator , containers >=0.6.3 , crypton-x509 , crypton-x509-store @@ -437,7 +436,6 @@ test-suite parser-typechecker-tests , clock , code-page , concurrent-output - , configurator , containers >=0.6.3 , crypton-x509 , crypton-x509-store diff --git a/stack.yaml b/stack.yaml index 19bccd7774..1eb80fdd2c 100644 --- a/stack.yaml +++ b/stack.yaml @@ -51,9 +51,6 @@ packages: resolver: lts-22.26 extra-deps: - # broken version in snapshot - - github: unisonweb/configurator - commit: e47e9e9fe1f576f8c835183b9def52d73c01327a # This custom Haskeline alters ANSI rendering on Windows. # If changing the haskeline dependency, please ensure color renders properly in a # Windows terminal. diff --git a/stack.yaml.lock b/stack.yaml.lock index 61c24795ea..316b017f48 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -4,17 +4,6 @@ # https://docs.haskellstack.org/en/stable/lock_files packages: -- completed: - name: configurator - pantry-tree: - sha256: 90547cd983fd15ebdc803e057d3ef8735fe93a75e29a00f8a74eadc13ee0f6e9 - size: 955 - sha256: d4fd87fb7bfc5d8e9fbc3e4ee7302c6b1500cdc00fdb9b659d0f4849b6ebe2d5 - size: 15989 - url: https://github.com/unisonweb/configurator/archive/e47e9e9fe1f576f8c835183b9def52d73c01327a.tar.gz - version: 0.3.0.0 - original: - url: https://github.com/unisonweb/configurator/archive/e47e9e9fe1f576f8c835183b9def52d73c01327a.tar.gz - completed: name: haskeline pantry-tree: diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml index 23b18fa9d9..ac5c0053be 100644 --- a/unison-cli/package.yaml +++ b/unison-cli/package.yaml @@ -23,7 +23,6 @@ dependencies: - co-log-core - code-page - concurrent-output - - configurator - containers >= 0.6.3 - cryptonite - directory diff --git a/unison-cli/src/Unison/Cli/Monad.hs b/unison-cli/src/Unison/Cli/Monad.hs index f712907fab..500a015a9a 100644 --- a/unison-cli/src/Unison/Cli/Monad.hs +++ b/unison-cli/src/Unison/Cli/Monad.hs @@ -62,7 +62,6 @@ import Control.Lens import Control.Monad.Reader (MonadReader (..)) import Control.Monad.State.Strict (MonadState) import Control.Monad.State.Strict qualified as State -import Data.Configurator.Types qualified as Configurator import Data.List.NonEmpty qualified as List (NonEmpty) import Data.List.NonEmpty qualified as List.NonEmpty import Data.List.NonEmpty qualified as NonEmpty @@ -160,7 +159,6 @@ type SourceName = Text data Env = Env { authHTTPClient :: AuthenticatedHttpClient, codebase :: Codebase IO Symbol Ann, - config :: Configurator.Config, credentialManager :: CredentialManager, -- | Generate a unique name. generateUniqueName :: IO Parser.UniqueName, diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 8ea64f0694..4546be1e84 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -1,10 +1,7 @@ -- | This module contains miscellaneous helper utils for rote actions in the Cli monad, like resolving a relative path -- to an absolute path, per the current path. module Unison.Cli.MonadUtils - ( -- * @.unisonConfig@ things - getConfig, - - -- * Paths + ( -- * Paths getCurrentPath, getCurrentProjectName, getCurrentProjectBranchName, @@ -88,8 +85,6 @@ where import Control.Lens import Control.Monad.Reader (ask) import Control.Monad.State -import Data.Configurator qualified as Configurator -import Data.Configurator.Types qualified as Configurator import Data.Foldable import Data.Set qualified as Set import U.Codebase.Branch qualified as V2 (Branch) @@ -138,15 +133,6 @@ import Unison.UnisonFile.Names qualified as UFN import Unison.Util.Set qualified as Set import Unison.Var qualified as Var ------------------------------------------------------------------------------------------------------------------------- --- .unisonConfig things - --- | Lookup a config value by key. -getConfig :: (Configurator.Configured a) => Text -> Cli (Maybe a) -getConfig key = do - Cli.Env {config} <- ask - liftIO (Configurator.lookup config key) - ------------------------------------------------------------------------------------------------------------------------ -- Getting paths, path resolution, etc. diff --git a/unison-cli/src/Unison/Codebase/Transcript/Runner.hs b/unison-cli/src/Unison/Codebase/Transcript/Runner.hs index 6e084a2eba..7ba207298e 100644 --- a/unison-cli/src/Unison/Codebase/Transcript/Runner.hs +++ b/unison-cli/src/Unison/Codebase/Transcript/Runner.hs @@ -13,8 +13,6 @@ import Crypto.Random qualified as Random import Data.Aeson qualified as Aeson import Data.Aeson.Encode.Pretty qualified as Aeson import Data.ByteString.Lazy.Char8 qualified as BL -import Data.Configurator qualified as Configurator -import Data.Configurator.Types (Config) import Data.IORef import Data.List (isSubsequenceOf) import Data.List.NonEmpty qualified as NonEmpty @@ -24,9 +22,7 @@ import Data.These (These (..)) import Data.UUID.V4 qualified as UUID import Network.HTTP.Client qualified as HTTP import System.Environment (lookupEnv) -import System.Exit (die) import System.IO qualified as IO -import System.IO.Error (catchIOError) import Text.Megaparsec qualified as P import U.Codebase.Sqlite.DbId qualified as Db import U.Codebase.Sqlite.Project (Project (..)) @@ -96,16 +92,15 @@ withRunner :: Verbosity -> UCMVersion -> FilePath -> - Maybe FilePath -> (Runner -> m r) -> m r -withRunner isTest verbosity ucmVersion nrtp configFile action = do - withRuntimes nrtp \runtime sbRuntime nRuntime -> withConfig \config -> do +withRunner isTest verbosity ucmVersion nrtp action = do + withRuntimes nrtp \runtime sbRuntime nRuntime -> do action \transcriptName transcriptSrc (codebaseDir, codebase) -> do Server.startServer (Backend.BackendEnv {Backend.useNamesIndex = False}) Server.defaultCodebaseServerOpts runtime codebase \baseUrl -> do let parsed = Transcript.stanzas transcriptName transcriptSrc result <- for parsed \stanzas -> do - liftIO $ run isTest verbosity codebaseDir stanzas codebase runtime sbRuntime nRuntime config ucmVersion (tShow baseUrl) + liftIO $ run isTest verbosity codebaseDir stanzas codebase runtime sbRuntime nRuntime ucmVersion (tShow baseUrl) pure . join $ first ParseError result where withRuntimes :: @@ -115,19 +110,6 @@ withRunner isTest verbosity ucmVersion nrtp configFile action = do RTI.withRuntime True RTI.Persistent ucmVersion \sbRuntime -> do action runtime sbRuntime =<< liftIO (RTI.startNativeRuntime ucmVersion nrtp) - withConfig :: forall a. ((Maybe Config -> m a) -> m a) - withConfig action = do - case configFile of - Nothing -> action Nothing - Just configFilePath -> do - let loadConfig = liftIO do - catchIOError - (watchConfig configFilePath) - \_ -> die "Your .unisonConfig could not be loaded. Check that it's correct!" - UnliftIO.bracket - loadConfig - (\(_config, cancelConfig) -> liftIO cancelConfig) - (\(config, _cancelConfig) -> action (Just config)) run :: -- | Whether to treat this transcript run as a transcript test, which will try to make output deterministic @@ -139,11 +121,10 @@ run :: Runtime.Runtime Symbol -> Runtime.Runtime Symbol -> Runtime.Runtime Symbol -> - Maybe Config -> UCMVersion -> Text -> IO (Either Error Text) -run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion baseURL = UnliftIO.try do +run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime ucmVersion baseURL = UnliftIO.try do httpManager <- HTTP.newManager HTTP.defaultManagerSettings (initialPP, emptyCausalHashId) <- Codebase.runTransaction codebase do (_, emptyCausalHashId) <- Codebase.emptyCausalHash @@ -427,7 +408,6 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmV Cli.Env { authHTTPClient = authenticatedHTTPClient, codebase, - config = fromMaybe Configurator.empty config, credentialManager = credMan, generateUniqueName = do i <- atomicModifyIORef' seedRef \i -> let !i' = i + 1 in (i', i) diff --git a/unison-cli/src/Unison/CommandLine.hs b/unison-cli/src/Unison/CommandLine.hs index 168e264894..99ac5799d9 100644 --- a/unison-cli/src/Unison/CommandLine.hs +++ b/unison-cli/src/Unison/CommandLine.hs @@ -6,7 +6,6 @@ module Unison.CommandLine ( allow, parseInput, prompt, - watchConfig, watchFileSystem, ) where @@ -15,9 +14,6 @@ import Control.Concurrent (forkIO, killThread) import Control.Lens hiding (aside) import Control.Monad.Except import Control.Monad.Trans.Except -import Data.Configurator (autoConfig, autoReload) -import Data.Configurator qualified as Config -import Data.Configurator.Types (Config, Worth (..)) import Data.List (isPrefixOf, isSuffixOf) import Data.Map qualified as Map import Data.Semialign qualified as Align @@ -50,23 +46,12 @@ import Unison.Util.TQueue qualified as Q import UnliftIO.STM import Prelude hiding (readFile, writeFile) -disableWatchConfig :: Bool -disableWatchConfig = False - allow :: FilePath -> Bool allow p = -- ignore Emacs .# prefixed files, see https://github.com/unisonweb/unison/issues/457 not (".#" `isPrefixOf` takeFileName p) && (isSuffixOf ".u" p || isSuffixOf ".uu" p) -watchConfig :: FilePath -> IO (Config, IO ()) -watchConfig path = - if disableWatchConfig - then pure (Config.empty, pure ()) - else do - (config, t) <- autoReload autoConfig [Optional path] - pure (config, killThread t) - watchFileSystem :: Q.TQueue Event -> FilePath -> IO (IO ()) watchFileSystem q dir = do (cancel, watcher) <- Watch.watchDirectory dir allow diff --git a/unison-cli/src/Unison/CommandLine/Main.hs b/unison-cli/src/Unison/CommandLine/Main.hs index 914581664b..cfefd666c0 100644 --- a/unison-cli/src/Unison/CommandLine/Main.hs +++ b/unison-cli/src/Unison/CommandLine/Main.hs @@ -9,7 +9,6 @@ import Control.Exception (catch, displayException, finally, mask) import Control.Lens ((?~)) import Control.Lens.Lens import Crypto.Random qualified as Random -import Data.Configurator.Types (Config) import Data.IORef import Data.List.NonEmpty qualified as NEL import Data.List.NonEmpty qualified as NonEmpty @@ -124,7 +123,6 @@ main :: FilePath -> Welcome.Welcome -> PP.ProjectPathIds -> - Config -> [Either Event Input] -> Runtime.Runtime Symbol -> Runtime.Runtime Symbol -> @@ -135,7 +133,7 @@ main :: (PP.ProjectPathIds -> IO ()) -> ShouldWatchFiles -> IO () -main dir welcome ppIds config initialInputs runtime sbRuntime nRuntime codebase serverBaseUrl ucmVersion lspCheckForChanges shouldWatchFiles = Ki.scoped \scope -> do +main dir welcome ppIds initialInputs runtime sbRuntime nRuntime codebase serverBaseUrl ucmVersion lspCheckForChanges shouldWatchFiles = Ki.scoped \scope -> do _ <- Ki.fork scope do -- Pre-load the project root in the background so it'll be ready when a command needs it. projectRoot <- Codebase.expectProjectBranchRoot codebase ppIds.project ppIds.branch @@ -221,7 +219,6 @@ main dir welcome ppIds config initialInputs runtime sbRuntime nRuntime codebase Cli.Env { authHTTPClient, codebase, - config, credentialManager, loadSource = loadSourceFile, writeSource = writeSourceFile, diff --git a/unison-cli/src/Unison/Main.hs b/unison-cli/src/Unison/Main.hs index 990f11354f..498f2b6218 100644 --- a/unison-cli/src/Unison/Main.hs +++ b/unison-cli/src/Unison/Main.hs @@ -27,7 +27,6 @@ import Compat (defaultInterruptHandler, withInterruptHandler) import Control.Concurrent (newEmptyMVar, runInUnboundThread, takeMVar) import Control.Exception (displayException, evaluate) import Data.ByteString.Lazy qualified as BL -import Data.Configurator.Types (Config) import Data.Either.Validation (Validation (..)) import Data.List.NonEmpty (NonEmpty) import Data.Text qualified as Text @@ -57,7 +56,6 @@ import System.FilePath ) import System.IO (stderr) import System.IO.CodePage (withCP65001) -import System.IO.Error (catchIOError) import System.IO.Temp qualified as Temp import System.Path qualified as Path import Text.Megaparsec qualified as MP @@ -76,7 +74,6 @@ import Unison.Codebase.Runtime qualified as Rt import Unison.Codebase.SqliteCodebase qualified as SC import Unison.Codebase.Transcript.Runner qualified as Transcript import Unison.Codebase.Verbosity qualified as Verbosity -import Unison.CommandLine (watchConfig) import Unison.CommandLine.Helpers (plural') import Unison.CommandLine.Main qualified as CommandLine import Unison.CommandLine.Types qualified as CommandLine @@ -96,7 +93,6 @@ import Unison.Symbol (Symbol) import Unison.Util.Pretty qualified as P import Unison.Version (Version) import Unison.Version qualified as Version -import UnliftIO qualified import UnliftIO.Directory (getHomeDirectory) type Runtimes = @@ -143,220 +139,216 @@ main version = do (renderUsageInfo, globalOptions, command) <- parseCLIArgs progName (Text.unpack (Version.gitDescribeWithDate version)) nrtp <- fixNativeRuntimePath (nativeRuntimePath globalOptions) let GlobalOptions {codebasePathOption = mCodePathOption, exitOption, lspFormattingConfig} = globalOptions - withConfig mCodePathOption \config -> do - currentDir <- getCurrentDirectory - case command of - PrintVersion -> - Text.putStrLn $ Text.pack progName <> " version: " <> Version.gitDescribeWithDate version - Init -> do - exitError - ( P.lines - [ "The Init command has been removed", - P.newline, - P.wrap "Use --codebase-create to create a codebase at a specified location and open it:", - P.indentN 2 (P.hiBlue "$ ucm --codebase-create myNewCodebase"), - "Running UCM without the --codebase-create flag: ", - P.indentN 2 (P.hiBlue "$ ucm"), - P.wrap ("will " <> P.bold "always" <> " create a codebase in your home directory if one does not already exist.") + currentDir <- getCurrentDirectory + case command of + PrintVersion -> + Text.putStrLn $ Text.pack progName <> " version: " <> Version.gitDescribeWithDate version + Init -> do + exitError + ( P.lines + [ "The Init command has been removed", + P.newline, + P.wrap "Use --codebase-create to create a codebase at a specified location and open it:", + P.indentN 2 (P.hiBlue "$ ucm --codebase-create myNewCodebase"), + "Running UCM without the --codebase-create flag: ", + P.indentN 2 (P.hiBlue "$ ucm"), + P.wrap ("will " <> P.bold "always" <> " create a codebase in your home directory if one does not already exist.") + ] + ) + Run (RunFromSymbol mainName) args -> do + getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(_, _, theCodebase) -> do + RTI.withRuntime False RTI.OneOff (Version.gitDescribeWithDate version) \runtime -> do + withArgs args (execute theCodebase runtime mainName) >>= \case + Left err -> exitError err + Right () -> pure () + Run (RunFromFile file mainName) args + | not (isDotU file) -> exitError "Files must have a .u extension." + | otherwise -> do + e <- safeReadUtf8 file + case e of + Left _ -> exitError "I couldn't find that file or it is for some reason unreadable." + Right contents -> do + getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do + withRuntimes nrtp RTI.OneOff \(rt, sbrt, nrt) -> do + let fileEvent = Input.UnisonFileChanged (Text.pack file) contents + let noOpCheckForChanges _ = pure () + let serverUrl = Nothing + startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath + launch + version + currentDir + rt + sbrt + nrt + theCodebase + [Left fileEvent, Right $ Input.ExecuteI mainName args, Right Input.QuitI] + serverUrl + (PP.toIds startProjectPath) + initRes + noOpCheckForChanges + CommandLine.ShouldNotWatchFiles + Run (RunFromPipe mainName) args -> do + e <- safeReadUtf8StdIn + case e of + Left _ -> exitError "I had trouble reading this input." + Right contents -> do + getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do + withRuntimes nrtp RTI.OneOff \(rt, sbrt, nrt) -> do + let fileEvent = Input.UnisonFileChanged (Text.pack "") contents + let noOpCheckForChanges _ = pure () + let serverUrl = Nothing + startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath + launch + version + currentDir + rt + sbrt + nrt + theCodebase + [Left fileEvent, Right $ Input.ExecuteI mainName args, Right Input.QuitI] + serverUrl + (PP.toIds startProjectPath) + initRes + noOpCheckForChanges + CommandLine.ShouldNotWatchFiles + Run (RunCompiled file) args -> + BL.readFile file >>= \bs -> + try (evaluate $ RTI.decodeStandalone bs) >>= \case + Left (PE _cs err) -> do + exitError . P.lines $ + [ P.wrap . P.text $ + "I was unable to parse this file as a compiled\ + \ program. The parser generated the following error:", + "", + P.indentN 2 $ err ] - ) - Run (RunFromSymbol mainName) args -> do - getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(_, _, theCodebase) -> do - RTI.withRuntime False RTI.OneOff (Version.gitDescribeWithDate version) \runtime -> do - withArgs args (execute theCodebase runtime mainName) >>= \case - Left err -> exitError err - Right () -> pure () - Run (RunFromFile file mainName) args - | not (isDotU file) -> exitError "Files must have a .u extension." - | otherwise -> do - e <- safeReadUtf8 file - case e of - Left _ -> exitError "I couldn't find that file or it is for some reason unreadable." - Right contents -> do - getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do - withRuntimes nrtp RTI.OneOff \(rt, sbrt, nrt) -> do - let fileEvent = Input.UnisonFileChanged (Text.pack file) contents - let noOpCheckForChanges _ = pure () - let serverUrl = Nothing - startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath + Right (Left err) -> + exitError . P.lines $ + [ P.wrap . P.text $ + "I was unable to parse this file as a compiled\ + \ program. The parser generated the following error:", + "", + P.indentN 2 . P.wrap $ P.string err + ] + Left _ -> do + exitError . P.wrap . P.text $ + "I was unable to parse this file as a compiled\ + \ program. The parser generated an unrecognized error." + Right (Right (v, rf, w, sto)) + | not vmatch -> mismatchMsg + | otherwise -> + withArgs args (RTI.runStandalone sto w) >>= \case + Left err -> exitError err + Right () -> pure () + where + vmatch = v == Version.gitDescribeWithDate version + ws s = P.wrap (P.text s) + ifile + | 'c' : 'u' : '.' : rest <- reverse file = reverse rest + | otherwise = file + mismatchMsg = + PT.putPrettyLn . P.lines $ + [ ws + "I can't run this compiled program since \ + \it works with a different version of Unison \ + \than the one you're running.", + "", + "Compiled file version", + P.indentN 4 $ P.text v, + "", + "Your version", + P.indentN 4 $ P.text $ Version.gitDescribeWithDate version, + "", + P.wrap $ + "The program was compiled from hash " + <> (P.text $ "`" <> rf <> "`.") + <> "If you have that hash in your codebase," + <> "you can do:", + "", + P.indentN 4 $ + ".> compile " + <> P.text rf + <> " " + <> P.string ifile, + "", + P.wrap + "to produce a new compiled program \ + \that matches your version of Unison." + ] + Transcript shouldFork shouldSaveCodebase mrtsStatsFp transcriptFiles -> do + let action = runTranscripts version Verbosity.Verbose renderUsageInfo shouldFork shouldSaveCodebase mCodePathOption nrtp transcriptFiles + case mrtsStatsFp of + Nothing -> action + Just fp -> recordRtsStats fp action + Launch isHeadless codebaseServerOpts mayStartingProject shouldWatchFiles -> do + getCodebaseOrExit mCodePathOption (SC.MigrateAfterPrompt SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do + withRuntimes nrtp RTI.Persistent \(runtime, sbRuntime, nRuntime) -> do + startingProjectPath <- do + -- If the user didn't provide a starting path on the command line, put them in the most recent + -- path they cd'd to + case mayStartingProject of + Just startingProject -> do + Codebase.runTransaction theCodebase (ProjectUtils.getProjectAndBranchByNames startingProject) >>= \case + Nothing -> do + PT.putPrettyLn $ + P.callout + "❓" + ( P.lines + [ P.indentN 2 "I couldn't find the project branch: " <> P.text (into @Text startingProject) + ] + ) + System.exitFailure + Just pab -> do + pure $ PP.fromProjectAndBranch pab Path.absoluteEmpty + Nothing -> do + Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath + currentPP <- Codebase.runTransaction theCodebase do + PP.toIds <$> Codebase.expectCurrentProjectPath + changeSignal <- Signal.newSignalIO (Just currentPP) + let lspCheckForChanges pp = Signal.writeSignalIO changeSignal pp + -- Unfortunately, the windows IO manager on GHC 8.* is prone to just hanging forever + -- when waiting for input on handles, so if we listen for LSP connections it will + -- prevent UCM from shutting down properly. Hopefully we can re-enable LSP on + -- Windows when we move to GHC 9.* + -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/1224 + void . Ki.fork scope $ LSP.spawnLsp lspFormattingConfig theCodebase runtime changeSignal + Server.startServer (Backend.BackendEnv {Backend.useNamesIndex = False}) codebaseServerOpts sbRuntime theCodebase $ \baseUrl -> do + case exitOption of + DoNotExit -> do + case isHeadless of + Headless -> do + PT.putPrettyLn $ + P.lines + [ "I've started the Codebase API server at", + P.text $ Server.urlFor Server.Api baseUrl, + "and the Codebase UI at", + P.text $ Server.urlFor (Server.ProjectBranchUI (ProjectAndBranch (UnsafeProjectName "scratch") (UnsafeProjectBranchName "main")) Path.absoluteEmpty Nothing) baseUrl + ] + PT.putPrettyLn $ + P.string "Running the codebase manager headless with " + <> P.shown GHC.Conc.numCapabilities + <> " " + <> plural' GHC.Conc.numCapabilities "cpu" "cpus" + <> "." + mvar <- newEmptyMVar + takeMVar mvar + WithCLI -> do + PT.putPrettyLn $ P.string "Now starting the Unison Codebase Manager (UCM)..." + launch version currentDir - config - rt - sbrt - nrt + runtime + sbRuntime + nRuntime theCodebase - [Left fileEvent, Right $ Input.ExecuteI mainName args, Right Input.QuitI] - serverUrl - (PP.toIds startProjectPath) + [] + (Just baseUrl) + (PP.toIds startingProjectPath) initRes - noOpCheckForChanges - CommandLine.ShouldNotWatchFiles - Run (RunFromPipe mainName) args -> do - e <- safeReadUtf8StdIn - case e of - Left _ -> exitError "I had trouble reading this input." - Right contents -> do - getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do - withRuntimes nrtp RTI.OneOff \(rt, sbrt, nrt) -> do - let fileEvent = Input.UnisonFileChanged (Text.pack "") contents - let noOpCheckForChanges _ = pure () - let serverUrl = Nothing - startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath - launch - version - currentDir - config - rt - sbrt - nrt - theCodebase - [Left fileEvent, Right $ Input.ExecuteI mainName args, Right Input.QuitI] - serverUrl - (PP.toIds startProjectPath) - initRes - noOpCheckForChanges - CommandLine.ShouldNotWatchFiles - Run (RunCompiled file) args -> - BL.readFile file >>= \bs -> - try (evaluate $ RTI.decodeStandalone bs) >>= \case - Left (PE _cs err) -> do - exitError . P.lines $ - [ P.wrap . P.text $ - "I was unable to parse this file as a compiled\ - \ program. The parser generated the following error:", - "", - P.indentN 2 $ err - ] - Right (Left err) -> - exitError . P.lines $ - [ P.wrap . P.text $ - "I was unable to parse this file as a compiled\ - \ program. The parser generated the following error:", - "", - P.indentN 2 . P.wrap $ P.string err - ] - Left _ -> do - exitError . P.wrap . P.text $ - "I was unable to parse this file as a compiled\ - \ program. The parser generated an unrecognized error." - Right (Right (v, rf, w, sto)) - | not vmatch -> mismatchMsg - | otherwise -> - withArgs args (RTI.runStandalone sto w) >>= \case - Left err -> exitError err - Right () -> pure () - where - vmatch = v == Version.gitDescribeWithDate version - ws s = P.wrap (P.text s) - ifile - | 'c' : 'u' : '.' : rest <- reverse file = reverse rest - | otherwise = file - mismatchMsg = - PT.putPrettyLn . P.lines $ - [ ws - "I can't run this compiled program since \ - \it works with a different version of Unison \ - \than the one you're running.", - "", - "Compiled file version", - P.indentN 4 $ P.text v, - "", - "Your version", - P.indentN 4 $ P.text $ Version.gitDescribeWithDate version, - "", - P.wrap $ - "The program was compiled from hash " - <> (P.text $ "`" <> rf <> "`.") - <> "If you have that hash in your codebase," - <> "you can do:", - "", - P.indentN 4 $ - ".> compile " - <> P.text rf - <> " " - <> P.string ifile, - "", - P.wrap - "to produce a new compiled program \ - \that matches your version of Unison." - ] - Transcript shouldFork shouldSaveCodebase mrtsStatsFp transcriptFiles -> do - let action = runTranscripts version Verbosity.Verbose renderUsageInfo shouldFork shouldSaveCodebase mCodePathOption nrtp transcriptFiles - case mrtsStatsFp of - Nothing -> action - Just fp -> recordRtsStats fp action - Launch isHeadless codebaseServerOpts mayStartingProject shouldWatchFiles -> do - getCodebaseOrExit mCodePathOption (SC.MigrateAfterPrompt SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do - withRuntimes nrtp RTI.Persistent \(runtime, sbRuntime, nRuntime) -> do - startingProjectPath <- do - -- If the user didn't provide a starting path on the command line, put them in the most recent - -- path they cd'd to - case mayStartingProject of - Just startingProject -> do - Codebase.runTransaction theCodebase (ProjectUtils.getProjectAndBranchByNames startingProject) >>= \case - Nothing -> do - PT.putPrettyLn $ - P.callout - "❓" - ( P.lines - [ P.indentN 2 "I couldn't find the project branch: " <> P.text (into @Text startingProject) - ] - ) - System.exitFailure - Just pab -> do - pure $ PP.fromProjectAndBranch pab Path.absoluteEmpty - Nothing -> do - Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath - currentPP <- Codebase.runTransaction theCodebase do - PP.toIds <$> Codebase.expectCurrentProjectPath - changeSignal <- Signal.newSignalIO (Just currentPP) - let lspCheckForChanges pp = Signal.writeSignalIO changeSignal pp - -- Unfortunately, the windows IO manager on GHC 8.* is prone to just hanging forever - -- when waiting for input on handles, so if we listen for LSP connections it will - -- prevent UCM from shutting down properly. Hopefully we can re-enable LSP on - -- Windows when we move to GHC 9.* - -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/1224 - void . Ki.fork scope $ LSP.spawnLsp lspFormattingConfig theCodebase runtime changeSignal - Server.startServer (Backend.BackendEnv {Backend.useNamesIndex = False}) codebaseServerOpts sbRuntime theCodebase $ \baseUrl -> do - case exitOption of - DoNotExit -> do - case isHeadless of - Headless -> do - PT.putPrettyLn $ - P.lines - [ "I've started the Codebase API server at", - P.text $ Server.urlFor Server.Api baseUrl, - "and the Codebase UI at", - P.text $ Server.urlFor (Server.ProjectBranchUI (ProjectAndBranch (UnsafeProjectName "scratch") (UnsafeProjectBranchName "main")) Path.absoluteEmpty Nothing) baseUrl - ] - PT.putPrettyLn $ - P.string "Running the codebase manager headless with " - <> P.shown GHC.Conc.numCapabilities - <> " " - <> plural' GHC.Conc.numCapabilities "cpu" "cpus" - <> "." - mvar <- newEmptyMVar - takeMVar mvar - WithCLI -> do - PT.putPrettyLn $ P.string "Now starting the Unison Codebase Manager (UCM)..." - - launch - version - currentDir - config - runtime - sbRuntime - nRuntime - theCodebase - [] - (Just baseUrl) - (PP.toIds startingProjectPath) - initRes - lspCheckForChanges - shouldWatchFiles - Exit -> do Exit.exitSuccess + lspCheckForChanges + shouldWatchFiles + Exit -> do Exit.exitSuccess where -- (runtime, sandboxed runtime) withRuntimes :: FilePath -> RTI.RuntimeHost -> (Runtimes -> IO a) -> IO a @@ -366,17 +358,6 @@ main version = do action . (runtime,sbRuntime,) -- startNativeRuntime saves the path to `unison-runtime` =<< RTI.startNativeRuntime (Version.gitDescribeWithDate version) nrtp - withConfig :: Maybe CodebasePathOption -> (Config -> IO a) -> IO a - withConfig mCodePathOption action = do - UnliftIO.bracket - ( do - let mcodepath = fmap codebasePathOptionToPath mCodePathOption - configFilePath <- getConfigFilePath mcodepath - catchIOError (watchConfig configFilePath) $ \_ -> - exitError "Your .unisonConfig could not be loaded. Check that it's correct!" - ) - (\(_config, cancel) -> cancel) - (\(config, _cancel) -> action config) -- | Set user agent and configure TLS on global http client. -- Note that the authorized http client is distinct from the global http client. @@ -416,14 +397,12 @@ prepareTranscriptDir verbosity shouldFork mCodePathOption shouldSaveCodebase = d runTranscripts' :: Version -> String -> - Maybe FilePath -> FilePath -> FilePath -> NonEmpty MarkdownFile -> IO Bool -runTranscripts' version progName mcodepath nativeRtp transcriptDir markdownFiles = do +runTranscripts' version progName nativeRtp transcriptDir markdownFiles = do currentDir <- getCurrentDirectory - configFilePath <- getConfigFilePath mcodepath -- We don't need to create a codebase through `getCodebaseOrExit` as we've already done so previously. and <$> getCodebaseOrExit @@ -436,7 +415,6 @@ runTranscripts' version progName mcodepath nativeRtp transcriptDir markdownFiles Verbosity.Verbose (Version.gitDescribeWithDate version) nativeRtp - (Just configFilePath) \runTranscript -> do for markdownFiles $ \(MarkdownFile fileName) -> do transcriptSrc <- readUtf8 fileName @@ -503,7 +481,7 @@ runTranscripts version verbosity renderUsageInfo shouldFork shouldSaveTempCodeba progName <- getProgName transcriptDir <- prepareTranscriptDir verbosity shouldFork mCodePathOption shouldSaveTempCodebase completed <- - runTranscripts' version progName (Just transcriptDir) nativeRtp transcriptDir markdownFiles + runTranscripts' version progName nativeRtp transcriptDir markdownFiles case shouldSaveTempCodebase of DontSaveCodebase -> removeDirectoryRecursive transcriptDir SaveCodebase _ -> @@ -527,7 +505,6 @@ runTranscripts version verbosity renderUsageInfo shouldFork shouldSaveTempCodeba launch :: Version -> FilePath -> - Config -> Rt.Runtime Symbol -> Rt.Runtime Symbol -> Rt.Runtime Symbol -> @@ -539,7 +516,7 @@ launch :: (PP.ProjectPathIds -> IO ()) -> CommandLine.ShouldWatchFiles -> IO () -launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseUrl startingPath initResult lspCheckForChanges shouldWatchFiles = do +launch version dir runtime sbRuntime nRuntime codebase inputs serverBaseUrl startingPath initResult lspCheckForChanges shouldWatchFiles = do showWelcomeHint <- Codebase.runTransaction codebase Queries.doProjectsExist let isNewCodebase = case initResult of CreatedCodebase -> NewlyCreatedCodebase @@ -550,7 +527,6 @@ launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseU dir welcome startingPath - config inputs runtime sbRuntime @@ -572,9 +548,6 @@ markdownFile md = case takeExtension md of isDotU :: String -> Bool isDotU file = takeExtension file == ".u" -getConfigFilePath :: Maybe FilePath -> IO FilePath -getConfigFilePath mcodepath = ( ".unisonConfig") <$> Codebase.getCodebaseDir mcodepath - getCodebaseOrExit :: Maybe CodebasePathOption -> SC.MigrationStrategy -> ((InitResult, CodebasePath, Codebase IO Symbol Ann) -> IO r) -> IO r getCodebaseOrExit codebasePathOption migrationStrategy action = do initOptions <- argsToCodebaseInitOptions codebasePathOption diff --git a/unison-cli/tests/Unison/Test/Ucm.hs b/unison-cli/tests/Unison/Test/Ucm.hs index 1a8033c52b..c0d2cb0977 100644 --- a/unison-cli/tests/Unison/Test/Ucm.hs +++ b/unison-cli/tests/Unison/Test/Ucm.hs @@ -67,7 +67,7 @@ runTranscript (Codebase codebasePath fmt) transcript = do let err e = fail $ "Parse error: \n" <> show e cbInit = case fmt of CodebaseFormat2 -> SC.init isTest = True - Transcript.withRunner isTest Verbosity.Silent "Unison.Test.Ucm.runTranscript Invalid Version String" rtp configFile $ + Transcript.withRunner isTest Verbosity.Silent "Unison.Test.Ucm.runTranscript Invalid Version String" rtp $ \runner -> do result <- Codebase.Init.withOpenCodebase cbInit "transcript" codebasePath SC.DoLock SC.DontMigrate \codebase -> do Codebase.runTransaction codebase (Codebase.installUcmDependencies codebase) @@ -77,7 +77,6 @@ runTranscript (Codebase codebasePath fmt) transcript = do pure output either (fail . P.toANSI 80 . P.shown) pure result where - configFile = Nothing -- Note: this needs to be properly configured if these tests ever -- need to do native compiles. But I suspect they won't. rtp = "native-compiler/bin" diff --git a/unison-cli/transcripts/Transcripts.hs b/unison-cli/transcripts/Transcripts.hs index 77220a3061..2b7d7677d0 100644 --- a/unison-cli/transcripts/Transcripts.hs +++ b/unison-cli/transcripts/Transcripts.hs @@ -49,7 +49,7 @@ testBuilder :: testBuilder expectFailure recordFailure runtimePath dir prelude transcript = scope transcript $ do outputs <- io . withTemporaryUcmCodebase SC.init Verbosity.Silent "transcript" SC.DoLock $ \(codebasePath, codebase) -> do let isTest = True - Transcript.withRunner isTest Verbosity.Silent "TODO: pass version here" runtimePath Nothing \runTranscript -> do + Transcript.withRunner isTest Verbosity.Silent "TODO: pass version here" runtimePath \runTranscript -> do for files \filePath -> do transcriptSrc <- readUtf8 filePath out <- silence $ runTranscript filePath transcriptSrc (codebasePath, codebase) diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 6a3df61e73..a12b033231 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -205,7 +205,6 @@ library , co-log-core , code-page , concurrent-output - , configurator , containers >=0.6.3 , cryptonite , directory @@ -347,7 +346,6 @@ executable transcripts , co-log-core , code-page , concurrent-output - , configurator , containers >=0.6.3 , cryptonite , directory @@ -496,7 +494,6 @@ test-suite cli-tests , co-log-core , code-page , concurrent-output - , configurator , containers >=0.6.3 , cryptonite , directory